1{- git-annex concurrency utilities 2 - 3 - Copyright 2020 Joey Hess <id@joeyh.name> 4 - 5 - Licensed under the GNU AGPL version 3 or higher. 6 -} 7 8module Annex.Concurrent.Utility where 9 10import Annex 11import Types.Concurrency 12 13import GHC.Conc 14 15getConcurrency :: Annex Concurrency 16getConcurrency = getConcurrency' <$> getState concurrency 17 18getConcurrency' :: ConcurrencySetting -> Concurrency 19getConcurrency' (ConcurrencyCmdLine c) = c 20getConcurrency' (ConcurrencyGitConfig c) = c 21 22{- Honor the requested level of concurrency, but only up to the number of 23 - CPU cores. Useful for things that are known to be CPU bound. -} 24concurrencyUpToCpus :: Concurrency -> IO Int 25concurrencyUpToCpus c = do 26 let cn = case c of 27 Concurrent n -> n 28 NonConcurrent -> 1 29 ConcurrentPerCpu -> 1 30 pn <- getNumProcessors 31 return (min cn pn) 32