diff --git a/Ledger/Dates.hs b/Ledger/Dates.hs index bbc81da4d..784d00c09 100644 --- a/Ledger/Dates.hs +++ b/Ledger/Dates.hs @@ -69,10 +69,13 @@ splitSpan Yearly s = splitspan start next s where (start,next) = (startofyea splitspan _ _ (DateSpan Nothing Nothing) = [] splitspan startof next (DateSpan Nothing (Just e)) = [DateSpan (Just $ startof e) (Just $ next $ startof e)] splitspan startof next (DateSpan (Just b) Nothing) = [DateSpan (Just $ startof b) (Just $ next $ startof b)] -splitspan startof next (DateSpan (Just b) (Just e)) - | b >= e = [] - | otherwise = [DateSpan (Just $ startof b) (Just $ next $ startof b)] - ++ splitspan startof next (DateSpan (Just $ next $ startof b) (Just e)) +splitspan startof next s@(DateSpan (Just b) (Just e)) + | b == e = [s] + | otherwise = splitspan' startof next s + where splitspan' startof next (DateSpan (Just b) (Just e)) + | b >= e = [] + | otherwise = [DateSpan (Just $ startof b) (Just $ next $ startof b)] + ++ splitspan' startof next (DateSpan (Just $ next $ startof b) (Just e)) -- | Parse a period expression to an Interval and overall DateSpan using -- the provided reference date. @@ -393,3 +396,7 @@ justdatespan rdate = do optional (string "in" >> many spacenonewline) d <- smartdate return $ spanFromSmartDate rdate d + +nulldatespan = DateSpan Nothing Nothing + +mkdatespan b e = DateSpan (Just $ parsedate b) (Just $ parsedate e) diff --git a/Ledger/Ledger.hs b/Ledger/Ledger.hs index 0057e0f61..d594c25d6 100644 --- a/Ledger/Ledger.hs +++ b/Ledger/Ledger.hs @@ -30,23 +30,27 @@ instance Show Ledger where -- | Convert a raw ledger to a more efficient cached type, described above. cacheLedger :: [String] -> RawLedger -> Ledger -cacheLedger apats l = Ledger l ant amap +cacheLedger apats l = Ledger l ant acctmap where + ts = filtertxns apats $ rawLedgerTransactions l ant = rawLedgerAccountNameTree l anames = flatten ant - ts = filtertxns apats $ rawLedgerTransactions l + txnmap = Map.union (transactionsByAccount ts) (Map.fromList [(a,[]) | a <- anames]) + subacctsof a = filter (a `isAccountNamePrefixOf`) anames + subtxnsof a = concat [txnmap ! a | a <- [a] ++ subacctsof a] + balmap = Map.union + (Map.fromList [(a,sumTransactions $ subtxnsof a) | a <- anames]) + (Map.fromList [(a,Mixed []) | a <- anames]) + acctmap = Map.fromList [(a, mkacct a) | a <- anames] + mkacct a = Account a (txnmap ! a) (balmap ! a) + +-- | Convert a list of transactions to a map from account name to the list +-- of all transactions in that account. +transactionsByAccount :: [Transaction] -> Map.Map AccountName [Transaction] +transactionsByAccount ts = Map.fromList [(account $ head g, g) | g <- groupedts] + where sortedts = sortBy (comparing account) ts groupedts = groupBy (\t1 t2 -> account t1 == account t2) sortedts - txnmap = Map.union - (Map.fromList [(account $ head g, g) | g <- groupedts]) - (Map.fromList [(a,[]) | a <- anames]) - txnsof = (txnmap !) - subacctsof a = filter (a `isAccountNamePrefixOf`) anames - subtxnsof a = concat [txnsof a | a <- [a] ++ subacctsof a] - balmap = Map.union - (Map.fromList [(a,(sumTransactions $ subtxnsof a)) | a <- anames]) - (Map.fromList [(a,Mixed []) | a <- anames]) - amap = Map.fromList [(a, Account a (txnmap ! a) (balmap ! a)) | a <- anames] filtertxns :: [String] -> [Transaction] -> [Transaction] filtertxns apats ts = filter (matchpats apats . account) ts @@ -92,6 +96,6 @@ ledgerAccountTreeAt l acct = subtreeat acct $ ledgerAccountTree 9999 l -- or DateSpan Nothing Nothing if there are no transactions. ledgerDateSpan l | null ts = DateSpan Nothing Nothing - | otherwise = DateSpan (Just $ date $ head ts) (Just $ date $ last ts) + | otherwise = DateSpan (Just $ date $ head ts) (Just $ addDays 1 $ date $ last ts) where ts = sortBy (comparing date) $ ledgerTransactions l diff --git a/NOTES b/NOTES index ba9c8bc62..850fba821 100644 --- a/NOTES +++ b/NOTES @@ -14,7 +14,6 @@ clever tricks like the plague." --Edsger Dijkstra *** should accept - before currency symbol ? *** can't parse comment line immediately after or within an entry ** features -*** show empty reporting intervals with the -E option, for clarity/consistency/graphing *** actual/effective entry & txn dates, for completeness *** speed **** easy profiling diff --git a/RegisterCommand.hs b/RegisterCommand.hs index 3c91c3740..88433f957 100644 --- a/RegisterCommand.hs +++ b/RegisterCommand.hs @@ -40,15 +40,66 @@ showRegisterReport opts args l matchdisplayopt (Just e) t = (fromparse $ parsewith datedisplayexpr e) t dopt = displayFromOpts opts empty = Empty `elem` opts - summaryts = concat $ map (\(n,s) -> summarise n s (filter (isTransactionInDateSpan s) ts)) $ zip [1..] spans + depth = depthFromOpts opts + summaryts = concatMap summarisespan (zip spans [1..]) + summarisespan (s,n) = summariseTransactionsInDateSpan s n depth empty (transactionsinspan s) + transactionsinspan s = filter (isTransactionInDateSpan s) ts spans = splitSpan interval (ledgerDateSpan l) - -- generate a grouped set of summary transactions for this date span - summarise :: Int -> DateSpan -> [Transaction] -> [Transaction] - summarise _ _ [] = [] - summarise n (DateSpan b e) ts = summarytxns (b',e') n empty ts - where - b' = fromMaybe (date $ head ts) b - e' = fromMaybe (date $ last ts) e + +-- | Convert a date span (representing a reporting interval) and a list of +-- transactions within it to a new list of transactions aggregated by +-- account, which showtxns will render as a summary for this interval. +-- +-- As usual with date spans the end date is exclusive, but for display +-- purposes we show the previous day as end date, like ledger. +-- +-- A unique entryno value is provided to that the new transactions will be +-- grouped as one entry. +-- +-- When a depth argument is present, transactions to accounts of greater +-- depth are aggregated where possible. +-- +-- The showempty flag forces the display of a zero-transaction span +-- and also zero-transaction accounts within the span. +summariseTransactionsInDateSpan :: DateSpan -> Int -> Maybe Int -> Bool -> [Transaction] -> [Transaction] +summariseTransactionsInDateSpan (DateSpan b e) entryno depth showempty ts + | null ts && showempty = [txn] + | null ts = [] + | otherwise = summaryts' + where + txn = nulltxn{entryno=entryno, date=b', description="- "++(showDate $ addDays (-1) e')} + b' = fromMaybe (date $ head ts) b + e' = fromMaybe (date $ last ts) e + summaryts' + | showempty = summaryts + | otherwise = filter (not . isZeroMixedAmount . amount) summaryts + -- aggregate balances by account, like cacheLedger: + anames = sort $ nub $ map account ts + allnames = expandAccountNames anames + -- from cacheLedger: + txnmap = Map.union (transactionsByAccount ts) (Map.fromList [(a,[]) | a <- allnames]) + txnsof = (txnmap !) -- a's txns + subacctsof a = filter (a `isAccountNamePrefixOf`) anames -- a plus any subaccounts + subtxnsof a = concat [txnsof a | a <- [a] ++ subacctsof a] -- a's and subaccounts' txns + inclusivebalmap = Map.union -- subaccount-including balances for all accounts + (Map.fromList [(a,(sumTransactions $ subtxnsof a)) | a <- allnames]) + (Map.fromList [(a,Mixed []) | a <- anames]) + -- + -- then do depth-clipping + exclusivebalmap = Map.union -- subaccount-excluding balances for all accounts + (Map.fromList [(a,(sumTransactions $ txnsof a)) | a <- allnames]) + (Map.fromList [(a,Mixed []) | a <- anames]) + inclusivebalanceof = (inclusivebalmap !) + exclusivebalanceof = (exclusivebalmap !) + clippedanames = clipAccountNames depth anames + isclipped a = accountNameLevel a >= fromMaybe 9999 depth + balancetoshowfor a = (if isclipped a then inclusivebalanceof else exclusivebalanceof) a + summaryts = [txn{account=a,amount=balancetoshowfor a} | a <- clippedanames] + +clipAccountNames :: Maybe Int -> [AccountName] -> [AccountName] +clipAccountNames Nothing as = as +clipAccountNames (Just d) as = nub $ map (clip d) as + where clip d = accountNameFromComponents . take d . accountNameComponents -- | Does the given transaction fall within the given date span ? isTransactionInDateSpan :: DateSpan -> Transaction -> Bool @@ -57,39 +108,6 @@ isTransactionInDateSpan (DateSpan Nothing (Just e)) (Transaction{date=d}) = d=b isTransactionInDateSpan (DateSpan (Just b) (Just e)) (Transaction{date=d}) = d>=b && d Int -> Bool -> [Transaction] -> [Transaction] -summarytxns (b,e) entryno showempty ts = summaryts' - where - summaryts' - | showempty = summaryts - | otherwise = filter (not . isZeroMixedAmount . amount) summaryts - summaryts = [templtxn{account=a,amount=balmap ! a} | a <- anames] - templtxn = nulltxn{entryno=entryno,date=b,description="- "++(showDate eprev)} - eprev = addDays (-1) e - anames = sort $ nub $ map account ts - -- from cacheLedger: - sortedts = sortBy (comparing account) ts - groupedts = groupBy (\t1 t2 -> account t1 == account t2) sortedts - txnmap = Map.union - (Map.fromList [(account $ head g, g) | g <- groupedts]) - (Map.fromList [(a,[]) | a <- anames]) - txnsof = (txnmap !) - subacctsof a = filter (a `isAccountNamePrefixOf`) anames - subtxnsof a = concat [txnsof a | a <- [a] ++ subacctsof a] - balmap = Map.union - (Map.fromList [(a,(sumTransactions $ subtxnsof a)) | a <- anames]) - (Map.fromList [(a,Mixed []) | a <- anames]) - -- - -- | Show transactions one per line, with each date/description appearing -- only once, and a running balance. showtxns [] _ _ = "" diff --git a/Tests.hs b/Tests.hs index 110f3c533..fee635556 100644 --- a/Tests.hs +++ b/Tests.hs @@ -156,6 +156,67 @@ misc_tests = TestList [ "every day from aug to oct" `gives` "(Daily,DateSpan (Just 2008-08-01) (Just 2008-10-01))" "daily from aug" `gives` "(Daily,DateSpan (Just 2008-08-01) Nothing)" "every week to 2009" `gives` "(Weekly,DateSpan Nothing (Just 2009-01-01))" + , + "splitSpan" ~: do + let (interval,span) `gives` spans = assertequal spans (splitSpan interval span) + (NoInterval,mkdatespan "2008/01/01" "2009/01/01") `gives` + [mkdatespan "2008/01/01" "2009/01/01"] + (Quarterly,mkdatespan "2008/01/01" "2009/01/01") `gives` + [mkdatespan "2008/01/01" "2008/04/01" + ,mkdatespan "2008/04/01" "2008/07/01" + ,mkdatespan "2008/07/01" "2008/10/01" + ,mkdatespan "2008/10/01" "2009/01/01" + ] + (Quarterly,nulldatespan) `gives` + [nulldatespan] + (Daily,mkdatespan "2008/01/01" "2008/01/01") `gives` + [mkdatespan "2008/01/01" "2008/01/01"] + (Quarterly,mkdatespan "2008/01/01" "2008/01/01") `gives` + [mkdatespan "2008/01/01" "2008/01/01"] + , + "summariseTransactionsInDateSpan" ~: do + let (b,e,entryno,depth,showempty,ts) `gives` summaryts = assertequal (summaryts) (summariseTransactionsInDateSpan (mkdatespan b e) entryno depth showempty ts) + + ("2008/01/01","2009/01/01",0,Nothing,False,[]) `gives` + [] + + ("2008/01/01","2009/01/01",0,Nothing,True,[]) `gives` + [ + nulltxn{date=parsedate "2008/01/01",description="- 2008/12/31"} + ] + + ("2008/01/01","2009/01/01",0,Nothing,False,[ + nulltxn{description="desc",account="expenses:food:groceries",amount=Mixed [dollars 1]} + ,nulltxn{description="desc",account="expenses:food:dining", amount=Mixed [dollars 2]} + ,nulltxn{description="desc",account="expenses:food", amount=Mixed [dollars 4]} + ,nulltxn{description="desc",account="expenses:food:dining", amount=Mixed [dollars 8]} + ]) `gives` + [ + nulltxn{date=parsedate "2008/01/01",description="- 2008/12/31",account="expenses:food", amount=Mixed [dollars 4]} + ,nulltxn{date=parsedate "2008/01/01",description="- 2008/12/31",account="expenses:food:dining", amount=Mixed [dollars 10]} + ,nulltxn{date=parsedate "2008/01/01",description="- 2008/12/31",account="expenses:food:groceries",amount=Mixed [dollars 1]} + ] + + ("2008/01/01","2009/01/01",0,Just 2,False,[ + nulltxn{description="desc",account="expenses:food:groceries",amount=Mixed [dollars 1]} + ,nulltxn{description="desc",account="expenses:food:dining", amount=Mixed [dollars 2]} + ,nulltxn{description="desc",account="expenses:food", amount=Mixed [dollars 4]} + ,nulltxn{description="desc",account="expenses:food:dining", amount=Mixed [dollars 8]} + ]) `gives` + [ + nulltxn{date=parsedate "2008/01/01",description="- 2008/12/31",account="expenses:food", amount=Mixed [dollars 15]} + ] + + ("2008/01/01","2009/01/01",0,Just 1,False,[ + nulltxn{description="desc",account="expenses:food:groceries",amount=Mixed [dollars 1]} + ,nulltxn{description="desc",account="expenses:food:dining", amount=Mixed [dollars 2]} + ,nulltxn{description="desc",account="expenses:food", amount=Mixed [dollars 4]} + ,nulltxn{description="desc",account="expenses:food:dining", amount=Mixed [dollars 8]} + ]) `gives` + [ + nulltxn{date=parsedate "2008/01/01",description="- 2008/12/31",account="expenses", amount=Mixed [dollars 15]} + ] + ] balancereportacctnames_tests = TestList