packages feed

hledger-flow 0.11.1.1 → 0.11.1.2

raw patch · 10 files changed

+180/−84 lines, 10 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- Hledger.Flow.Common: logVerboseTime :: (HasVerbosity o, HasExitCode a) => o -> TChan LogMessage -> Text -> IO a -> IO (a, NominalDiffTime)
- Hledger.Flow.Types: class HasExitCode a
- Hledger.Flow.Types: exitCode :: HasExitCode a => a -> ExitCode
- Hledger.Flow.Types: instance Hledger.Flow.Types.HasExitCode GHC.IO.Exception.ExitCode
- Hledger.Flow.Types: instance Hledger.Flow.Types.HasExitCode Hledger.Flow.Types.FullOutput
+ Hledger.Flow.Common: channelErrLn :: TChan LogMessage -> Text -> IO ()
+ Hledger.Flow.Common: channelOutLn :: TChan LogMessage -> Text -> IO ()
+ Hledger.Flow.Common: hledgerInfoFromPath :: Maybe FilePath -> IO HledgerInfo
+ Hledger.Flow.Common: hledgerPathFromOption :: Maybe FilePath -> IO FilePath
+ Hledger.Flow.Common: hledgerVersionFromPath :: FilePath -> IO Text
+ Hledger.Flow.Common: parAwareProc :: (HasSequential o, MonadIO io) => o -> Text -> [Text] -> Shell Line -> io FullOutput
+ Hledger.Flow.Common: timeAndExitOnErr :: HasVerbosity o => o -> TChan LogMessage -> Text -> IO FullOutput -> IO FullTimedOutput
+ Hledger.Flow.Import.Types: [hledgerInfo] :: ImportOptions -> HledgerInfo
+ Hledger.Flow.Import.Types: instance Hledger.Flow.Types.HasSequential Hledger.Flow.Import.Types.ImportOptions
+ Hledger.Flow.Report.Types: [hledgerInfo] :: ReportOptions -> HledgerInfo
+ Hledger.Flow.Report.Types: instance Hledger.Flow.Types.HasSequential Hledger.Flow.Report.Types.ReportOptions
+ Hledger.Flow.Types: HledgerInfo :: FilePath -> Text -> HledgerInfo
+ Hledger.Flow.Types: [hlPath] :: HledgerInfo -> FilePath
+ Hledger.Flow.Types: [hlVersion] :: HledgerInfo -> Text
+ Hledger.Flow.Types: class HasSequential a
+ Hledger.Flow.Types: data HledgerInfo
+ Hledger.Flow.Types: instance GHC.Show.Show Hledger.Flow.Types.HledgerInfo
+ Hledger.Flow.Types: sequential :: HasSequential a => a -> Bool
- Hledger.Flow.Import.Types: ImportOptions :: FilePath -> Bool -> Bool -> Bool -> ImportOptions
+ Hledger.Flow.Import.Types: ImportOptions :: FilePath -> HledgerInfo -> Bool -> Bool -> Bool -> ImportOptions
- Hledger.Flow.Report.Types: ReportOptions :: FilePath -> Bool -> Bool -> Bool -> ReportOptions
+ Hledger.Flow.Report.Types: ReportOptions :: FilePath -> HledgerInfo -> Bool -> Bool -> Bool -> ReportOptions

Files

