Skip to content

Commit 7b8684b

Browse files
adeptsimonmichael
adept
authored and
simonmichael
committed
;scripts: fix all the scripts in ./bin. Fixes #2497 
1 parent 41a81fa commit 7b8684b

File tree

5 files changed

+132
-21
lines changed

5 files changed

+132
-21
lines changed

‎bin/hledger-balance-as-budget-multi.hs‎

Lines changed: 60 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,8 @@ import Data.Text.Lazy.IO qualified as TL
1212
import System.Environment (getArgs)
1313
import Hledger.Cli.Script
1414
import Hledger.Cli.Commands.Balance
15+
import qualified Data.Map as Map
16+
import Data.List (sortOn)
1517

1618
------------------------------------------------------------------------------
1719
cmdmode = hledgerCommandMode
@@ -23,7 +25,7 @@ cmdmode = hledgerCommandMode
2325
,"2019.journal 2020.journal commands.txt"
2426
,"and put '\"assets\" --depth 3 --value=$,then' in the commands.txt"
2527
])
26-
[]
28+
[]
2729
[generalflagsgroup1]
2830
[]
2931
([], Just $ argsFlag "BUDGET_JOURNAL ACTUAL_JOURNAL COMMAND_FILE")
@@ -49,9 +51,62 @@ runAllCommands budget_f real_f commands_f = do
4951
[] -> return ()
5052
"echo":args -> putStrLn $ unwords args
5153
_ -> do
52-
opts@CliOpts{reportspec_=rspec} <- getHledgerCliOpts' balancemode args
53-
let b = multiBalanceReport rspec budget
54-
let r = multiBalanceReport rspec real
54+
opts@CliOpts{reportspec_=rspec} <- getHledgerCliOpts' balancemode args
5555
let reportopts = _rsReportOpts rspec
56-
let combined = combineBudgetAndActual reportopts real b{prDates=prDates r} r
56+
57+
-- Generate both reports from their respective journals (unchanged)
58+
let budgetReport = multiBalanceReport rspec budget
59+
actualReport = multiBalanceReport rspec real
60+
61+
-- Combine the reports
62+
let combined = combineBudgetAndActual reportopts real budgetReport actualReport
63+
5764
writeOutputLazyText opts $ budgetReportAsText reportopts $ styleAmounts styles $ combined
65+
66+
-- | Combine two MultiBalanceReports into a BudgetReport, comparing them side by side.
67+
-- The budget report uses the date periods from the actual (second) report.
68+
combineBudgetAndActual :: ReportOpts -> Journal -> MultiBalanceReport -> MultiBalanceReport -> BudgetReport
69+
combineBudgetAndActual ropts j
70+
(PeriodicReport budgetperiods budgetrows (PeriodicReportRow _ budgettots budgetgrandtot budgetgrandavg))
71+
(PeriodicReport actualperiods actualrows (PeriodicReportRow _ actualtots actualgrandtot actualgrandavg)) =
72+
PeriodicReport actualperiods combinedrows totalrow
73+
where
74+
-- Build maps of amounts by account name
75+
budgetMap = Map.fromList
76+
[ (prrFullName row, (prrAmounts row, prrTotal row, prrAverage row))
77+
| row <- budgetrows
78+
]
79+
actualMap = Map.fromList
80+
[ (prrFullName row, (prrAmounts row, prrTotal row, prrAverage row))
81+
| row <- actualrows
82+
]
83+
84+
-- Accounts with actual amounts (and their budgets if available)
85+
actualWithBudget =
86+
[ PeriodicReportRow acct cells total avg
87+
| PeriodicReportRow acct actualamts actualtot actualavg <- actualrows
88+
, let budgetamts = maybe (replicate (length actualperiods) Nothing) (\(amts, _, _) -> map Just amts)
89+
(Map.lookup (displayFull acct) budgetMap)
90+
, let cells = zip (map Just actualamts) budgetamts
91+
, let total = (Just actualtot, fmap (\(_, t, _) -> t) (Map.lookup (displayFull acct) budgetMap))
92+
, let avg = (Just actualavg, fmap (\(_, _, a) -> a) (Map.lookup (displayFull acct) budgetMap))
93+
]
94+
95+
-- Budget-only accounts (no actual amounts)
96+
budgetOnly =
97+
[ PeriodicReportRow acct cells total avg
98+
| PeriodicReportRow acct budgetamts budgettot budgetavg <- budgetrows
99+
, let acctName = displayFull acct
100+
, not (acctName `Map.member` actualMap) -- Only include if not in actual
101+
, let cells = zip (replicate (length actualperiods) (Just nullmixedamt)) (map Just budgetamts)
102+
, let total = (Just nullmixedamt, Just budgettot)
103+
, let avg = (Just nullmixedamt, Just budgetavg)
104+
]
105+
106+
-- Combine and sort all rows by account name
107+
combinedrows = sortOn prrFullName (actualWithBudget ++ budgetOnly)
108+
109+
totalrow = PeriodicReportRow ()
110+
(zip (map Just actualtots) (map Just budgettots))
111+
(Just actualgrandtot, Just budgetgrandtot)
112+
(Just actualgrandavg, Just budgetgrandavg)

