hledger-flow 0.12.0.0 → 0.12.1.0

raw patch · 5 files changed

+146/−37 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +8/−0
• hledger-flow.cabal +2/−2
• src/Hledger/Flow/Common.hs +32/−0
• src/Hledger/Flow/Reports.hs +58/−34
• test/Common/Unit.hs +46/−1

@@ -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:

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 72f9fcacd29271706ca6cfe3ac4fff4ee4706b2086e783d7ba995f4f5b6c5162+-- hash: 1b3a9804ade02ced0d603a43f2e702e5316ee719a6fdb2c17806fddaa6409172  name:           hledger-flow-version:        0.12.0.0+version:        0.12.1.0 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

@@ -6,9 +6,13 @@ 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 @@                       %"\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

@@ -6,12 +6,15 @@  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 (   do@@ -19,51 +22,72 @@     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-  logVerbose opts ch "Something will be here Real Soon Now (tm)"-  channelOutLn ch "Report generation has not been implemented. Yet. https://github.com/apauley/hledger-flow/pull/4"-  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])

@@ -10,6 +10,10 @@ 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"]@@ -17,4 +21,45 @@     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]