From ce89169795f4355acde6d3f468ce9173add52b59 Mon Sep 17 00:00:00 2001
From: Malo Bourgon <mbourgon@gmail.com>
Date: Wed, 28 Jun 2023 11:36:22 -0700
Subject: [PATCH] Limit number of concurrent threads to avoid running out of
 file descriptors

---
 package.yaml      |  1 +
 prefmanager.cabal |  5 +++--
 src/Defaults.hs   | 10 ++++++++--
 stack.yaml        |  2 +-
 4 files changed, 13 insertions(+), 5 deletions(-)

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