diff --git a/package.yaml b/package.yaml index 09639c8..4c34a69 100644 --- a/package.yaml +++ b/package.yaml @@ -22,6 +22,7 @@ library: - relude - ansi-terminal - async + - async-pool - containers - hxt - patience diff --git a/prefmanager.cabal b/prefmanager.cabal index 84af11f..28f4eed 100644 --- a/prefmanager.cabal +++ b/prefmanager.cabal @@ -1,10 +1,10 @@ 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 -- --- hash: f6c3525e0baa5d12b8726a3fb2e8555c5e71a4604b8cccf146af041be3186c93 +-- hash: 4bc817bf57fae042a1b016e58f5362763ec47db040b12f0912db03d7ad80580f name: prefmanager version: 0.1.0.0 @@ -39,6 +39,7 @@ library build-depends: ansi-terminal , async + , async-pool , base-noprelude , containers , hxt diff --git a/src/Defaults.hs b/src/Defaults.hs index 90de244..9815b7f 100644 --- a/src/Defaults.hs +++ b/src/Defaults.hs @@ -9,6 +9,7 @@ import Defaults.Types (DomainDiff(..), Domains(..), Domain(..), DomainName(..), import Relude.Extra (un, wrap, traverseToSnd, keys) import Control.Concurrent.Async (mapConcurrently) +import Control.Concurrent.Async.Pool (withTaskGroup, async, wait) import Data.List (delete) import qualified Data.Map.Strict as M import Data.Text (stripEnd, splitOn) @@ -46,9 +47,14 @@ export d . fromPlDict <$> (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 = 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 old) (Domain new) = wrap $ M.filter (not . isSame) $ diff old new diff --git a/stack.yaml b/stack.yaml index cd1142e..e8c476b 100644 --- a/stack.yaml +++ b/stack.yaml @@ -11,5 +11,5 @@ extra-deps: allow-newer: true nix: - # pure: true + pure: true shell-file: ./stack.nix