slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

lib: Generalise PeriodicReport to be polymorphic in the account labels.

Browse Source
This commit is contained in:
Stephen Morgan 2020-01-04 14:05:55 +11:00 committed by Simon Michael
parent 88dc619257
commit 2e20d0717f
3 changed files with 85 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
hledger-lib/Hledger/Reports/BudgetReport.hs
View File

@ -47,8 +47,8 @@ type BudgetAverage = Average
-- | A budget report tracks expected and actual changes per account and subperiod. -- | A budget report tracks expected and actual changes per account and subperiod.
type BudgetCell = (Maybe Change, Maybe BudgetGoal) type BudgetCell = (Maybe Change, Maybe BudgetGoal)
type BudgetReport = PeriodicReport BudgetCell type BudgetReport = PeriodicReport AccountLeaf BudgetCell
type BudgetReportRow = PeriodicReportRow BudgetCell type BudgetReportRow = PeriodicReportRow AccountLeaf BudgetCell
-- | Calculate budget goals from all periodic transactions, -- | Calculate budget goals from all periodic transactions,
-- actual balance changes from the regular transactions, -- actual balance changes from the regular transactions,
@ -100,9 +100,9 @@ sortBudgetReport ropts j (PeriodicReport ps rows trow) = PeriodicReport ps sorte
sortTreeBURByActualAmount :: [BudgetReportRow] -> [BudgetReportRow] sortTreeBURByActualAmount :: [BudgetReportRow] -> [BudgetReportRow]
sortTreeBURByActualAmount rows = sortedrows sortTreeBURByActualAmount rows = sortedrows
where where
anamesandrows = [(prrName r, r) | r <- rows] anamesandrows = [(prrFullName r, r) | r <- rows]
anames = map fst anamesandrows anames = map fst anamesandrows
atotals = [(a, tot) | PeriodicReportRow a _ _ _ (tot,_) _ <- rows] atotals = [(acctFull a, tot) | PeriodicReportRow a _ _ (tot,_) _ <- rows]
accounttree = accountTree "root" anames accounttree = accountTree "root" anames
accounttreewithbals = mapAccounts setibalance accounttree accounttreewithbals = mapAccounts setibalance accounttree
where where
@ -125,8 +125,8 @@ sortBudgetReport ropts j (PeriodicReport ps rows trow) = PeriodicReport ps sorte
-- <unbudgeted> remains at the top. -- <unbudgeted> remains at the top.
sortByAccountDeclaration rows = sortedrows sortByAccountDeclaration rows = sortedrows
where where
(unbudgetedrow,rows') = partition ((=="<unbudgeted>") . prrName) rows (unbudgetedrow,rows') = partition ((=="<unbudgeted>") . prrFullName) rows
anamesandrows = [(prrName r, r) | r <- rows'] anamesandrows = [(prrFullName r, r) | r <- rows']
anames = map fst anamesandrows anames = map fst anamesandrows
sortedanames = sortAccountNamesByDeclaration j (tree_ ropts) anames sortedanames = sortAccountNamesByDeclaration j (tree_ ropts) anames
sortedrows = unbudgetedrow ++ sortAccountItemsLike sortedanames anamesandrows sortedrows = unbudgetedrow ++ sortAccountItemsLike sortedanames anamesandrows
@ -190,17 +190,17 @@ budgetRollUp budgetedaccts showunbudgeted j = j { jtxns = remapTxn <$> jtxns j }
-- --
combineBudgetAndActual :: MultiBalanceReport -> MultiBalanceReport -> BudgetReport combineBudgetAndActual :: MultiBalanceReport -> MultiBalanceReport -> BudgetReport
combineBudgetAndActual combineBudgetAndActual
(PeriodicReport budgetperiods budgetrows (PeriodicReportRow _ _ _ budgettots budgetgrandtot budgetgrandavg)) (PeriodicReport budgetperiods budgetrows (PeriodicReportRow _ _ budgettots budgetgrandtot budgetgrandavg))
(PeriodicReport actualperiods actualrows (PeriodicReportRow _ _ _ actualtots actualgrandtot actualgrandavg)) = (PeriodicReport actualperiods actualrows (PeriodicReportRow _ _ actualtots actualgrandtot actualgrandavg)) =
PeriodicReport periods rows totalrow PeriodicReport periods rows totalrow
where where
periods = nubSort . filter (/= nulldatespan) $ budgetperiods ++ actualperiods periods = nubSort . filter (/= nulldatespan) $ budgetperiods ++ actualperiods
-- first, combine any corresponding budget goals with actual changes -- first, combine any corresponding budget goals with actual changes
rows1 = rows1 =
[ PeriodicReportRow acct treeacct treeindent amtandgoals totamtandgoal avgamtandgoal [ PeriodicReportRow acct treeindent amtandgoals totamtandgoal avgamtandgoal
| PeriodicReportRow acct treeacct treeindent actualamts actualtot actualavg <- actualrows | PeriodicReportRow acct treeindent actualamts actualtot actualavg <- actualrows
, let mbudgetgoals = Map.lookup acct budgetGoalsByAcct :: Maybe ([BudgetGoal], BudgetTotal, BudgetAverage) , let mbudgetgoals = Map.lookup (acctFull acct) budgetGoalsByAcct :: Maybe ([BudgetGoal], BudgetTotal, BudgetAverage)
, let budgetmamts = maybe (replicate (length periods) Nothing) (map Just . first3) mbudgetgoals :: [Maybe BudgetGoal] , let budgetmamts = maybe (replicate (length periods) Nothing) (map Just . first3) mbudgetgoals :: [Maybe BudgetGoal]
, let mbudgettot = second3 <$> mbudgetgoals :: Maybe BudgetTotal , let mbudgettot = second3 <$> mbudgetgoals :: Maybe BudgetTotal
, let mbudgetavg = third3 <$> mbudgetgoals :: Maybe BudgetAverage , let mbudgetavg = third3 <$> mbudgetgoals :: Maybe BudgetAverage
@ -212,31 +212,31 @@ combineBudgetAndActual
] ]
where where
budgetGoalsByAcct :: Map AccountName ([BudgetGoal], BudgetTotal, BudgetAverage) = budgetGoalsByAcct :: Map AccountName ([BudgetGoal], BudgetTotal, BudgetAverage) =
Map.fromList [ (acct, (amts, tot, avg)) Map.fromList [ (acctFull acct, (amts, tot, avg))
| PeriodicReportRow acct _ _ amts tot avg <- budgetrows ] | PeriodicReportRow acct _ amts tot avg <- budgetrows ]
-- next, make rows for budget goals with no actual changes -- next, make rows for budget goals with no actual changes
rows2 = rows2 =
[ PeriodicReportRow acct treeacct treeindent amtandgoals totamtandgoal avgamtandgoal [ PeriodicReportRow acct treeindent amtandgoals totamtandgoal avgamtandgoal
| PeriodicReportRow acct treeacct treeindent budgetgoals budgettot budgetavg <- budgetrows | PeriodicReportRow acct treeindent budgetgoals budgettot budgetavg <- budgetrows
, acct `notElem` acctsdone , acctFull acct `notElem` acctsdone
, let acctBudgetByPeriod = Map.fromList $ zip budgetperiods budgetgoals :: Map DateSpan BudgetGoal , let acctBudgetByPeriod = Map.fromList $ zip budgetperiods budgetgoals :: Map DateSpan BudgetGoal
, let amtandgoals = [ (Nothing, Map.lookup p acctBudgetByPeriod) | p <- periods ] :: [BudgetCell] , let amtandgoals = [ (Nothing, Map.lookup p acctBudgetByPeriod) | p <- periods ] :: [BudgetCell]
, let totamtandgoal = (Nothing, Just budgettot) , let totamtandgoal = (Nothing, Just budgettot)
, let avgamtandgoal = (Nothing, Just budgetavg) , let avgamtandgoal = (Nothing, Just budgetavg)
] ]
where where
acctsdone = map prrName rows1 acctsdone = map prrFullName rows1
-- combine and re-sort rows -- combine and re-sort rows
-- TODO: use MBR code -- TODO: use MBR code
-- TODO: respect --sort-amount -- TODO: respect --sort-amount
-- TODO: add --sort-budget to sort by budget goal amount -- TODO: add --sort-budget to sort by budget goal amount
rows :: [BudgetReportRow] = rows :: [BudgetReportRow] =
sortOn prrName $ rows1 ++ rows2 sortOn prrFullName $ rows1 ++ rows2
-- TODO: grand total & average shows 0% when there are no actual amounts, inconsistent with other cells -- TODO: grand total & average shows 0% when there are no actual amounts, inconsistent with other cells
totalrow = PeriodicReportRow "" "" 0 totalrow = PeriodicReportRow () 0
[ (Map.lookup p totActualByPeriod, Map.lookup p totBudgetByPeriod) | p <- periods ] [ (Map.lookup p totActualByPeriod, Map.lookup p totBudgetByPeriod) | p <- periods ]
( Just actualgrandtot, Just budgetgrandtot ) ( Just actualgrandtot, Just budgetgrandtot )
( Just actualgrandavg, Just budgetgrandavg ) ( Just actualgrandavg, Just budgetgrandavg )
@ -313,7 +313,7 @@ budgetReportAsText ropts@ReportOpts{..} budgetr =
budgetReportAsTable :: ReportOpts -> BudgetReport -> Table String String (Maybe MixedAmount, Maybe MixedAmount) budgetReportAsTable :: ReportOpts -> BudgetReport -> Table String String (Maybe MixedAmount, Maybe MixedAmount)
budgetReportAsTable budgetReportAsTable
ropts ropts
(PeriodicReport periods rows (PeriodicReportRow _ _ _ coltots grandtot grandavg)) = (PeriodicReport periods rows (PeriodicReportRow _ _ coltots grandtot grandavg)) =
addtotalrow $ addtotalrow $
Table Table
(T.Group NoLine $ map Header accts) (T.Group NoLine $ map Header accts)
@ -324,10 +324,10 @@ budgetReportAsTable
++ [" Total" | row_total_ ropts] ++ [" Total" | row_total_ ropts]
++ ["Average" | average_ ropts] ++ ["Average" | average_ ropts]
accts = map renderacct rows accts = map renderacct rows
renderacct (PeriodicReportRow a a' i _ _ _) renderacct (PeriodicReportRow (AccountLeaf a a') i _ _ _)
| tree_ ropts = replicate ((i-1)*2) ' ' ++ T.unpack a' | tree_ ropts = replicate ((i-1)*2) ' ' ++ T.unpack a'
| otherwise = T.unpack $ maybeAccountNameDrop ropts a | otherwise = T.unpack $ maybeAccountNameDrop ropts a
rowvals (PeriodicReportRow _ _ _ as rowtot rowavg) = rowvals (PeriodicReportRow _ _ as rowtot rowavg) =
as ++ [rowtot | row_total_ ropts] ++ [rowavg | average_ ropts] as ++ [rowtot | row_total_ ropts] ++ [rowavg | average_ ropts]
addtotalrow addtotalrow
| no_total_ ropts = id | no_total_ ropts = id

