mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-20 02:37:12 +03:00
budget: use a new first-class BudgetReport for --budget
This commit is contained in:
parent
4b3c6afe75
commit
43287a3e26
@ -16,6 +16,7 @@ module Hledger.Reports (
|
|||||||
module Hledger.Reports.TransactionsReports,
|
module Hledger.Reports.TransactionsReports,
|
||||||
module Hledger.Reports.BalanceReport,
|
module Hledger.Reports.BalanceReport,
|
||||||
module Hledger.Reports.MultiBalanceReports,
|
module Hledger.Reports.MultiBalanceReports,
|
||||||
|
module Hledger.Reports.BudgetReport,
|
||||||
-- module Hledger.Reports.BalanceHistoryReport,
|
-- module Hledger.Reports.BalanceHistoryReport,
|
||||||
|
|
||||||
-- * Tests
|
-- * Tests
|
||||||
@ -32,6 +33,7 @@ import Hledger.Reports.PostingsReport
|
|||||||
import Hledger.Reports.TransactionsReports
|
import Hledger.Reports.TransactionsReports
|
||||||
import Hledger.Reports.BalanceReport
|
import Hledger.Reports.BalanceReport
|
||||||
import Hledger.Reports.MultiBalanceReports
|
import Hledger.Reports.MultiBalanceReports
|
||||||
|
import Hledger.Reports.BudgetReport
|
||||||
-- import Hledger.Reports.BalanceHistoryReport
|
-- import Hledger.Reports.BalanceHistoryReport
|
||||||
|
|
||||||
tests_Hledger_Reports :: Test
|
tests_Hledger_Reports :: Test
|
||||||
@ -42,5 +44,6 @@ tests_Hledger_Reports = TestList $
|
|||||||
tests_Hledger_Reports_EntriesReport,
|
tests_Hledger_Reports_EntriesReport,
|
||||||
tests_Hledger_Reports_PostingsReport,
|
tests_Hledger_Reports_PostingsReport,
|
||||||
tests_Hledger_Reports_BalanceReport,
|
tests_Hledger_Reports_BalanceReport,
|
||||||
tests_Hledger_Reports_MultiBalanceReport
|
tests_Hledger_Reports_MultiBalanceReport,
|
||||||
|
tests_Hledger_Reports_BudgetReport
|
||||||
]
|
]
|
||||||
|
341
hledger-lib/Hledger/Reports/BudgetReport.hs
Normal file
341
hledger-lib/Hledger/Reports/BudgetReport.hs
Normal file
@ -0,0 +1,341 @@
|
|||||||
|
{- |
|
||||||
|
-}
|
||||||
|
|
||||||
|
{-# LANGUAGE CPP #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
|
||||||
|
module Hledger.Reports.BudgetReport
|
||||||
|
where
|
||||||
|
|
||||||
|
import Data.Decimal
|
||||||
|
import Data.List
|
||||||
|
import Data.Maybe
|
||||||
|
#if !(MIN_VERSION_base(4,11,0))
|
||||||
|
import Data.Monoid ((<>))
|
||||||
|
#endif
|
||||||
|
import Data.Ord
|
||||||
|
import Data.Time.Calendar
|
||||||
|
--import Safe
|
||||||
|
import Test.HUnit
|
||||||
|
--import Data.List
|
||||||
|
--import Data.Maybe
|
||||||
|
import qualified Data.Map as Map
|
||||||
|
import Data.Map (Map)
|
||||||
|
import qualified Data.Text as T
|
||||||
|
--import qualified Data.Text.Lazy as TL
|
||||||
|
--import System.Console.CmdArgs.Explicit as C
|
||||||
|
--import Lucid as L
|
||||||
|
--import Text.CSV
|
||||||
|
--import Test.HUnit
|
||||||
|
import Text.Printf (printf)
|
||||||
|
import Text.Tabular as T
|
||||||
|
--import Text.Tabular.AsciiWide
|
||||||
|
|
||||||
|
import Hledger.Data
|
||||||
|
--import Hledger.Query
|
||||||
|
import Hledger.Utils
|
||||||
|
--import Hledger.Read (mamountp')
|
||||||
|
import Hledger.Reports.ReportOptions
|
||||||
|
import Hledger.Reports.ReportTypes
|
||||||
|
import Hledger.Reports.MultiBalanceReports
|
||||||
|
|
||||||
|
|
||||||
|
--type MultiBalanceReportRow = (AccountName, AccountName, Int, [MixedAmount], MixedAmount, MixedAmount)
|
||||||
|
--type MultiBalanceReportTotals = ([MixedAmount], MixedAmount, MixedAmount) -- (Totals list, sum of totals, average of totals)
|
||||||
|
|
||||||
|
--type PeriodicReportRow a =
|
||||||
|
-- ( AccountName -- ^ A full account name.
|
||||||
|
-- , [a] -- ^ The data value for each subperiod.
|
||||||
|
-- , a -- ^ The total of this row's values.
|
||||||
|
-- , a -- ^ The average of this row's values.
|
||||||
|
-- )
|
||||||
|
|
||||||
|
type BudgetGoal = Change
|
||||||
|
type BudgetTotal = Total
|
||||||
|
type BudgetAverage = Average
|
||||||
|
|
||||||
|
-- | A budget report tracks expected and actual changes per account and subperiod.
|
||||||
|
type BudgetReport = PeriodicReport (Maybe Change, Maybe BudgetGoal)
|
||||||
|
|
||||||
|
-- | Calculate budget goals from periodic transactions with the specified report interval,
|
||||||
|
-- calculate actual inflows/outflows from the regular transactions (adjusted to match the
|
||||||
|
-- budget goals' account tree), and return both as a 'BudgetReport'.
|
||||||
|
budgetReport :: ReportOpts -> Bool -> Bool -> DateSpan -> Day -> Journal -> BudgetReport
|
||||||
|
budgetReport ropts assrt showunbudgeted reportspan d j =
|
||||||
|
let
|
||||||
|
budgetj = budgetJournal assrt ropts reportspan j
|
||||||
|
actualj = budgetRollUp showunbudgeted budgetj j
|
||||||
|
q = queryFromOpts d ropts
|
||||||
|
budgetgoalreport = dbg1 "budgetgoalreport" $ multiBalanceReport ropts q budgetj
|
||||||
|
actualreport = dbg1 "actualreport" $ multiBalanceReport ropts q actualj
|
||||||
|
in
|
||||||
|
dbg1 "budgetreport" $
|
||||||
|
combineBudgetAndActual budgetgoalreport actualreport
|
||||||
|
|
||||||
|
-- | Select all periodic transactions from the given journal which
|
||||||
|
-- match the requested report interval, and use them to generate
|
||||||
|
-- budget transactions (like forecast transactions) in the specified
|
||||||
|
-- report period (calculated in IO and passed in).
|
||||||
|
budgetJournal :: Bool -> ReportOpts -> DateSpan -> Journal -> Journal
|
||||||
|
budgetJournal assrt ropts reportspan j =
|
||||||
|
either error' id $ journalBalanceTransactions assrt j{ jtxns = budgetts }
|
||||||
|
where
|
||||||
|
budgetinterval = dbg2 "budgetinterval" $ interval_ ropts
|
||||||
|
budgetspan = dbg2 "budgetspan" $ reportspan
|
||||||
|
budgetts =
|
||||||
|
dbg1 "budgetts" $
|
||||||
|
[makeBudgetTxn t
|
||||||
|
| pt <- jperiodictxns j
|
||||||
|
, periodTransactionInterval pt == Just budgetinterval
|
||||||
|
, t <- runPeriodicTransaction pt budgetspan
|
||||||
|
]
|
||||||
|
makeBudgetTxn t = txnTieKnot $ t { tdescription = T.pack "Budget transaction" }
|
||||||
|
|
||||||
|
-- | Re-map account names to closest parent with periodic transaction from budget.
|
||||||
|
-- Accounts that don't have suitable parent are either remapped to "<unbudgeted>:topAccount"
|
||||||
|
-- or left as-is if --show-unbudgeted is provided.
|
||||||
|
budgetRollUp :: Bool -> Journal -> Journal -> Journal
|
||||||
|
budgetRollUp showunbudgeted budget j = j { jtxns = remapTxn <$> jtxns j }
|
||||||
|
where
|
||||||
|
budgetAccounts = nub $ concatMap (map paccount . ptpostings) $ jperiodictxns budget
|
||||||
|
remapAccount origAcctName = remapAccount' origAcctName
|
||||||
|
where
|
||||||
|
remapAccount' acctName
|
||||||
|
| acctName `elem` budgetAccounts = acctName
|
||||||
|
| otherwise =
|
||||||
|
case parentAccountName acctName of
|
||||||
|
"" | showunbudgeted -> origAcctName
|
||||||
|
| otherwise -> T.append (T.pack "<unbudgeted>:") acctName -- TODO: --drop should not remove this
|
||||||
|
parent -> remapAccount' parent
|
||||||
|
remapPosting p = p { paccount = remapAccount $ paccount p, porigin = Just . fromMaybe p $ porigin p }
|
||||||
|
remapTxn = mapPostings (map remapPosting)
|
||||||
|
mapPostings f t = txnTieKnot $ t { tpostings = f $ tpostings t }
|
||||||
|
|
||||||
|
-- | Combine a per-account-and-subperiod report of budget goals, and one
|
||||||
|
-- of actual change amounts, into a budget performance report.
|
||||||
|
-- The two reports should have the same report interval, but need not
|
||||||
|
-- have exactly the same account rows or date columns.
|
||||||
|
-- (Cells in the combined budget report can be missing a budget goal,
|
||||||
|
-- an actual amount, or both.) The combined report will include:
|
||||||
|
--
|
||||||
|
-- - consecutive subperiods at the same interval as the two reports,
|
||||||
|
-- spanning the period of both reports
|
||||||
|
--
|
||||||
|
-- - all accounts mentioned in either report, sorted by account code or
|
||||||
|
-- account name or amount as appropriate.
|
||||||
|
--
|
||||||
|
combineBudgetAndActual :: MultiBalanceReport -> MultiBalanceReport -> BudgetReport
|
||||||
|
combineBudgetAndActual
|
||||||
|
(MultiBalanceReport (budgetperiods, budgetrows, (budgettots, budgetgrandtot, budgetgrandavg)))
|
||||||
|
(MultiBalanceReport (actualperiods, actualrows, (actualtots, actualgrandtot, actualgrandavg))) =
|
||||||
|
let
|
||||||
|
periods = nub $ sort $ filter (/= nulldatespan) $ budgetperiods ++ actualperiods
|
||||||
|
|
||||||
|
-- first, combine any corresponding budget goals with actual changes
|
||||||
|
rows1 =
|
||||||
|
[ (acct, treeacct, treeindent, amtandgoals, totamtandgoal, avgamtandgoal)
|
||||||
|
| (acct, treeacct, treeindent, actualamts, actualtot, actualavg) <- actualrows
|
||||||
|
, let mbudgetgoals = Map.lookup acct budgetGoalsByAcct :: Maybe ([BudgetGoal], BudgetTotal, BudgetAverage)
|
||||||
|
, let budgetmamts = maybe (replicate (length periods) Nothing) (map Just . first3) mbudgetgoals :: [Maybe BudgetGoal]
|
||||||
|
, let mbudgettot = maybe Nothing (Just . second3) mbudgetgoals :: Maybe BudgetTotal
|
||||||
|
, let mbudgetavg = maybe Nothing (Just . third3) mbudgetgoals :: Maybe BudgetAverage
|
||||||
|
, let acctBudgetByPeriod = Map.fromList [ (p,budgetamt) | (p, Just budgetamt) <- zip budgetperiods budgetmamts ] :: Map DateSpan BudgetGoal
|
||||||
|
, let acctActualByPeriod = Map.fromList [ (p,actualamt) | (p, Just actualamt) <- zip actualperiods (map Just actualamts) ] :: Map DateSpan Change
|
||||||
|
, let amtandgoals = [ (Map.lookup p acctActualByPeriod, Map.lookup p acctBudgetByPeriod) | p <- periods ] :: [(Maybe Change, Maybe BudgetGoal)]
|
||||||
|
, let totamtandgoal = (Just actualtot, mbudgettot)
|
||||||
|
, let avgamtandgoal = (Just actualavg, mbudgetavg)
|
||||||
|
]
|
||||||
|
where
|
||||||
|
budgetGoalsByAcct :: Map AccountName ([BudgetGoal], BudgetTotal, BudgetAverage) =
|
||||||
|
Map.fromList [ (acct, (amts, tot, avg)) | (acct, _, _, amts, tot, avg) <- budgetrows ]
|
||||||
|
|
||||||
|
-- next, make rows for budget goals with no actual changes
|
||||||
|
rows2 =
|
||||||
|
[ (acct, treeacct, treeindent, amtandgoals, totamtandgoal, avgamtandgoal)
|
||||||
|
| (acct, treeacct, treeindent, budgetgoals, budgettot, budgetavg) <- budgetrows
|
||||||
|
, not $ acct `elem` acctsdone
|
||||||
|
, let acctBudgetByPeriod = Map.fromList $ zip budgetperiods budgetgoals :: Map DateSpan BudgetGoal
|
||||||
|
, let amtandgoals = [ (Nothing, Map.lookup p acctBudgetByPeriod) | p <- periods ] :: [(Maybe Change, Maybe BudgetGoal)]
|
||||||
|
, let totamtandgoal = (Nothing, Just budgettot)
|
||||||
|
, let avgamtandgoal = (Nothing, Just budgetavg)
|
||||||
|
]
|
||||||
|
where
|
||||||
|
acctsdone = map first6 rows1
|
||||||
|
|
||||||
|
-- combine and re-sort rows
|
||||||
|
-- TODO: respect hierarchy in tree mode
|
||||||
|
-- TODO: respect --sort-amount
|
||||||
|
-- TODO: add --sort-budget
|
||||||
|
rows :: [PeriodicReportRow (Maybe Change, Maybe BudgetGoal)] =
|
||||||
|
sortBy (comparing first6) $ rows1 ++ rows2
|
||||||
|
-- massive duplication from multiBalanceReport to handle tree mode sorting ?
|
||||||
|
-- dbg1 "sorteditems" $
|
||||||
|
-- sortitems items
|
||||||
|
-- where
|
||||||
|
-- sortitems
|
||||||
|
-- | sort_amount_ opts && accountlistmode_ opts == ALTree = sortTreeMultiBalanceReportRowsByAmount
|
||||||
|
-- | sort_amount_ opts = sortFlatMultiBalanceReportRowsByAmount
|
||||||
|
-- | not (sort_amount_ opts) && accountlistmode_ opts == ALTree = sortTreeMultiBalanceReportRowsByAccountCodeAndName
|
||||||
|
-- | otherwise = sortFlatMultiBalanceReportRowsByAccountCodeAndName
|
||||||
|
-- where
|
||||||
|
-- -- Sort the report rows, representing a flat account list, by row total.
|
||||||
|
-- sortFlatMultiBalanceReportRowsByAmount = sortBy (maybeflip $ comparing fifth6)
|
||||||
|
-- where
|
||||||
|
-- maybeflip = if normalbalance_ opts == Just NormallyNegative then id else flip
|
||||||
|
--
|
||||||
|
-- -- Sort the report rows, representing a tree of accounts, by row total at each level.
|
||||||
|
-- -- To do this we recreate an Account tree with the row totals as balances,
|
||||||
|
-- -- so we can do a hierarchical sort, flatten again, and then reorder the
|
||||||
|
-- -- report rows similarly. Yes this is pretty long winded.
|
||||||
|
-- sortTreeMultiBalanceReportRowsByAmount rows = sortedrows
|
||||||
|
-- where
|
||||||
|
-- anamesandrows = [(first6 r, r) | r <- rows]
|
||||||
|
-- anames = map fst anamesandrows
|
||||||
|
-- atotals = [(a,tot) | (a,_,_,_,tot,_) <- rows]
|
||||||
|
-- nametree = treeFromPaths $ map expandAccountName anames
|
||||||
|
-- accounttree = nameTreeToAccount "root" nametree
|
||||||
|
-- accounttreewithbals = mapAccounts setibalance accounttree
|
||||||
|
-- where
|
||||||
|
-- -- this error should not happen, but it's ugly TODO
|
||||||
|
-- setibalance a = a{aibalance=fromMaybe (error "sortTreeMultiBalanceReportRowsByAmount 1") $ lookup (aname a) atotals}
|
||||||
|
-- sortedaccounttree = sortAccountTreeByAmount (fromMaybe NormallyPositive $ normalbalance_ opts) accounttreewithbals
|
||||||
|
-- sortedaccounts = drop 1 $ flattenAccounts sortedaccounttree
|
||||||
|
-- -- dropped the root account, also ignore any parent accounts not in rows
|
||||||
|
-- sortedrows = concatMap (\a -> maybe [] (:[]) $ lookup (aname a) anamesandrows) sortedaccounts
|
||||||
|
--
|
||||||
|
-- -- Sort the report rows by account code if any, with the empty account code coming last, then account name.
|
||||||
|
-- sortFlatMultiBalanceReportRowsByAccountCodeAndName = sortBy (comparing acodeandname)
|
||||||
|
-- where
|
||||||
|
-- acodeandname r = (acode', aname)
|
||||||
|
-- where
|
||||||
|
-- aname = first6 r
|
||||||
|
-- macode = fromMaybe Nothing $ lookup aname $ jaccounts j
|
||||||
|
-- acode' = fromMaybe maxBound macode
|
||||||
|
--
|
||||||
|
-- -- Sort the report rows, representing a tree of accounts, by account code and then account name at each level.
|
||||||
|
-- -- Convert a tree of account names, look up the account codes, sort and flatten the tree, reorder the rows.
|
||||||
|
-- sortTreeMultiBalanceReportRowsByAccountCodeAndName rows = sortedrows
|
||||||
|
-- where
|
||||||
|
-- anamesandrows = [(first6 r, r) | r <- rows]
|
||||||
|
-- anames = map fst anamesandrows
|
||||||
|
-- nametree = treeFromPaths $ map expandAccountName anames
|
||||||
|
-- accounttree = nameTreeToAccount "root" nametree
|
||||||
|
-- accounttreewithcodes = mapAccounts (accountSetCodeFrom j) accounttree
|
||||||
|
-- sortedaccounttree = sortAccountTreeByAccountCodeAndName accounttreewithcodes
|
||||||
|
-- sortedaccounts = drop 1 $ flattenAccounts sortedaccounttree
|
||||||
|
-- -- dropped the root account, also ignore any parent accounts not in rows
|
||||||
|
-- sortedrows = concatMap (\a -> maybe [] (:[]) $ lookup (aname a) anamesandrows) sortedaccounts
|
||||||
|
--
|
||||||
|
|
||||||
|
-- TODO: grand total & average shows 0% when there are no actual amounts, inconsistent with other cells
|
||||||
|
totalrow =
|
||||||
|
( ""
|
||||||
|
, ""
|
||||||
|
, 0
|
||||||
|
, [ (Map.lookup p totActualByPeriod, Map.lookup p totBudgetByPeriod) | p <- periods ] :: [(Maybe Total, Maybe BudgetTotal)]
|
||||||
|
, ( Just actualgrandtot, Just budgetgrandtot ) :: (Maybe Total, Maybe BudgetTotal)
|
||||||
|
, ( Just actualgrandavg, Just budgetgrandavg ) :: (Maybe Total, Maybe BudgetTotal)
|
||||||
|
)
|
||||||
|
where
|
||||||
|
totBudgetByPeriod = Map.fromList $ zip budgetperiods budgettots :: Map DateSpan BudgetTotal
|
||||||
|
totActualByPeriod = Map.fromList $ zip actualperiods actualtots :: Map DateSpan Change
|
||||||
|
|
||||||
|
in
|
||||||
|
PeriodicReport
|
||||||
|
( periods
|
||||||
|
, rows
|
||||||
|
, totalrow
|
||||||
|
)
|
||||||
|
|
||||||
|
-- | Figure out the overall period of a BudgetReport.
|
||||||
|
budgetReportSpan :: BudgetReport -> DateSpan
|
||||||
|
budgetReportSpan (PeriodicReport ([], _, _)) = DateSpan Nothing Nothing
|
||||||
|
budgetReportSpan (PeriodicReport (spans, _, _)) = DateSpan (spanStart $ head spans) (spanEnd $ last spans)
|
||||||
|
|
||||||
|
-- | Render a budget report as plain text suitable for console output.
|
||||||
|
budgetReportAsText :: ReportOpts -> BudgetReport -> String
|
||||||
|
budgetReportAsText ropts budgetr =
|
||||||
|
printf "Budget performance in %s:\n\n" (showDateSpan $ budgetReportSpan budgetr)
|
||||||
|
++
|
||||||
|
tableAsText ropts showcell (budgetReportAsTable ropts budgetr)
|
||||||
|
where
|
||||||
|
showcell :: (Maybe Change, Maybe BudgetGoal) -> String
|
||||||
|
showcell (mactual, mbudget) = actualstr ++ " " ++ budgetstr
|
||||||
|
where
|
||||||
|
actualwidth = 7
|
||||||
|
percentwidth = 4
|
||||||
|
budgetwidth = 5
|
||||||
|
actualstr = printf ("%"++show actualwidth++"s") (maybe "0" showamt mactual)
|
||||||
|
budgetstr = case (mactual, mbudget) of
|
||||||
|
(_, Nothing) -> replicate (percentwidth + 7 + budgetwidth) ' '
|
||||||
|
(mactual, Just budget) ->
|
||||||
|
case percentage mactual budget of
|
||||||
|
Just pct ->
|
||||||
|
printf ("[%"++show percentwidth++"s%% of %"++show budgetwidth++"s]")
|
||||||
|
(show $ roundTo 0 pct) (showbudgetamt budget)
|
||||||
|
Nothing ->
|
||||||
|
printf ("["++replicate (percentwidth+5) ' '++"%"++show budgetwidth++"s]")
|
||||||
|
(showbudgetamt budget)
|
||||||
|
|
||||||
|
percentage :: Maybe Change -> BudgetGoal -> Maybe Percentage
|
||||||
|
percentage Nothing _ = Nothing
|
||||||
|
percentage (Just actual) budget =
|
||||||
|
-- percentage of budget consumed is always computed in the cost basis
|
||||||
|
case (toCost actual, toCost budget) of
|
||||||
|
(Mixed [a1], Mixed [a2])
|
||||||
|
| isReallyZeroAmount a1 -> Just 0 -- if there are no postings, we consumed 0% of budget
|
||||||
|
| acommodity a1 == acommodity a2 && aquantity a2 /= 0 ->
|
||||||
|
Just $ 100 * aquantity a1 / aquantity a2
|
||||||
|
_ -> Nothing
|
||||||
|
where
|
||||||
|
toCost = normaliseMixedAmount . costOfMixedAmount
|
||||||
|
|
||||||
|
showamt :: MixedAmount -> String
|
||||||
|
showamt | color_ ropts = cshowMixedAmountOneLineWithoutPrice
|
||||||
|
| otherwise = showMixedAmountOneLineWithoutPrice
|
||||||
|
|
||||||
|
-- don't show the budget amount in color, it messes up alignment
|
||||||
|
showbudgetamt = showMixedAmountOneLineWithoutPrice
|
||||||
|
|
||||||
|
-- | Build a 'Table' from a multi-column balance report.
|
||||||
|
budgetReportAsTable :: ReportOpts -> BudgetReport -> Table String String (Maybe MixedAmount, Maybe MixedAmount)
|
||||||
|
budgetReportAsTable
|
||||||
|
ropts
|
||||||
|
(PeriodicReport
|
||||||
|
( periods
|
||||||
|
, rows
|
||||||
|
, (_, _, _, coltots, grandtot, grandavg)
|
||||||
|
)) =
|
||||||
|
addtotalrow $
|
||||||
|
Table
|
||||||
|
(T.Group NoLine $ map Header accts)
|
||||||
|
(T.Group NoLine $ map Header colheadings)
|
||||||
|
(map rowvals rows)
|
||||||
|
where
|
||||||
|
colheadings = map showDateSpanMonthAbbrev periods
|
||||||
|
++ (if row_total_ ropts then [" Total"] else [])
|
||||||
|
++ (if average_ ropts then ["Average"] else [])
|
||||||
|
accts = map renderacct rows
|
||||||
|
renderacct (a,a',i,_,_,_)
|
||||||
|
| tree_ ropts = replicate ((i-1)*2) ' ' ++ T.unpack a'
|
||||||
|
| otherwise = T.unpack $ maybeAccountNameDrop ropts a
|
||||||
|
rowvals (_,_,_,as,rowtot,rowavg) = as
|
||||||
|
++ (if row_total_ ropts then [rowtot] else [])
|
||||||
|
++ (if average_ ropts then [rowavg] else [])
|
||||||
|
addtotalrow | no_total_ ropts = id
|
||||||
|
| otherwise = (+----+ (row "" $
|
||||||
|
coltots
|
||||||
|
++ (if row_total_ ropts && not (null coltots) then [grandtot] else [])
|
||||||
|
++ (if average_ ropts && not (null coltots) then [grandavg] else [])
|
||||||
|
))
|
||||||
|
|
||||||
|
-- XXX here for now
|
||||||
|
-- | Drop leading components of accounts names as specified by --drop, but only in --flat mode.
|
||||||
|
maybeAccountNameDrop :: ReportOpts -> AccountName -> AccountName
|
||||||
|
maybeAccountNameDrop opts a | tree_ opts = a
|
||||||
|
| otherwise = accountNameDrop (drop_ opts) a
|
||||||
|
|
||||||
|
tests_Hledger_Reports_BudgetReport :: Test
|
||||||
|
tests_Hledger_Reports_BudgetReport = TestList [
|
||||||
|
]
|
@ -12,6 +12,8 @@ module Hledger.Reports.MultiBalanceReports (
|
|||||||
balanceReportFromMultiBalanceReport,
|
balanceReportFromMultiBalanceReport,
|
||||||
mbrNegate,
|
mbrNegate,
|
||||||
mbrNormaliseSign,
|
mbrNormaliseSign,
|
||||||
|
multiBalanceReportSpan,
|
||||||
|
tableAsText,
|
||||||
|
|
||||||
-- -- * Tests
|
-- -- * Tests
|
||||||
tests_Hledger_Reports_MultiBalanceReport
|
tests_Hledger_Reports_MultiBalanceReport
|
||||||
@ -24,6 +26,8 @@ import Data.Ord
|
|||||||
import Data.Time.Calendar
|
import Data.Time.Calendar
|
||||||
import Safe
|
import Safe
|
||||||
import Test.HUnit
|
import Test.HUnit
|
||||||
|
import Text.Tabular as T
|
||||||
|
import Text.Tabular.AsciiWide
|
||||||
|
|
||||||
import Hledger.Data
|
import Hledger.Data
|
||||||
import Hledger.Query
|
import Hledger.Query
|
||||||
@ -259,6 +263,11 @@ mbrNegate (MultiBalanceReport (colspans, rows, totalsrow)) =
|
|||||||
mbrRowNegate (acct,shortacct,indent,amts,tot,avg) = (acct,shortacct,indent,map negate amts,-tot,-avg)
|
mbrRowNegate (acct,shortacct,indent,amts,tot,avg) = (acct,shortacct,indent,map negate amts,-tot,-avg)
|
||||||
mbrTotalsRowNegate (amts,tot,avg) = (map negate amts,-tot,-avg)
|
mbrTotalsRowNegate (amts,tot,avg) = (map negate amts,-tot,-avg)
|
||||||
|
|
||||||
|
-- | Figure out the overall date span of a multicolumn balance report.
|
||||||
|
multiBalanceReportSpan :: MultiBalanceReport -> DateSpan
|
||||||
|
multiBalanceReportSpan (MultiBalanceReport ([], _, _)) = DateSpan Nothing Nothing
|
||||||
|
multiBalanceReportSpan (MultiBalanceReport (colspans, _, _)) = DateSpan (spanStart $ head colspans) (spanEnd $ last colspans)
|
||||||
|
|
||||||
-- | Generates a simple non-columnar BalanceReport, but using multiBalanceReport,
|
-- | Generates a simple non-columnar BalanceReport, but using multiBalanceReport,
|
||||||
-- in order to support --historical. Does not support tree-mode boring parent eliding.
|
-- in order to support --historical. Does not support tree-mode boring parent eliding.
|
||||||
-- If the normalbalance_ option is set, it adjusts the sorting and sign of amounts
|
-- If the normalbalance_ option is set, it adjusts the sorting and sign of amounts
|
||||||
@ -322,6 +331,22 @@ tests_multiBalanceReport =
|
|||||||
Mixed [usd0])
|
Mixed [usd0])
|
||||||
]
|
]
|
||||||
|
|
||||||
|
-- common rendering helper, XXX here for now
|
||||||
|
|
||||||
|
tableAsText :: ReportOpts -> (a -> String) -> Table String String a -> String
|
||||||
|
tableAsText (ReportOpts{pretty_tables_ = pretty}) showcell =
|
||||||
|
unlines
|
||||||
|
. trimborder
|
||||||
|
. lines
|
||||||
|
. render pretty id id showcell
|
||||||
|
. align
|
||||||
|
where
|
||||||
|
trimborder = drop 1 . init . map (drop 1 . init)
|
||||||
|
align (Table l t d) = Table l' t d
|
||||||
|
where
|
||||||
|
acctswidth = maximum' $ map strWidth (headerContents l)
|
||||||
|
l' = padRightWide acctswidth <$> l
|
||||||
|
|
||||||
tests_Hledger_Reports_MultiBalanceReport :: Test
|
tests_Hledger_Reports_MultiBalanceReport :: Test
|
||||||
tests_Hledger_Reports_MultiBalanceReport = TestList
|
tests_Hledger_Reports_MultiBalanceReport = TestList
|
||||||
tests_multiBalanceReport
|
tests_multiBalanceReport
|
||||||
|
@ -22,19 +22,19 @@ type Average = MixedAmount -- ^ The average of 'Change's or 'Balance's in a rep
|
|||||||
-- budget performance, etc. Successor to MultiBalanceReport.
|
-- budget performance, etc. Successor to MultiBalanceReport.
|
||||||
data PeriodicReport a =
|
data PeriodicReport a =
|
||||||
PeriodicReport
|
PeriodicReport
|
||||||
( [DateSpan] -- ^ The subperiods formed by spliting the overall report period by the report interval.
|
( [DateSpan] -- The subperiods formed by splitting the overall report period by the report interval.
|
||||||
-- For ending-balance reports, only the end date is significant.
|
-- For ending-balance reports, only the end date is significant.
|
||||||
-- Usually displayed as report columns.
|
-- Usually displayed as report columns.
|
||||||
, [PeriodicReportRow a] -- ^ One row per account in the report.
|
, [PeriodicReportRow a] -- One row per account in the report.
|
||||||
, PeriodicReportRow a -- ^ The grand totals row. The account name in this row is always empty.
|
, PeriodicReportRow a -- The grand totals row. The account name in this row is always empty.
|
||||||
)
|
)
|
||||||
deriving (Show)
|
deriving (Show)
|
||||||
|
|
||||||
type PeriodicReportRow a =
|
type PeriodicReportRow a =
|
||||||
( AccountName -- ^ A full account name.
|
( AccountName -- A full account name.
|
||||||
, AccountName -- ^ Shortened form of the account name to display in tree mode. Usually the leaf name, possibly with parent accounts prefixed.
|
, AccountName -- Shortened form of the account name to display in tree mode. Usually the leaf name, possibly with parent accounts prefixed.
|
||||||
, Int -- ^ Indent level for displaying this account name in tree mode. 0, 1, 2...
|
, Int -- Indent level for displaying this account name in tree mode. 0, 1, 2...
|
||||||
, [a] -- ^ The data value for each subperiod.
|
, [a] -- The data value for each subperiod.
|
||||||
, a -- ^ The total of this row's values.
|
, a -- The total of this row's values.
|
||||||
, a -- ^ The average of this row's values.
|
, a -- The average of this row's values.
|
||||||
)
|
)
|
||||||
|
@ -113,8 +113,10 @@ library
|
|||||||
Hledger.Read.TimeclockReader
|
Hledger.Read.TimeclockReader
|
||||||
Hledger.Reports
|
Hledger.Reports
|
||||||
Hledger.Reports.ReportOptions
|
Hledger.Reports.ReportOptions
|
||||||
|
Hledger.Reports.ReportTypes
|
||||||
Hledger.Reports.BalanceHistoryReport
|
Hledger.Reports.BalanceHistoryReport
|
||||||
Hledger.Reports.BalanceReport
|
Hledger.Reports.BalanceReport
|
||||||
|
Hledger.Reports.BudgetReport
|
||||||
Hledger.Reports.EntriesReport
|
Hledger.Reports.EntriesReport
|
||||||
Hledger.Reports.MultiBalanceReports
|
Hledger.Reports.MultiBalanceReports
|
||||||
Hledger.Reports.PostingsReport
|
Hledger.Reports.PostingsReport
|
||||||
@ -130,9 +132,8 @@ library
|
|||||||
Hledger.Utils.Tree
|
Hledger.Utils.Tree
|
||||||
Hledger.Utils.UTF8IOCompat
|
Hledger.Utils.UTF8IOCompat
|
||||||
Text.Megaparsec.Compat
|
Text.Megaparsec.Compat
|
||||||
|
Text.Tabular.AsciiWide
|
||||||
other-modules:
|
other-modules:
|
||||||
Hledger.Reports.BudgetReport
|
|
||||||
Hledger.Reports.ReportTypes
|
|
||||||
Paths_hledger_lib
|
Paths_hledger_lib
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
@ -172,6 +173,7 @@ test-suite doctests
|
|||||||
, regex-tdfa
|
, regex-tdfa
|
||||||
, safe >=0.2
|
, safe >=0.2
|
||||||
, split >=0.1
|
, split >=0.1
|
||||||
|
, tabular >=0.2
|
||||||
, text >=1.2
|
, text >=1.2
|
||||||
, time >=1.5
|
, time >=1.5
|
||||||
, transformers >=0.2
|
, transformers >=0.2
|
||||||
@ -229,6 +231,7 @@ test-suite doctests
|
|||||||
Hledger.Utils.Tree
|
Hledger.Utils.Tree
|
||||||
Hledger.Utils.UTF8IOCompat
|
Hledger.Utils.UTF8IOCompat
|
||||||
Text.Megaparsec.Compat
|
Text.Megaparsec.Compat
|
||||||
|
Text.Tabular.AsciiWide
|
||||||
Paths_hledger_lib
|
Paths_hledger_lib
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
@ -268,6 +271,7 @@ test-suite easytests
|
|||||||
, regex-tdfa
|
, regex-tdfa
|
||||||
, safe >=0.2
|
, safe >=0.2
|
||||||
, split >=0.1
|
, split >=0.1
|
||||||
|
, tabular >=0.2
|
||||||
, text >=1.2
|
, text >=1.2
|
||||||
, time >=1.5
|
, time >=1.5
|
||||||
, transformers >=0.2
|
, transformers >=0.2
|
||||||
@ -323,6 +327,7 @@ test-suite easytests
|
|||||||
Hledger.Utils.Tree
|
Hledger.Utils.Tree
|
||||||
Hledger.Utils.UTF8IOCompat
|
Hledger.Utils.UTF8IOCompat
|
||||||
Text.Megaparsec.Compat
|
Text.Megaparsec.Compat
|
||||||
|
Text.Tabular.AsciiWide
|
||||||
Paths_hledger_lib
|
Paths_hledger_lib
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
@ -363,6 +368,7 @@ test-suite hunittests
|
|||||||
, split >=0.1
|
, split >=0.1
|
||||||
, test-framework
|
, test-framework
|
||||||
, test-framework-hunit
|
, test-framework-hunit
|
||||||
|
, tabular >=0.2
|
||||||
, text >=1.2
|
, text >=1.2
|
||||||
, time >=1.5
|
, time >=1.5
|
||||||
, transformers >=0.2
|
, transformers >=0.2
|
||||||
@ -418,5 +424,6 @@ test-suite hunittests
|
|||||||
Hledger.Utils.Tree
|
Hledger.Utils.Tree
|
||||||
Hledger.Utils.UTF8IOCompat
|
Hledger.Utils.UTF8IOCompat
|
||||||
Text.Megaparsec.Compat
|
Text.Megaparsec.Compat
|
||||||
|
Text.Tabular.AsciiWide
|
||||||
Paths_hledger_lib
|
Paths_hledger_lib
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
@ -63,6 +63,7 @@ dependencies:
|
|||||||
- regex-tdfa
|
- regex-tdfa
|
||||||
- safe >=0.2
|
- safe >=0.2
|
||||||
- split >=0.1
|
- split >=0.1
|
||||||
|
- tabular >=0.2
|
||||||
- text >=1.2
|
- text >=1.2
|
||||||
- time >=1.5
|
- time >=1.5
|
||||||
- transformers >=0.2
|
- transformers >=0.2
|
||||||
@ -141,6 +142,7 @@ library:
|
|||||||
- Hledger.Utils.Tree
|
- Hledger.Utils.Tree
|
||||||
- Hledger.Utils.UTF8IOCompat
|
- Hledger.Utils.UTF8IOCompat
|
||||||
- Text.Megaparsec.Compat
|
- Text.Megaparsec.Compat
|
||||||
|
- Text.Tabular.AsciiWide
|
||||||
# other-modules:
|
# other-modules:
|
||||||
# - Ledger.Parser.Text
|
# - Ledger.Parser.Text
|
||||||
|
|
||||||
|
@ -53,7 +53,6 @@ module Hledger.Cli.CliOptions (
|
|||||||
replaceNumericFlags,
|
replaceNumericFlags,
|
||||||
-- | For register:
|
-- | For register:
|
||||||
registerWidthsFromOpts,
|
registerWidthsFromOpts,
|
||||||
maybeAccountNameDrop,
|
|
||||||
-- | For balance:
|
-- | For balance:
|
||||||
lineFormatFromOpts,
|
lineFormatFromOpts,
|
||||||
|
|
||||||
@ -584,11 +583,6 @@ registerWidthsFromOpts CliOpts{width_=Just s} =
|
|||||||
eof
|
eof
|
||||||
return (totalwidth, descwidth)
|
return (totalwidth, descwidth)
|
||||||
|
|
||||||
-- | Drop leading components of accounts names as specified by --drop, but only in --flat mode.
|
|
||||||
maybeAccountNameDrop :: ReportOpts -> AccountName -> AccountName
|
|
||||||
maybeAccountNameDrop opts a | tree_ opts = a
|
|
||||||
| otherwise = accountNameDrop (drop_ opts) a
|
|
||||||
|
|
||||||
-- for balance, currently:
|
-- for balance, currently:
|
||||||
|
|
||||||
-- | Parse the format option if provided, possibly returning an error,
|
-- | Parse the format option if provided, possibly returning an error,
|
||||||
|
@ -245,25 +245,23 @@ module Hledger.Cli.Commands.Balance (
|
|||||||
,multiBalanceReportAsCsv
|
,multiBalanceReportAsCsv
|
||||||
,multiBalanceReportAsHtml
|
,multiBalanceReportAsHtml
|
||||||
,multiBalanceReportHtmlRows
|
,multiBalanceReportHtmlRows
|
||||||
,renderBalanceReportTable
|
|
||||||
,balanceReportAsTable
|
,balanceReportAsTable
|
||||||
|
,balanceReportTableAsText
|
||||||
,tests_Hledger_Cli_Commands_Balance
|
,tests_Hledger_Cli_Commands_Balance
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.Decimal
|
|
||||||
import Data.List
|
import Data.List
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import qualified Data.Map as Map
|
--import qualified Data.Map as Map
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.Lazy as TL
|
import qualified Data.Text.Lazy as TL
|
||||||
import System.Console.CmdArgs.Explicit as C
|
import System.Console.CmdArgs.Explicit as C
|
||||||
import Data.Decimal (roundTo)
|
|
||||||
import Lucid as L
|
import Lucid as L
|
||||||
import Text.CSV
|
import Text.CSV
|
||||||
import Test.HUnit
|
import Test.HUnit
|
||||||
import Text.Printf (printf)
|
import Text.Printf (printf)
|
||||||
import Text.Tabular as T
|
import Text.Tabular as T
|
||||||
import Text.Tabular.AsciiWide
|
--import Text.Tabular.AsciiWide
|
||||||
|
|
||||||
import Hledger
|
import Hledger
|
||||||
import Hledger.Cli.CliOptions
|
import Hledger.Cli.CliOptions
|
||||||
@ -330,15 +328,15 @@ balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
|
|||||||
_ | boolopt "budget" rawopts -> do
|
_ | boolopt "budget" rawopts -> do
|
||||||
-- multi column budget report
|
-- multi column budget report
|
||||||
reportspan <- reportSpan j ropts
|
reportspan <- reportSpan j ropts
|
||||||
let budget = budgetJournal opts reportspan j
|
let budgetreport = dbg1 "budgetreport" $ budgetReport ropts assrt showunbudgeted reportspan d j
|
||||||
j' = budgetRollUp opts budget j
|
where
|
||||||
report = dbg1 "report" $ multiBalanceReport ropts (queryFromOpts d ropts) j'
|
showunbudgeted = boolopt "show-unbudgeted" rawopts
|
||||||
budgetReport = dbg1 "budgetreport" $ multiBalanceReport ropts (queryFromOpts d ropts) budget
|
assrt = not $ ignore_assertions_ $ inputopts_ opts
|
||||||
render = case format of
|
render = case format of
|
||||||
"csv" -> const $ error' "Sorry, CSV output is not yet implemented for this kind of report." -- TODO
|
"csv" -> const $ error' "Sorry, CSV output is not yet implemented for this kind of report." -- TODO
|
||||||
"html" -> const $ error' "Sorry, HTML output is not yet implemented for this kind of report." -- TODO
|
"html" -> const $ error' "Sorry, HTML output is not yet implemented for this kind of report." -- TODO
|
||||||
_ -> multiBalanceReportWithBudgetAsText ropts budgetReport
|
_ -> budgetReportAsText ropts
|
||||||
writeOutput opts $ render report
|
writeOutput opts $ render budgetreport
|
||||||
|
|
||||||
| otherwise -> do
|
| otherwise -> do
|
||||||
-- multi column balance report
|
-- multi column balance report
|
||||||
@ -349,50 +347,7 @@ balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
|
|||||||
_ -> multiBalanceReportAsText ropts
|
_ -> multiBalanceReportAsText ropts
|
||||||
writeOutput opts $ render report
|
writeOutput opts $ render report
|
||||||
|
|
||||||
-- | Re-map account names to closest parent with periodic transaction from budget.
|
-- rendering single-column balance reports
|
||||||
-- Accounts that don't have suitable parent are either remapped to "<unbudgeted>:topAccount"
|
|
||||||
-- or left as-is if --show-unbudgeted is provided.
|
|
||||||
budgetRollUp :: CliOpts -> Journal -> Journal -> Journal
|
|
||||||
budgetRollUp CliOpts{rawopts_=rawopts} budget j = j { jtxns = remapTxn <$> jtxns j }
|
|
||||||
where
|
|
||||||
budgetAccounts = nub $ concatMap (map paccount . ptpostings) $ jperiodictxns budget
|
|
||||||
remapAccount origAcctName = remapAccount' origAcctName
|
|
||||||
where
|
|
||||||
remapAccount' acctName
|
|
||||||
| acctName `elem` budgetAccounts = acctName
|
|
||||||
| otherwise =
|
|
||||||
case parentAccountName acctName of
|
|
||||||
"" | boolopt "show-unbudgeted" rawopts -> origAcctName
|
|
||||||
| otherwise -> T.append (T.pack "<unbudgeted>:") acctName -- TODO: --drop should not remove this
|
|
||||||
parent -> remapAccount' parent
|
|
||||||
remapPosting p = p { paccount = remapAccount $ paccount p, porigin = Just . fromMaybe p $ porigin p }
|
|
||||||
remapTxn = mapPostings (map remapPosting)
|
|
||||||
mapPostings f t = txnTieKnot $ t { tpostings = f $ tpostings t }
|
|
||||||
|
|
||||||
-- | Select all periodic transactions from the given journal which
|
|
||||||
-- match the requested report interval, and use them to generate
|
|
||||||
-- budget transactions (like forecast transactions) in the specified
|
|
||||||
-- report period (calculated in IO and passed in).
|
|
||||||
budgetJournal :: CliOpts -> DateSpan -> Journal -> Journal
|
|
||||||
budgetJournal opts reportspan j = journalBalanceTransactions' opts j { jtxns = budgetts }
|
|
||||||
where
|
|
||||||
budgetinterval = dbg2 "budgetinterval" $ intervalFromRawOpts $ rawopts_ opts
|
|
||||||
budgetspan = dbg2 "budgetspan" $ reportspan
|
|
||||||
budgetts =
|
|
||||||
dbg1 "budgetts" $
|
|
||||||
[makeBudgetTxn t
|
|
||||||
| pt <- jperiodictxns j
|
|
||||||
, periodTransactionInterval pt == Just budgetinterval
|
|
||||||
, t <- runPeriodicTransaction pt budgetspan
|
|
||||||
]
|
|
||||||
makeBudgetTxn t = txnTieKnot $ t { tdescription = T.pack "Budget transaction" }
|
|
||||||
journalBalanceTransactions' opts j =
|
|
||||||
let assrt = not . ignore_assertions_ $ inputopts_ opts
|
|
||||||
in
|
|
||||||
either error' id $ journalBalanceTransactions assrt j
|
|
||||||
|
|
||||||
|
|
||||||
-- single-column balance reports
|
|
||||||
|
|
||||||
-- | Find the best commodity to convert to when asked to show the
|
-- | Find the best commodity to convert to when asked to show the
|
||||||
-- market value of this commodity on the given date. That is, the one
|
-- market value of this commodity on the given date. That is, the one
|
||||||
@ -522,7 +477,7 @@ renderComponent1 opts (acctname, depth, total) (FormatField ljust min max field)
|
|||||||
| otherwise = showMixedAmountWithoutPrice
|
| otherwise = showMixedAmountWithoutPrice
|
||||||
_ -> ""
|
_ -> ""
|
||||||
|
|
||||||
-- multi-column balance reports
|
-- rendering multi-column balance reports
|
||||||
|
|
||||||
-- | Render a multi-column balance report as CSV.
|
-- | Render a multi-column balance report as CSV.
|
||||||
-- The CSV will always include the initial headings row,
|
-- The CSV will always include the initial headings row,
|
||||||
@ -641,7 +596,7 @@ multiBalanceReportHtmlFootRow ropts (acct:rest) =
|
|||||||
multiBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> String
|
multiBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> String
|
||||||
multiBalanceReportAsText opts r =
|
multiBalanceReportAsText opts r =
|
||||||
printf "%s in %s:\n\n" desc (showDateSpan $ multiBalanceReportSpan r)
|
printf "%s in %s:\n\n" desc (showDateSpan $ multiBalanceReportSpan r)
|
||||||
++ renderBalanceReportTable opts tabl
|
++ balanceReportTableAsText opts tabl
|
||||||
where
|
where
|
||||||
tabl = balanceReportAsTable opts r
|
tabl = balanceReportAsTable opts r
|
||||||
desc = case balancetype_ opts of
|
desc = case balancetype_ opts of
|
||||||
@ -649,129 +604,11 @@ multiBalanceReportAsText opts r =
|
|||||||
CumulativeChange -> "Ending balances (cumulative)"
|
CumulativeChange -> "Ending balances (cumulative)"
|
||||||
HistoricalBalance -> "Ending balances (historical)"
|
HistoricalBalance -> "Ending balances (historical)"
|
||||||
|
|
||||||
type ActualAmount = MixedAmount
|
|
||||||
type BudgetAmount = MixedAmount
|
|
||||||
type ActualAmountsReport = MultiBalanceReport
|
|
||||||
type BudgetAmountsReport = MultiBalanceReport
|
|
||||||
type ActualAmountsTable = Table String String MixedAmount
|
|
||||||
type BudgetAmountsTable = Table String String MixedAmount
|
|
||||||
type ActualAndBudgetAmountsTable = Table String String (Maybe MixedAmount, Maybe MixedAmount)
|
|
||||||
type Percentage = Decimal
|
|
||||||
|
|
||||||
-- | Given two multi-column balance reports, the first representing a budget
|
|
||||||
-- (target change amounts) and the second representing actual change amounts,
|
|
||||||
-- render a budget report as plain text suitable for console output.
|
|
||||||
-- The reports should have the same number of columns.
|
|
||||||
multiBalanceReportWithBudgetAsText :: ReportOpts -> BudgetAmountsReport -> ActualAmountsReport -> String
|
|
||||||
multiBalanceReportWithBudgetAsText opts budgetr actualr =
|
|
||||||
printf "%s in %s:\n\n" desc (showDateSpan $ multiBalanceReportSpan actualr)
|
|
||||||
++ renderBalanceReportTable' opts showcell actualandbudgetamts
|
|
||||||
where
|
|
||||||
desc :: String
|
|
||||||
desc = case balancetype_ opts of
|
|
||||||
PeriodChange -> "Balance changes"
|
|
||||||
CumulativeChange -> "Ending balances (cumulative)"
|
|
||||||
HistoricalBalance -> "Ending balances (historical)"
|
|
||||||
|
|
||||||
actualandbudgetamts :: ActualAndBudgetAmountsTable
|
|
||||||
actualandbudgetamts = combineTables (balanceReportAsTable opts actualr) (balanceReportAsTable opts budgetr)
|
|
||||||
|
|
||||||
showcell :: (Maybe ActualAmount, Maybe BudgetAmount) -> String
|
|
||||||
showcell (mactual, mbudget) = actualstr ++ " " ++ budgetstr
|
|
||||||
where
|
|
||||||
actualwidth = 7
|
|
||||||
percentwidth = 4
|
|
||||||
budgetwidth = 5
|
|
||||||
actualstr = printf ("%"++show actualwidth++"s") (maybe "" showamt mactual)
|
|
||||||
budgetstr = case (mactual, mbudget) of
|
|
||||||
(_, Nothing) -> replicate (percentwidth + 7 + budgetwidth) ' '
|
|
||||||
(mactual, Just budget) ->
|
|
||||||
case percentage mactual budget of
|
|
||||||
Just pct ->
|
|
||||||
printf ("[%"++show percentwidth++"s%% of %"++show budgetwidth++"s]")
|
|
||||||
(show $ roundTo 0 pct) (showamt budget)
|
|
||||||
Nothing ->
|
|
||||||
printf ("["++replicate (percentwidth+5) ' '++"%"++show budgetwidth++"s]")
|
|
||||||
(showamt budget)
|
|
||||||
|
|
||||||
percentage :: Maybe ActualAmount -> BudgetAmount -> Maybe Percentage
|
|
||||||
percentage Nothing _ = Nothing
|
|
||||||
percentage (Just actual) budget =
|
|
||||||
-- percentage of budget consumed is always computed in the cost basis
|
|
||||||
case (toCost actual, toCost budget) of
|
|
||||||
(Mixed [a1], Mixed [a2])
|
|
||||||
| isReallyZeroAmount a1 -> Just 0 -- if there are no postings, we consumed 0% of budget
|
|
||||||
| acommodity a1 == acommodity a2 && aquantity a2 /= 0 ->
|
|
||||||
Just $ 100 * aquantity a1 / aquantity a2
|
|
||||||
_ -> Nothing
|
|
||||||
where
|
|
||||||
toCost = normaliseMixedAmount . costOfMixedAmount
|
|
||||||
|
|
||||||
showamt :: MixedAmount -> String
|
|
||||||
showamt | color_ opts = cshowMixedAmountOneLineWithoutPrice
|
|
||||||
| otherwise = showMixedAmountOneLineWithoutPrice
|
|
||||||
|
|
||||||
-- Combine a table of actual amounts and a table of budgeted amounts into
|
|
||||||
-- a single table of (Maybe actualamount, Maybe budgetamount) tuples.
|
|
||||||
-- The actual and budget table need not have the same account rows or date columns.
|
|
||||||
-- Every row and column from either table will appear in the combined table.
|
|
||||||
-- TODO better to combine the reports, not these tables which are just rendering helpers
|
|
||||||
combineTables :: ActualAmountsTable -> BudgetAmountsTable -> ActualAndBudgetAmountsTable
|
|
||||||
combineTables (Table aaccthdrs adatehdrs arows) (Table baccthdrs bdatehdrs brows) =
|
|
||||||
addtotalrow $ Table caccthdrs cdatehdrs crows
|
|
||||||
where
|
|
||||||
[aaccts, adates, baccts, bdates] = map headerContents [aaccthdrs, adatehdrs, baccthdrs, bdatehdrs]
|
|
||||||
-- combined account names
|
|
||||||
-- TODO Can't sort these or things will fall apart.
|
|
||||||
caccts = dbg2 "caccts" $ init $ (dbg2 "aaccts" $ filter (not . null) aaccts) `union` (dbg2 "baccts" baccts)
|
|
||||||
caccthdrs = T.Group NoLine $ map Header $ caccts
|
|
||||||
-- Actual column dates and budget column dates could be different.
|
|
||||||
-- TODO Can't easily combine these preserving correct order, will go wrong on monthly reports probably.
|
|
||||||
cdates = dbg2 "cdates" $ sort $ (dbg2 "adates" adates) `union` (dbg2 "bdates" bdates)
|
|
||||||
cdatehdrs = T.Group NoLine $ map Header cdates
|
|
||||||
-- corresponding rows of combined actual and/or budget amounts
|
|
||||||
crows = [ combineRow (actualRow a) (budgetRow a) | a <- caccts ]
|
|
||||||
-- totals row
|
|
||||||
addtotalrow | no_total_ opts = id
|
|
||||||
| otherwise = (+----+ (row "" $ combineRow (actualRow "") (budgetRow "")))
|
|
||||||
-- helpers
|
|
||||||
combineRow arow brow =
|
|
||||||
dbg1 "row" $ [(actualAmt d, budgetAmt d) | d <- cdates]
|
|
||||||
where
|
|
||||||
actualAmt date = Map.lookup date $ Map.fromList $ zip adates arow
|
|
||||||
budgetAmt date = Map.lookup date $ Map.fromList $ zip bdates brow
|
|
||||||
|
|
||||||
actualRow acct = fromMaybe [] $ Map.lookup acct $ Map.fromList $ zip aaccts arows
|
|
||||||
budgetRow acct = fromMaybe [] $ Map.lookup acct $ Map.fromList $ zip baccts brows
|
|
||||||
|
|
||||||
-- | Given a table representing a multi-column balance report (for example,
|
|
||||||
-- made using 'balanceReportAsTable'), render it in a format suitable for
|
|
||||||
-- console output.
|
|
||||||
renderBalanceReportTable :: ReportOpts -> Table String String MixedAmount -> String
|
|
||||||
renderBalanceReportTable ropts =
|
|
||||||
renderBalanceReportTable' ropts showamt
|
|
||||||
where
|
|
||||||
showamt | color_ ropts = cshowMixedAmountOneLineWithoutPrice
|
|
||||||
| otherwise = showMixedAmountOneLineWithoutPrice
|
|
||||||
|
|
||||||
renderBalanceReportTable' :: ReportOpts -> (a -> String) -> Table String String a -> String
|
|
||||||
renderBalanceReportTable' (ReportOpts { pretty_tables_ = pretty}) showamt =
|
|
||||||
unlines
|
|
||||||
. trimborder
|
|
||||||
. lines
|
|
||||||
. render pretty id id showamt
|
|
||||||
. align
|
|
||||||
where
|
|
||||||
trimborder = drop 1 . init . map (drop 1 . init)
|
|
||||||
align (Table l t d) = Table l' t d
|
|
||||||
where
|
|
||||||
acctswidth = maximum' $ map strWidth (headerContents l)
|
|
||||||
l' = padRightWide acctswidth <$> l
|
|
||||||
|
|
||||||
-- | Build a 'Table' from a multi-column balance report.
|
-- | Build a 'Table' from a multi-column balance report.
|
||||||
balanceReportAsTable :: ReportOpts -> MultiBalanceReport -> Table String String MixedAmount
|
balanceReportAsTable :: ReportOpts -> MultiBalanceReport -> Table String String MixedAmount
|
||||||
balanceReportAsTable opts (MultiBalanceReport (colspans, items, (coltotals,tot,avg))) =
|
balanceReportAsTable opts (MultiBalanceReport (colspans, items, (coltotals,tot,avg))) =
|
||||||
addtotalrow $ Table
|
addtotalrow $
|
||||||
|
Table
|
||||||
(T.Group NoLine $ map Header accts)
|
(T.Group NoLine $ map Header accts)
|
||||||
(T.Group NoLine $ map Header colheadings)
|
(T.Group NoLine $ map Header colheadings)
|
||||||
(map rowvals items)
|
(map rowvals items)
|
||||||
@ -796,10 +633,14 @@ balanceReportAsTable opts (MultiBalanceReport (colspans, items, (coltotals,tot,a
|
|||||||
++ (if average_ opts && not (null coltotals) then [avg] else [])
|
++ (if average_ opts && not (null coltotals) then [avg] else [])
|
||||||
))
|
))
|
||||||
|
|
||||||
-- | Figure out the overall date span of a multicolumn balance report.
|
-- | Given a table representing a multi-column balance report (for example,
|
||||||
multiBalanceReportSpan :: MultiBalanceReport -> DateSpan
|
-- made using 'balanceReportAsTable'), render it in a format suitable for
|
||||||
multiBalanceReportSpan (MultiBalanceReport ([], _, _)) = DateSpan Nothing Nothing
|
-- console output.
|
||||||
multiBalanceReportSpan (MultiBalanceReport (colspans, _, _)) = DateSpan (spanStart $ head colspans) (spanEnd $ last colspans)
|
balanceReportTableAsText :: ReportOpts -> Table String String MixedAmount -> String
|
||||||
|
balanceReportTableAsText ropts = tableAsText ropts showamt
|
||||||
|
where
|
||||||
|
showamt | color_ ropts = cshowMixedAmountOneLineWithoutPrice
|
||||||
|
| otherwise = showMixedAmountOneLineWithoutPrice
|
||||||
|
|
||||||
|
|
||||||
tests_Hledger_Cli_Commands_Balance = TestList
|
tests_Hledger_Cli_Commands_Balance = TestList
|
||||||
|
@ -249,7 +249,7 @@ Balance Sheet
|
|||||||
compoundBalanceReportAsText :: ReportOpts -> CompoundBalanceReport -> String
|
compoundBalanceReportAsText :: ReportOpts -> CompoundBalanceReport -> String
|
||||||
compoundBalanceReportAsText ropts (title, _colspans, subreports, (coltotals, grandtotal, grandavg)) =
|
compoundBalanceReportAsText ropts (title, _colspans, subreports, (coltotals, grandtotal, grandavg)) =
|
||||||
title ++ "\n\n" ++
|
title ++ "\n\n" ++
|
||||||
renderBalanceReportTable ropts bigtable'
|
balanceReportTableAsText ropts bigtable'
|
||||||
where
|
where
|
||||||
singlesubreport = length subreports == 1
|
singlesubreport = length subreports == 1
|
||||||
bigtable =
|
bigtable =
|
||||||
|
@ -150,7 +150,6 @@ library
|
|||||||
Hledger.Cli.Commands.Stats
|
Hledger.Cli.Commands.Stats
|
||||||
Hledger.Cli.Commands.Tags
|
Hledger.Cli.Commands.Tags
|
||||||
Hledger.Cli.CompoundBalanceCommand
|
Hledger.Cli.CompoundBalanceCommand
|
||||||
Text.Tabular.AsciiWide
|
|
||||||
other-modules:
|
other-modules:
|
||||||
Paths_hledger
|
Paths_hledger
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
@ -131,7 +131,6 @@ library:
|
|||||||
- Hledger.Cli.Commands.Stats
|
- Hledger.Cli.Commands.Stats
|
||||||
- Hledger.Cli.Commands.Tags
|
- Hledger.Cli.Commands.Tags
|
||||||
- Hledger.Cli.CompoundBalanceCommand
|
- Hledger.Cli.CompoundBalanceCommand
|
||||||
- Text.Tabular.AsciiWide
|
|
||||||
dependencies:
|
dependencies:
|
||||||
- bytestring
|
- bytestring
|
||||||
- containers
|
- containers
|
||||||
|
@ -32,7 +32,7 @@
|
|||||||
|
|
||||||
# 1. Test --budget switch
|
# 1. Test --budget switch
|
||||||
$ hledger bal -D -b 2016-12-01 -e 2016-12-04 -f - --budget
|
$ hledger bal -D -b 2016-12-01 -e 2016-12-04 -f - --budget
|
||||||
Balance changes in 2016/12/01-2016/12/03:
|
Budget performance in 2016/12/01-2016/12/03:
|
||||||
|
|
||||||
|| 2016/12/01 2016/12/02 2016/12/03
|
|| 2016/12/01 2016/12/02 2016/12/03
|
||||||
=======================++==============================================================================
|
=======================++==============================================================================
|
||||||
@ -45,7 +45,7 @@ Balance changes in 2016/12/01-2016/12/03:
|
|||||||
|
|
||||||
# 2. --show-unbudgeted
|
# 2. --show-unbudgeted
|
||||||
$ hledger bal -D -b 2016-12-01 -e 2016-12-04 -f - --budget --show-unbudgeted
|
$ hledger bal -D -b 2016-12-01 -e 2016-12-04 -f - --budget --show-unbudgeted
|
||||||
Balance changes in 2016/12/01-2016/12/03:
|
Budget performance in 2016/12/01-2016/12/03:
|
||||||
|
|
||||||
|| 2016/12/01 2016/12/02 2016/12/03
|
|| 2016/12/01 2016/12/02 2016/12/03
|
||||||
==================++==============================================================================
|
==================++==============================================================================
|
||||||
@ -93,7 +93,7 @@ Balance changes in 2016/12/01-2016/12/03:
|
|||||||
assets:cash
|
assets:cash
|
||||||
|
|
||||||
$ hledger bal -D -b 2016-12-01 -e 2016-12-04 -f - --budget
|
$ hledger bal -D -b 2016-12-01 -e 2016-12-04 -f - --budget
|
||||||
Balance changes in 2016/12/01-2016/12/03:
|
Budget performance in 2016/12/01-2016/12/03:
|
||||||
|
|
||||||
|| 2016/12/01 2016/12/02 2016/12/03
|
|| 2016/12/01 2016/12/02 2016/12/03
|
||||||
=======================++=====================================================================================
|
=======================++=====================================================================================
|
||||||
@ -137,7 +137,7 @@ $ hledger -f- bal --budget
|
|||||||
# 5. With -D it selects the daily budget.
|
# 5. With -D it selects the daily budget.
|
||||||
# The budget is unbounded, so extends through the report period.
|
# The budget is unbounded, so extends through the report period.
|
||||||
$ hledger -f- bal --budget -D
|
$ hledger -f- bal --budget -D
|
||||||
Balance changes in 2018/01/01-2018/01/03:
|
Budget performance in 2018/01/01-2018/01/03:
|
||||||
|
|
||||||
|| 2018/01/01 2018/01/02 2018/01/03
|
|| 2018/01/01 2018/01/02 2018/01/03
|
||||||
===++==============================================================================
|
===++==============================================================================
|
||||||
@ -150,7 +150,7 @@ Balance changes in 2018/01/01-2018/01/03:
|
|||||||
|
|
||||||
# 6. And with -W it selects the weekly budget, defined by all weekly periodic transactions.
|
# 6. And with -W it selects the weekly budget, defined by all weekly periodic transactions.
|
||||||
$ hledger -f- bal --budget -W
|
$ hledger -f- bal --budget -W
|
||||||
Balance changes in 2018/01/01w01:
|
Budget performance in 2018/01/01w01:
|
||||||
|
|
||||||
|| 2018/01/01w01
|
|| 2018/01/01w01
|
||||||
===++==========================
|
===++==========================
|
||||||
@ -182,7 +182,7 @@ Balance changes in 2018/01/01w01:
|
|||||||
(b) 1
|
(b) 1
|
||||||
|
|
||||||
$ hledger -f- bal --budget -D
|
$ hledger -f- bal --budget -D
|
||||||
Balance changes in 2018/01/01-2018/01/04:
|
Budget performance in 2018/01/01-2018/01/04:
|
||||||
|
|
||||||
|| 2018/01/01 2018/01/02 2018/01/03 2018/01/04
|
|| 2018/01/01 2018/01/02 2018/01/03 2018/01/04
|
||||||
================++========================================================================================================
|
================++========================================================================================================
|
||||||
@ -212,7 +212,7 @@ Balance changes in 2018/01/01-2018/01/04:
|
|||||||
(a) 1
|
(a) 1
|
||||||
|
|
||||||
$ hledger -f- bal --budget -D
|
$ hledger -f- bal --budget -D
|
||||||
Balance changes in 2018/01/01-2018/01/04:
|
Budget performance in 2018/01/01-2018/01/04:
|
||||||
|
|
||||||
|| 2018/01/01 2018/01/02 2018/01/03 2018/01/04
|
|| 2018/01/01 2018/01/02 2018/01/03 2018/01/04
|
||||||
===++========================================================================================================
|
===++========================================================================================================
|
||||||
@ -222,7 +222,7 @@ Balance changes in 2018/01/01-2018/01/04:
|
|||||||
|
|
||||||
# 9. A "from A to B" budget should not be included in a report beginning on B.
|
# 9. A "from A to B" budget should not be included in a report beginning on B.
|
||||||
$ hledger -f- bal --budget -D -b 2018/1/3
|
$ hledger -f- bal --budget -D -b 2018/1/3
|
||||||
Balance changes in 2018/01/03-2018/01/04:
|
Budget performance in 2018/01/03-2018/01/04:
|
||||||
|
|
||||||
|| 2018/01/03 2018/01/04
|
|| 2018/01/03 2018/01/04
|
||||||
===++====================================================
|
===++====================================================
|
||||||
@ -243,18 +243,18 @@ Balance changes in 2018/01/03-2018/01/04:
|
|||||||
# 10. accounts with non-zero budget should be shown by default
|
# 10. accounts with non-zero budget should be shown by default
|
||||||
# even if there are no actual transactions in the period,
|
# even if there are no actual transactions in the period,
|
||||||
# or if the actual amount is zero.
|
# or if the actual amount is zero.
|
||||||
# $ hledger -f- bal --budget -D date:2018/1/1-2018/1/3
|
$ hledger -f- bal --budget -D date:2018/1/1-2018/1/3
|
||||||
# Balance changes in 2018/01/01-2018/01/02:
|
Budget performance in 2018/01/01-2018/01/02:
|
||||||
|
|
||||||
# || 2018/01/01 2018/01/02
|
|| 2018/01/01 2018/01/02
|
||||||
# ===++====================================================
|
===++====================================================
|
||||||
# a || [ 1] [ 1]
|
a || 0 [ 1] 0 [ 1]
|
||||||
# ---++----------------------------------------------------
|
---++----------------------------------------------------
|
||||||
# || [ 1] [ 1]
|
|| 0 [ 1] 0 [ 1]
|
||||||
|
|
||||||
# 11. With -E, zeroes are shown
|
# 11. With -E, zeroes are shown
|
||||||
$ hledger -f- bal --budget -D date:2018/1/1-2018/1/3 -E
|
$ hledger -f- bal --budget -D date:2018/1/1-2018/1/3 -E
|
||||||
Balance changes in 2018/01/01-2018/01/02:
|
Budget performance in 2018/01/01-2018/01/02:
|
||||||
|
|
||||||
|| 2018/01/01 2018/01/02
|
|| 2018/01/01 2018/01/02
|
||||||
===++====================================================
|
===++====================================================
|
||||||
|
Loading…
Reference in New Issue
Block a user