diff options
| author |  Alexander Foremny <aforemny@posteo.de> | 2023-10-14 12:20:36 +0200 |
|---|---|---|
| committer | Alexander Foremny <aforemny@posteo.de> | 2023-10-14 12:25:50 +0200 |
| commit | 5fea8f22f379713f0af748eb04a957ff6a9d6bfa (patch) | |
| tree | 9717ef19ef6b7701b0ebda1cb65d91db53c8c48f | |
| parent | 306587efadccf3d02c4b43efc30610ddf2697663 (diff) | |
utilize all processors
| -rw-r--r-- | anissue.cabal | 6 | ||||
| -rw-r--r-- | app/History.hs | 3 | ||||
| -rw-r--r-- | app/Parallel.hs | 9 |
3 files changed, 15 insertions, 3 deletions
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) |