hledger-flow 0.11.1.0 → 0.11.1.1

raw patch · 10 files changed

+109/−28 lines, 10 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +7/−1
• app/Main.hs +13/−6
• hledger-flow.cabal +2/−2
• src/Hledger/Flow/CSVImport.hs +12/−9
• src/Hledger/Flow/Common.hs +8/−0
• src/Hledger/Flow/Import/Types.hs +6/−3
• src/Hledger/Flow/Report/Types.hs +6/−3
• src/Hledger/Flow/Reports.hs +46/−3
• src/Hledger/Flow/Types.hs +8/−0
• test/TestHelpers.hs +1/−1

@@ -1,12 +1,18 @@ # Changelog for [hledger-flow](https://github.com/apauley/hledger-flow) +## 0.11.1.1++- Support input files from the year 2011 - https://github.com/apauley/hledger-flow/issues/27+  Use a more specific input-file pattern, so as not to match 2011-include.journal+- Print command-line options if requested - https://github.com/apauley/hledger-flow/issues/11+- Use the channel output functions consistently to avoid concurrency issues.+ ## 0.11.1  - Create statically linked executables on Linux - https://github.com/apauley/hledger-flow/releases - Add an option to disable parallel processing - Log the exit status of shell commands. - Upgrade to LTS 13.16 for GHC 8.6.4.-  ## 0.11 

@@ -14,7 +14,7 @@ import Hledger.Flow.Reports import Hledger.Flow.CSVImport -type SubcommandParams = (Maybe FilePath, Bool, Bool)+type SubcommandParams = (Maybe FilePath, Bool, Bool, Bool) data Command = Version (Maybe Text) | Import SubcommandParams | Report SubcommandParams deriving (Show)  main :: IO ()@@ -26,14 +26,20 @@     Report subParams -> toReportOptions subParams >>= generateReports  toImportOptions :: SubcommandParams -> IO IT.ImportOptions-toImportOptions (maybeBaseDir, verbose, sequential) = do+toImportOptions (maybeBaseDir, verbose, showOpts, sequential) = do   bd <- dirOrPwd maybeBaseDir-  return IT.ImportOptions {IT.baseDir = bd, IT.verbose = verbose, IT.sequential = sequential}+  return IT.ImportOptions { IT.baseDir = bd+                          , IT.verbose = verbose+                          , IT.showOptions = showOpts+                          , IT.sequential = sequential }  toReportOptions :: SubcommandParams -> IO RT.ReportOptions-toReportOptions (maybeBaseDir, verbose, sequential) = do+toReportOptions (maybeBaseDir, verbose, showOpts, sequential) = do   bd <- dirOrPwd maybeBaseDir-  return RT.ReportOptions {RT.baseDir = bd, RT.verbose = verbose, RT.sequential = sequential}+  return RT.ReportOptions { RT.baseDir = bd+                          , RT.verbose = verbose+                          , RT.showOptions = showOpts+                          , RT.sequential = sequential }  parser :: Parser Command parser = fmap Import (subcommand "import" "Converts CSV transactions into categorised journal files" subcommandParser)@@ -41,9 +47,10 @@   <|> fmap Version (subcommand "version" "Display version information" noArgs)  subcommandParser :: Parser SubcommandParams-subcommandParser = (,,)+subcommandParser = (,,,)   <$> optional (argPath "basedir" "The hledger-flow base directory")   <*> 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")  noArgs :: Parser (Maybe Text)

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: dff74bf821d03440baa4b4f2c9e36afa00f7ce580680c1c94e598f56f06bf1bd+-- hash: f8d8a671bb403b7d049e7310c834a0396e836ca37eb0c7717ccb48a15691213d  name:           hledger-flow-version:        0.11.1.0+version:        0.11.1.1 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