36
hledger-lib/Hledger/Reports/MultiBalanceReport.hs
View File

@ -60,8 +60,8 @@ import Hledger.Reports.BalanceReport
-- 3. the column totals, and the overall grand total (or zero for -- 3. the column totals, and the overall grand total (or zero for
-- cumulative/historical reports) and grand average. -- cumulative/historical reports) and grand average.
type MultiBalanceReport = PeriodicReport MixedAmount type MultiBalanceReport = PeriodicReport AccountLeaf MixedAmount
type MultiBalanceReportRow = PeriodicReportRow MixedAmount type MultiBalanceReportRow = PeriodicReportRow AccountLeaf MixedAmount
-- type alias just to remind us which AccountNames might be depth-clipped, below. -- type alias just to remind us which AccountNames might be depth-clipped, below.
type ClippedAccountName = AccountName type ClippedAccountName = AccountName
@ -233,7 +233,7 @@ multiBalanceReportWith ropts@ReportOpts{..} q j priceoracle =
-- One row per account, with account name info, row amounts, row total and row average. -- One row per account, with account name info, row amounts, row total and row average.
rows :: [MultiBalanceReportRow] = rows :: [MultiBalanceReportRow] =
dbg1 "rows" $ dbg1 "rows" $
[ PeriodicReportRow a (accountLeafName a) [ PeriodicReportRow (AccountLeaf a $ accountLeafName a)
(accountNameLevel a) valuedrowbals rowtot rowavg (accountNameLevel a) valuedrowbals rowtot rowavg
| (a,changes) <- dbg1 "acctchanges" acctchanges | (a,changes) <- dbg1 "acctchanges" acctchanges
-- The row amounts to be displayed: per-period changes, -- The row amounts to be displayed: per-period changes,
@ -287,9 +287,9 @@ multiBalanceReportWith ropts@ReportOpts{..} q j priceoracle =
sortTreeMBRByAmount :: [MultiBalanceReportRow] -> [MultiBalanceReportRow] sortTreeMBRByAmount :: [MultiBalanceReportRow] -> [MultiBalanceReportRow]
sortTreeMBRByAmount rows = sortedrows sortTreeMBRByAmount rows = sortedrows
where where
anamesandrows = [(prrName r, r) | r <- rows] anamesandrows = [(prrFullName r, r) | r <- rows]
anames = map fst anamesandrows anames = map fst anamesandrows
atotals = [(a,tot) | PeriodicReportRow a _ _ _ tot _ <- rows] atotals = [(prrFullName r, prrTotal r) | r <- rows]
accounttree = accountTree "root" anames accounttree = accountTree "root" anames
accounttreewithbals = mapAccounts setibalance accounttree accounttreewithbals = mapAccounts setibalance accounttree
where where
@ -307,7 +307,7 @@ multiBalanceReportWith ropts@ReportOpts{..} q j priceoracle =
-- Sort the report rows by account declaration order then account name. -- Sort the report rows by account declaration order then account name.
sortMBRByAccountDeclaration rows = sortedrows sortMBRByAccountDeclaration rows = sortedrows
where where
anamesandrows = [(prrName r, r) | r <- rows] anamesandrows = [(prrFullName r, r) | r <- rows]
anames = map fst anamesandrows anames = map fst anamesandrows
sortedanames = sortAccountNamesByDeclaration j (tree_ ropts) anames sortedanames = sortAccountNamesByDeclaration j (tree_ ropts) anames
sortedrows = sortAccountItemsLike sortedanames anamesandrows sortedrows = sortAccountItemsLike sortedanames anamesandrows
@ -318,7 +318,7 @@ multiBalanceReportWith ropts@ReportOpts{..} q j priceoracle =
-- Calculate the column totals. These are always the sum of column amounts. -- Calculate the column totals. These are always the sum of column amounts.
highestlevelaccts = [a | a <- displayaccts, not $ any (`elem` displayaccts) $ init $ expandAccountName a] highestlevelaccts = [a | a <- displayaccts, not $ any (`elem` displayaccts) $ init $ expandAccountName a]
colamts = transpose . map prrAmounts $ filter isHighest rows colamts = transpose . map prrAmounts $ filter isHighest rows
where isHighest row = not (tree_ ropts) || prrName row `elem` highestlevelaccts where isHighest row = not (tree_ ropts) || prrFullName row `elem` highestlevelaccts
coltotals :: [MixedAmount] = coltotals :: [MixedAmount] =
dbg1 "coltotals" $ map sum colamts dbg1 "coltotals" $ map sum colamts
-- Calculate the grand total and average. These are always the sum/average -- Calculate the grand total and average. These are always the sum/average
@ -330,8 +330,8 @@ multiBalanceReportWith ropts@ReportOpts{..} q j priceoracle =
] ]
in amts in amts
-- Totals row. -- Totals row.
totalsrow :: PeriodicReportRow MixedAmount = totalsrow :: PeriodicReportRow () MixedAmount =
dbg1 "totalsrow" $ PeriodicReportRow "" "" 0 coltotals grandtotal grandaverage dbg1 "totalsrow" $ PeriodicReportRow () 0 coltotals grandtotal grandaverage
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- 9. Map the report rows to percentages if needed -- 9. Map the report rows to percentages if needed
@ -341,14 +341,14 @@ multiBalanceReportWith ropts@ReportOpts{..} q j priceoracle =
mappedsortedrows :: [MultiBalanceReportRow] = mappedsortedrows :: [MultiBalanceReportRow] =
if not percent_ then sortedrows if not percent_ then sortedrows
else dbg1 "mappedsortedrows" else dbg1 "mappedsortedrows"
[ PeriodicReportRow aname alname alevel [ PeriodicReportRow aname alevel
(zipWith perdivide rowvals coltotals) (zipWith perdivide rowvals coltotals)
(rowtotal `perdivide` grandtotal) (rowtotal `perdivide` grandtotal)
(rowavg `perdivide` grandaverage) (rowavg `perdivide` grandaverage)
| PeriodicReportRow aname alname alevel rowvals rowtotal rowavg <- sortedrows | PeriodicReportRow aname alevel rowvals rowtotal rowavg <- sortedrows
] ]
mappedtotalsrow :: PeriodicReportRow MixedAmount mappedtotalsrow :: PeriodicReportRow () MixedAmount
| percent_ = dbg1 "mappedtotalsrow" $ PeriodicReportRow "" "" 0 | percent_ = dbg1 "mappedtotalsrow" $ PeriodicReportRow () 0
(map (\t -> perdivide t t) coltotals) (map (\t -> perdivide t t) coltotals)
(perdivide grandtotal grandtotal) (perdivide grandtotal grandtotal)
(perdivide grandaverage grandaverage) (perdivide grandaverage grandaverage)
@ -361,12 +361,12 @@ multiBalanceReportWith ropts@ReportOpts{..} q j priceoracle =
balanceReportFromMultiBalanceReport :: ReportOpts -> Query -> Journal -> BalanceReport balanceReportFromMultiBalanceReport :: ReportOpts -> Query -> Journal -> BalanceReport
balanceReportFromMultiBalanceReport opts q j = (rows', total) balanceReportFromMultiBalanceReport opts q j = (rows', total)
where where
PeriodicReport _ rows (PeriodicReportRow _ _ _ totals _ _) = multiBalanceReport opts q j PeriodicReport _ rows (PeriodicReportRow _ _ totals _ _) = multiBalanceReport opts q j
rows' = [( a rows' = [( a
, if flat_ opts then a else a' -- BalanceReport expects full account name here with --flat , if flat_ opts then a else a' -- BalanceReport expects full account name here with --flat
, if tree_ opts then d-1 else 0 -- BalanceReport uses 0-based account depths , if tree_ opts then d-1 else 0 -- BalanceReport uses 0-based account depths
, headDef nullmixedamt amts -- 0 columns is illegal, should not happen, return zeroes if it does , headDef nullmixedamt amts -- 0 columns is illegal, should not happen, return zeroes if it does
) | PeriodicReportRow a a' d amts _ _ <- rows] ) | PeriodicReportRow (AccountLeaf a a') d amts _ _ <- rows]
total = headDef nullmixedamt totals total = headDef nullmixedamt totals
@ -395,7 +395,7 @@ tests_MultiBalanceReport = tests "MultiBalanceReport" [
(opts,journal) `gives` r = do (opts,journal) `gives` r = do
let (eitems, etotal) = r let (eitems, etotal) = r
(PeriodicReport _ aitems atotal) = multiBalanceReport opts (queryFromOpts nulldate opts) journal (PeriodicReport _ aitems atotal) = multiBalanceReport opts (queryFromOpts nulldate opts) journal
showw (PeriodicReportRow acct acct' indent lAmt amt amt') showw (PeriodicReportRow (AccountLeaf acct acct') indent lAmt amt amt')
= (acct, acct', indent, map showMixedAmountDebug lAmt, showMixedAmountDebug amt, showMixedAmountDebug amt') = (acct, acct', indent, map showMixedAmountDebug lAmt, showMixedAmountDebug amt, showMixedAmountDebug amt')
(map showw aitems) @?= (map showw eitems) (map showw aitems) @?= (map showw eitems)
showMixedAmountDebug (prrTotal atotal) @?= showMixedAmountDebug etotal -- we only check the sum of the totals showMixedAmountDebug (prrTotal atotal) @?= showMixedAmountDebug etotal -- we only check the sum of the totals
@ -407,8 +407,8 @@ tests_MultiBalanceReport = tests "MultiBalanceReport" [
,test "with -H on a populated period" $ ,test "with -H on a populated period" $
(defreportopts{period_= PeriodBetween (fromGregorian 2008 1 1) (fromGregorian 2008 1 2), balancetype_=HistoricalBalance}, samplejournal) `gives` (defreportopts{period_= PeriodBetween (fromGregorian 2008 1 1) (fromGregorian 2008 1 2), balancetype_=HistoricalBalance}, samplejournal) `gives`
( (
[ PeriodicReportRow "assets:bank:checking" "checking" 3 [mamountp' "$1.00"] (Mixed [nullamt]) (Mixed [amt0 {aquantity=1}]) [ PeriodicReportRow (AccountLeaf "assets:bank:checking" "checking") 3 [mamountp' "$1.00"] (Mixed [nullamt]) (Mixed [amt0 {aquantity=1}])
, PeriodicReportRow "income:salary" "salary" 2 [mamountp' "$-1.00"] (Mixed [nullamt]) (Mixed [amt0 {aquantity=(-1)}]) , PeriodicReportRow (AccountLeaf "income:salary" "salary") 2 [mamountp' "$-1.00"] (Mixed [nullamt]) (Mixed [amt0 {aquantity=(-1)}])
], ],
Mixed [nullamt]) Mixed [nullamt])

72
hledger-lib/Hledger/Reports/ReportTypes.hs
View File

@ -5,6 +5,7 @@ New common report types, used by the BudgetReport for now, perhaps all reports l
module Hledger.Reports.ReportTypes module Hledger.Reports.ReportTypes
( PeriodicReport(..) ( PeriodicReport(..)
, PeriodicReportRow(..) , PeriodicReportRow(..)
, AccountLeaf(..)
, Percentage , Percentage
, Change , Change
@ -15,6 +16,9 @@ module Hledger.Reports.ReportTypes
, periodicReportSpan , periodicReportSpan
, prNegate , prNegate
, prNormaliseSign , prNormaliseSign
, prrFullName
, prrLeaf
) where ) where
import Data.Decimal import Data.Decimal
@ -28,17 +32,16 @@ type Total = MixedAmount -- ^ The sum of 'Change's in a report or a report ro
type Average = MixedAmount -- ^ The average of 'Change's or 'Balance's in a report or report row. type Average = MixedAmount -- ^ The average of 'Change's or 'Balance's in a report or report row.
-- | A periodic report is a generic tabular report, where each row corresponds -- | A periodic report is a generic tabular report, where each row corresponds
-- to an account and each column to a date period. The column periods are -- to some label (usually an account name) and each column to a date period.
-- usually consecutive subperiods formed by splitting the overall report period -- The column periods are usually consecutive subperiods formed by splitting
-- by some report interval (daily, weekly, etc.). It has: -- the overall report period by some report interval (daily, weekly, etc.).
-- It has:
-- --
-- 1. a list of each column's period (date span) -- 1. a list of each column's period (date span)
-- --
-- 2. a list of rows, each containing: -- 2. a list of rows, each containing:
-- --
-- * the full account name -- * an account label
--
-- * the leaf account name
-- --
-- * the account's depth -- * the account's depth
-- --
@ -56,43 +59,58 @@ type Average = MixedAmount -- ^ The average of 'Change's or 'Balance's in a rep
-- 3. the column totals, and the overall grand total (or zero for -- 3. the column totals, and the overall grand total (or zero for
-- cumulative/historical reports) and grand average. -- cumulative/historical reports) and grand average.
data PeriodicReport a = data PeriodicReport a b =
PeriodicReport PeriodicReport
{ prDates :: [DateSpan] -- The subperiods formed by splitting the overall { prDates :: [DateSpan] -- The subperiods formed by splitting the overall
-- report period by the report interval. For -- report period by the report interval. For
-- ending-balance reports, only the end date is -- ending-balance reports, only the end date is
-- significant. Usually displayed as report columns. -- significant. Usually displayed as report columns.
, prRows :: [PeriodicReportRow a] -- One row per account in the report. , prRows :: [PeriodicReportRow a b] -- One row per account in the report.
, prTotals :: PeriodicReportRow a -- The grand totals row. The account name in this row is always empty. , prTotals :: PeriodicReportRow () b -- The grand totals row.
} deriving (Show) } deriving (Show)
data PeriodicReportRow a = data PeriodicReportRow a b =
PeriodicReportRow PeriodicReportRow
{ prrName :: AccountName -- A full account name. { prrName :: a -- An account name.
, prrLeaf :: AccountName -- Shortened form of the account name to display , prrDepth :: Int -- Indent level for displaying this account name in tree mode. 0, 1, 2...
-- in tree mode. Usually the leaf name, possibly , prrAmounts :: [b] -- The data value for each subperiod.
-- with parent accounts prefixed. , prrTotal :: b -- The total of this row's values.
, prrDepth :: Int -- Indent level for displaying this account name in tree mode. 0, 1, 2... , prrAverage :: b -- The average of this row's values.
, prrAmounts :: [a] -- The data value for each subperiod.
, prrTotal :: a -- The total of this row's values.
, prrAverage :: a -- The average of this row's values.
} deriving (Show) } deriving (Show)
-- | A combination of a full account name and a shortened form, used for display
-- purposes.
data AccountLeaf = AccountLeaf
{ acctFull :: AccountName -- A full account name.
, acctLeaf :: AccountName -- Shortened form of the account name to display
-- in tree mode. Usually the leaf name, possibly
-- with parent accounts prefixed.
}
deriving (Show)
-- | Figure out the overall date span of a PeridicReport -- | Figure out the overall date span of a PeridicReport
periodicReportSpan :: PeriodicReport a -> DateSpan periodicReportSpan :: PeriodicReport a b -> DateSpan
periodicReportSpan (PeriodicReport [] _ _) = DateSpan Nothing Nothing periodicReportSpan (PeriodicReport [] _ _) = DateSpan Nothing Nothing
periodicReportSpan (PeriodicReport colspans _ _) = DateSpan (spanStart $ head colspans) (spanEnd $ last colspans) periodicReportSpan (PeriodicReport colspans _ _) = DateSpan (spanStart $ head colspans) (spanEnd $ last colspans)
-- | Given a PeriodicReport and its normal balance sign, -- | Given a PeriodicReport and its normal balance sign,
-- if it is known to be normally negative, convert it to normally positive. -- if it is known to be normally negative, convert it to normally positive.
prNormaliseSign :: Num a => NormalSign -> PeriodicReport a -> PeriodicReport a prNormaliseSign :: Num b => NormalSign -> PeriodicReport a b -> PeriodicReport a b
prNormaliseSign NormallyNegative = prNegate prNormaliseSign NormallyNegative = prNegate
prNormaliseSign _ = id prNormaliseSign _ = id
-- | Flip the sign of all amounts in a PeriodicReport. -- | Flip the sign of all amounts in a PeriodicReport.
prNegate :: Num a => PeriodicReport a -> PeriodicReport a prNegate :: Num b => PeriodicReport a b -> PeriodicReport a b
prNegate (PeriodicReport colspans rows totalsrow) = prNegate (PeriodicReport colspans rows totalsrow) =
PeriodicReport colspans (map rowNegate rows) (rowNegate totalsrow) PeriodicReport colspans (map rowNegate rows) (rowNegate totalsrow)
where where
rowNegate (PeriodicReportRow name leaf indent amts tot avg) = rowNegate (PeriodicReportRow name indent amts tot avg) =
PeriodicReportRow name leaf indent (map negate amts) (-tot) (-avg) PeriodicReportRow name indent (map negate amts) (-tot) (-avg)
-- | Get the full account name for a `PeriodicReport AccountLeaf`>
prrFullName :: PeriodicReportRow AccountLeaf b -> AccountName
prrFullName = acctFull . prrName
-- | Get the shortened form of the account name for a `PeriodicReport AccountLeaf`>
prrLeaf :: PeriodicReportRow AccountLeaf b -> AccountName
prrLeaf = acctLeaf . prrName