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

lib: account name clipping takes Maybe Int as depth.

Browse Source
This commit is contained in:
Stephen Morgan 2020-07-17 16:00:47 +10:00 committed by Simon Michael
parent 51ea6d9f25
commit 30f02b0882
5 changed files with 60 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
hledger-lib/Hledger/Data/Account.hs
View File

@ -134,11 +134,13 @@ clipAccounts d a = a{asubs=subs}
-- | Remove subaccounts below the specified depth, aggregating their balance at the depth limit
-- (accounts at the depth limit will have any sub-balances merged into their exclusive balance).
clipAccountsAndAggregate :: Int -> [Account] -> [Account]
clipAccountsAndAggregate d as = combined
-- If the depth is Nothing, return the original accounts
clipAccountsAndAggregate :: Maybe Int -> [Account] -> [Account]
clipAccountsAndAggregate Nothing as = as
clipAccountsAndAggregate (Just d) as = combined
where
clipped = [a{aname=clipOrEllipsifyAccountName d $ aname a} | a <- as]
combined = [a{aebalance=sum (map aebalance same)}
clipped = [a{aname=clipOrEllipsifyAccountName (Just d) $ aname a} | a <- as]
combined = [a{aebalance=sum $ map aebalance same}
| same@(a:_) <- groupOn aname clipped]
{-
test cases, assuming d=1:

17
hledger-lib/Hledger/Data/AccountName.hs
View File

@ -194,15 +194,18 @@ elideAccountName width s
| otherwise = done++ss
-- | Keep only the first n components of an account name, where n
-- is a positive integer. If n is 0, returns the empty string.
clipAccountName :: Int -> AccountName -> AccountName
clipAccountName n = accountNameFromComponents . take n . accountNameComponents
-- is a positive integer. If n is Just 0, returns the empty string, if n is
-- Nothing, return the full name.
clipAccountName :: Maybe Int -> AccountName -> AccountName
clipAccountName Nothing = id
clipAccountName (Just n) = accountNameFromComponents . take n . accountNameComponents
-- | Keep only the first n components of an account name, where n
-- is a positive integer. If n is 0, returns "...".
clipOrEllipsifyAccountName :: Int -> AccountName -> AccountName
clipOrEllipsifyAccountName 0 = const "..."
clipOrEllipsifyAccountName n = accountNameFromComponents . take n . accountNameComponents
-- is a positive integer. If n is Just 0, returns "...", if n is Nothing, return
-- the full name.
clipOrEllipsifyAccountName :: Maybe Int -> AccountName -> AccountName
clipOrEllipsifyAccountName (Just 0) = const "..."
clipOrEllipsifyAccountName n = clipAccountName n
-- | Escape an AccountName for use within a regular expression.
-- >>> putStr $ escapeName "First?!#$*?$(*) !@^#*? %)*!@#"

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

@ -289,7 +289,7 @@ acctChangesFromPostings ropts q ps = HM.fromList [(aname a, a) | a <- as]
as = filterAccounts . drop 1 $ accountsFromPostings ps
filterAccounts = case accountlistmode_ ropts of
ALTree -> filter ((depthq `matchesAccount`) . aname) -- exclude deeper balances
ALFlat -> maybe id clipAccountsAndAggregate (queryDepth depthq) . -- aggregate deeper balances at the depth limit.
ALFlat -> clipAccountsAndAggregate (queryDepth depthq) . -- aggregate deeper balances at the depth limit.
filter ((0<) . anumpostings)
depthq = dbg "depthq" $ filterQuery queryIsDepth q

84
hledger-lib/Hledger/Reports/PostingsReport.hs
View File

@ -72,7 +72,7 @@ postingsReport ropts@ReportOpts{..} q j =
where
reportspan = adjustReportDates ropts q j
whichdate = whichDateFromOpts ropts
depth = fromMaybe maxBound $ queryDepth q
mdepth = queryDepth q
styles = journalCommodityStyles j
priceoracle = journalPriceOracle infer_value_ j
multiperiod = interval_ /= NoInterval
@ -84,7 +84,7 @@ postingsReport ropts@ReportOpts{..} q j =
-- Postings, or summary postings with their subperiod's end date, to be displayed.
displayps :: [(Posting, Maybe Day)]
| multiperiod =
let summaryps = summarisePostingsByInterval interval_ whichdate depth showempty reportspan reportps
let summaryps = summarisePostingsByInterval interval_ whichdate mdepth showempty reportspan reportps
in [(pvalue p lastday, Just periodend) | (p, periodend) <- summaryps, let lastday = addDays (-1) periodend]
| otherwise =
[(pvalue p reportorjournallast, Nothing) | p <- reportps]
@ -101,7 +101,7 @@ postingsReport ropts@ReportOpts{..} q j =
-- Posting report items ready for display.
items =
dbg4 "postingsReport items" $
postingsReportItems displayps (nullposting,Nothing) whichdate depth startbal runningcalc startnum
postingsReportItems displayps (nullposting,Nothing) whichdate mdepth startbal runningcalc startnum
where
-- In historical mode we'll need a starting balance, which we
-- may be converting to value per hledger_options.m4.md "Effect
@ -189,18 +189,19 @@ matchedPostingsBeforeAndDuring opts q j (DateSpan mstart mend) =
-- | Generate postings report line items from a list of postings or (with
-- non-Nothing dates attached) summary postings.
postingsReportItems :: [(Posting,Maybe Day)] -> (Posting,Maybe Day) -> WhichDate -> Int -> MixedAmount -> (Int -> MixedAmount -> MixedAmount -> MixedAmount) -> Int -> [PostingsReportItem]
postingsReportItems :: [(Posting,Maybe Day)] -> (Posting,Maybe Day) -> WhichDate -> Maybe Int -> MixedAmount -> (Int -> MixedAmount -> MixedAmount -> MixedAmount) -> Int -> [PostingsReportItem]
postingsReportItems [] _ _ _ _ _ _ = []
postingsReportItems ((p,menddate):ps) (pprev,menddateprev) wd d b runningcalcfn itemnum = i:(postingsReportItems ps (p,menddate) wd d b' runningcalcfn (itemnum+1))
where
i = mkpostingsReportItem showdate showdesc wd menddate p' b'
(showdate, showdesc) | isJust menddate = (menddate /= menddateprev, False)
| otherwise = (isfirstintxn || isdifferentdate, isfirstintxn)
isfirstintxn = ptransaction p /= ptransaction pprev
isdifferentdate = case wd of PrimaryDate -> postingDate p /= postingDate pprev
SecondaryDate -> postingDate2 p /= postingDate2 pprev
p' = p{paccount= clipOrEllipsifyAccountName d $ paccount p}
b' = runningcalcfn itemnum b (pamount p)
postingsReportItems ((p,menddate):ps) (pprev,menddateprev) wd d b runningcalcfn itemnum =
i:(postingsReportItems ps (p,menddate) wd d b' runningcalcfn (itemnum+1))
where
i = mkpostingsReportItem showdate showdesc wd menddate p' b'
(showdate, showdesc) | isJust menddate = (menddate /= menddateprev, False)
| otherwise = (isfirstintxn || isdifferentdate, isfirstintxn)
isfirstintxn = ptransaction p /= ptransaction pprev
isdifferentdate = case wd of PrimaryDate -> postingDate p /= postingDate pprev
SecondaryDate -> postingDate2 p /= postingDate2 pprev
p' = p{paccount= clipOrEllipsifyAccountName d $ paccount p}
b' = runningcalcfn itemnum b (pamount p)
-- | Generate one postings report line item, containing the posting,
-- the current running balance, and optionally the posting date and/or
@ -221,11 +222,11 @@ mkpostingsReportItem showdate showdesc wd menddate p b =
-- | Convert a list of postings into summary postings, one per interval,
-- aggregated to the specified depth if any.
-- Each summary posting will have a non-Nothing interval end date.
summarisePostingsByInterval :: Interval -> WhichDate -> Int -> Bool -> DateSpan -> [Posting] -> [SummaryPosting]
summarisePostingsByInterval interval wd depth showempty reportspan ps = concatMap summarisespan $ splitSpan interval reportspan
where
summarisespan s = summarisePostingsInDateSpan s wd depth showempty (postingsinspan s)
postingsinspan s = filter (isPostingInDateSpan' wd s) ps
summarisePostingsByInterval :: Interval -> WhichDate -> Maybe Int -> Bool -> DateSpan -> [Posting] -> [SummaryPosting]
summarisePostingsByInterval interval wd mdepth showempty reportspan ps = concatMap summarisespan $ splitSpan interval reportspan
where
summarisespan s = summarisePostingsInDateSpan s wd mdepth showempty (postingsinspan s)
postingsinspan s = filter (isPostingInDateSpan' wd s) ps
-- | Given a date span (representing a report interval) and a list of
-- postings within it, aggregate the postings into one summary posting per
@ -239,28 +240,27 @@ summarisePostingsByInterval interval wd depth showempty reportspan ps = concatMa
-- The showempty flag includes spans with no postings and also postings
-- with 0 amount.
--
summarisePostingsInDateSpan :: DateSpan -> WhichDate -> Int -> Bool -> [Posting] -> [SummaryPosting]
summarisePostingsInDateSpan (DateSpan b e) wd depth showempty ps
| null ps && (isNothing b || isNothing e) = []
| null ps && showempty = [(summaryp, e')]
| otherwise = summarypes
where
postingdate = if wd == PrimaryDate then postingDate else postingDate2
b' = fromMaybe (maybe nulldate postingdate $ headMay ps) b
e' = fromMaybe (maybe (addDays 1 nulldate) postingdate $ lastMay ps) e
summaryp = nullposting{pdate=Just b'}
clippedanames | depth > 0 = nub $ map (clipAccountName depth) anames
| otherwise = ["..."]
summaryps | depth > 0 = [summaryp{paccount=a,pamount=balance a} | a <- clippedanames]
| otherwise = [summaryp{paccount="...",pamount=sum $ map pamount ps}]
summarypes = map (, e') $ (if showempty then id else filter (not . mixedAmountLooksZero . pamount)) summaryps
anames = nubSort $ map paccount ps
-- aggregate balances by account, like ledgerFromJournal, then do depth-clipping
accts = accountsFromPostings ps
balance a = maybe nullmixedamt bal $ lookupAccount a accts
where
bal = if isclipped a then aibalance else aebalance
isclipped a = accountNameLevel a >= depth
summarisePostingsInDateSpan :: DateSpan -> WhichDate -> Maybe Int -> Bool -> [Posting] -> [SummaryPosting]
summarisePostingsInDateSpan (DateSpan b e) wd mdepth showempty ps
| null ps && (isNothing b || isNothing e) = []
| null ps && showempty = [(summaryp, e')]
| otherwise = summarypes
where
postingdate = if wd == PrimaryDate then postingDate else postingDate2
b' = fromMaybe (maybe nulldate postingdate $ headMay ps) b
e' = fromMaybe (maybe (addDays 1 nulldate) postingdate $ lastMay ps) e
summaryp = nullposting{pdate=Just b'}
clippedanames = nub $ map (clipAccountName mdepth) anames
summaryps | mdepth == Just 0 = [summaryp{paccount="...",pamount=sum $ map pamount ps}]
| otherwise = [summaryp{paccount=a,pamount=balance a} | a <- clippedanames]
summarypes = map (, e') $ (if showempty then id else filter (not . mixedAmountLooksZero . pamount)) summaryps
anames = nubSort $ map paccount ps
-- aggregate balances by account, like ledgerFromJournal, then do depth-clipping
accts = accountsFromPostings ps
balance a = maybe nullmixedamt bal $ lookupAccount a accts
where
bal = if isclipped a then aibalance else aebalance
isclipped a = maybe True (accountNameLevel a >=) mdepth
negatePostingAmount :: Posting -> Posting
negatePostingAmount p = p { pamount = negate $ pamount p }
@ -432,7 +432,7 @@ tests_PostingsReport = tests "PostingsReport" [
-}
,test "summarisePostingsByInterval" $
summarisePostingsByInterval (Quarters 1) PrimaryDate 99999 False (DateSpan Nothing Nothing) [] @?= []
summarisePostingsByInterval (Quarters 1) PrimaryDate Nothing False (DateSpan Nothing Nothing) [] @?= []
-- ,tests_summarisePostingsInDateSpan = [
-- "summarisePostingsInDateSpan" ~: do

2
hledger/Hledger/Cli/Commands/Accounts.hs
View File

@ -77,7 +77,7 @@ accounts CliOpts{rawopts_=rawopts, reportopts_=ropts} j = do
filter (matchesAccount acctq) $ -- clipping can leave accounts that no longer match the query, remove such
nub $ -- clipping can leave duplicates (adjacent, hopefully)
filter (not . T.null) $ -- depth:0 can leave nulls
maybe id (map . clipAccountName) depth $ -- clip at depth if specified
map (clipAccountName depth) $ -- clip at depth if specified
sortedaccts
-- 4. print what remains as a list or tree, maybe applying --drop in the former case