lib: account name clipping takes Maybe Int as depth.
This commit is contained in:
		
							parent
							
								
									51ea6d9f25
								
							
						
					
					
						commit
						30f02b0882
					
				| @ -134,11 +134,13 @@ clipAccounts d a = a{asubs=subs} | |||||||
| 
 | 
 | ||||||
| -- | Remove subaccounts below the specified depth, aggregating their balance at the depth limit | -- | 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). | -- (accounts at the depth limit will have any sub-balances merged into their exclusive balance). | ||||||
| clipAccountsAndAggregate :: Int -> [Account] -> [Account] | -- If the depth is Nothing, return the original accounts | ||||||
| clipAccountsAndAggregate d as = combined | clipAccountsAndAggregate :: Maybe Int -> [Account] -> [Account] | ||||||
|  | clipAccountsAndAggregate Nothing  as = as | ||||||
|  | clipAccountsAndAggregate (Just d) as = combined | ||||||
|     where |     where | ||||||
|       clipped  = [a{aname=clipOrEllipsifyAccountName d $ aname a} | a <- as] |       clipped  = [a{aname=clipOrEllipsifyAccountName (Just d) $ aname a} | a <- as] | ||||||
|       combined = [a{aebalance=sum (map aebalance same)} |       combined = [a{aebalance=sum $ map aebalance same} | ||||||
|                  | same@(a:_) <- groupOn aname clipped] |                  | same@(a:_) <- groupOn aname clipped] | ||||||
| {- | {- | ||||||
| test cases, assuming d=1: | test cases, assuming d=1: | ||||||
|  | |||||||
| @ -194,15 +194,18 @@ elideAccountName width s | |||||||
|           | otherwise = done++ss |           | otherwise = done++ss | ||||||
| 
 | 
 | ||||||
| -- | Keep only the first n components of an account name, where n | -- | Keep only the first n components of an account name, where n | ||||||
| -- is a positive integer. If n is 0, returns the empty string. | -- is a positive integer. If n is Just 0, returns the empty string, if n is | ||||||
| clipAccountName :: Int -> AccountName -> AccountName | -- Nothing, return the full name. | ||||||
| clipAccountName n = accountNameFromComponents . take n . accountNameComponents | 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 | -- | Keep only the first n components of an account name, where n | ||||||
| -- is a positive integer. If n is 0, returns "...". | -- is a positive integer. If n is Just 0, returns "...", if n is Nothing, return | ||||||
| clipOrEllipsifyAccountName :: Int -> AccountName -> AccountName | -- the full name. | ||||||
| clipOrEllipsifyAccountName 0 = const "..." | clipOrEllipsifyAccountName :: Maybe Int -> AccountName -> AccountName | ||||||
| clipOrEllipsifyAccountName n = accountNameFromComponents . take n . accountNameComponents | clipOrEllipsifyAccountName (Just 0) = const "..." | ||||||
|  | clipOrEllipsifyAccountName n        = clipAccountName n | ||||||
| 
 | 
 | ||||||
| -- | Escape an AccountName for use within a regular expression. | -- | Escape an AccountName for use within a regular expression. | ||||||
| -- >>> putStr $ escapeName "First?!#$*?$(*) !@^#*? %)*!@#" | -- >>> putStr $ escapeName "First?!#$*?$(*) !@^#*? %)*!@#" | ||||||
|  | |||||||
| @ -289,7 +289,7 @@ acctChangesFromPostings ropts q ps = HM.fromList [(aname a, a) | a <- as] | |||||||
|     as = filterAccounts . drop 1 $ accountsFromPostings ps |     as = filterAccounts . drop 1 $ accountsFromPostings ps | ||||||
|     filterAccounts = case accountlistmode_ ropts of |     filterAccounts = case accountlistmode_ ropts of | ||||||
|         ALTree -> filter ((depthq `matchesAccount`) . aname)      -- exclude deeper balances |         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) |                       filter ((0<) . anumpostings) | ||||||
|     depthq = dbg "depthq" $ filterQuery queryIsDepth q |     depthq = dbg "depthq" $ filterQuery queryIsDepth q | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -72,7 +72,7 @@ postingsReport ropts@ReportOpts{..} q j = | |||||||
|     where |     where | ||||||
|       reportspan  = adjustReportDates ropts q j |       reportspan  = adjustReportDates ropts q j | ||||||
|       whichdate   = whichDateFromOpts ropts |       whichdate   = whichDateFromOpts ropts | ||||||
|       depth       = fromMaybe maxBound $ queryDepth q |       mdepth      = queryDepth q | ||||||
|       styles      = journalCommodityStyles j |       styles      = journalCommodityStyles j | ||||||
|       priceoracle = journalPriceOracle infer_value_ j |       priceoracle = journalPriceOracle infer_value_ j | ||||||
|       multiperiod = interval_ /= NoInterval |       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. |       -- Postings, or summary postings with their subperiod's end date, to be displayed. | ||||||
|       displayps :: [(Posting, Maybe Day)] |       displayps :: [(Posting, Maybe Day)] | ||||||
|         | multiperiod = |         | 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] |             in [(pvalue p lastday, Just periodend) | (p, periodend) <- summaryps, let lastday = addDays (-1) periodend] | ||||||
|         | otherwise = |         | otherwise = | ||||||
|             [(pvalue p reportorjournallast, Nothing) | p <- reportps] |             [(pvalue p reportorjournallast, Nothing) | p <- reportps] | ||||||
| @ -101,7 +101,7 @@ postingsReport ropts@ReportOpts{..} q j = | |||||||
|       -- Posting report items ready for display. |       -- Posting report items ready for display. | ||||||
|       items = |       items = | ||||||
|         dbg4 "postingsReport items" $ |         dbg4 "postingsReport items" $ | ||||||
|         postingsReportItems displayps (nullposting,Nothing) whichdate depth startbal runningcalc startnum |         postingsReportItems displayps (nullposting,Nothing) whichdate mdepth startbal runningcalc startnum | ||||||
|         where |         where | ||||||
|           -- In historical mode we'll need a starting balance, which we |           -- In historical mode we'll need a starting balance, which we | ||||||
|           -- may be converting to value per hledger_options.m4.md "Effect |           -- 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 | -- | Generate postings report line items from a list of postings or (with | ||||||
| -- non-Nothing dates attached) summary postings. | -- 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 [] _ _ _ _ _ _ = [] | ||||||
| postingsReportItems ((p,menddate):ps) (pprev,menddateprev) wd d b runningcalcfn itemnum = i:(postingsReportItems ps (p,menddate) wd d b' runningcalcfn (itemnum+1)) | postingsReportItems ((p,menddate):ps) (pprev,menddateprev) wd d b runningcalcfn itemnum = | ||||||
|     where |     i:(postingsReportItems ps (p,menddate) wd d b' runningcalcfn (itemnum+1)) | ||||||
|       i = mkpostingsReportItem showdate showdesc wd menddate p' b' |   where | ||||||
|       (showdate, showdesc) | isJust menddate = (menddate /= menddateprev,        False) |     i = mkpostingsReportItem showdate showdesc wd menddate p' b' | ||||||
|                            | otherwise       = (isfirstintxn || isdifferentdate, isfirstintxn) |     (showdate, showdesc) | isJust menddate = (menddate /= menddateprev,        False) | ||||||
|       isfirstintxn = ptransaction p /= ptransaction pprev |                          | otherwise       = (isfirstintxn || isdifferentdate, isfirstintxn) | ||||||
|       isdifferentdate = case wd of PrimaryDate   -> postingDate p  /= postingDate pprev |     isfirstintxn = ptransaction p /= ptransaction pprev | ||||||
|                                    SecondaryDate -> postingDate2 p /= postingDate2 pprev |     isdifferentdate = case wd of PrimaryDate   -> postingDate p  /= postingDate pprev | ||||||
|       p' = p{paccount= clipOrEllipsifyAccountName d $ paccount p} |                                  SecondaryDate -> postingDate2 p /= postingDate2 pprev | ||||||
|       b' = runningcalcfn itemnum b (pamount p) |     p' = p{paccount= clipOrEllipsifyAccountName d $ paccount p} | ||||||
|  |     b' = runningcalcfn itemnum b (pamount p) | ||||||
| 
 | 
 | ||||||
| -- | Generate one postings report line item, containing the posting, | -- | Generate one postings report line item, containing the posting, | ||||||
| -- the current running balance, and optionally the posting date and/or | -- 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, | -- | Convert a list of postings into summary postings, one per interval, | ||||||
| -- aggregated to the specified depth if any. | -- aggregated to the specified depth if any. | ||||||
| -- Each summary posting will have a non-Nothing interval end date. | -- Each summary posting will have a non-Nothing interval end date. | ||||||
| summarisePostingsByInterval :: Interval -> WhichDate -> Int -> Bool -> DateSpan -> [Posting] -> [SummaryPosting] | summarisePostingsByInterval :: Interval -> WhichDate -> Maybe Int -> Bool -> DateSpan -> [Posting] -> [SummaryPosting] | ||||||
| summarisePostingsByInterval interval wd depth showempty reportspan ps = concatMap summarisespan $ splitSpan interval reportspan | summarisePostingsByInterval interval wd mdepth showempty reportspan ps = concatMap summarisespan $ splitSpan interval reportspan | ||||||
|     where |   where | ||||||
|       summarisespan s = summarisePostingsInDateSpan s wd depth showempty (postingsinspan s) |     summarisespan s = summarisePostingsInDateSpan s wd mdepth showempty (postingsinspan s) | ||||||
|       postingsinspan s = filter (isPostingInDateSpan' wd s) ps |     postingsinspan s = filter (isPostingInDateSpan' wd s) ps | ||||||
| 
 | 
 | ||||||
| -- | Given a date span (representing a report interval) and a list of | -- | Given a date span (representing a report interval) and a list of | ||||||
| -- postings within it, aggregate the postings into one summary posting per | -- 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 | -- The showempty flag includes spans with no postings and also postings | ||||||
| -- with 0 amount. | -- with 0 amount. | ||||||
| -- | -- | ||||||
| summarisePostingsInDateSpan :: DateSpan -> WhichDate -> Int -> Bool -> [Posting] -> [SummaryPosting] | summarisePostingsInDateSpan :: DateSpan -> WhichDate -> Maybe Int -> Bool -> [Posting] -> [SummaryPosting] | ||||||
| summarisePostingsInDateSpan (DateSpan b e) wd depth showempty ps | summarisePostingsInDateSpan (DateSpan b e) wd mdepth showempty ps | ||||||
|     | null ps && (isNothing b || isNothing e) = [] |   | null ps && (isNothing b || isNothing e) = [] | ||||||
|     | null ps && showempty = [(summaryp, e')] |   | null ps && showempty = [(summaryp, e')] | ||||||
|     | otherwise = summarypes |   | otherwise = summarypes | ||||||
|     where |   where | ||||||
|       postingdate = if wd == PrimaryDate then postingDate else postingDate2 |     postingdate = if wd == PrimaryDate then postingDate else postingDate2 | ||||||
|       b' = fromMaybe (maybe nulldate postingdate $ headMay ps) b |     b' = fromMaybe (maybe nulldate postingdate $ headMay ps) b | ||||||
|       e' = fromMaybe (maybe (addDays 1 nulldate) postingdate $ lastMay ps) e |     e' = fromMaybe (maybe (addDays 1 nulldate) postingdate $ lastMay ps) e | ||||||
|       summaryp = nullposting{pdate=Just b'} |     summaryp = nullposting{pdate=Just b'} | ||||||
|       clippedanames | depth > 0 = nub $ map (clipAccountName depth) anames |     clippedanames = nub $ map (clipAccountName mdepth) anames | ||||||
|                     | otherwise = ["..."] |     summaryps | mdepth == Just 0 = [summaryp{paccount="...",pamount=sum $ map pamount ps}] | ||||||
|       summaryps | depth > 0 = [summaryp{paccount=a,pamount=balance a} | a <- clippedanames] |               | otherwise        = [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 | ||||||
|       summarypes = map (, e') $ (if showempty then id else filter (not . mixedAmountLooksZero . pamount)) summaryps |     anames = nubSort $ map paccount ps | ||||||
|       anames = nubSort $ map paccount ps |     -- aggregate balances by account, like ledgerFromJournal, then do depth-clipping | ||||||
|       -- aggregate balances by account, like ledgerFromJournal, then do depth-clipping |     accts = accountsFromPostings ps | ||||||
|       accts = accountsFromPostings ps |     balance a = maybe nullmixedamt bal $ lookupAccount a accts | ||||||
|       balance a = maybe nullmixedamt bal $ lookupAccount a accts |       where | ||||||
|         where |         bal = if isclipped a then aibalance else aebalance | ||||||
|           bal = if isclipped a then aibalance else aebalance |         isclipped a = maybe True (accountNameLevel a >=) mdepth | ||||||
|           isclipped a = accountNameLevel a >= depth |  | ||||||
| 
 | 
 | ||||||
| negatePostingAmount :: Posting -> Posting | negatePostingAmount :: Posting -> Posting | ||||||
| negatePostingAmount p = p { pamount = negate $ pamount p } | negatePostingAmount p = p { pamount = negate $ pamount p } | ||||||
| @ -432,7 +432,7 @@ tests_PostingsReport = tests "PostingsReport" [ | |||||||
|     -} |     -} | ||||||
| 
 | 
 | ||||||
|   ,test "summarisePostingsByInterval" $ |   ,test "summarisePostingsByInterval" $ | ||||||
|     summarisePostingsByInterval (Quarters 1) PrimaryDate 99999 False (DateSpan Nothing Nothing) [] @?= [] |     summarisePostingsByInterval (Quarters 1) PrimaryDate Nothing False (DateSpan Nothing Nothing) [] @?= [] | ||||||
| 
 | 
 | ||||||
|   -- ,tests_summarisePostingsInDateSpan = [ |   -- ,tests_summarisePostingsInDateSpan = [ | ||||||
|     --  "summarisePostingsInDateSpan" ~: do |     --  "summarisePostingsInDateSpan" ~: do | ||||||
|  | |||||||
| @ -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 |         filter (matchesAccount acctq) $           -- clipping can leave accounts that no longer match the query, remove such | ||||||
|         nub $                                     -- clipping can leave duplicates (adjacent, hopefully) |         nub $                                     -- clipping can leave duplicates (adjacent, hopefully) | ||||||
|         filter (not . T.null) $                   -- depth:0 can leave nulls |         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 |         sortedaccts | ||||||
| 
 | 
 | ||||||
|   -- 4. print what remains as a list or tree, maybe applying --drop in the former case |   -- 4. print what remains as a list or tree, maybe applying --drop in the former case | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user