Merge pull request #29 from apauley/support-year-2011

Support the year 2011

Author: apauley

ChangeLog.md

@@ -1,13 +1,19 @@
 # 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
 
 - Change the name from `hledger-makeitso` to `hledger-flow`.

app/Main.hs

@@ -14,7 +14,7 @@ import Hledger.Flow.Common
 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,24 +26,31 @@ main = do
     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)
   <|> fmap Report (subcommand "report" "Generate Reports" subcommandParser)
   <|> 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)

package.yaml

@@ -1,5 +1,5 @@
 name:                hledger-flow
-version:             0.11.1.0
+version:             0.11.1.1
 synopsis:            An hledger workflow focusing on automated statement import and classification.
 category:            Finance, Console
 license:             GPL-3

src/Hledger/Flow/CSVImport.hs

@@ -18,25 +18,31 @@ importCSVs opts = sh (
   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
     liftIO $ terminateChannelLoop ch
     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 @@ extractAndImport opts ch inputFile = do
   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 @@ hledgerImport opts ch csvSrc journalOut = do
   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 @@ hledgerImport' opts ch importDirs csvSrc journalOut = do
                           %"\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

src/Hledger/Flow/Common.hs

@@ -8,6 +8,7 @@ module Hledger.Flow.Common
     , terminateChannelLoop
     , channelOut
     , channelErr
+    , errExit
     , logVerbose
     , logVerboseTime
     , verboseTestFile
@@ -77,6 +78,13 @@ channelOut ch txt = atomically $ writeTChan ch $ StdOut txt
 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
   t <- getZonedTime

src/Hledger/Flow/Import/Types.hs

@@ -5,14 +5,17 @@ import Turtle
 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

src/Hledger/Flow/Report/Types.hs

@@ -5,11 +5,14 @@ import Turtle
 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

src/Hledger/Flow/Reports.hs

@@ -5,8 +5,9 @@ module Hledger.Flow.Reports
     ) 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 @@ generateReports opts = sh (
   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' :: ReportOptions -> TChan 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"
-  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)

src/Hledger/Flow/Types.hs

@@ -1,10 +1,15 @@
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+
 module Hledger.Flow.Types
 where
 
 import Turtle
 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 @@ class HasExitCode a where
 
 instance HasExitCode ExitCode where
   exitCode c = c
+
+instance HasExitCode FullOutput where
+  exitCode (c, _, _) = c

test/TestHelpers.hs

@@ -50,7 +50,7 @@ extraFiles = ["import/john/bogartbank/savings/2017-opening.journal"] :: [FilePat
 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")