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

register: fix a Prelude.head error with reporting interval, --empty, and --depth

Browse Source
This commit is contained in:
Simon Michael 2010-02-16 21:45:40 +00:00
parent 8937ed457d
commit abcc831b5a
2 changed files with 19 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
Commands/Register.hs
View File

@ -7,6 +7,7 @@ A ledger-compatible @register@ command.
module Commands.Register module Commands.Register
where where
import Safe (headMay, lastMay)
import Ledger import Ledger
import Options import Options
#if __GLASGOW_HASKELL__ <= 610 #if __GLASGOW_HASKELL__ <= 610
@ -45,6 +46,7 @@ showRegisterReport opts filterspec l
Nothing -> True Nothing -> True
Just e -> (fromparse $ parsewith datedisplayexpr e) p Just e -> (fromparse $ parsewith datedisplayexpr e) p
-- XXX confusing, refactor
-- | Given a date span (representing a reporting interval) and a list of -- | Given a date span (representing a reporting interval) and a list of
-- postings within it: aggregate the postings so there is only one per -- postings within it: aggregate the postings so there is only one per
-- account, and adjust their date/description so that they will render -- account, and adjust their date/description so that they will render
@ -60,17 +62,17 @@ showRegisterReport opts filterspec l
-- and also zero-posting accounts within the span. -- and also zero-posting accounts within the span.
summarisePostingsInDateSpan :: DateSpan -> Maybe Int -> Bool -> [Posting] -> [Posting] summarisePostingsInDateSpan :: DateSpan -> Maybe Int -> Bool -> [Posting] -> [Posting]
summarisePostingsInDateSpan (DateSpan b e) depth showempty ps summarisePostingsInDateSpan (DateSpan b e) depth showempty ps
| null ps && showempty = [p] | null ps && (isNothing b || isNothing e) = []
| null ps = [] | null ps && showempty = [summaryp]
| otherwise = summaryps' | otherwise = summaryps'
where where
postingwithinfo date desc = nullposting{ptransaction=Just nulltransaction{tdate=date,tdescription=desc}} summaryp = summaryPosting b' ("- "++ showDate (addDays (-1) e'))
p = postingwithinfo b' ("- "++ showDate (addDays (-1) e')) b' = fromMaybe (maybe nulldate postingDate $ headMay ps) b
b' = fromMaybe (postingDate $ head ps) b e' = fromMaybe (maybe (addDays 1 nulldate) postingDate $ lastMay ps) e
e' = fromMaybe (postingDate $ last ps) e summaryPosting date desc = nullposting{ptransaction=Just nulltransaction{tdate=date,tdescription=desc}}
summaryps'
| showempty = summaryps summaryps' = (if showempty then id else filter (not . isZeroMixedAmount . pamount)) summaryps
| otherwise = filter (not . isZeroMixedAmount . pamount) summaryps summaryps = [summaryp{paccount=a,pamount=balancetoshowfor a} | a <- clippedanames]
anames = sort $ nub $ map paccount ps anames = sort $ nub $ map paccount ps
-- aggregate balances by account, like cacheLedger, then do depth-clipping -- aggregate balances by account, like cacheLedger, then do depth-clipping
(_,_,exclbalof,inclbalof) = groupPostings ps (_,_,exclbalof,inclbalof) = groupPostings ps
@ -79,7 +81,6 @@ summarisePostingsInDateSpan (DateSpan b e) depth showempty ps
d = fromMaybe 99999 $ depth d = fromMaybe 99999 $ depth
balancetoshowfor a = balancetoshowfor a =
(if isclipped a then inclbalof else exclbalof) (if null a then "top" else a) (if isclipped a then inclbalof else exclbalof) (if null a then "top" else a)
summaryps = [p{paccount=a,pamount=balancetoshowfor a} | a <- clippedanames]
{- | {- |
Show postings one per line, plus transaction info for the first posting of Show postings one per line, plus transaction info for the first posting of

8
tests/register-depth-empty.test Normal file
View File

@ -0,0 +1,8 @@
-f - register --depth 1 --empty --monthly
<<<
2010/1/1 x
a:aa 1
b:bb:bbb
>>>
>>>2