ChangeLog.md view
@@ -1,5 +1,12 @@ # Changelog for [hledger-flow](https://github.com/apauley/hledger-flow) +## 0.11.1.2++- Exit with an error code when any external script fails - https://github.com/apauley/hledger-flow/issues/28+- Capture external process output when doing parallel processing, in order to better prevent mangled concurrent output.+- Allow users to specify a path to an hledger executable+- Display a user-friendly error message if hledger cannot be found - https://github.com/apauley/hledger-flow/issues/22+ ## 0.11.1.1  - Support input files from the year 2011 - https://github.com/apauley/hledger-flow/issues/27
app/Main.hs view
@@ -14,7 +14,13 @@ import Hledger.Flow.Reports import Hledger.Flow.CSVImport -type SubcommandParams = (Maybe FilePath, Bool, Bool, Bool)+data SubcommandParams = SubcommandParams { maybeBaseDir :: Maybe FilePath+                                         , hledgerPathOpt :: Maybe FilePath+                                         , verbose :: Bool+                                         , showOpts :: Bool+                                         , sequential :: Bool+                                         }+                      deriving (Show) data Command = Version (Maybe Text) | Import SubcommandParams | Report SubcommandParams deriving (Show)  main :: IO ()@@ -26,20 +32,24 @@     Report subParams -> toReportOptions subParams >>= generateReports  toImportOptions :: SubcommandParams -> IO IT.ImportOptions-toImportOptions (maybeBaseDir, verbose, showOpts, sequential) = do-  bd <- dirOrPwd maybeBaseDir+toImportOptions params = do+  bd <- dirOrPwd $ maybeBaseDir params+  hli <- hledgerInfoFromPath $ hledgerPathOpt params   return IT.ImportOptions { IT.baseDir = bd-                          , IT.verbose = verbose-                          , IT.showOptions = showOpts-                          , IT.sequential = sequential }+                          , IT.hledgerInfo = hli+                          , IT.verbose = verbose params+                          , IT.showOptions = showOpts params+                          , IT.sequential = sequential params }  toReportOptions :: SubcommandParams -> IO RT.ReportOptions-toReportOptions (maybeBaseDir, verbose, showOpts, sequential) = do-  bd <- dirOrPwd maybeBaseDir+toReportOptions params = do+  bd <- dirOrPwd $ maybeBaseDir params+  hli <- hledgerInfoFromPath $ hledgerPathOpt params   return RT.ReportOptions { RT.baseDir = bd-                          , RT.verbose = verbose-                          , RT.showOptions = showOpts-                          , RT.sequential = sequential }+                          , RT.hledgerInfo = hli+                          , RT.verbose = verbose params+                          , RT.showOptions = showOpts params+                          , RT.sequential = sequential params }  parser :: Parser Command parser = fmap Import (subcommand "import" "Converts CSV transactions into categorised journal files" subcommandParser)@@ -47,8 +57,9 @@   <|> fmap Version (subcommand "version" "Display version information" noArgs)  subcommandParser :: Parser SubcommandParams-subcommandParser = (,,,)+subcommandParser = SubcommandParams   <$> optional (argPath "basedir" "The hledger-flow base directory")+  <*> optional (optPath "hledger-path" 'H' "The full path to an hledger executable")   <*> switch (long "verbose" <> short 'v' <> help "Print more verbose output")   <*> switch (long "show-options" <> help "Print the options this program will run with")   <*> switch (long "sequential" <> help "Disable parallel processing")
hledger-flow.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: f8d8a671bb403b7d049e7310c834a0396e836ca37eb0c7717ccb48a15691213d+-- hash: 752e52ff23c6e0069c279dc21baa46e6c8b0b20124b506e7bdca5d52136bb483  name:           hledger-flow-version:        0.11.1.1+version:        0.11.1.2 synopsis:       An hledger workflow focusing on automated statement import and classification. description:    Please see the README on GitHub at <https://github.com/apauley/hledger-flow#readme> category:       Finance, Console
src/Hledger/Flow/CSVImport.hs view
@@ -4,11 +4,11 @@     ( importCSVs     ) where -import Turtle+import Turtle hiding (stdout, stderr, proc, procStrictWithErr) import Prelude hiding (FilePath, putStrLn, take) import qualified Data.Text as T import qualified Data.List.NonEmpty as NonEmpty-import Hledger.Flow.Types (LogMessage)+import qualified Hledger.Flow.Types as FlowTypes import Hledger.Flow.Import.Types import Hledger.Flow.Common import Control.Concurrent.STM@@ -18,10 +18,10 @@   do     ch <- liftIO newTChanIO     logHandle <- fork $ consoleChannelLoop ch-    liftIO $ if (showOptions opts) then channelOut ch (repr opts) else return ()+    liftIO $ if (showOptions opts) then channelOutLn ch (repr opts) else return ()     liftIO $ logVerbose opts ch "Starting import"     (journals, diff) <- time $ liftIO $ importCSVs' opts ch-    liftIO $ channelOut ch $ format ("Imported "%d%" journals in "%s) (length journals) $ repr diff+    liftIO $ channelOutLn ch $ format ("Imported "%d%" journals in "%s) (length journals) $ repr diff     liftIO $ terminateChannelLoop ch     wait logHandle   )@@ -32,9 +32,9 @@ inputFilePattern :: Pattern Text inputFilePattern = contains (once (oneOf pathSeparators) <> asciiCI "1-in" <> once (oneOf pathSeparators) <> plus digit <> once (oneOf pathSeparators)) -importCSVs' :: ImportOptions -> TChan LogMessage -> IO [FilePath]+importCSVs' :: ImportOptions -> TChan FlowTypes.LogMessage -> IO [FilePath] importCSVs' opts ch = do-  channelOut ch "Collecting input files..."+  channelOutLn ch "Collecting input files..."   (inputFiles, diff) <- time $ single . shellToList . onlyFiles $ find inputFilePattern $ baseDir opts   let fileCount = length inputFiles   if (fileCount == 0) then@@ -45,20 +45,20 @@       errExit 1 ch msg []     else     do-      channelOut ch $ format ("Found "%d%" input files in "%s%". Proceeding with import...") fileCount (repr diff)+      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       sh $ writeIncludesUpTo opts ch "import" importedJournals       return importedJournals -extractAndImport :: ImportOptions -> TChan LogMessage -> FilePath -> IO FilePath+extractAndImport :: ImportOptions -> TChan FlowTypes.LogMessage -> FilePath -> IO FilePath extractAndImport opts ch inputFile = do   case extractImportDirs inputFile of     Right importDirs -> importCSV opts ch importDirs inputFile     Left errorMessage -> do       errExit 1 ch errorMessage inputFile -importCSV :: ImportOptions -> TChan LogMessage -> ImportDirs -> FilePath -> IO FilePath+importCSV :: ImportOptions -> TChan FlowTypes.LogMessage -> ImportDirs -> FilePath -> IO FilePath importCSV opts ch importDirs srcFile = do   let preprocessScript = accountDir importDirs </> "preprocess"   let constructScript = accountDir importDirs </> "construct"@@ -74,33 +74,34 @@   mktree $ directory journalOut   importFun csvFile journalOut -preprocessIfNeeded :: ImportOptions -> TChan LogMessage -> FilePath -> Line -> Line -> Line -> FilePath -> IO FilePath+preprocessIfNeeded :: ImportOptions -> TChan FlowTypes.LogMessage -> FilePath -> Line -> Line -> Line -> FilePath -> IO FilePath preprocessIfNeeded opts ch script bank account owner src = do   shouldPreprocess <- verboseTestFile opts ch script   if shouldPreprocess     then preprocess opts ch script bank account owner src     else return src -preprocess :: ImportOptions -> TChan LogMessage -> FilePath -> Line -> Line -> Line -> FilePath -> IO FilePath+preprocess :: ImportOptions -> TChan FlowTypes.LogMessage -> FilePath -> Line -> Line -> Line -> FilePath -> IO FilePath preprocess opts ch script bank account owner src = do   let csvOut = changePathAndExtension "2-preprocessed" "csv" src   mktree $ directory csvOut   let script' = format fp script :: Text-  let action = proc script' [format fp src, format fp csvOut, lineToText bank, lineToText account, lineToText owner] empty+  let action = (parAwareProc opts) script' [format fp src, format fp csvOut, lineToText bank, lineToText account, lineToText owner] empty   let relScript = relativeToBase opts script   let relSrc = relativeToBase opts src   let msg = format ("executing '"%fp%"' on '"%fp%"'") relScript relSrc-  _ <- logVerboseTime opts ch msg action+  ((_, stdOut, _), _) <- timeAndExitOnErr opts ch msg action+  channelOut ch stdOut   return csvOut -hledgerImport :: ImportOptions -> TChan LogMessage -> FilePath -> FilePath -> IO FilePath+hledgerImport :: ImportOptions -> TChan FlowTypes.LogMessage -> FilePath -> FilePath -> IO FilePath hledgerImport opts ch csvSrc journalOut = do   case extractImportDirs csvSrc of     Right importDirs -> hledgerImport' opts ch importDirs csvSrc journalOut     Left errorMessage -> do       errExit 1 ch errorMessage csvSrc -hledgerImport' :: ImportOptions -> TChan LogMessage -> ImportDirs -> FilePath -> FilePath -> IO FilePath+hledgerImport' :: ImportOptions -> TChan FlowTypes.LogMessage -> ImportDirs -> FilePath -> FilePath -> IO FilePath hledgerImport' opts ch importDirs csvSrc journalOut = do   let candidates = rulesFileCandidates csvSrc importDirs   maybeRulesFile <- firstExistingFile candidates@@ -108,9 +109,11 @@   case maybeRulesFile of     Just rf -> do       let relRules = relativeToBase opts rf-      let action = proc "hledger" ["print", "--rules-file", format fp rf, "--file", format fp csvSrc, "--output-file", format fp journalOut] empty+      let hledger = format fp $ FlowTypes.hlPath . hledgerInfo $ opts :: Text+      let action = (parAwareProc opts) hledger ["print", "--rules-file", format fp rf, "--file", format fp csvSrc, "--output-file", format fp journalOut] empty       let msg = format ("importing '"%fp%"' using rules file '"%fp%"'") relCSV relRules-      _ <- logVerboseTime opts ch msg action+      ((_, stdOut, _), _) <- timeAndExitOnErr opts ch msg action+      channelOut ch stdOut       return journalOut     Nothing ->       do@@ -151,14 +154,15 @@       map (</> srcSpecificFilename) [accountDir importDirs, bankDir importDirs, importDir importDirs]     else [] -customConstruct :: ImportOptions -> TChan LogMessage -> FilePath -> Line -> Line -> Line -> FilePath -> FilePath -> IO FilePath+customConstruct :: ImportOptions -> TChan FlowTypes.LogMessage -> FilePath -> Line -> Line -> Line -> FilePath -> FilePath -> IO FilePath customConstruct opts ch constructScript bank account owner csvSrc journalOut = do   let script = format fp constructScript :: Text   let importOut = inproc script [format fp csvSrc, "-", lineToText bank, lineToText account, lineToText owner] empty-  let action = proc "hledger" ["print", "--ignore-assertions", "--file", "-", "--output-file", format fp journalOut] importOut+  let hledger = format fp $ FlowTypes.hlPath . hledgerInfo $ opts :: Text+  let action = (parAwareProc opts) hledger ["print", "--ignore-assertions", "--file", "-", "--output-file", format fp journalOut] importOut   let relScript = relativeToBase opts constructScript   let relSrc = relativeToBase opts csvSrc   let msg = format ("executing '"%fp%"' on '"%fp%"'") relScript relSrc-  _ <- logVerboseTime opts ch msg action-+  ((_, stdOut, _), _) <- timeAndExitOnErr opts ch msg action+  channelOut ch stdOut   return journalOut
src/Hledger/Flow/Common.hs view
@@ -3,14 +3,18 @@ module Hledger.Flow.Common     ( docURL     , versionInfo+    , hledgerPathFromOption+    , hledgerVersionFromPath+    , hledgerInfoFromPath     , showCmdArgs     , consoleChannelLoop     , terminateChannelLoop-    , channelOut-    , channelErr+    , channelOut, channelOutLn+    , channelErr, channelErrLn     , errExit     , logVerbose-    , logVerboseTime+    , timeAndExitOnErr+    , parAwareProc     , verboseTestFile     , relativeToBase     , relativeToBase'@@ -66,6 +70,33 @@ versionInfo :: NE.NonEmpty Line versionInfo = textToLines $ T.pack ("hledger-flow " ++ Version.showVersion version) +hledgerPathFromOption :: Maybe FilePath -> IO FilePath+hledgerPathFromOption pathOption = do+  case pathOption of+    Just h  -> do+      isOnDisk <- testfile h+      if isOnDisk then return h else do+        let msg = format ("Unable to find hledger at "%fp) h+        errExit' 1 (T.hPutStrLn H.stderr) msg h+    Nothing -> do+      maybeH <- which "hledger"+      case maybeH of+        Just h  -> return h+        Nothing -> do+          let msg = "Unable to find hledger in your path.\n"+                <> "You need to either install hledger, or add it to your PATH, or provide the path to an hledger executable.\n\n"+                <> "There are a number of installation options on the hledger website: https://hledger.org/download.html"+          errExit' 1 (T.hPutStrLn H.stderr) msg "/"++hledgerVersionFromPath :: FilePath -> IO Text+hledgerVersionFromPath hlp = fmap (T.strip . linesToText) (single $ shellToList $ inproc (format fp hlp) ["--version"] empty)++hledgerInfoFromPath :: Maybe FilePath -> IO HledgerInfo+hledgerInfoFromPath pathOption = do+  hlp <- hledgerPathFromOption pathOption+  hlv <- hledgerVersionFromPath hlp+  return $ HledgerInfo hlp hlv+ showCmdArgs :: [Text] -> Text showCmdArgs args = T.intercalate " " (map escapeArg args) @@ -75,12 +106,21 @@ channelOut :: TChan LogMessage -> Text -> IO () channelOut ch txt = atomically $ writeTChan ch $ StdOut txt +channelOutLn :: TChan LogMessage -> Text -> IO ()+channelOutLn ch txt = channelOut ch (txt <> "\n")+ channelErr :: TChan LogMessage -> Text -> IO () channelErr ch txt = atomically $ writeTChan ch $ StdErr txt +channelErrLn :: TChan LogMessage -> Text -> IO ()+channelErrLn ch txt = channelErr ch (txt <> "\n")+ errExit :: Int -> TChan LogMessage -> Text -> a -> IO a-errExit exitStatus ch errorMessage dummyReturnValue = do-  channelErr ch errorMessage+errExit exitStatus ch = errExit' exitStatus (channelErrLn ch)++errExit' :: Int -> (Text -> IO ()) -> Text -> a -> IO a+errExit' exitStatus logFun errorMessage dummyReturnValue = do+  logFun errorMessage   sleep 0.1   _ <- exit $ ExitFailure exitStatus   return dummyReturnValue@@ -93,17 +133,17 @@ logToChannel :: TChan LogMessage -> Text -> IO () logToChannel ch msg = do   ts <- timestampPrefix msg-  channelErr ch ts+  channelErrLn ch ts  consoleChannelLoop :: TChan LogMessage -> IO () consoleChannelLoop ch = do   logMsg <- atomically $ readTChan ch   case logMsg of     StdOut msg -> do-      T.hPutStrLn H.stdout msg+      T.hPutStr H.stdout msg       consoleChannelLoop ch     StdErr msg -> do-      T.hPutStrLn H.stderr msg+      T.hPutStr H.stderr msg       consoleChannelLoop ch     Terminate  -> return () @@ -113,12 +153,41 @@ logVerbose :: HasVerbosity o => o -> TChan LogMessage -> Text -> IO () logVerbose opts ch msg = if (verbose opts) then logToChannel ch msg else return () -logVerboseTime :: (HasVerbosity o, HasExitCode a) => o -> TChan LogMessage -> Text -> IO a -> IO (a, NominalDiffTime)-logVerboseTime opts ch msg action = do+logTimedAction :: HasVerbosity o => o -> TChan LogMessage -> Text -> IO FullOutput -> IO FullTimedOutput+logTimedAction opts ch msg action = do   logVerbose opts ch $ format ("Begin: "%s) msg-  (result, diff) <- time action-  logVerbose opts ch $ format ("End:   "%s%" "%s%" ("%s%")") msg (repr $ exitCode result) (repr diff)-  return (result, diff)+  timed@((ec, _, _), diff) <- time action+  logVerbose opts ch $ format ("End:   "%s%" "%s%" ("%s%")") msg (repr ec) (repr diff)+  return timed++timeAndExitOnErr :: HasVerbosity o => o -> TChan LogMessage -> Text -> IO FullOutput -> IO FullTimedOutput+timeAndExitOnErr opts ch msg action = do+  timed@((ec, stdOut, stdErr), _) <- logTimedAction opts ch msg action+  if not (T.null stdErr)+    then channelErr ch stdErr+    else return ()+  case ec of+    ExitFailure i -> do+      let msgOut = if not (T.null stdOut)+            then format ("Standard output:\n"%s%"\n") stdOut+            else ""++      let msgErr = if not (T.null stdErr)+            then format ("Error output:\n"%s%"\n") stdErr+            else ""++      let exitMsg = format ("\nhledger-flow: an external process exited with exit code "%d%". \n"+                            %s%s%"\nSee verbose output for more details.") i msgOut msgErr+      errExit i ch exitMsg timed+    ExitSuccess -> return timed++procWithEmptyOutput :: MonadIO io => Text -> [Text] -> Shell Line -> io FullOutput+procWithEmptyOutput cmd args stdinput = do+  ec <- proc cmd args stdinput+  return (ec, T.empty, T.empty)++parAwareProc :: (HasSequential o, MonadIO io) => o -> Text -> [Text] -> Shell Line -> io FullOutput+parAwareProc opts = if (sequential opts) then procWithEmptyOutput else procStrictWithErr  verboseTestFile :: (HasVerbosity o, HasBaseDir o) => o -> TChan LogMessage -> FilePath -> IO Bool verboseTestFile opts ch p = do
src/Hledger/Flow/Import/Types.hs view
@@ -6,16 +6,20 @@ import Hledger.Flow.Types  data ImportOptions = ImportOptions { baseDir :: FilePath+                                   , hledgerInfo :: HledgerInfo                                    , 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+ instance HasBaseDir ImportOptions where-  baseDir (ImportOptions bd _ _ _) = bd+  baseDir (ImportOptions bd _ _ _ _) = bd  data ImportDirs = ImportDirs { importDir  :: FilePath                              , ownerDir   :: FilePath
src/Hledger/Flow/Report/Types.hs view
@@ -6,13 +6,18 @@ import Hledger.Flow.Types  data ReportOptions = ReportOptions { baseDir :: FilePath+                                   , hledgerInfo :: HledgerInfo                                    , verbose :: Bool                                    , showOptions :: Bool-                                   , sequential :: Bool }+                                   , sequential :: Bool+                                   }   deriving (Show)  instance HasVerbosity ReportOptions where-  verbose (ReportOptions _ v _ _) = v+  verbose (ReportOptions _ _ v _ _) = v +instance HasSequential ReportOptions where+  sequential (ReportOptions _ _ _ _ sq) = sq+ instance HasBaseDir ReportOptions where-  baseDir (ReportOptions bd _ _ _) = bd+  baseDir (ReportOptions bd _ _ _ _) = bd
src/Hledger/Flow/Reports.hs view
@@ -4,10 +4,10 @@     ( generateReports     ) where -import Turtle+import Turtle hiding (stdout, stderr, proc) import Prelude hiding (FilePath, putStrLn, writeFile) import qualified Data.Text as T-import Hledger.Flow.Types (LogMessage, FullTimedOutput)+import qualified Hledger.Flow.Types as FlowTypes import Hledger.Flow.Report.Types import Hledger.Flow.Common import Control.Concurrent.STM@@ -17,20 +17,20 @@   do     ch <- liftIO newTChanIO     logHandle <- fork $ consoleChannelLoop ch-    liftIO $ if (showOptions opts) then channelOut ch (repr opts) else return ()+    liftIO $ if (showOptions opts) then channelOutLn ch (repr opts) else return ()     (reports, diff) <- time $ liftIO $ generateReports' opts ch-    liftIO $ channelOut ch $ format ("Generated "%d%" reports in "%s) (length reports) $ repr diff+    liftIO $ channelOutLn ch $ format ("Generated "%d%" reports in "%s) (length reports) $ repr diff     liftIO $ terminateChannelLoop ch     wait logHandle   ) -generateReports' :: ReportOptions -> TChan LogMessage -> IO [FilePath]+generateReports' :: ReportOptions -> TChan FlowTypes.LogMessage -> IO [FilePath] generateReports' opts ch = do   logVerbose opts ch "Something will be here Real Soon Now (tm)"-  channelOut ch "Report generation has not been implemented. Yet. https://github.com/apauley/hledger-flow/pull/4"+  channelOutLn ch "Report generation has not been implemented. Yet. https://github.com/apauley/hledger-flow/pull/4"   ownerReports opts ch "everyone" -ownerReports :: ReportOptions -> TChan LogMessage -> Text -> IO [FilePath]+ownerReports :: ReportOptions -> TChan FlowTypes.LogMessage -> Text -> IO [FilePath] ownerReports opts ch owner = do   let journal = (baseDir opts) </> "all-years" <.> "journal"   let reportsDir = (baseDir opts) </> "reports" </> fromText owner@@ -38,7 +38,7 @@   results <- if (sequential opts) then sequence actions else single $ shellToList $ parallel actions   return $ map fst results -incomeStatement :: ReportOptions -> TChan LogMessage -> FilePath -> FilePath -> IO (FilePath, FullTimedOutput)+incomeStatement :: ReportOptions -> TChan FlowTypes.LogMessage -> FilePath -> FilePath -> IO (FilePath, FlowTypes.FullTimedOutput) incomeStatement opts ch journal reportsDir = do   mktree reportsDir   let outputFile = reportsDir </> "income-expenses" <.> "txt"@@ -46,27 +46,25 @@   let reportArgs = ["incomestatement"] ++ sharedOptions ++ ["--average", "--yearly"]   generateReport' opts ch journal outputFile reportArgs -accountList :: ReportOptions -> TChan LogMessage -> FilePath -> FilePath -> IO (FilePath, FullTimedOutput)+accountList :: ReportOptions -> TChan FlowTypes.LogMessage -> FilePath -> FilePath -> IO (FilePath, FlowTypes.FullTimedOutput) accountList opts ch journal reportsDir = do   let outputFile = reportsDir </> "accounts" <.> "txt"   let reportArgs = ["accounts"]   generateReport' opts ch journal outputFile reportArgs -generateReport' :: ReportOptions -> TChan LogMessage -> FilePath -> FilePath -> [Text] -> IO (FilePath, FullTimedOutput)+generateReport' :: ReportOptions -> TChan FlowTypes.LogMessage -> FilePath -> FilePath -> [Text] -> IO (FilePath, FlowTypes.FullTimedOutput) generateReport' opts ch journal outputFile args = do   let reportsDir = directory outputFile   mktree reportsDir   let relativeJournal = relativeToBase opts journal   let reportArgs = ["--file", format fp journal] ++ args   let reportDisplayArgs = ["--file", format fp relativeJournal] ++ args-  let action = procStrictWithErr "hledger" reportArgs empty+  let hledger = format fp $ FlowTypes.hlPath . hledgerInfo $ opts :: Text+  let action = procStrictWithErr hledger reportArgs empty   let cmd = format ("hledger "%s) $ showCmdArgs reportDisplayArgs-  result@((exitCode, stdOut, stdErr), _) <- logVerboseTime opts ch cmd action+  result@((exitCode, stdOut, _), _) <- timeAndExitOnErr opts ch cmd action   if not (T.null stdOut) then do     writeTextFile outputFile (cmd <> "\n\n"<> stdOut)-    channelOut ch $ format ("Wrote "%fp) $ relativeToBase opts outputFile-    else channelErr ch $ format ("No report output for '"%s%"' "%s) cmd (repr exitCode)-  if not (T.null stdErr)-    then channelErr ch $ stdErr-    else return ()+    channelOutLn ch $ format ("Wrote "%fp) $ relativeToBase opts outputFile+    else channelErrLn ch $ format ("No report output for '"%s%"' "%s) cmd (repr exitCode)   return (outputFile, result)
src/Hledger/Flow/Types.hs view
@@ -11,17 +11,16 @@ type FullOutput = (ExitCode, Text, Text) type FullTimedOutput = (FullOutput, NominalDiffTime) +data HledgerInfo = HledgerInfo { hlPath :: FilePath+                               , hlVersion :: Text+                               }+                 deriving (Show)+ class HasVerbosity a where   verbose :: a -> Bool  class HasBaseDir a where   baseDir :: a -> FilePath -class HasExitCode a where-  exitCode :: a -> ExitCode--instance HasExitCode ExitCode where-  exitCode c = c--instance HasExitCode FullOutput where-  exitCode (c, _, _) = c+class HasSequential a where+  sequential :: a -> Bool
test/TestHelpers.hs view
@@ -3,14 +3,10 @@  module TestHelpers where -import Test.HUnit import Turtle import Prelude hiding (FilePath)-import qualified Data.Map.Strict as Map-import qualified Control.Foldl as Fold-import qualified Data.Text as T-import qualified Data.List as List (sort) +import qualified Hledger.Flow.Types as FlowTypes import Hledger.Flow.Import.Types import Hledger.Flow.Common @@ -49,8 +45,11 @@ extraFiles = ["import/john/bogartbank/savings/2017-opening.journal"] :: [FilePath] hiddenFiles = [".hiddenfile", "checking/.DS_Store", "import/john/bogartbank/savings/1-in/.anotherhiddenfile", "import/john/bogartbank/checking/1-in/2018/.hidden"] :: [FilePath] +defaultHlInfo :: FlowTypes.HledgerInfo+defaultHlInfo = FlowTypes.HledgerInfo "/path/to/hledger" "1.2.3"+ defaultOpts :: FilePath -> ImportOptions-defaultOpts bd = ImportOptions bd False False False+defaultOpts bd = ImportOptions bd defaultHlInfo False False False  toJournals :: [FilePath] -> [FilePath] toJournals = map (changePathAndExtension "3-journal" "journal")