Merge pull request #57 from apauley/reports

Generate reports per owner per year

Author: apauley

.github/ISSUE_TEMPLATE/bug_report.md

@@ -26,6 +26,12 @@ $ hledger-flow --show-options import
 ```
 
 **To Reproduce**
+
+FYI, we have a repo with some example transactions which you can use to run `hledger-flow` on:
+https://github.com/apauley/hledger-flow-example
+
+Can you reproduce your issue on these example files?
+
 Steps to reproduce the behavior:
 1. Given this input (files or other input)
 2. And when running this exact command (with `--show-options`)

.github/ISSUE_TEMPLATE/feature_request.md

@@ -26,6 +26,12 @@ the runtime options with `--show-options` e.g:
 $ hledger-flow --show-options import
 ```
 
+**Our Example Statements Repository**
+
+FYI, we have a repo with some example transactions which you can use to run `hledger-flow` on:
+https://github.com/apauley/hledger-flow-example
+
+Can you give examples of what you would like by running `hledger-flow` on these files?
 
 **Describe the solution you'd like**
 A clear and concise description of what you want to happen.

ChangeLog.md

@@ -1,5 +1,13 @@
 # Changelog for [hledger-flow](https://github.com/apauley/hledger-flow)
 
+## 0.12.1
+
+Generate some reports per owner.
+
+Report generation is still a work-in-progress.
+
+https://github.com/apauley/hledger-flow/pull/57
+
 ## 0.12.0
 
 - Re-organised the command-line interface:

package.yaml

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

src/Hledger/Flow/Common.hs

@@ -6,9 +6,13 @@ import Turtle
 import Prelude hiding (FilePath, putStrLn)
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
+import qualified Data.Text.Read as T
 import qualified GHC.IO.Handle.FD as H
 
+import Data.Char (isDigit)
 import Data.Maybe
+import Data.Either
+
 import qualified Control.Foldl as Fold
 import qualified Data.Map.Strict as Map
 import Data.Time.LocalTime
@@ -446,3 +450,31 @@ extractImportDirs inputFile = do
                       %"\n\nhledger-flow expects to find input files in this structure:\n"%
                       "import/owner/bank/account/filestate/year/trxfile\n\n"%
                       "Have a look at the documentation for a detailed explanation:\n"%s) inputFile (docURL "input-files")
+
+listOwners :: HasBaseDir o => o -> Shell FilePath
+listOwners opts = fmap basename $ lsDirs $ (baseDir opts) </> "import"
+
+intPath :: Integer -> FilePath
+intPath = fromText . (format d)
+
+includeYears :: TChan LogMessage -> FilePath -> IO [Integer]
+includeYears ch includeFile = do
+  txt <- readTextFile includeFile
+  case includeYears' txt of
+    Left  msg   -> do
+      channelErrLn ch msg
+      return []
+    Right years -> return years
+
+includeYears' :: Text -> Either Text [Integer]
+includeYears' txt = case partitionEithers (includeYears'' txt) of
+  (errors, []) -> do
+    let msg = format ("Unable to extract years from the following text:\n"%s%"\nErrors:\n"%s) txt (T.intercalate "\n" $ map T.pack errors)
+    Left msg
+  (_, years) -> Right years
+
+includeYears'' :: Text -> [Either String Integer]
+includeYears'' txt = map extractDigits (T.lines txt)
+
+extractDigits :: Text -> Either String Integer
+extractDigits txt = fmap fst $ (T.decimal . (T.filter isDigit)) txt

src/Hledger/Flow/Reports.hs

@@ -6,11 +6,14 @@ module Hledger.Flow.Reports
 
 import Turtle hiding (stdout, stderr, proc)
 import Prelude hiding (FilePath, putStrLn, writeFile)
-import qualified Data.Text as T
-import qualified Hledger.Flow.Types as FlowTypes
 import Hledger.Flow.Report.Types
 import Hledger.Flow.Common
 import Control.Concurrent.STM
