diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/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: diff --git a/hledger-flow.cabal b/hledger-flow.cabal --- a/hledger-flow.cabal +++ b/hledger-flow.cabal @@ -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 category: Finance, Console diff --git a/src/Hledger/Flow/Common.hs b/src/Hledger/Flow/Common.hs --- a/src/Hledger/Flow/Common.hs +++ b/src/Hledger/Flow/Common.hs @@ -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 diff --git a/src/Hledger/Flow/Reports.hs b/src/Hledger/Flow/Reports.hs --- a/src/Hledger/Flow/Reports.hs +++ b/src/Hledger/Flow/Reports.hs @@ -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]) diff --git a/test/Common/Unit.hs b/test/Common/Unit.hs --- a/test/Common/Unit.hs +++ b/test/Common/Unit.hs @@ -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]