From 5fea8f22f379713f0af748eb04a957ff6a9d6bfa Mon Sep 17 00:00:00 2001
From: Alexander Foremny <aforemny@posteo.de>
Date: Sat, 14 Oct 2023 12:20:36 +0200
Subject: utilize all processors

---
 anissue.cabal   | 6 ++++--
 app/History.hs  | 3 ++-
 app/Parallel.hs | 9 +++++++++
 3 files changed, 15 insertions(+), 3 deletions(-)
 create mode 100644 app/Parallel.hs

diff --git a/anissue.cabal b/anissue.cabal
index 046abb6..3ab0809 100644
--- a/anissue.cabal
+++ b/anissue.cabal
@@ -55,7 +55,7 @@ extra-doc-files:    CHANGELOG.md
 -- extra-source-files:
 
 common warnings
-    ghc-options: -Wall
+    ghc-options: -Wall -threaded
 
 executable anissue
     -- Import common warning flags.
@@ -71,6 +71,7 @@ executable anissue
       Issue.Filter
       Issue.Tag
       Issue.Text
+      Parallel
       Process
       TreeGrepper.FileType
       TreeGrepper.Match
@@ -92,7 +93,8 @@ executable anissue
                       text,
                       temporary,
                       time,
-                      typed-process
+                      typed-process,
+                      parallel-io
 
     -- Directories containing source files.
     hs-source-dirs:   app
diff --git a/app/History.hs b/app/History.hs
index 1604760..b1ccd10 100644
--- a/app/History.hs
+++ b/app/History.hs
@@ -15,6 +15,7 @@ import Data.Text (Text, lines, unpack)
 import Data.Text.Encoding (decodeUtf8)
 import Issue (Issue (..), fromMatch, id)
 import Issue.Filter (Filter, applyFilter)
+import Parallel (parMapM)
 import Process (quote, sh, sh_)
 import System.Directory (createDirectoryIfMissing, doesFileExist, getCurrentDirectory)
 import System.Exit (ExitCode (ExitFailure), exitWith)
@@ -44,7 +45,7 @@ instance Exception InvalidTreeGrepperResult
 listIssues :: [Filter] -> [FilePath] -> IO [Issue]
 listIssues filters files = do
   commits <- fmap (lines . decodeUtf8 . L8.toStrict) $ sh ("git log --format=%H")
-  issueses <- mapM (\commit -> cached commit (\_ -> listIssuesOf commit filters files)) commits
+  issueses <- parMapM (\commit -> cached commit (\_ -> listIssuesOf commit filters files)) commits
   (currentIssues, historicalIssues) <-
     case issueses of
       currentIssues : historicalIssueses ->
diff --git a/app/Parallel.hs b/app/Parallel.hs
new file mode 100644
index 0000000..0b57545
--- /dev/null
+++ b/app/Parallel.hs
@@ -0,0 +1,9 @@
+module Parallel (parMapM) where
+
+import Control.Concurrent.ParallelIO.Local (parallel, withPool)
+import GHC.Conc (getNumProcessors)
+
+parMapM :: (a -> IO b) -> [a] -> IO [b]
+parMapM f xs = do
+  n <- getNumProcessors
+  withPool n $ \pool -> parallel pool (map f xs)
-- 
cgit v1.2.3