cli: ability to pass arguments to getHledgerCliOpts + two example scripts

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. 

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)

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)

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 RawOpts -> [String] -> IO CliOpts
-getHledgerCliOpts mode' = do
+getHledgerCliOpts' mode' args' = do
-  args' <- getArgs >>= expandArgsAt
   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