diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,13 @@ # Changelog for [hledger-flow](https://github.com/apauley/hledger-flow) +## 0.12.2 + +Slightly smarter reporting. + +- Get the available report years for each individual owner. Only generate reports for those years. +- Create uniform output directories. +- Add system info to version output + ## 0.12.1 Generate some reports per owner. diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -37,7 +37,9 @@ bd <- determineBaseDir $ maybeBaseDir subParams' hli <- hledgerInfoFromPath $ hledgerPathOpt mainParams' return IT.ImportOptions { IT.baseDir = bd + , IT.hfVersion = versionInfo' , IT.hledgerInfo = hli + , IT.sysInfo = systemInfo , IT.verbose = verbose mainParams' , IT.showOptions = showOpts mainParams' , IT.sequential = sequential mainParams' } @@ -47,7 +49,9 @@ bd <- determineBaseDir $ maybeBaseDir subParams' hli <- hledgerInfoFromPath $ hledgerPathOpt mainParams' return RT.ReportOptions { RT.baseDir = bd + , RT.hfVersion = versionInfo' , RT.hledgerInfo = hli + , RT.sysInfo = systemInfo , RT.verbose = verbose mainParams' , RT.showOptions = showOpts mainParams' , RT.sequential = sequential mainParams' } diff --git a/hledger-flow.cabal b/hledger-flow.cabal --- a/hledger-flow.cabal +++ b/hledger-flow.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 1b3a9804ade02ced0d603a43f2e702e5316ee719a6fdb2c17806fddaa6409172 +-- hash: d862de8e7e5f00798b64b8fbcd2f5f12462f7d8379703e79e9f010844b50280f name: hledger-flow -version: 0.12.1.0 +version: 0.12.2.0 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/CSVImport.hs b/src/Hledger/Flow/CSVImport.hs --- a/src/Hledger/Flow/CSVImport.hs +++ b/src/Hledger/Flow/CSVImport.hs @@ -47,7 +47,7 @@ do channelOutLn ch $ format ("Found "%d%" input files in "%s%". Proceeding with import...") fileCount (repr diff) let actions = map (extractAndImport opts ch) inputFiles :: [IO FilePath] - importedJournals <- if (sequential opts) then sequence actions else single . shellToList $ parallel actions + importedJournals <- parAwareActions opts actions sh $ writeIncludesUpTo opts ch "import" importedJournals return importedJournals 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 @@ -27,12 +27,26 @@ import qualified Data.List.NonEmpty as NE import Paths_hledger_flow (version) import qualified Data.Version as Version (showVersion) +import qualified System.Info as Sys type InputFileBundle = Map.Map FilePath [FilePath] versionInfo :: NE.NonEmpty Line -versionInfo = textToLines $ T.pack ("hledger-flow " ++ Version.showVersion version) +versionInfo = textToLines versionInfo' +versionInfo' :: Text +versionInfo' = T.pack ("hledger-flow " ++ Version.showVersion version ++ " " ++ + os systemInfo ++ " " ++ arch systemInfo ++ " " ++ + compilerName systemInfo ++ " " ++ + Version.showVersion (compilerVersion systemInfo)) + +systemInfo :: SystemInfo +systemInfo = SystemInfo { os = Sys.os + , arch = Sys.arch + , compilerName = Sys.compilerName + , compilerVersion = Sys.compilerVersion + } + hledgerPathFromOption :: Maybe FilePath -> IO FilePath hledgerPathFromOption pathOption = do case pathOption of @@ -169,6 +183,11 @@ parAwareProc :: HasSequential o => o -> ProcFun parAwareProc opts = if (sequential opts) then procWithEmptyOutput else procStrictWithErr + +parAwareActions :: HasSequential o => o -> [IO a] -> IO [a] +parAwareActions opts = parAwareFun opts + where + parAwareFun op = if (sequential op) then sequence else single . shellToList . parallel inprocWithErrFun :: (Text -> IO ()) -> ProcInput -> Shell Line inprocWithErrFun errFun (cmd, args, standardInput) = do diff --git a/src/Hledger/Flow/Import/Types.hs b/src/Hledger/Flow/Import/Types.hs --- a/src/Hledger/Flow/Import/Types.hs +++ b/src/Hledger/Flow/Import/Types.hs @@ -6,20 +6,22 @@ import Hledger.Flow.Types data ImportOptions = ImportOptions { baseDir :: FilePath + , hfVersion :: Text , hledgerInfo :: HledgerInfo + , sysInfo :: SystemInfo , verbose :: Bool , showOptions :: Bool , sequential :: Bool } deriving (Show) instance HasVerbosity ImportOptions where - verbose (ImportOptions _ _ v _ _) = v + verbose (ImportOptions _ _ _ _ v _ _) = v instance HasSequential ImportOptions where - sequential (ImportOptions _ _ _ _ sq) = sq + sequential (ImportOptions _ _ _ _ _ _ sq) = sq instance HasBaseDir ImportOptions where - baseDir (ImportOptions bd _ _ _ _) = bd + baseDir (ImportOptions bd _ _ _ _ _ _) = bd data ImportDirs = ImportDirs { importDir :: FilePath , ownerDir :: FilePath diff --git a/src/Hledger/Flow/Report/Types.hs b/src/Hledger/Flow/Report/Types.hs --- a/src/Hledger/Flow/Report/Types.hs +++ b/src/Hledger/Flow/Report/Types.hs @@ -6,7 +6,9 @@ import Hledger.Flow.Types data ReportOptions = ReportOptions { baseDir :: FilePath + , hfVersion :: Text , hledgerInfo :: HledgerInfo + , sysInfo :: SystemInfo , verbose :: Bool , showOptions :: Bool , sequential :: Bool @@ -14,10 +16,10 @@ deriving (Show) instance HasVerbosity ReportOptions where - verbose (ReportOptions _ _ v _ _) = v + verbose (ReportOptions _ _ _ _ v _ _) = v instance HasSequential ReportOptions where - sequential (ReportOptions _ _ _ _ sq) = sq + sequential (ReportOptions _ _ _ _ _ _ sq) = sq instance HasBaseDir ReportOptions where - baseDir (ReportOptions bd _ _ _ _) = bd + baseDir (ReportOptions bd _ _ _ _ _ _) = bd diff --git a/src/Hledger/Flow/Reports.hs b/src/Hledger/Flow/Reports.hs --- a/src/Hledger/Flow/Reports.hs +++ b/src/Hledger/Flow/Reports.hs @@ -15,6 +15,12 @@ import qualified Hledger.Flow.Types as FlowTypes import qualified Data.List as List +data ReportParams = ReportParams { ledgerFile :: FilePath + , reportYears :: [Integer] + , outputDir :: FilePath + } + deriving (Show) + generateReports :: ReportOptions -> IO () generateReports opts = sh ( do @@ -38,21 +44,23 @@ channelOutLn ch wipMsg owners <- single $ shellToList $ listOwners opts let baseJournal = journalFile opts [] - let baseReportDir = outputDir opts [] - years <- includeYears ch baseJournal - let reportParams = [(baseJournal, baseReportDir)] ++ map (ownerParams opts) owners - let actions = List.concat $ fmap (generateReports'' opts ch years) reportParams - if (sequential opts) then sequence actions else single $ shellToList $ parallel actions + let baseReportDir = outputReportDir opts ["all"] + baseYears <- includeYears ch baseJournal + let baseParams = if length owners > 1 then [(ReportParams baseJournal baseYears baseReportDir)] else [] + ownerParams <- ownerParameters opts ch owners + let reportParams = baseParams ++ ownerParams + let actions = List.concat $ fmap (generateReports'' opts ch) reportParams + parAwareActions opts actions -generateReports'' :: ReportOptions -> TChan FlowTypes.LogMessage -> [Integer] -> (FilePath, FilePath) -> [IO (Either FilePath FilePath)] -generateReports'' opts ch years (journal, reportsDir) = do +generateReports'' :: ReportOptions -> TChan FlowTypes.LogMessage -> ReportParams -> [IO (Either FilePath FilePath)] +generateReports'' opts ch (ReportParams journal years reportsDir) = do y <- years let actions = map (\r -> r opts ch journal reportsDir y) [accountList, incomeStatement] map (fmap fst) actions incomeStatement :: ReportOptions -> TChan FlowTypes.LogMessage -> FilePath -> FilePath -> Integer -> IO (Either FilePath FilePath, FlowTypes.FullTimedOutput) incomeStatement opts ch journal reportsDir year = do - let sharedOptions = ["--depth", "2", "--pretty-tables", "not:equity"] + let sharedOptions = ["--depth", "2", "--pretty-tables", "not:equity", "--cost", "--value"] let reportArgs = ["incomestatement"] ++ sharedOptions generateReport opts ch journal reportsDir year ("income-expenses" <.> "txt") reportArgs @@ -76,7 +84,7 @@ then do writeTextFile outputFile (cmdLabel <> "\n\n"<> stdOut) - channelOutLn ch $ format ("Wrote "%fp) $ relativeToBase opts outputFile + logVerbose opts ch $ format ("Wrote "%fp) $ relativeToBase opts outputFile return (Right outputFile, result) else do @@ -86,8 +94,16 @@ journalFile :: ReportOptions -> [FilePath] -> FilePath journalFile opts dirs = (foldl () (baseDir opts) dirs) "all-years" <.> "journal" -outputDir :: ReportOptions -> [FilePath] -> FilePath -outputDir opts dirs = foldl () (baseDir opts) ("reports":dirs) +outputReportDir :: ReportOptions -> [FilePath] -> FilePath +outputReportDir opts dirs = foldl () (baseDir opts) ("reports":dirs) -ownerParams :: ReportOptions -> FilePath -> (FilePath, FilePath) -ownerParams opts owner = (journalFile opts ["import", owner], outputDir opts [owner]) +ownerParameters :: ReportOptions -> TChan FlowTypes.LogMessage -> [FilePath] -> IO [ReportParams] +ownerParameters opts ch owners = do + let actions = map (ownerParameters' opts ch) owners + parAwareActions opts actions + +ownerParameters' :: ReportOptions -> TChan FlowTypes.LogMessage -> FilePath -> IO ReportParams +ownerParameters' opts ch owner = do + let ownerJournal = journalFile opts ["import", owner] + years <- includeYears ch ownerJournal + return $ ReportParams ownerJournal years (outputReportDir opts [owner]) 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 @@ -6,6 +6,7 @@ import Turtle import Prelude hiding (FilePath, putStrLn) +import Data.Version data LogMessage = StdOut Text | StdErr Text | Terminate deriving (Show) type FullOutput = (ExitCode, Text, Text) @@ -18,6 +19,13 @@ , hlVersion :: Text } deriving (Show) + +data SystemInfo = SystemInfo { os :: String + , arch :: String + , compilerName :: String + , compilerVersion :: Version + } + deriving (Show) class HasVerbosity a where verbose :: a -> Bool diff --git a/test/TestHelpers.hs b/test/TestHelpers.hs --- a/test/TestHelpers.hs +++ b/test/TestHelpers.hs @@ -49,7 +49,7 @@ defaultHlInfo = FlowTypes.HledgerInfo "/path/to/hledger" "1.2.3" defaultOpts :: FilePath -> ImportOptions -defaultOpts bd = ImportOptions bd defaultHlInfo False False False +defaultOpts bd = ImportOptions bd versionInfo' defaultHlInfo systemInfo False False False toJournals :: [FilePath] -> [FilePath] toJournals = map (changePathAndExtension "3-journal" "journal")