From 7b8684ba7a1304ac6afbc73edafd360eb77849d0 Mon Sep 17 00:00:00 2001 From: Dmitry Astapov Date: Fri, 5 Dec 2025 23:13:52 +0000 Subject: [PATCH] ;scripts: fix all the scripts in ./bin. Fixes #2497 --- bin/hledger-balance-as-budget-multi.hs | 65 +++++++++++++++++++-- bin/hledger-balance-as-budget.hs | 78 ++++++++++++++++++++++---- bin/hledger-register-max.hs | 2 +- bin/hledger-register-max2.hs | 4 +- bin/hledger-report1.hs | 4 +- 5 files changed, 132 insertions(+), 21 deletions(-) diff --git a/bin/hledger-balance-as-budget-multi.hs b/bin/hledger-balance-as-budget-multi.hs index 6657983ab..297a5ca43 100644 --- a/bin/hledger-balance-as-budget-multi.hs +++ b/bin/hledger-balance-as-budget-multi.hs @@ -12,6 +12,8 @@ import Data.Text.Lazy.IO qualified as TL import System.Environment (getArgs) import Hledger.Cli.Script import Hledger.Cli.Commands.Balance +import qualified Data.Map as Map +import Data.List (sortOn) ------------------------------------------------------------------------------ cmdmode = hledgerCommandMode @@ -23,7 +25,7 @@ cmdmode = hledgerCommandMode ,"2019.journal 2020.journal commands.txt" ,"and put '\"assets\" --depth 3 --value=$,then' in the commands.txt" ]) - [] + [] [generalflagsgroup1] [] ([], Just $ argsFlag "BUDGET_JOURNAL ACTUAL_JOURNAL COMMAND_FILE") @@ -49,9 +51,62 @@ runAllCommands budget_f real_f commands_f = do [] -> return () "echo":args -> putStrLn $ unwords args _ -> do - opts@CliOpts{reportspec_=rspec} <- getHledgerCliOpts' balancemode args - let b = multiBalanceReport rspec budget - let r = multiBalanceReport rspec real + opts@CliOpts{reportspec_=rspec} <- getHledgerCliOpts' balancemode args let reportopts = _rsReportOpts rspec - let combined = combineBudgetAndActual reportopts real b{prDates=prDates r} r + + -- Generate both reports from their respective journals (unchanged) + let budgetReport = multiBalanceReport rspec budget + actualReport = multiBalanceReport rspec real + + -- Combine the reports + let combined = combineBudgetAndActual reportopts real budgetReport actualReport + writeOutputLazyText opts $ budgetReportAsText reportopts $ styleAmounts styles $ combined + +-- | Combine two MultiBalanceReports into a BudgetReport, comparing them side by side. +-- The budget report uses the date periods from the actual (second) report. +combineBudgetAndActual :: ReportOpts -> Journal -> MultiBalanceReport -> MultiBalanceReport -> BudgetReport +combineBudgetAndActual ropts j + (PeriodicReport budgetperiods budgetrows (PeriodicReportRow _ budgettots budgetgrandtot budgetgrandavg)) + (PeriodicReport actualperiods actualrows (PeriodicReportRow _ actualtots actualgrandtot actualgrandavg)) = + PeriodicReport actualperiods combinedrows totalrow + where + -- Build maps of amounts by account name + budgetMap = Map.fromList + [ (prrFullName row, (prrAmounts row, prrTotal row, prrAverage row)) + | row <- budgetrows + ] + actualMap = Map.fromList + [ (prrFullName row, (prrAmounts row, prrTotal row, prrAverage row)) + | row <- actualrows + ] + + -- Accounts with actual amounts (and their budgets if available) + actualWithBudget = + [ PeriodicReportRow acct cells total avg + | PeriodicReportRow acct actualamts actualtot actualavg <- actualrows + , let budgetamts = maybe (replicate (length actualperiods) Nothing) (\(amts, _, _) -> map Just amts) + (Map.lookup (displayFull acct) budgetMap) + , let cells = zip (map Just actualamts) budgetamts + , let total = (Just actualtot, fmap (\(_, t, _) -> t) (Map.lookup (displayFull acct) budgetMap)) + , let avg = (Just actualavg, fmap (\(_, _, a) -> a) (Map.lookup (displayFull acct) budgetMap)) + ] + + -- Budget-only accounts (no actual amounts) + budgetOnly = + [ PeriodicReportRow acct cells total avg + | PeriodicReportRow acct budgetamts budgettot budgetavg <- budgetrows + , let acctName = displayFull acct + , not (acctName `Map.member` actualMap) -- Only include if not in actual + , let cells = zip (replicate (length actualperiods) (Just nullmixedamt)) (map Just budgetamts) + , let total = (Just nullmixedamt, Just budgettot) + , let avg = (Just nullmixedamt, Just budgetavg) + ] + + -- Combine and sort all rows by account name + combinedrows = sortOn prrFullName (actualWithBudget ++ budgetOnly) + + totalrow = PeriodicReportRow () + (zip (map Just actualtots) (map Just budgettots)) + (Just actualgrandtot, Just budgetgrandtot) + (Just actualgrandavg, Just budgetgrandavg) diff --git a/bin/hledger-balance-as-budget.hs b/bin/hledger-balance-as-budget.hs index 2e24de360..e868555e0 100755 --- a/bin/hledger-balance-as-budget.hs +++ b/bin/hledger-balance-as-budget.hs @@ -12,6 +12,8 @@ import Data.Text.Lazy.IO as TL import System.Environment (getArgs) import Hledger.Cli.Script import Hledger.Cli.Commands.Balance +import qualified Data.Map as Map +import Data.List (sortOn) ------------------------------------------------------------------------------ cmdmode = hledgerCommandMode @@ -24,7 +26,7 @@ cmdmode = hledgerCommandMode ," " ,"Display features in the report are driven by the second set of args" ]) - [] + [] [generalflagsgroup1] [] ([], Just $ argsFlag "[QUERY]") @@ -35,14 +37,68 @@ main = do args <- getArgs let report1args = takeWhile (/= "--") args let report2args = drop 1 $ dropWhile (/= "--") args - (opts,_,_,report1) <- mbReport report1args - (_,ropts2,j,report2) <- mbReport report2args - let pastAsBudget = combineBudgetAndActual ropts2 j report1{prDates=prDates report2} report2 - styles = journalCommodityStylesWith HardRounding j - writeOutputLazyText opts $ budgetReportAsText ropts2 $ styleAmounts styles $ pastAsBudget + + -- Get options for both reports + opts1@CliOpts{reportspec_=rspec1} <- getHledgerCliOpts' balancemode report1args + opts2@CliOpts{reportspec_=rspec2} <- getHledgerCliOpts' balancemode report2args + + withJournal opts1 $ \j1 -> do + withJournal opts2 $ \j2 -> do + -- Generate both reports with their respective date periods + let report1 = multiBalanceReport rspec1 j1 -- budget + report2 = multiBalanceReport rspec2 j2 -- actual + ropts2 = _rsReportOpts rspec2 + styles = journalCommodityStylesWith HardRounding j2 + + -- Combine the reports (using report2's date periods for display) + let combined = combineBudgetAndActual ropts2 j2 report1 report2 + + writeOutputLazyText opts2 $ budgetReportAsText ropts2 $ styleAmounts styles $ combined + +-- | Combine two MultiBalanceReports into a BudgetReport, comparing them side by side. +-- The budget report uses the date periods from the actual (second) report. +combineBudgetAndActual :: ReportOpts -> Journal -> MultiBalanceReport -> MultiBalanceReport -> BudgetReport +combineBudgetAndActual ropts j + (PeriodicReport budgetperiods budgetrows (PeriodicReportRow _ budgettots budgetgrandtot budgetgrandavg)) + (PeriodicReport actualperiods actualrows (PeriodicReportRow _ actualtots actualgrandtot actualgrandavg)) = + PeriodicReport actualperiods combinedrows totalrow where - mbReport args = do - opts@CliOpts{reportspec_=rspec} <- getHledgerCliOpts' balancemode args - d <- getCurrentDay - (report,j) <- withJournal opts $ \j -> return (multiBalanceReport rspec j, j) - return (opts, _rsReportOpts rspec,j,report) + -- Build maps of amounts by account name + budgetMap = Map.fromList + [ (prrFullName row, (prrAmounts row, prrTotal row, prrAverage row)) + | row <- budgetrows + ] + actualMap = Map.fromList + [ (prrFullName row, (prrAmounts row, prrTotal row, prrAverage row)) + | row <- actualrows + ] + + -- Accounts with actual amounts (and their budgets if available) + actualWithBudget = + [ PeriodicReportRow acct cells total avg + | PeriodicReportRow acct actualamts actualtot actualavg <- actualrows + , let budgetamts = maybe (replicate (length actualperiods) Nothing) (\(amts, _, _) -> map Just amts) + (Map.lookup (displayFull acct) budgetMap) + , let cells = zip (map Just actualamts) budgetamts + , let total = (Just actualtot, fmap (\(_, t, _) -> t) (Map.lookup (displayFull acct) budgetMap)) + , let avg = (Just actualavg, fmap (\(_, _, a) -> a) (Map.lookup (displayFull acct) budgetMap)) + ] + + -- Budget-only accounts (no actual amounts) + budgetOnly = + [ PeriodicReportRow acct cells total avg + | PeriodicReportRow acct budgetamts budgettot budgetavg <- budgetrows + , let acctName = displayFull acct + , not (acctName `Map.member` actualMap) -- Only include if not in actual + , let cells = zip (replicate (length actualperiods) (Just nullmixedamt)) (map Just budgetamts) + , let total = (Just nullmixedamt, Just budgettot) + , let avg = (Just nullmixedamt, Just budgetavg) + ] + + -- Combine and sort all rows by account name + combinedrows = sortOn prrFullName (actualWithBudget ++ budgetOnly) + + totalrow = PeriodicReportRow () + (zip (map Just actualtots) (map Just budgettots)) + (Just actualgrandtot, Just budgetgrandtot) + (Just actualgrandavg, Just budgetgrandavg) diff --git a/bin/hledger-register-max.hs b/bin/hledger-register-max.hs index 213f417a9..a6508c33b 100755 --- a/bin/hledger-register-max.hs +++ b/bin/hledger-register-max.hs @@ -23,7 +23,7 @@ import Control.Monad import Data.List import Data.Maybe import Data.Ord -import "text" qualified Data.Text as T +import qualified "text" Data.Text as T import Data.Text.IO qualified as T import Safe import System.Environment diff --git a/bin/hledger-register-max2.hs b/bin/hledger-register-max2.hs index 4f1ff3c85..44a22f1c2 100755 --- a/bin/hledger-register-max2.hs +++ b/bin/hledger-register-max2.hs @@ -12,8 +12,8 @@ {-# LANGUAGE PackageImports #-} import Hledger.Cli.Script -import "text" qualified Data.Text as T -import "text" qualified Data.Text.IO as T +import qualified "text" Data.Text as T +import qualified "text" Data.Text.IO as T cmdmode = hledgerCommandMode (unlines -- Command name, then --help text. Note, empty help lines get stripped. diff --git a/bin/hledger-report1.hs b/bin/hledger-report1.hs index 0dcbc97de..f2a2b92a1 100755 --- a/bin/hledger-report1.hs +++ b/bin/hledger-report1.hs @@ -12,8 +12,8 @@ {-# LANGUAGE PackageImports #-} import Hledger.Cli.Script -import "text" qualified Data.Text as T -import "text" qualified Data.Text.IO as T +import qualified "text" Data.Text as T +import qualified "text" Data.Text.IO as T cmdmode = hledgerCommandMode (unlines ["report1"