‎bin/hledger-balance-as-budget.hs‎

Lines changed: 67 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,8 @@ import Data.Text.Lazy.IO as TL
1212
import System.Environment (getArgs)
1313
import Hledger.Cli.Script
1414
import Hledger.Cli.Commands.Balance
15+
import qualified Data.Map as Map
16+
import Data.List (sortOn)
1517

1618
------------------------------------------------------------------------------
1719
cmdmode = hledgerCommandMode
@@ -24,7 +26,7 @@ cmdmode = hledgerCommandMode
2426
," "
2527
,"Display features in the report are driven by the second set of args"
2628
])
27-
[]
29+
[]
2830
[generalflagsgroup1]
2931
[]
3032
([], Just $ argsFlag "[QUERY]")
@@ -35,14 +37,68 @@ main = do
3537
args <- getArgs
3638
let report1args = takeWhile (/= "--") args
3739
let report2args = drop 1 $ dropWhile (/= "--") args
38-
(opts,_,_,report1) <- mbReport report1args
39-
(_,ropts2,j,report2) <- mbReport report2args
40-
let pastAsBudget = combineBudgetAndActual ropts2 j report1{prDates=prDates report2} report2
41-
styles = journalCommodityStylesWith HardRounding j
42-
writeOutputLazyText opts $ budgetReportAsText ropts2 $ styleAmounts styles $ pastAsBudget
40+
41+
-- Get options for both reports
42+
opts1@CliOpts{reportspec_=rspec1} <- getHledgerCliOpts' balancemode report1args
43+
opts2@CliOpts{reportspec_=rspec2} <- getHledgerCliOpts' balancemode report2args
44+
45+
withJournal opts1 $ \j1 -> do
46+
withJournal opts2 $ \j2 -> do
47+
-- Generate both reports with their respective date periods
48+
let report1 = multiBalanceReport rspec1 j1 -- budget
49+
report2 = multiBalanceReport rspec2 j2 -- actual
50+
ropts2 = _rsReportOpts rspec2
51+
styles = journalCommodityStylesWith HardRounding j2
52+
53+
-- Combine the reports (using report2's date periods for display)
54+
let combined = combineBudgetAndActual ropts2 j2 report1 report2
55+
56+
writeOutputLazyText opts2 $ budgetReportAsText ropts2 $ styleAmounts styles $ combined
57+
58+
-- | Combine two MultiBalanceReports into a BudgetReport, comparing them side by side.
59+
-- The budget report uses the date periods from the actual (second) report.
60+
combineBudgetAndActual :: ReportOpts -> Journal -> MultiBalanceReport -> MultiBalanceReport -> BudgetReport
61+
combineBudgetAndActual ropts j
62+
(PeriodicReport budgetperiods budgetrows (PeriodicReportRow _ budgettots budgetgrandtot budgetgrandavg))
63+
(PeriodicReport actualperiods actualrows (PeriodicReportRow _ actualtots actualgrandtot actualgrandavg)) =
64+
PeriodicReport actualperiods combinedrows totalrow
4365
where
44-
mbReport args = do
45-
opts@CliOpts{reportspec_=rspec} <- getHledgerCliOpts' balancemode args
46-
d <- getCurrentDay
47-
(report,j) <- withJournal opts $ \j -> return (multiBalanceReport rspec j, j)
48-
return (opts, _rsReportOpts rspec,j,report)
66+
-- Build maps of amounts by account name
67+
budgetMap = Map.fromList
68+
[ (prrFullName row, (prrAmounts row, prrTotal row, prrAverage row))
69+
| row <- budgetrows
70+
]
71+
actualMap = Map.fromList
72+
[ (prrFullName row, (prrAmounts row, prrTotal row, prrAverage row))
73+
| row <- actualrows
74+
]
75+
76+
-- Accounts with actual amounts (and their budgets if available)
77+
actualWithBudget =
78+
[ PeriodicReportRow acct cells total avg
79+
| PeriodicReportRow acct actualamts actualtot actualavg <- actualrows
80+
, let budgetamts = maybe (replicate (length actualperiods) Nothing) (\(amts, _, _) -> map Just amts)
81+
(Map.lookup (displayFull acct) budgetMap)
82+
, let cells = zip (map Just actualamts) budgetamts
83+
, let total = (Just actualtot, fmap (\(_, t, _) -> t) (Map.lookup (displayFull acct) budgetMap))
84+
, let avg = (Just actualavg, fmap (\(_, _, a) -> a) (Map.lookup (displayFull acct) budgetMap))
85+
]
86+
87+
-- Budget-only accounts (no actual amounts)
88+
budgetOnly =
89+
[ PeriodicReportRow acct cells total avg
90+
| PeriodicReportRow acct budgetamts budgettot budgetavg <- budgetrows
91+
, let acctName = displayFull acct
92+
, not (acctName `Map.member` actualMap) -- Only include if not in actual
93+
, let cells = zip (replicate (length actualperiods) (Just nullmixedamt)) (map Just budgetamts)
94+
, let total = (Just nullmixedamt, Just budgettot)
95+
, let avg = (Just nullmixedamt, Just budgetavg)
96+
]
97+
98+
-- Combine and sort all rows by account name
99+
combinedrows = sortOn prrFullName (actualWithBudget ++ budgetOnly)
100+
101+
totalrow = PeriodicReportRow ()
102+
(zip (map Just actualtots) (map Just budgettots))
103+
(Just actualgrandtot, Just budgetgrandtot)
104+
(Just actualgrandavg, Just budgetgrandavg)

‎bin/hledger-register-max.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -23,7 +23,7 @@ import Control.Monad
2323
import Data.List
2424
import Data.Maybe
2525
import Data.Ord
26-
import "text" qualified Data.Text as T
26+
import qualified "text" Data.Text as T
2727
import Data.Text.IO qualified as T
2828
import Safe
2929
import System.Environment

‎bin/hledger-register-max2.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -12,8 +12,8 @@
1212
{-# LANGUAGE PackageImports #-}
1313

1414
import Hledger.Cli.Script
15-
import "text" qualified Data.Text as T
16-
import "text" qualified Data.Text.IO as T
15+
import qualified "text" Data.Text as T
16+
import qualified "text" Data.Text.IO as T
1717

1818
cmdmode = hledgerCommandMode (unlines
1919
-- Command name, then --help text. Note, empty help lines get stripped.

‎bin/hledger-report1.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -12,8 +12,8 @@
1212
{-# LANGUAGE PackageImports #-}
1313

1414
import Hledger.Cli.Script
15-
import "text" qualified Data.Text as T
16-
import "text" qualified Data.Text.IO as T
15+
import qualified "text" Data.Text as T
16+
import qualified "text" Data.Text.IO as T
1717

1818
cmdmode = hledgerCommandMode (unlines
1919
["report1"

0 commit comments

Comments
 (0)