aboutsummaryrefslogtreecommitdiffstats
path: root/app
diff options
context:
space:
mode:
Diffstat (limited to 'app')
-rw-r--r--app/History.hs3
-rw-r--r--app/Parallel.hs9
2 files changed, 11 insertions, 1 deletions
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)