hledger/bin/hledger-combine-balances.hs
Simon Michael 2db87333d7 bin: switch scripts to "stack ghc" and "env -S" (#1453)
Using stack's script command meant that the scripts needed to be
compatible, and regularly tested, with a hledger release in stackage,
rather than the latest hledger source. This created hassles for
maintainers, contributors and sometimes for users.

To simplify things overall, we now require script users to check out
the hledger source tree and run the scripts (or, bin/compile.sh) from
there once so they compile themselves. Some notes on alternative
setups are included (in one of the scripts, and referenced by the
others). This ensures that users and our CI tests are building scripts
the same way.

Current stack does not allow a stack options line to be used with the
"stack ghc" command, unfortunately, so instead we are using env's -S
flag, which hopefully has sufficiently wide support by now, and
putting all arguments in the shebang line.

This method will probably require complete explicit --package options,
unlike "stack script", so more testing and tweaking is expected.
Probably we're going to end up with some long shebang lines.

This isn't pretty but seems like a possible way to keep things
manageable.
2021-01-11 21:04:07 -08:00

72 lines
2.7 KiB
Haskell
Executable File

#!/usr/bin/env -S stack ghc --verbosity info --package hledger -- -O0
-- See hledger-check-fancyassertions.hs
{-# 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
import qualified Data.Text.Lazy.IO as TL
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 amt1 tot1 avg1) (PeriodicReportRow _ amt2 tot2 avg2) =
PeriodicReportRow { prrName = name
, 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
(rspec2,report2) <- mbReport report2args
let merged = appendReports report1 report2
TL.putStrLn $ multiBalanceReportAsText (rsOpts rspec2) merged
where
mbReport args = do
opts@CliOpts{reportspec_=rspec} <- getHledgerCliOpts' cmdmode args
report <- withJournalDo opts (return . multiBalanceReport rspec)
return (rspec,report)