@@ -18,6 +18,7 @@   do     ch <- liftIO newTChanIO     logHandle <- fork $ consoleChannelLoop ch+    liftIO $ if (showOptions opts) then channelOut 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@@ -25,18 +26,23 @@     wait logHandle   ) +pathSeparators :: [Char]+pathSeparators = ['/', '\\', ':']++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' opts ch = do   channelOut ch "Collecting input files..."-  (inputFiles, diff) <- time $ single . shellToList . onlyFiles $ find (has (suffix "1-in")) $ baseDir opts+  (inputFiles, diff) <- time $ single . shellToList . onlyFiles $ find inputFilePattern $ baseDir opts   let fileCount = length inputFiles   if (fileCount == 0) then     do       let msg = format ("I couldn't find any input files underneath "%fp                         %"\n\nhledger-makitso expects to find its input files in specifically\nnamed directories.\n\n"%                         "Have a look at the documentation for a detailed explanation:\n"%s) (dirname (baseDir opts) </> "import/") (docURL "input-files")-      stderr $ select $ textToLines msg-      exit $ ExitFailure 1+      errExit 1 ch msg []     else     do       channelOut ch $ format ("Found "%d%" input files in "%s%". Proceeding with import...") fileCount (repr diff)@@ -50,8 +56,7 @@   case extractImportDirs inputFile of     Right importDirs -> importCSV opts ch importDirs inputFile     Left errorMessage -> do-      stderr $ select $ textToLines errorMessage-      exit $ ExitFailure 1+      errExit 1 ch errorMessage inputFile  importCSV :: ImportOptions -> TChan LogMessage -> ImportDirs -> FilePath -> IO FilePath importCSV opts ch importDirs srcFile = do@@ -93,8 +98,7 @@   case extractImportDirs csvSrc of     Right importDirs -> hledgerImport' opts ch importDirs csvSrc journalOut     Left errorMessage -> do-      stderr $ select $ textToLines errorMessage-      exit $ ExitFailure 1+      errExit 1 ch errorMessage csvSrc  hledgerImport' :: ImportOptions -> TChan LogMessage -> ImportDirs -> FilePath -> FilePath -> IO FilePath hledgerImport' opts ch importDirs csvSrc journalOut = do@@ -116,8 +120,7 @@                           %"\n\nI will happily use the first rules file I can find from any one of these "%d%" files:\n"%s                           %"\n\nHere is a bit of documentation about rules files that you may find helpful:\n"%s)                   relCSV (length candidates) candidatesTxt (docURL "rules-files")-        stderr $ select $ textToLines msg-        exit $ ExitFailure 1+        errExit 1 ch msg csvSrc  rulesFileCandidates :: FilePath -> ImportDirs -> [FilePath] rulesFileCandidates csvSrc importDirs = statementSpecificRulesFiles csvSrc importDirs ++ generalRulesFiles importDirs

@@ -8,6 +8,7 @@     , terminateChannelLoop     , channelOut     , channelErr+    , errExit     , logVerbose     , logVerboseTime     , verboseTestFile@@ -76,6 +77,13 @@  channelErr :: TChan LogMessage -> Text -> IO () channelErr ch txt = atomically $ writeTChan ch $ StdErr txt++errExit :: Int -> TChan LogMessage -> Text -> a -> IO a+errExit exitStatus ch errorMessage dummyReturnValue = do+  channelErr ch errorMessage+  sleep 0.1+  _ <- exit $ ExitFailure exitStatus+  return dummyReturnValue  timestampPrefix :: Text -> IO Text timestampPrefix txt = do