+import Data.Either
+
+import qualified Data.Text as T
+import qualified Hledger.Flow.Types as FlowTypes
+import qualified Data.List as List
 
 generateReports :: ReportOptions -> IO ()
 generateReports opts = sh (
@@ -19,50 +22,72 @@ generateReports opts = sh (
     logHandle <- fork $ consoleChannelLoop ch
     liftIO $ if (showOptions opts) then channelOutLn ch (repr opts) else return ()
     (reports, diff) <- time $ liftIO $ generateReports' opts ch
-    liftIO $ channelOutLn ch $ format ("Generated "%d%" reports in "%s) (length reports) $ repr diff
+    let failedAttempts = lefts reports
+    let failedText = if List.null failedAttempts then "" else format ("(and attempted to write "%d%" more) ") $ length failedAttempts
+    liftIO $ channelOutLn ch $ format ("Generated "%d%" reports "%s%"in "%s) (length (rights reports)) failedText $ repr diff
     liftIO $ terminateChannelLoop ch
     wait logHandle
   )
 
-generateReports' :: ReportOptions -> TChan FlowTypes.LogMessage -> IO [FilePath]
+generateReports' :: ReportOptions -> TChan FlowTypes.LogMessage -> IO [Either FilePath FilePath]
 generateReports' opts ch = do
-  channelOutLn ch "Report generation has not been fully implemented yet. Keep an eye out for report pull requests: https://github.com/apauley/hledger-flow/pulls"
-  ownerReports opts ch "everyone"
+  let wipMsg = "Report generation is still a work-in-progress - please let me know how this can be more useful.\n\n"
+               <> "Keep an eye out for report-related pull requests and issues, and feel free to submit some of your own:\n"
+               <> "https://github.com/apauley/hledger-flow/pulls\n"
+               <> "https://github.com/apauley/hledger-flow/issues\n"
+  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
 
-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
-  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
+generateReports'' :: ReportOptions -> TChan FlowTypes.LogMessage -> [Integer] -> (FilePath, FilePath) -> [IO (Either FilePath FilePath)]
+generateReports'' opts ch years (journal, 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 -> IO (FilePath, FlowTypes.FullTimedOutput)
-incomeStatement opts ch journal reportsDir = do
-  mktree reportsDir
-  let outputFile = reportsDir </> "income-expenses" <.> "txt"
+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 reportArgs = ["incomestatement"] ++ sharedOptions ++ ["--average", "--yearly"]
-  generateReport' opts ch journal outputFile reportArgs
+  let reportArgs = ["incomestatement"] ++ sharedOptions
+  generateReport opts ch journal reportsDir year ("income-expenses" <.> "txt") reportArgs
 
-accountList :: ReportOptions -> TChan FlowTypes.LogMessage -> FilePath -> FilePath -> IO (FilePath, FlowTypes.FullTimedOutput)
-accountList opts ch journal reportsDir = do
-  let outputFile = reportsDir </> "accounts" <.> "txt"
+accountList :: ReportOptions -> TChan FlowTypes.LogMessage -> FilePath -> FilePath -> Integer -> IO (Either FilePath FilePath, FlowTypes.FullTimedOutput)
+accountList opts ch journal reportsDir year = do
   let reportArgs = ["accounts"]
-  generateReport' opts ch journal outputFile reportArgs
+  generateReport opts ch journal reportsDir year ("accounts" <.> "txt") reportArgs
 
-generateReport' :: ReportOptions -> TChan FlowTypes.LogMessage -> FilePath -> FilePath -> [Text] -> IO (FilePath, FlowTypes.FullTimedOutput)
-generateReport' opts ch journal outputFile args = do
-  let reportsDir = directory outputFile
+generateReport :: ReportOptions -> TChan FlowTypes.LogMessage -> FilePath -> FilePath -> Integer -> FilePath -> [Text] -> IO (Either FilePath FilePath, FlowTypes.FullTimedOutput)
+generateReport opts ch journal baseOutDir year fileName args = do
+  let reportsDir = baseOutDir </> intPath year
   mktree reportsDir
+  let outputFile = reportsDir </> fileName
   let relativeJournal = relativeToBase opts journal
-  let reportArgs = ["--file", format fp journal] ++ args
-  let reportDisplayArgs = ["--file", format fp relativeJournal] ++ args
+  let reportArgs = ["--file", format fp journal, "--period", repr year] ++ args
+  let reportDisplayArgs = ["--file", format fp relativeJournal, "--period", repr year] ++ args
   let hledger = format fp $ FlowTypes.hlPath . hledgerInfo $ opts :: Text
   let cmdLabel = format ("hledger "%s) $ showCmdArgs reportDisplayArgs
   result@((exitCode, stdOut, _), _) <- timeAndExitOnErr opts ch cmdLabel dummyLogger channelErr procStrictWithErr (hledger, reportArgs, empty)
-  if not (T.null stdOut) then do
-    writeTextFile outputFile (cmdLabel <> "\n\n"<> stdOut)
-    channelOutLn ch $ format ("Wrote "%fp) $ relativeToBase opts outputFile
-    else channelErrLn ch $ format ("No report output for '"%s%"' "%s) cmdLabel (repr exitCode)
-  return (outputFile, result)
+  if not (T.null stdOut)
+    then
+    do
+      writeTextFile outputFile (cmdLabel <> "\n\n"<> stdOut)
+      channelOutLn ch $ format ("Wrote "%fp) $ relativeToBase opts outputFile
+      return (Right outputFile, result)
+    else
+    do
+      channelErrLn ch $ format ("No report output for '"%s%"' "%s) cmdLabel (repr exitCode)
+      return (Left outputFile, result)
+
+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)
+
+ownerParams :: ReportOptions -> FilePath -> (FilePath, FilePath)
+ownerParams opts owner = (journalFile opts ["import", owner], outputDir opts [owner])

test/Common/Unit.hs

@@ -10,11 +10,56 @@ import Prelude hiding (FilePath)
 import TestHelpers
 import Hledger.Flow.Common
 
+import Data.Either
+import qualified Data.Text as T
+import qualified Data.List as List
+
 testShowCmdArgs = TestCase (
   do
     let options = ["--number", "/tmp/file with spaces"]
     let expected = "--number '/tmp/file with spaces'"
     let actual = showCmdArgs options
     assertEqual "Convert command-line arguments to text" expected actual)
 
-tests = TestList [testShowCmdArgs]
+testIncludeYears = TestCase (
+  do
+    let txterr = "Some text without years"
+    let expectederr = ["Unable to extract years from the following text:", txterr, "Errors:"]
+    let actualerr = (init . head) $ map (T.lines) $ lefts [includeYears' txterr] :: [Text]
+    assertEqual "Get a list of years from an include file - error case" expectederr actualerr
+
+    let txt1 = "### Generated by hledger-flow - DO NOT EDIT ###\n\n" <>
+          "!include import/2014-include.journal\n" <>
+          "!include import/2015-include.journal\n" <>
+          "!include import/2016-include.journal\n" <>
+          "!include import/2017-include.journal\n" <>
+          "!include import/2018-include.journal\n" <>
+          "!include import/2019-include.journal"
+
+    let expected1 = Right [2014..2019]
+    let actual1 = includeYears' txt1
+    assertEqual "Get a list of years from an include file - success case 1" expected1 actual1
+
+    let txt2 = "!include 2019-include.journal"
+
+    let expected2 = Right [2019]
+    let actual2 = includeYears' txt2
+    assertEqual "Get a list of years from an include file - success case 2" expected2 actual2
+  )
+
+testExtractDigits = TestCase (
+  do
+    let txt1 = "A number: 321\nAnother number is 42, so is 0"
+
+    let expected1 = Right 321420
+    let actual1 = extractDigits txt1
+    assertEqual "Extract digits from text 1" expected1 actual1
+
+    let txt2 = "No numbers in this line"
+
+    let expected2 = Left "input does not start with a digit"
+    let actual2 = extractDigits txt2
+    assertEqual "Extract digits from text 2" expected2 actual2
+  )
+
+tests = TestList [testShowCmdArgs, testIncludeYears, testExtractDigits]