diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,17 @@ # Changelog for [hledger-flow](https://github.com/apauley/hledger-flow) +## 0.14.4 + +Add an option to process files in batches. + +If the number of input files processed by `hledger-flow` grows large, and you have resource-intensive processing scripts, your system resources can be overwhelmed. + +With this change the input files will be processed in batches, by default 200 at a time. The batch size can be set from the command-line. + +https://github.com/apauley/hledger-flow/issues/93 + +https://github.com/apauley/hledger-flow/pull/94 + ## 0.14.3 Ensure that generated include files only contain files ending with .journal diff --git a/README.org b/README.org --- a/README.org +++ b/README.org @@ -7,7 +7,7 @@ | TravisCI | CircleCI | |--------------------------------------------------------------+------------------------------------------------------------| -| [[https://travis-ci.org/apauley/hledger-flow][https://travis-ci.org/apauley/hledger-flow.svg?branch=master]] | [[https://circleci.com/gh/apauley/hledger-flow][https://circleci.com/gh/apauley/hledger-flow.svg?style=svg]] | +| [[https://travis-ci.com/apauley/hledger-flow][https://travis-ci.com/apauley/hledger-flow.svg?branch=master]] | [[https://circleci.com/gh/apauley/hledger-flow][https://circleci.com/gh/apauley/hledger-flow.svg?style=svg]] | * What is it? :PROPERTIES: diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -3,28 +3,39 @@ module Main where -import Parsing -import Path +import Parsing ( parseStartYear ) +import Path ( reldir ) + import qualified Turtle hiding (switch) import Prelude hiding (putStrLn) import Options.Applicative + ( auto, + optional, + Alternative(many, (<|>)), + Parser, + flag', + help, + long, + metavar, + option, + short, + str, + switch ) import Hledger.Flow.PathHelpers (TurtlePath) -import Hledger.Flow.Common +import Hledger.Flow.Common ( hledgerInfoFromPath ) import Hledger.Flow.Internals (versionInfo, systemInfo) -import Hledger.Flow.BaseDir +import Hledger.Flow.BaseDir ( determineBaseDir ) import qualified Hledger.Flow.RuntimeOptions as RT -import Hledger.Flow.Reports -import Hledger.Flow.Import.CSVImport +import Hledger.Flow.Reports ( generateReports ) +import Hledger.Flow.Import.CSVImport ( importCSVs ) -import Control.Monad (when) import qualified Data.Text.IO as T data ImportParams = ImportParams { maybeImportBaseDir :: Maybe TurtlePath , importStartYear :: Maybe String , onlyNewFiles :: Bool - , importUseRunDir :: Bool } deriving (Show) newtype ReportParams = ReportParams {maybeReportBaseDir :: Maybe TurtlePath} deriving Show @@ -34,6 +45,7 @@ data MainParams = MainParams { verbosity :: Int , hledgerPathOpt :: Maybe TurtlePath , showOpts :: Bool + , batchSize :: Maybe Int , sequential :: Bool } deriving (Show) data BaseCommand = Version | Command { mainParams :: MainParams, command :: Command } deriving (Show) @@ -42,44 +54,61 @@ main = do cmd <- Turtle.options "An hledger workflow focusing on automated statement import and classification:\nhttps://github.com/apauley/hledger-flow#readme" baseCommandParser case cmd of - Version -> T.putStrLn versionInfo + Version -> do + sysInfo <- systemInfo + T.putStrLn $ versionInfo sysInfo Command mainParams' (Import subParams) -> toRuntimeOptionsImport mainParams' subParams >>= importCSVs Command mainParams' (Report subParams) -> toRuntimeOptionsReport mainParams' subParams >>= generateReports +defaultBatchSize :: Int +defaultBatchSize = 200 + +determineBatchSize :: MainParams -> IO Int +determineBatchSize mainParams' = + case (batchSize mainParams') of + Nothing -> return defaultBatchSize + Just size -> return size + toRuntimeOptionsImport :: MainParams -> ImportParams -> IO RT.RuntimeOptions toRuntimeOptionsImport mainParams' subParams' = do startYear <- parseStartYear $ importStartYear subParams' let maybeBD = maybeImportBaseDir subParams' :: Maybe TurtlePath - Control.Monad.when (importUseRunDir subParams') $ do - T.putStrLn "The enable-future-rundir option is now the default, no need to specify it. This option is currently being ignored and will be removed in future." (bd, runDir) <- determineBaseDir maybeBD hli <- hledgerInfoFromPath $ hledgerPathOpt mainParams' + size <- determineBatchSize mainParams' + sysInfo <- systemInfo return RT.RuntimeOptions { RT.baseDir = bd , RT.importRunDir = runDir , RT.importStartYear = startYear , RT.onlyNewFiles = onlyNewFiles subParams' - , RT.hfVersion = versionInfo + , RT.hfVersion = versionInfo sysInfo , RT.hledgerInfo = hli - , RT.sysInfo = systemInfo + , RT.sysInfo = sysInfo , RT.verbose = verbosity mainParams' > 0 , RT.showOptions = showOpts mainParams' - , RT.sequential = sequential mainParams' } + , RT.sequential = sequential mainParams' + , RT.batchSize = size + } toRuntimeOptionsReport :: MainParams -> ReportParams -> IO RT.RuntimeOptions toRuntimeOptionsReport mainParams' subParams' = do let maybeBD = maybeReportBaseDir subParams' :: Maybe TurtlePath (bd, _) <- determineBaseDir maybeBD hli <- hledgerInfoFromPath $ hledgerPathOpt mainParams' + size <- determineBatchSize mainParams' + sysInfo <- systemInfo return RT.RuntimeOptions { RT.baseDir = bd , RT.importRunDir = [reldir|.|] , RT.importStartYear = Nothing , RT.onlyNewFiles = False - , RT.hfVersion = versionInfo + , RT.hfVersion = versionInfo sysInfo , RT.hledgerInfo = hli - , RT.sysInfo = systemInfo + , RT.sysInfo = sysInfo , RT.verbose = verbosity mainParams' > 0 , RT.showOptions = showOpts mainParams' - , RT.sequential = sequential mainParams' } + , RT.sequential = sequential mainParams' + , RT.batchSize = size + } baseCommandParser :: Parser BaseCommand baseCommandParser = (Command <$> verboseParser <*> commandParser) @@ -94,14 +123,14 @@ <$> (length <$> many (flag' () (long "verbose" <> short 'v' <> help "Print more verbose output"))) <*> optional (Turtle.optPath "hledger-path" 'H' "The full path to an hledger executable") <*> switch (long "show-options" <> help "Print the options this program will run with") + <*> optional (option auto (long "batch-size" <> metavar "SIZE" <> help ("Parallel processing of files are done in batches of the specified size. Default: " <> show defaultBatchSize <> ". Ignored during sequential processing."))) <*> switch (long "sequential" <> help "Disable parallel processing") subcommandParserImport :: Parser ImportParams subcommandParserImport = ImportParams <$> optional (Turtle.argPath "dir" "The directory to import. Use the base directory for a full import or a sub-directory for a partial import. Defaults to the current directory. This behaviour is changing: see --enable-future-rundir") - <*> optional (strOption (long "start-year" <> metavar "YEAR" <> help "Import only from the specified year and onwards, ignoring previous years. By default all available years are imported. Valid values include a 4-digit year or 'current' for the current year")) + <*> optional (option str (long "start-year" <> metavar "YEAR" <> help "Import only from the specified year and onwards, ignoring previous years. By default all available years are imported. Valid values include a 4-digit year or 'current' for the current year")) <*> switch (long "new-files-only" <> help "Don't regenerate transaction files if they are already present. This applies to hledger journal files as well as files produced by the preprocess and construct scripts.") - <*> switch (long "enable-future-rundir" <> help "This switch is currently being ignored, since the behaviour it previously enabled is now the default. It will be removed in future.") subcommandParserReport :: Parser ReportParams subcommandParserReport = ReportParams diff --git a/hledger-flow.cabal b/hledger-flow.cabal --- a/hledger-flow.cabal +++ b/hledger-flow.cabal @@ -1,13 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.33.0. +-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack --- --- hash: 7dede2e183b932b3b9af01bd855ca6725acdbefbc962fee1ed1eb113df327286 name: hledger-flow -version: 0.14.3.0 +version: 0.14.4 synopsis: An hledger workflow focusing on automated statement import and classification. description: Please see the README on GitHub at category: Finance, Console diff --git a/src/Hledger/Flow/Common.hs b/src/Hledger/Flow/Common.hs --- a/src/Hledger/Flow/Common.hs +++ b/src/Hledger/Flow/Common.hs @@ -128,10 +128,17 @@ parAwareProc :: HasSequential o => o -> ProcFun parAwareProc opts = if (sequential opts) then procWithEmptyOutput else Turtle.procStrictWithErr -parAwareActions :: HasSequential o => o -> [IO a] -> IO [a] -parAwareActions opts = parAwareFun opts - where - parAwareFun op = if (sequential op) then sequence else Turtle.single . shellToList . Turtle.parallel +parAwareActions :: (HasSequential o, HasBatchSize o) => o -> [IO a] -> IO [a] +parAwareActions opts = if (sequential opts) then sequence else parBatchedActions (batchSize opts) [] + +parBatchedActions :: Int -> [a] -> [IO a] -> IO [a] +parBatchedActions _ done [] = return done +parBatchedActions batch done todo = do + let doNow = take batch todo + let remaining = drop batch todo + doneNow <- (Turtle.single . shellToList . Turtle.parallel) doNow + parBatchedActions batch (done ++ doneNow) remaining + inprocWithErrFun :: (T.Text -> IO ()) -> ProcInput -> Turtle.Shell Turtle.Line inprocWithErrFun errFun (cmd, args, standardInput) = do diff --git a/src/Hledger/Flow/Internals.hs b/src/Hledger/Flow/Internals.hs --- a/src/Hledger/Flow/Internals.hs +++ b/src/Hledger/Flow/Internals.hs @@ -2,6 +2,7 @@ module Hledger.Flow.Internals where +import GHC.Conc (getNumCapabilities, getNumProcessors) import Development.GitRev import Data.Version (Version, showVersion) import Paths_hledger_flow (version) @@ -13,19 +14,27 @@ , arch :: String , compilerName :: String , compilerVersion :: Version + , cores :: Int + , availableCores :: Int } deriving (Show) -versionInfo :: T.Text -versionInfo = T.pack ("hledger-flow " ++ showVersion version ++ " " ++ - os systemInfo ++ " " ++ arch systemInfo ++ " " ++ - compilerName systemInfo ++ " " ++ - showVersion (compilerVersion systemInfo) ++ +versionInfo :: SystemInfo -> T.Text +versionInfo sysInfo = T.pack ("hledger-flow " ++ showVersion version ++ " " ++ + os sysInfo ++ " " ++ arch sysInfo ++ " " ++ + compilerName sysInfo ++ " " ++ + showVersion (compilerVersion sysInfo) ++ " " ++ $(gitHash)) -systemInfo :: SystemInfo -systemInfo = SystemInfo { os = Sys.os - , arch = Sys.arch - , compilerName = Sys.compilerName - , compilerVersion = Sys.compilerVersion - } +systemInfo :: IO SystemInfo +systemInfo = do + processors <- getNumProcessors + available <- getNumCapabilities + return SystemInfo { + os = Sys.os, + arch = Sys.arch, + compilerName = Sys.compilerName, + compilerVersion = Sys.compilerVersion, + cores = processors, + availableCores = available + } diff --git a/src/Hledger/Flow/RuntimeOptions.hs b/src/Hledger/Flow/RuntimeOptions.hs --- a/src/Hledger/Flow/RuntimeOptions.hs +++ b/src/Hledger/Flow/RuntimeOptions.hs @@ -16,17 +16,21 @@ , verbose :: Bool , showOptions :: Bool , sequential :: Bool + , batchSize :: Int } deriving (Show) instance HasVerbosity RuntimeOptions where - verbose (RuntimeOptions _ _ _ _ _ _ _ v _ _) = v + verbose (RuntimeOptions _ _ _ _ _ _ _ v _ _ _) = v instance HasSequential RuntimeOptions where - sequential (RuntimeOptions _ _ _ _ _ _ _ _ _ sq) = sq + sequential (RuntimeOptions _ _ _ _ _ _ _ _ _ sq _) = sq +instance HasBatchSize RuntimeOptions where + batchSize (RuntimeOptions _ _ _ _ _ _ _ _ _ _ bs) = bs + instance HasBaseDir RuntimeOptions where - baseDir (RuntimeOptions bd _ _ _ _ _ _ _ _ _) = bd + baseDir (RuntimeOptions bd _ _ _ _ _ _ _ _ _ _) = bd instance HasRunDir RuntimeOptions where - importRunDir (RuntimeOptions _ rd _ _ _ _ _ _ _ _) = rd + importRunDir (RuntimeOptions _ rd _ _ _ _ _ _ _ _ _) = rd diff --git a/src/Hledger/Flow/Types.hs b/src/Hledger/Flow/Types.hs --- a/src/Hledger/Flow/Types.hs +++ b/src/Hledger/Flow/Types.hs @@ -33,3 +33,6 @@ class HasSequential a where sequential :: a -> Bool + +class HasBatchSize a where + batchSize :: a -> Int diff --git a/test/TestHelpers.hs b/test/TestHelpers.hs --- a/test/TestHelpers.hs +++ b/test/TestHelpers.hs @@ -7,27 +7,39 @@ import Data.Maybe (fromMaybe) -import Hledger.Flow.Internals (versionInfo, systemInfo) +import Hledger.Flow.Internals ( versionInfo, SystemInfo(..) ) import Hledger.Flow.PathHelpers (RelFile) import qualified Hledger.Flow.Types as FlowTypes import Hledger.Flow.RuntimeOptions +import qualified System.Info as Sys defaultHlInfo :: FlowTypes.HledgerInfo defaultHlInfo = FlowTypes.HledgerInfo [absfile|/path/to/hledger|] "1.2.3" +testSystemInfo :: SystemInfo +testSystemInfo = SystemInfo { + os = Sys.os, + arch = Sys.arch, + compilerName = Sys.compilerName, + compilerVersion = Sys.compilerVersion, + cores = 1, + availableCores = 1 + } + defaultOpts :: FlowTypes.BaseDir -> RuntimeOptions defaultOpts bd = RuntimeOptions { baseDir = bd , importRunDir = [reldir|./|] , importStartYear = Nothing , onlyNewFiles = False - , hfVersion = versionInfo + , hfVersion = versionInfo testSystemInfo , hledgerInfo = defaultHlInfo - , sysInfo = systemInfo + , sysInfo = testSystemInfo , verbose = False , showOptions = False , sequential = False + , batchSize = 1 } toJournal :: RelFile -> RelFile