diff --git a/bin/README.md b/bin/README.md index fbf754a3f..9bc43a086 100644 --- a/bin/README.md +++ b/bin/README.md @@ -7,6 +7,8 @@ shipped as executable stack scripts: - hledger-check.hs - check more complex account balance assertions - hledger-smooth.hs - an attempt at automatically splitting infrequent/irregular transactions - hledger-swap-dates.hs - print transactions with their date and date2 fields swapped +- hledger-combine-balances.hs - render two balance reports as single multi-column one +- hledger-balance-as-budget.hs - use one balance report as the budget for the other one You can run them directly and they will install required dependencies and run in interpreted mode. diff --git a/bin/hledger-balance-as-budget.hs b/bin/hledger-balance-as-budget.hs new file mode 100755 index 000000000..bfb45fbef --- /dev/null +++ b/bin/hledger-balance-as-budget.hs @@ -0,0 +1,46 @@ +#!/usr/bin/env stack +{- stack runghc --verbosity info + --package hledger-lib + --package hledger +-} + +{-# OPTIONS_GHC -Wno-missing-signatures -Wno-name-shadowing #-} + +{-| Construct two balance reports for two different time periods and use one of the as "budget" for + the other, thus comparing them +-} +import System.Environment (getArgs) +import Hledger.Cli + +------------------------------------------------------------------------------ +cmdmode = hledgerCommandMode + (unlines ["balance-as-budget" + ,"Generate two balance reports and use first of them as budget for the second." + ," " + ,"Pass two sets of hledger-compatible options, separated by --." + ,"For example, to use Jan 2019 as budget for Jan 2020, use:" + ,"-f 2019.journal -p 2019-01 -- -f 2020.journal -p 2020-01" + ," " + ,"Display features in the report are driven by the second set of args" + ]) + [] + [generalflagsgroup1] + [] + ([], Just $ argsFlag "[QUERY]") +------------------------------------------------------------------------------ + +main :: IO () +main = do + args <- getArgs + let report1args = takeWhile (/= "--") args + let report2args = drop 1 $ dropWhile (/= "--") args + (_,report1) <- mbReport report1args + (ropts2,report2) <- mbReport report2args + let pastAsBudget = combineBudgetAndActual report1{prDates=prDates report2} report2 + putStrLn $ budgetReportAsText ropts2 pastAsBudget + where + mbReport args = do + opts@CliOpts{reportopts_=ropts} <- getHledgerCliOpts' cmdmode args + d <- getCurrentDay + report <- withJournalDo opts (return . multiBalanceReport d ropts) + return (ropts,report) diff --git a/bin/hledger-combine-balances.hs b/bin/hledger-combine-balances.hs new file mode 100755 index 000000000..be65e9b5f --- /dev/null +++ b/bin/hledger-combine-balances.hs @@ -0,0 +1,75 @@ +#!/usr/bin/env stack +{- stack runghc --verbosity info + --package hledger-lib + --package hledger +-} + +{-# OPTIONS_GHC -Wno-missing-signatures -Wno-name-shadowing #-} + +{-| Construct two balance reports for two different time periods and render them side by side +-} +import System.Environment (getArgs) +import Hledger.Cli +import qualified Data.Map as M +import Data.Map.Merge.Strict + +appendReports :: MultiBalanceReport -> MultiBalanceReport -> MultiBalanceReport +appendReports r1 r2 = + PeriodicReport + { prDates = prDates r1 ++ prDates r2 + , prRows = map snd $ M.toAscList mergedRows + , prTotals = mergeRows (prTotals r1) (prTotals r2) + } + where + rowsByAcct report = M.fromList $ map (\r -> (prrName r, r)) (prRows report) + r1map = rowsByAcct r1 + r2map = rowsByAcct r2 + + mergedRows = merge (mapMissing left) (mapMissing right) (zipWithMatched both) r1map r2map + left _ row = row{prrAmounts = prrAmounts row ++ [nullmixedamt]} + right _ row = row{prrAmounts = nullmixedamt:(prrAmounts row) } + both _ = mergeRows + + -- name/depth in the second row would be the same by contruction + mergeRows (PeriodicReportRow name depth amt1 tot1 avg1) (PeriodicReportRow _ _ amt2 tot2 avg2) = + PeriodicReportRow { prrName = name + , prrDepth = depth + , prrAmounts = amt1++amt2 + , prrTotal = tot1+tot2 + , prrAverage = averageMixedAmounts [avg1,avg2] + } + +------------------------------------------------------------------------------ +cmdmode = hledgerCommandMode + (unlines ["combine-balances" + ,"Generate two balance reports and render them side by side." + ,"(Dates in headers could look funky.)" + ," " + ,"Pass two sets of hledger-compatible options, separated by --." + ,"For example, to see Jan 2019 and Jan 2020 together, use:" + ,"-f 2019.journal -p 2019-01 -- -f 2020eaf.journal -p 2020-01" + ," " + ,"Display features in the report are driven by the second set of args" + ]) + [] + [generalflagsgroup1] + [] + ([], Just $ argsFlag "[QUERY]") +------------------------------------------------------------------------------ + + +main :: IO () +main = do + args <- getArgs + let report1args = takeWhile (/= "--") args + let report2args = drop 1 $ dropWhile (/= "--") args + (_,report1) <- mbReport report1args + (ropts2,report2) <- mbReport report2args + let merged = appendReports report1 report2 + putStrLn $ multiBalanceReportAsText ropts2 merged + where + mbReport args = do + opts@CliOpts{reportopts_=ropts} <- getHledgerCliOpts' cmdmode args + d <- getCurrentDay + report <- withJournalDo opts (return . multiBalanceReport d ropts) + return (ropts,report) diff --git a/hledger/Hledger/Cli/CliOptions.hs b/hledger/Hledger/Cli/CliOptions.hs index 65f93e14a..a9002d3e6 100644 --- a/hledger/Hledger/Cli/CliOptions.hs +++ b/hledger/Hledger/Cli/CliOptions.hs @@ -35,6 +35,7 @@ module Hledger.Cli.CliOptions ( CliOpts(..), defcliopts, getHledgerCliOpts, + getHledgerCliOpts', rawOptsToCliOpts, checkCliOpts, outputFormats, @@ -479,9 +480,8 @@ checkCliOpts opts = -- Empty lines in the pre/postamble are removed by cmdargs; -- add a space character to preserve them. -- -getHledgerCliOpts :: Mode RawOpts -> IO CliOpts -getHledgerCliOpts mode' = do - args' <- getArgs >>= expandArgsAt +getHledgerCliOpts' :: Mode RawOpts -> [String] -> IO CliOpts +getHledgerCliOpts' mode' args' = do let rawopts = either usageError id $ process mode' args' opts <- rawOptsToCliOpts rawopts debugArgs args' opts @@ -508,6 +508,11 @@ getHledgerCliOpts mode' = do d <- getCurrentDay putStrLn $ "search query: " ++ show (queryFromOpts d $ reportopts_ opts) +getHledgerCliOpts :: Mode RawOpts -> IO CliOpts +getHledgerCliOpts mode' = do + args' <- getArgs >>= expandArgsAt + getHledgerCliOpts' mode' args' + -- CliOpts accessors -- | Get the (tilde-expanded, absolute) journal file path from