@@ -5,14 +5,17 @@ import Prelude hiding (FilePath, putStrLn) import Hledger.Flow.Types -data ImportOptions = ImportOptions { baseDir :: FilePath, verbose :: Bool, sequential :: Bool }+data ImportOptions = ImportOptions { baseDir :: FilePath+                                   , verbose :: Bool+                                   , showOptions :: Bool+                                   , sequential :: Bool }   deriving (Show)  instance HasVerbosity ImportOptions where-  verbose (ImportOptions _ v _) = v+  verbose (ImportOptions _ v _ _) = v  instance HasBaseDir ImportOptions where-  baseDir (ImportOptions bd _ _) = bd+  baseDir (ImportOptions bd _ _ _) = bd  data ImportDirs = ImportDirs { importDir  :: FilePath                              , ownerDir   :: FilePath

@@ -5,11 +5,14 @@ import Prelude hiding (FilePath, putStrLn) import Hledger.Flow.Types -data ReportOptions = ReportOptions { baseDir :: FilePath, verbose :: Bool, sequential :: Bool }+data ReportOptions = ReportOptions { baseDir :: FilePath+                                   , verbose :: Bool+                                   , showOptions :: Bool+                                   , sequential :: Bool }   deriving (Show)  instance HasVerbosity ReportOptions where-  verbose (ReportOptions _ v _) = v+  verbose (ReportOptions _ v _ _) = v  instance HasBaseDir ReportOptions where-  baseDir (ReportOptions bd _ _) = bd+  baseDir (ReportOptions bd _ _ _) = bd

@@ -5,8 +5,9 @@     ) where  import Turtle-import Prelude hiding (FilePath, putStrLn)-import Hledger.Flow.Types+import Prelude hiding (FilePath, putStrLn, writeFile)+import qualified Data.Text as T+import Hledger.Flow.Types (LogMessage, FullTimedOutput) import Hledger.Flow.Report.Types import Hledger.Flow.Common import Control.Concurrent.STM@@ -16,6 +17,7 @@   do     ch <- liftIO newTChanIO     logHandle <- fork $ consoleChannelLoop ch+    liftIO $ if (showOptions opts) then channelOut 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 $ terminateChannelLoop ch@@ -26,4 +28,45 @@ 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"-  return []+  ownerReports opts ch "everyone"++ownerReports :: ReportOptions -> TChan LogMessage -> Text -> IO [FilePath]+ownerReports opts ch owner = do+  let journal = (baseDir opts) </> "all-years" <.> "journal"+  let reportsDir = (baseDir opts) </> "reports" </> fromText owner+  let actions = map (\r -> r opts ch journal reportsDir) [accountList, incomeStatement]+  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 opts ch journal reportsDir = do+  mktree reportsDir+  let outputFile = reportsDir </> "income-expenses" <.> "txt"+  let sharedOptions = ["--depth", "2", "--pretty-tables", "not:equity"]+  let reportArgs = ["incomestatement"] ++ sharedOptions ++ ["--average", "--yearly"]+  generateReport' opts ch journal outputFile reportArgs++accountList :: ReportOptions -> TChan LogMessage -> FilePath -> FilePath -> IO (FilePath, 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' 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 cmd = format ("hledger "%s) $ showCmdArgs reportDisplayArgs+  result@((exitCode, stdOut, stdErr), _) <- logVerboseTime 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 ()+  return (outputFile, result)

@@ -1,3 +1,6 @@+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+ module Hledger.Flow.Types where @@ -5,6 +8,8 @@ import Prelude hiding (FilePath, putStrLn)  data LogMessage = StdOut Text | StdErr Text | Terminate deriving (Show)+type FullOutput = (ExitCode, Text, Text)+type FullTimedOutput = (FullOutput, NominalDiffTime)  class HasVerbosity a where   verbose :: a -> Bool@@ -17,3 +22,6 @@  instance HasExitCode ExitCode where   exitCode c = c++instance HasExitCode FullOutput where+  exitCode (c, _, _) = c

@@ -50,7 +50,7 @@ hiddenFiles = [".hiddenfile", "checking/.DS_Store", "import/john/bogartbank/savings/1-in/.anotherhiddenfile", "import/john/bogartbank/checking/1-in/2018/.hidden"] :: [FilePath]  defaultOpts :: FilePath -> ImportOptions-defaultOpts bd = ImportOptions bd False False+defaultOpts bd = ImportOptions bd False False False  toJournals :: [FilePath] -> [FilePath] toJournals = map (changePathAndExtension "3-journal" "journal")