diff --git a/HistogramCommand.hs b/HistogramCommand.hs index d24ee246f..3bf7f81c0 100644 --- a/HistogramCommand.hs +++ b/HistogramCommand.hs @@ -29,13 +29,13 @@ histogram opts args l = days = filter (DateSpan Nothing Nothing /=) $ splitSpan interval fullspan daytxns = [(s, filter (isTransactionInDateSpan s) ts) | s <- days] -- same as RegisterCommand - ts = sortBy (comparing date) $ filterempties $ filter matchapats $ filterdepth $ ledgerTransactions l + ts = sortBy (comparing tdate) $ filterempties $ filter matchapats $ filterdepth $ ledgerTransactions l filterempties | Empty `elem` opts = id - | otherwise = filter (not . isZeroMixedAmount . amount) - matchapats t = matchpats apats $ account t + | otherwise = filter (not . isZeroMixedAmount . tamount) + matchapats t = matchpats apats $ taccount t (apats,_) = parsePatternArgs args - filterdepth | interval == NoInterval = filter (\t -> (accountNameLevel $ account t) <= depth) + filterdepth | interval == NoInterval = filter (\t -> (accountNameLevel $ taccount t) <= depth) | otherwise = id depth = depthFromOpts opts diff --git a/Ledger/Ledger.hs b/Ledger/Ledger.hs index cb11eaa49..4e43e86a5 100644 --- a/Ledger/Ledger.hs +++ b/Ledger/Ledger.hs @@ -56,7 +56,7 @@ groupTransactions :: [Transaction] -> (Tree AccountName, (AccountName -> MixedAmount)) groupTransactions ts = (ant,txnsof,exclbalof,inclbalof) where - txnanames = sort $ nub $ map account ts + txnanames = sort $ nub $ map taccount ts ant = accountNameTreeFrom $ expandAccountNames $ txnanames allanames = flatten ant txnmap = Map.union (transactionsByAccount ts) (Map.fromList [(a,[]) | a <- allanames]) @@ -86,14 +86,14 @@ calculateBalances ant txnsof = addbalances ant transactionsByAccount :: [Transaction] -> Map.Map AccountName [Transaction] transactionsByAccount ts = m' where - sortedts = sortBy (comparing account) ts - groupedts = groupBy (\t1 t2 -> account t1 == account t2) sortedts - m' = Map.fromList [(account $ head g, g) | g <- groupedts] + sortedts = sortBy (comparing taccount) ts + groupedts = groupBy (\t1 t2 -> taccount t1 == taccount t2) sortedts + m' = Map.fromList [(taccount $ head g, g) | g <- groupedts] -- The special account name "top" can be used to look up all transactions. ? -- m' = Map.insert "top" sortedts m filtertxns :: [String] -> [Transaction] -> [Transaction] -filtertxns apats ts = filter (matchpats apats . account) ts +filtertxns apats ts = filter (matchpats apats . taccount) ts -- | List a ledger's account names. accountnames :: Ledger -> [AccountName] @@ -137,6 +137,6 @@ ledgerAccountTreeAt l acct = subtreeat acct $ ledgerAccountTree 9999 l ledgerDateSpan :: Ledger -> DateSpan ledgerDateSpan l | null ts = DateSpan Nothing Nothing - | otherwise = DateSpan (Just $ date $ head ts) (Just $ addDays 1 $ date $ last ts) + | otherwise = DateSpan (Just $ tdate $ head ts) (Just $ addDays 1 $ tdate $ last ts) where - ts = sortBy (comparing date) $ ledgerTransactions l + ts = sortBy (comparing tdate) $ ledgerTransactions l diff --git a/Ledger/Parse.hs b/Ledger/Parse.hs index 39d3e5a12..9b8c56e90 100644 --- a/Ledger/Parse.hs +++ b/Ledger/Parse.hs @@ -567,14 +567,14 @@ datedisplayexpr = do (y,m,d) <- smartdate char ']' let ltdate = parsedate $ printf "%04s/%02s/%02s" y m d - let matcher = \(Transaction{date=tdate}) -> + let matcher = \(Transaction{tdate=d}) -> case op of - "<" -> tdate < ltdate - "<=" -> tdate <= ltdate - "=" -> tdate == ltdate - "==" -> tdate == ltdate -- just in case - ">=" -> tdate >= ltdate - ">" -> tdate > ltdate + "<" -> d < ltdate + "<=" -> d <= ltdate + "=" -> d == ltdate + "==" -> d == ltdate -- just in case + ">=" -> d >= ltdate + ">" -> d > ltdate return matcher compareop = choice $ map (try . string) ["<=",">=","==","<","=",">"] diff --git a/Ledger/RawLedger.hs b/Ledger/RawLedger.hs index 018d10852..9eff60d78 100644 --- a/Ledger/RawLedger.hs +++ b/Ledger/RawLedger.hs @@ -142,11 +142,11 @@ canonicaliseAmounts costbasis l@(RawLedger ms ps ts tls hs f fp) = RawLedger ms commoditymap = Map.fromList [(s,commoditieswithsymbol s) | s <- commoditysymbols] commoditieswithsymbol s = filter ((s==) . symbol) commodities commoditysymbols = nub $ map symbol commodities - commodities = map commodity $ concatMap (amounts . amount) $ rawLedgerTransactions l + commodities = map commodity $ concatMap (amounts . tamount) $ rawLedgerTransactions l -- | Get just the amounts from a ledger, in the order parsed. rawLedgerAmounts :: RawLedger -> [MixedAmount] -rawLedgerAmounts = map amount . rawLedgerTransactions +rawLedgerAmounts = map tamount . rawLedgerTransactions -- | Get just the ammount commodities from a ledger, in the order parsed. rawLedgerCommodities :: RawLedger -> [Commodity] diff --git a/Ledger/Transaction.hs b/Ledger/Transaction.hs index 43b888f47..1c200f66e 100644 --- a/Ledger/Transaction.hs +++ b/Ledger/Transaction.hs @@ -33,10 +33,10 @@ flattenLedgerTransaction (LedgerTransaction d s _ desc _ ps _, n) = [Transaction n s d desc (paccount p) (pamount p) (ptype p) | p <- ps] accountNamesFromTransactions :: [Transaction] -> [AccountName] -accountNamesFromTransactions ts = nub $ map account ts +accountNamesFromTransactions ts = nub $ map taccount ts sumTransactions :: [Transaction] -> MixedAmount -sumTransactions = sum . map amount +sumTransactions = sum . map tamount nulltxn :: Transaction nulltxn = Transaction 0 False (parsedate "1900/1/1") "" "" nullmixedamt RegularPosting @@ -44,7 +44,7 @@ nulltxn = Transaction 0 False (parsedate "1900/1/1") "" "" nullmixedamt RegularP -- | Does the given transaction fall within the given date span ? isTransactionInDateSpan :: DateSpan -> Transaction -> Bool isTransactionInDateSpan (DateSpan Nothing Nothing) _ = True -isTransactionInDateSpan (DateSpan Nothing (Just e)) (Transaction{date=d}) = d=b -isTransactionInDateSpan (DateSpan (Just b) (Just e)) (Transaction{date=d}) = d>=b && d=b +isTransactionInDateSpan (DateSpan (Just b) (Just e)) (Transaction{tdate=d}) = d>=b && d (accountNameLevel $ account t) <= depth) + ts = sortBy (comparing tdate) $ filterempties $ filter matchapats $ filterdepth $ ledgerTransactions l + filterdepth | interval == NoInterval = filter (\t -> (accountNameLevel $ taccount t) <= depth) | otherwise = id filterempties | Empty `elem` opts = id - | otherwise = filter (not . isZeroMixedAmount . amount) + | otherwise = filter (not . isZeroMixedAmount . tamount) (precedingts, ts') = break (matchdisplayopt dopt) ts (displayedts, _) = span (matchdisplayopt dopt) ts' startbal = sumTransactions precedingts - matchapats t = matchpats apats $ account t + matchapats t = matchpats apats $ taccount t apats = fst $ parseAccountDescriptionArgs opts args matchdisplayopt Nothing t = True matchdisplayopt (Just e) t = (fromparse $ parsewith datedisplayexpr e) t @@ -77,20 +77,20 @@ summariseTransactionsInDateSpan (DateSpan b e) tnum depth showempty ts | null ts = [] | otherwise = summaryts' where - txn = nulltxn{tnum=tnum, date=b', description="- "++(showDate $ addDays (-1) e')} - b' = fromMaybe (date $ head ts) b - e' = fromMaybe (date $ last ts) e + txn = nulltxn{tnum=tnum, tdate=b', tdescription="- "++(showDate $ addDays (-1) e')} + b' = fromMaybe (tdate $ head ts) b + e' = fromMaybe (tdate $ last ts) e summaryts' | showempty = summaryts - | otherwise = filter (not . isZeroMixedAmount . amount) summaryts - txnanames = sort $ nub $ map account ts + | otherwise = filter (not . isZeroMixedAmount . tamount) summaryts + txnanames = sort $ nub $ map taccount ts -- aggregate balances by account, like cacheLedger, then do depth-clipping (_,_,exclbalof,inclbalof) = groupTransactions ts clippedanames = clipAccountNames depth txnanames isclipped a = accountNameLevel a >= depth balancetoshowfor a = (if isclipped a then inclbalof else exclbalof) (if null a then "top" else a) - summaryts = [txn{account=a,amount=balancetoshowfor a} | a <- clippedanames] + summaryts = [txn{taccount=a,tamount=balancetoshowfor a} | a <- clippedanames] clipAccountNames :: Int -> [AccountName] -> [AccountName] clipAccountNames d as = nub $ map (clip d) as @@ -99,11 +99,11 @@ clipAccountNames d as = nub $ map (clip d) as -- | Show transactions one per line, with each date/description appearing -- only once, and a running balance. showtxns [] _ _ = "" -showtxns (t@Transaction{amount=a}:ts) tprev bal = this ++ showtxns ts t bal' +showtxns (t@Transaction{tamount=a}:ts) tprev bal = this ++ showtxns ts t bal' where this = showtxn (t `issame` tprev) t bal' issame t1 t2 = tnum t1 == tnum t2 - bal' = bal + amount t + bal' = bal + tamount t -- | Show one transaction line and balance with or without the entry details. showtxn :: Bool -> Transaction -> MixedAmount -> String @@ -114,5 +114,5 @@ showtxn omitdesc t b = concatBottomPadded [entrydesc ++ p ++ " ", bal] ++ "\n" desc = printf "%-20s" $ elideRight 20 de :: String p = showPosting $ Posting s a amt "" tt bal = padleft 12 (showMixedAmountOrZero b) - Transaction{status=s,date=da,description=de,account=a,amount=amt,ttype=tt} = t + Transaction{tstatus=s,tdate=da,tdescription=de,taccount=a,tamount=amt,ttype=tt} = t diff --git a/Tests.hs b/Tests.hs index 63754c7d6..c785e6ffe 100644 --- a/Tests.hs +++ b/Tests.hs @@ -884,34 +884,34 @@ tests = [ summariseTransactionsInDateSpan (mkdatespan b e) tnum depth showempty ts `is` summaryts let ts = [ - 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]} + nulltxn{tdescription="desc",taccount="expenses:food:groceries",tamount=Mixed [dollars 1]} + ,nulltxn{tdescription="desc",taccount="expenses:food:dining", tamount=Mixed [dollars 2]} + ,nulltxn{tdescription="desc",taccount="expenses:food", tamount=Mixed [dollars 4]} + ,nulltxn{tdescription="desc",taccount="expenses:food:dining", tamount=Mixed [dollars 8]} ] ("2008/01/01","2009/01/01",0,9999,False,[]) `gives` [] ("2008/01/01","2009/01/01",0,9999,True,[]) `gives` [ - nulltxn{date=parsedate "2008/01/01",description="- 2008/12/31"} + nulltxn{tdate=parsedate "2008/01/01",tdescription="- 2008/12/31"} ] ("2008/01/01","2009/01/01",0,9999,False,ts) `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]} + nulltxn{tdate=parsedate "2008/01/01",tdescription="- 2008/12/31",taccount="expenses:food", tamount=Mixed [dollars 4]} + ,nulltxn{tdate=parsedate "2008/01/01",tdescription="- 2008/12/31",taccount="expenses:food:dining", tamount=Mixed [dollars 10]} + ,nulltxn{tdate=parsedate "2008/01/01",tdescription="- 2008/12/31",taccount="expenses:food:groceries",tamount=Mixed [dollars 1]} ] ("2008/01/01","2009/01/01",0,2,False,ts) `gives` [ - nulltxn{date=parsedate "2008/01/01",description="- 2008/12/31",account="expenses:food",amount=Mixed [dollars 15]} + nulltxn{tdate=parsedate "2008/01/01",tdescription="- 2008/12/31",taccount="expenses:food",tamount=Mixed [dollars 15]} ] ("2008/01/01","2009/01/01",0,1,False,ts) `gives` [ - nulltxn{date=parsedate "2008/01/01",description="- 2008/12/31",account="expenses",amount=Mixed [dollars 15]} + nulltxn{tdate=parsedate "2008/01/01",tdescription="- 2008/12/31",taccount="expenses",tamount=Mixed [dollars 15]} ] ("2008/01/01","2009/01/01",0,0,False,ts) `gives` [ - nulltxn{date=parsedate "2008/01/01",description="- 2008/12/31",account="",amount=Mixed [dollars 15]} + nulltxn{tdate=parsedate "2008/01/01",tdescription="- 2008/12/31",taccount="",tamount=Mixed [dollars 15]} ] ,"postingamount" ~: do diff --git a/UICommand.hs b/UICommand.hs index c4da077d0..bb249335b 100644 --- a/UICommand.hs +++ b/UICommand.hs @@ -281,7 +281,7 @@ currentLedgerTransaction :: AppState -> LedgerTransaction currentLedgerTransaction a@AppState{aledger=l,abuf=buf} = entryContainingTransaction a t where t = safehead nulltxn $ filter ismatch $ ledgerTransactions l - ismatch t = date t == (parsedate $ take 10 datedesc) + ismatch t = tdate t == (parsedate $ take 10 datedesc) && (take 70 $ showtxn False t nullmixedamt) == (datedesc ++ acctamt) datedesc = take 32 $ fromMaybe "" $ find (not . (" " `isPrefixOf`)) $ [safehead "" rest] ++ reverse above acctamt = drop 32 $ safehead "" rest