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

refactor

Browse Source
This commit is contained in:
Simon Michael 2010-03-07 15:32:48 +00:00
parent abcc831b5a
commit 306013e21e
1 changed files with 36 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
Commands/Register.hs
View File

@ -5,8 +5,11 @@ A ledger-compatible @register@ command.
-} -}
module Commands.Register module Commands.Register (
where register
,showRegisterReport
) where
import Safe (headMay, lastMay) import Safe (headMay, lastMay)
import Ledger import Ledger
import Options import Options
@ -25,26 +28,40 @@ register opts args l = do
-- | Generate the register report, which is a list of postings with transaction -- | Generate the register report, which is a list of postings with transaction
-- info and a running balance. -- info and a running balance.
showRegisterReport :: [Opt] -> FilterSpec -> Ledger -> String showRegisterReport :: [Opt] -> FilterSpec -> Ledger -> String
showRegisterReport opts filterspec l showRegisterReport opts filterspec l = showpostings ps nullposting startbal
| interval == NoInterval = showpostings displayedps nullposting startbal
| otherwise = showpostings summaryps nullposting startbal
where where
ps | interval == NoInterval = displayableps
| otherwise = summarisePostings interval depth empty span displayableps
startbal = sumPostings precedingps startbal = sumPostings precedingps
(displayedps, _) = span displayExprMatches restofps (precedingps,displayableps,_) =
(precedingps, restofps) = break displayExprMatches sortedps postingsMatchingDisplayExpr (displayExprFromOpts opts) $ journalPostings $ filterJournalPostings filterspec $ journal l
sortedps = sortBy (comparing postingDate) ps (interval, depth, empty) = (intervalFromOpts opts, depthFromOpts opts, Empty `elem` opts)
ps = journalPostings $ filterJournalPostings filterspec $ journal l span = datespan filterspec
summaryps = concatMap summarisespan spans
-- | Convert a list of postings into summary postings, one per interval.
summarisePostings :: Interval -> Maybe Int -> Bool -> DateSpan -> [Posting] -> [Posting]
summarisePostings interval depth empty span ps = concatMap summarisespan spans
where
summarisespan s = summarisePostingsInDateSpan s depth empty (postingsinspan s) summarisespan s = summarisePostingsInDateSpan s depth empty (postingsinspan s)
postingsinspan s = filter (isPostingInDateSpan s) displayedps where postingsinspan s = filter (isPostingInDateSpan s) ps
spans = splitSpan interval (postingsDateSpan displayedps) spans = splitSpan interval spantoreport
interval = intervalFromOpts opts where spantoreport | empty = span
empty = Empty `elem` opts | otherwise = postingsDateSpan ps
depth = depthFromOpts opts
dispexpr = displayExprFromOpts opts -- | Date-sort and split a list of postings into three spans - postings matched
displayExprMatches p = case dispexpr of -- by the given display expression, and the preceding and following postings.
Nothing -> True postingsMatchingDisplayExpr :: Maybe String -> [Posting] -> ([Posting],[Posting],[Posting])
Just e -> (fromparse $ parsewith datedisplayexpr e) p postingsMatchingDisplayExpr d ps = (before, matched, after)
where
sorted = sortBy (comparing postingDate) ps
(before, rest) = break (displayExprMatches d) sorted
(matched, after) = span (displayExprMatches d) rest
-- | Does this display expression allow this posting to be displayed ?
-- Raises an error if the display expression can't be parsed.
displayExprMatches :: Maybe String -> Posting -> Bool
displayExprMatches Nothing _ = True
displayExprMatches (Just d) p = (fromparse $ parsewith datedisplayexpr d) p
-- XXX confusing, refactor -- 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