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

web: another whack at register account field, simpler now

Browse Source
This commit is contained in:
Simon Michael 2011-07-01 00:32:45 +00:00
parent 35f145f03d
commit 29ac7f0d4f
1 changed files with 28 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
hledger/Hledger/Cli/Register.hs
View File

@ -189,7 +189,7 @@ journalRegisterReport :: [Opt] -> Journal -> Matcher -> AccountRegisterReport
journalRegisterReport _ Journal{jtxns=ts} m = (totallabel, items) journalRegisterReport _ Journal{jtxns=ts} m = (totallabel, items)
where where
ts' = sortBy (comparing tdate) $ filter (not . null . tpostings) $ map (filterTransactionPostings m) ts ts' = sortBy (comparing tdate) $ filter (not . null . tpostings) $ map (filterTransactionPostings m) ts
items = reverse $ accountRegisterReportItems m MatchNone nullmixedamt id (+) ts' items = reverse $ accountRegisterReportItems m Nothing nullmixedamt id (+) ts'
-- | Get a conventional account register report, with the specified -- | Get a conventional account register report, with the specified
-- options, for the currently focussed account (or possibly the focussed -- options, for the currently focussed account (or possibly the focussed
@ -227,45 +227,49 @@ accountRegisterReport opts j m thisacctmatcher = (label, items)
tostartdatematcher = MatchDate True (DateSpan Nothing startdate) tostartdatematcher = MatchDate True (DateSpan Nothing startdate)
startdate = matcherStartDate effective m startdate = matcherStartDate effective m
effective = Effective `elem` opts effective = Effective `elem` opts
items = reverse $ accountRegisterReportItems m thisacctmatcher startbal negate sumfn ts items = reverse $ accountRegisterReportItems m (Just thisacctmatcher) startbal negate sumfn ts
-- | Generate account register line items from a list of transactions, -- | Generate account register line items from a list of transactions,
-- using the provided query and "this account" matchers, starting balance, -- using the provided query and "this account" matchers, starting balance,
-- sign-setting function and balance-summing function. -- sign-setting function and balance-summing function.
accountRegisterReportItems :: Matcher -> Matcher -> MixedAmount -> (MixedAmount -> MixedAmount) -> (MixedAmount -> MixedAmount -> MixedAmount) -> [Transaction] -> [AccountRegisterReportItem]
-- This is used for both accountRegisterReport and journalRegisterReport,
-- which makes it a bit overcomplicated.
accountRegisterReportItems :: Matcher -> Maybe Matcher -> MixedAmount -> (MixedAmount -> MixedAmount) -> (MixedAmount -> MixedAmount -> MixedAmount) -> [Transaction] -> [AccountRegisterReportItem]
accountRegisterReportItems _ _ _ _ _ [] = [] accountRegisterReportItems _ _ _ _ _ [] = []
accountRegisterReportItems matcher thisacctmatcher bal signfn sumfn (t:ts) = accountRegisterReportItems matcher thisacctmatcher bal signfn sumfn (t:ts) =
case i of Just i' -> i':is case i of Just i' -> i':is
Nothing -> is Nothing -> is
where where
thisacctps = tpostings $ filterTransactionPostings thisacctmatcher t tmatched@Transaction{tpostings=psmatched} = filterTransactionPostings matcher t
numthisacctsposted = length $ nub $ map paccount thisacctps (psthisacct,psotheracct) = case thisacctmatcher of Just m -> partition (matchesPosting m) psmatched
displaymatcher | numthisacctsposted > 1 = matcher Nothing -> ([],psmatched)
| otherwise = MatchAnd [negateMatcher thisacctmatcher, matcher] numthisaccts = length $ nub $ map paccount psthisacct
t'@Transaction{tpostings=ps'} = filterTransactionPostings displaymatcher t numotheraccts = length $ nub $ map paccount psotheracct
acct = summarisePostings $ tpostings t amt = sum $ map pamount psotheracct
(i,bal'') = case ps' of acct | isNothing thisacctmatcher = summarisePostings psmatched -- journal register
[] -> (Nothing,bal) -- maybe a virtual transaction, or transfer to self | numotheraccts > 0 = prefix ++ commafy (simplifyPostingAccounts psotheracct)
[p] -> (Just (t, t', False, acct, amt, bal'), bal') | otherwise = "transfer between " ++ commafy (simplifyPostingAccounts psthisacct)
where where prefix = maybe "" (\b -> if b then "from " else "to ") $ isNegativeMixedAmount amt
amt = signfn $ pamount p (i,bal') = case psmatched of
bal' = bal `sumfn` amt [] -> (Nothing,bal)
ps'' -> (Just (t, t', True, acct, amt, bal'), bal') _ -> (Just (t, tmatched, numotheraccts > 1, acct, a, b), b)
where where
amt = signfn $ sum $ map pamount ps'' a = signfn amt
bal' = bal `sumfn` amt b = bal `sumfn` a
is = accountRegisterReportItems matcher thisacctmatcher bal'' signfn sumfn ts is = accountRegisterReportItems matcher thisacctmatcher bal' signfn sumfn ts
-- | Generate a short readable summary of a transaction's postings. -- | Generate a short readable summary of some postings.
summarisePostings ps = summarisePostings ps =
case (simplify tos, simplify froms) of case (simplifyPostingAccounts tos, simplifyPostingAccounts froms) of
([],ts) -> "to "++commafy ts ([],ts) -> "to "++commafy ts
(fs,[]) -> "from "++commafy fs (fs,[]) -> "from "++commafy fs
(fs,ts) -> "from "++commafy fs++" to "++commafy ts (fs,ts) -> "from "++commafy fs++" to "++commafy ts
where where
(tos,froms) = partition (fromMaybe False . isNegativeMixedAmount . pamount) ps (tos,froms) = partition (fromMaybe False . isNegativeMixedAmount . pamount) ps
simplify = nub . map (accountLeafName . paccount)
commafy = intercalate ", " simplifyPostingAccounts = nub . map (accountLeafName . paccount)
commafy = intercalate ", "
filterTransactionPostings :: Matcher -> Transaction -> Transaction filterTransactionPostings :: Matcher -> Transaction -> Transaction
filterTransactionPostings m t@Transaction{tpostings=ps} = t{tpostings=filter (m `matchesPosting`) ps} filterTransactionPostings m t@Transaction{tpostings=ps} = t{tpostings=filter (m `matchesPosting`) ps}