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