1
0
Fork 0
mirror of https://github.com/malob/prefmanager.git synced 2024-12-14 11:57:49 +00:00

Limit number of concurrent threads to avoid running out of file descriptors

This commit is contained in:
Malo Bourgon 2023-06-28 11:36:22 -07:00
parent 7626b247fd
commit ce89169795
4 changed files with 13 additions and 5 deletions

View file

@ -22,6 +22,7 @@ library:
- relude - relude
- ansi-terminal - ansi-terminal
- async - async
- async-pool
- containers - containers
- hxt - hxt
- patience - patience

View file

@ -1,10 +1,10 @@
cabal-version: 1.12 cabal-version: 1.12
-- This file has been generated from package.yaml by hpack version 0.34.3. -- This file has been generated from package.yaml by hpack version 0.35.2.
-- --
-- see: https://github.com/sol/hpack -- see: https://github.com/sol/hpack
-- --
-- hash: f6c3525e0baa5d12b8726a3fb2e8555c5e71a4604b8cccf146af041be3186c93 -- hash: 4bc817bf57fae042a1b016e58f5362763ec47db040b12f0912db03d7ad80580f
name: prefmanager name: prefmanager
version: 0.1.0.0 version: 0.1.0.0
@ -39,6 +39,7 @@ library
build-depends: build-depends:
ansi-terminal ansi-terminal
, async , async
, async-pool
, base-noprelude , base-noprelude
, containers , containers
, hxt , hxt

View file

@ -9,6 +9,7 @@ import Defaults.Types (DomainDiff(..), Domains(..), Domain(..), DomainName(..),
import Relude.Extra (un, wrap, traverseToSnd, keys) import Relude.Extra (un, wrap, traverseToSnd, keys)
import Control.Concurrent.Async (mapConcurrently) import Control.Concurrent.Async (mapConcurrently)
import Control.Concurrent.Async.Pool (withTaskGroup, async, wait)
import Data.List (delete) import Data.List (delete)
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import Data.Text (stripEnd, splitOn) import Data.Text (stripEnd, splitOn)
@ -46,9 +47,14 @@ export d
. fromPlDict . fromPlDict
<$> (defaultsCmd ("export '" <> un d <> "' -") >>= parsePlist) <$> (defaultsCmd ("export '" <> un d <> "' -") >>= parsePlist)
-- | Runs 'export' on the 'Set' of provided domains -- | Runs 'export' on the 'Set' of provided domains.
--
-- Uses a thread pool to run the exports in parallel with a limit of 100 threads to ensure we don't
-- run out of file descriptors. This limit is somewhat arbitrary.
exports :: Set DomainName -> IO Domains exports :: Set DomainName -> IO Domains
exports = wrap . fmap (fromList @(Map _ _)) . mapConcurrently (traverseToSnd export) . toList exports ds = withTaskGroup 100 $ \tg -> do
results <- forM (toList ds) $ \d -> async tg $ traverseToSnd export d
wrap . fromList @(Map _ _) <$> mapM wait results
diffDomain :: Domain -> Domain -> DomainDiff diffDomain :: Domain -> Domain -> DomainDiff
diffDomain (Domain old) (Domain new) = wrap $ M.filter (not . isSame) $ diff old new diffDomain (Domain old) (Domain new) = wrap $ M.filter (not . isSame) $ diff old new

View file

@ -11,5 +11,5 @@ extra-deps:
allow-newer: true allow-newer: true
nix: nix:
# pure: true pure: true
shell-file: ./stack.nix shell-file: ./stack.nix