diff --git a/Commands/Balance.hs b/Commands/Balance.hs index 77de6a42b..a4455f690 100644 --- a/Commands/Balance.hs +++ b/Commands/Balance.hs @@ -101,7 +101,7 @@ import Ledger.Utils import Ledger.Types import Ledger.Amount import Ledger.AccountName -import Ledger.Transaction +import Ledger.LedgerPosting import Ledger.Ledger import Options import System.IO.UTF8 @@ -151,7 +151,7 @@ isInteresting opts l a emptyflag = Empty `elem` opts acct = ledgerAccount l a notzero = not $ isZeroMixedAmount inclbalance where inclbalance = abalance acct - notlikesub = not $ isZeroMixedAmount exclbalance where exclbalance = sumTransactions $ atransactions acct + notlikesub = not $ isZeroMixedAmount exclbalance where exclbalance = sumLedgerPostings $ apostings acct numinterestingsubs = length $ filter isInterestingTree subtrees where isInterestingTree = treeany (isInteresting opts l . aname) diff --git a/Commands/Histogram.hs b/Commands/Histogram.hs index 95ca83505..3f3837bea 100644 --- a/Commands/Histogram.hs +++ b/Commands/Histogram.hs @@ -27,10 +27,10 @@ showHistogram opts args l = concatMap (printDayWith countBar) daytxns | otherwise = i fullspan = journalDateSpan $ journal l days = filter (DateSpan Nothing Nothing /=) $ splitSpan interval fullspan - daytxns = [(s, filter (isTransactionInDateSpan s) ts) | s <- days] + daytxns = [(s, filter (isLedgerPostingInDateSpan s) ts) | s <- days] -- same as Register -- should count raw transactions, not posting transactions - ts = sortBy (comparing tdate) $ filterempties $ filter matchapats $ filterdepth $ ledgerTransactions l + ts = sortBy (comparing tdate) $ filterempties $ filter matchapats $ filterdepth $ ledgerLedgerPostings l filterempties | Empty `elem` opts = id | otherwise = filter (not . isZeroMixedAmount . tamount) @@ -44,6 +44,6 @@ printDayWith f (DateSpan b _, ts) = printf "%s %s\n" (show $ fromJust b) (f ts) countBar ts = replicate (length ts) barchar -total = show . sumTransactions +total = show . sumLedgerPostings --- totalBar ts = replicate (sumTransactions ts) barchar +-- totalBar ts = replicate (sumLedgerPostings ts) barchar diff --git a/Commands/Print.hs b/Commands/Print.hs index 7860934bc..4a60c8f8d 100644 --- a/Commands/Print.hs +++ b/Commands/Print.hs @@ -22,7 +22,7 @@ showLedgerTransactions opts args l = concatMap (showLedgerTransactionForPrint ef txns = sortBy (comparing ltdate) $ ledger_txns $ filterJournalPostingsByDepth depth $ - filterJournalTransactionsByAccount apats $ + filterJournalPostingsByAccount apats $ journal l depth = depthFromOpts opts effective = Effective `elem` opts diff --git a/Commands/Register.hs b/Commands/Register.hs index 46f783373..aa6fa6171 100644 --- a/Commands/Register.hs +++ b/Commands/Register.hs @@ -34,7 +34,7 @@ showRegisterReport opts args l | otherwise = showtxns summaryts nulltxn startbal where interval = intervalFromOpts opts - ts = sortBy (comparing tdate) $ filterempties $ filtertxns apats $ filterdepth $ ledgerTransactions l + ts = sortBy (comparing tdate) $ filterempties $ filtertxns apats $ filterdepth $ ledgerLedgerPostings l filterdepth | interval == NoInterval = filter (\t -> accountNameLevel (taccount t) <= depth) | otherwise = id filterempties @@ -42,7 +42,7 @@ showRegisterReport opts args l | otherwise = filter (not . isZeroMixedAmount . tamount) (precedingts, ts') = break (matchdisplayopt dopt) ts (displayedts, _) = span (matchdisplayopt dopt) ts' - startbal = sumTransactions precedingts + startbal = sumLedgerPostings precedingts (apats,_) = parsePatternArgs args matchdisplayopt Nothing _ = True matchdisplayopt (Just e) t = (fromparse $ parsewith datedisplayexpr e) t @@ -50,8 +50,8 @@ showRegisterReport opts args l empty = Empty `elem` opts depth = depthFromOpts opts summaryts = concatMap summarisespan (zip spans [1..]) - summarisespan (s,n) = summariseTransactionsInDateSpan s n depth empty (transactionsinspan s) - transactionsinspan s = filter (isTransactionInDateSpan s) displayedts + summarisespan (s,n) = summariseLedgerPostingsInDateSpan s n depth empty (transactionsinspan s) + transactionsinspan s = filter (isLedgerPostingInDateSpan s) displayedts spans = splitSpan interval (ledgerDateSpan l) -- | Convert a date span (representing a reporting interval) and a list of @@ -69,8 +69,8 @@ showRegisterReport opts args l -- -- The showempty flag forces the display of a zero-transaction span -- and also zero-transaction accounts within the span. -summariseTransactionsInDateSpan :: DateSpan -> Int -> Int -> Bool -> [Transaction] -> [Transaction] -summariseTransactionsInDateSpan (DateSpan b e) tnum depth showempty ts +summariseLedgerPostingsInDateSpan :: DateSpan -> Int -> Int -> Bool -> [LedgerPosting] -> [LedgerPosting] +summariseLedgerPostingsInDateSpan (DateSpan b e) tnum depth showempty ts | null ts && showempty = [txn] | null ts = [] | otherwise = summaryts' @@ -83,7 +83,7 @@ summariseTransactionsInDateSpan (DateSpan b e) tnum depth showempty 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 + (_,_,exclbalof,inclbalof) = groupLedgerPostings ts clippedanames = clipAccountNames depth txnanames isclipped a = accountNameLevel a >= depth balancetoshowfor a = @@ -104,7 +104,7 @@ showtxns (t:ts) tprev bal = this ++ showtxns ts t bal' bal' = bal + tamount t -- | Show one transaction line and balance with or without the entry details. -showtxn :: Bool -> Transaction -> MixedAmount -> String +showtxn :: Bool -> LedgerPosting -> MixedAmount -> String showtxn omitdesc t b = concatBottomPadded [entrydesc ++ p ++ " ", bal] ++ "\n" where ledger3ishlayout = False @@ -116,5 +116,5 @@ showtxn omitdesc t b = concatBottomPadded [entrydesc ++ p ++ " ", bal] ++ "\n" desc = printf ("%-"++(show descwidth)++"s") $ elideRight descwidth de :: String p = showPostingWithoutPrice $ Posting s a amt "" tt bal = padleft 12 (showMixedAmountOrZeroWithoutPrice b) - Transaction{tstatus=s,tdate=da,tdescription=de,taccount=a,tamount=amt,ttype=tt} = t + LedgerPosting{tstatus=s,tdate=da,tdescription=de,taccount=a,tamount=amt,ttype=tt} = t diff --git a/Commands/UI.hs b/Commands/UI.hs index b9c934b66..961706b6b 100644 --- a/Commands/UI.hs +++ b/Commands/UI.hs @@ -273,9 +273,9 @@ scrollToLedgerTransaction e a@AppState{abuf=buf} = setCursorY cy $ setScrollY sy -- cursor on the register screen (or best guess). Results undefined while -- on other screens. Doesn't work. currentLedgerTransaction :: AppState -> LedgerTransaction -currentLedgerTransaction a@AppState{aledger=l,abuf=buf} = entryContainingTransaction a t +currentLedgerTransaction a@AppState{aledger=l,abuf=buf} = transactionContainingLedgerPosting a t where - t = safehead nulltxn $ filter ismatch $ ledgerTransactions l + t = safehead nulltxn $ filter ismatch $ ledgerLedgerPostings l 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 @@ -286,8 +286,8 @@ currentLedgerTransaction a@AppState{aledger=l,abuf=buf} = entryContainingTransac -- | Get the entry which contains the given transaction. -- Will raise an error if there are problems. -entryContainingTransaction :: AppState -> Transaction -> LedgerTransaction -entryContainingTransaction AppState{aledger=l} t = ledger_txns (journal l) !! tnum t +transactionContainingLedgerPosting :: AppState -> LedgerPosting -> LedgerTransaction +transactionContainingLedgerPosting AppState{aledger=l} t = ledger_txns (journal l) !! tnum t -- renderers diff --git a/Ledger.hs b/Ledger.hs index 5fb2836b5..833ff2eee 100644 --- a/Ledger.hs +++ b/Ledger.hs @@ -19,7 +19,7 @@ module Ledger ( module Ledger.Journal, module Ledger.Posting, module Ledger.TimeLog, - module Ledger.Transaction, + module Ledger.LedgerPosting, module Ledger.Types, module Ledger.Utils, ) @@ -36,6 +36,6 @@ import Ledger.Parse import Ledger.Journal import Ledger.Posting import Ledger.TimeLog -import Ledger.Transaction +import Ledger.LedgerPosting import Ledger.Types import Ledger.Utils diff --git a/Ledger/Account.hs b/Ledger/Account.hs index 7fc70b460..6b5eaf4b1 100644 --- a/Ledger/Account.hs +++ b/Ledger/Account.hs @@ -4,7 +4,7 @@ A compound data type for efficiency. An 'Account' stores - an 'AccountName', -- all 'Transaction's (postings plus ledger transaction info) in the +- all 'LedgerPosting's (postings plus ledger transaction info) in the account, excluding subaccounts - a 'MixedAmount' representing the account balance, including subaccounts. diff --git a/Ledger/Journal.hs b/Ledger/Journal.hs index 2cbd1cd23..139822222 100644 --- a/Ledger/Journal.hs +++ b/Ledger/Journal.hs @@ -14,7 +14,7 @@ import Ledger.Types import Ledger.AccountName import Ledger.Amount import Ledger.LedgerTransaction (ledgerTransactionWithDate) -import Ledger.Transaction +import Ledger.LedgerPosting import Ledger.Posting import Ledger.TimeLog @@ -55,12 +55,12 @@ addHistoricalPrice h l0 = l0 { historical_prices = h : historical_prices l0 } addTimeLogEntry :: TimeLogEntry -> Journal -> Journal addTimeLogEntry tle l0 = l0 { open_timelog_entries = tle : open_timelog_entries l0 } -journalTransactions :: Journal -> [Transaction] -journalTransactions = txnsof . ledger_txns +journalLedgerPostings :: Journal -> [LedgerPosting] +journalLedgerPostings = txnsof . ledger_txns where txnsof ts = concatMap flattenLedgerTransaction $ zip ts [1..] journalAccountNamesUsed :: Journal -> [AccountName] -journalAccountNamesUsed = accountNamesFromTransactions . journalTransactions +journalAccountNamesUsed = accountNamesFromLedgerPostings . journalLedgerPostings journalAccountNames :: Journal -> [AccountName] journalAccountNames = sort . expandAccountNames . journalAccountNamesUsed @@ -74,30 +74,30 @@ journalAccountNameTree = accountNameTreeFrom . journalAccountNames filterJournal :: DateSpan -> [String] -> Maybe Bool -> Bool -> Journal -> Journal filterJournal span pats clearedonly realonly = filterJournalPostingsByRealness realonly . - filterJournalTransactionsByClearedStatus clearedonly . - filterJournalTransactionsByDate span . - filterJournalTransactionsByDescription pats + filterJournalPostingsByClearedStatus clearedonly . + filterJournalLedgerTransactionsByDate span . + filterJournalLedgerTransactionsByDescription pats -- | Keep only ledger transactions whose description matches the description patterns. -filterJournalTransactionsByDescription :: [String] -> Journal -> Journal -filterJournalTransactionsByDescription pats (Journal ms ps ts tls hs f fp ft) = +filterJournalLedgerTransactionsByDescription :: [String] -> Journal -> Journal +filterJournalLedgerTransactionsByDescription pats (Journal ms ps ts tls hs f fp ft) = Journal ms ps (filter matchdesc ts) tls hs f fp ft where matchdesc = matchpats pats . ltdescription -- | Keep only ledger transactions which fall between begin and end dates. -- We include transactions on the begin date and exclude transactions on the end -- date, like ledger. An empty date string means no restriction. -filterJournalTransactionsByDate :: DateSpan -> Journal -> Journal -filterJournalTransactionsByDate (DateSpan begin end) (Journal ms ps ts tls hs f fp ft) = +filterJournalLedgerTransactionsByDate :: DateSpan -> Journal -> Journal +filterJournalLedgerTransactionsByDate (DateSpan begin end) (Journal ms ps ts tls hs f fp ft) = Journal ms ps (filter matchdate ts) tls hs f fp ft where matchdate t = maybe True (ltdate t>=) begin && maybe True (ltdate t<) end -- | Keep only ledger transactions which have the requested -- cleared/uncleared status, if there is one. -filterJournalTransactionsByClearedStatus :: Maybe Bool -> Journal -> Journal -filterJournalTransactionsByClearedStatus Nothing rl = rl -filterJournalTransactionsByClearedStatus (Just val) (Journal ms ps ts tls hs f fp ft) = +filterJournalPostingsByClearedStatus :: Maybe Bool -> Journal -> Journal +filterJournalPostingsByClearedStatus Nothing rl = rl +filterJournalPostingsByClearedStatus (Just val) (Journal ms ps ts tls hs f fp ft) = Journal ms ps (filter ((==val).ltstatus) ts) tls hs f fp ft -- | Strip out any virtual postings, if the flag is true, otherwise do @@ -117,8 +117,8 @@ filterJournalPostingsByDepth depth (Journal mts pts ts tls hs f fp ft) = t{ltpostings=filter ((<= depth) . accountNameLevel . paccount) ps} -- | Keep only ledger transactions which affect accounts matched by the account patterns. -filterJournalTransactionsByAccount :: [String] -> Journal -> Journal -filterJournalTransactionsByAccount apats (Journal ms ps ts tls hs f fp ft) = +filterJournalPostingsByAccount :: [String] -> Journal -> Journal +filterJournalPostingsByAccount apats (Journal ms ps ts tls hs f fp ft) = Journal ms ps (filter (any (matchpats apats . paccount) . ltpostings) ts) tls hs f fp ft -- | Convert this ledger's transactions' primary date to either their @@ -153,7 +153,7 @@ canonicaliseAmounts costbasis rl@(Journal ms ps ts tls hs f fp ft) = Journal 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 . tamount) (journalTransactions rl) + commodities = map commodity (concatMap (amounts . tamount) (journalLedgerPostings rl) ++ concatMap (amounts . hamount) (historical_prices rl)) fixprice :: Amount -> Amount fixprice a@Amount{price=Just _} = a @@ -173,7 +173,7 @@ canonicaliseAmounts costbasis rl@(Journal ms ps ts tls hs f fp ft) = Journal ms -- | Get just the amounts from a ledger, in the order parsed. journalAmounts :: Journal -> [MixedAmount] -journalAmounts = map tamount . journalTransactions +journalAmounts = map tamount . journalLedgerPostings -- | Get just the ammount commodities from a ledger, in the order parsed. journalCommodities :: Journal -> [Commodity] diff --git a/Ledger/Ledger.hs b/Ledger/Ledger.hs index 7e1f872d5..8e151495b 100644 --- a/Ledger/Ledger.hs +++ b/Ledger/Ledger.hs @@ -59,7 +59,7 @@ import Ledger.Utils import Ledger.Types import Ledger.Account () import Ledger.AccountName -import Ledger.Transaction +import Ledger.LedgerPosting import Ledger.Journal @@ -75,7 +75,7 @@ instance Show Ledger where cacheLedger :: [String] -> Journal -> Ledger cacheLedger apats l = Ledger{journaltext="",journal=l,accountnametree=ant,accountmap=acctmap} where - (ant,txnsof,_,inclbalof) = groupTransactions $ filtertxns apats $ journalTransactions l + (ant,txnsof,_,inclbalof) = groupLedgerPostings $ filtertxns apats $ journalLedgerPostings l acctmap = Map.fromList [(a, mkacct a) | a <- flatten ant] where mkacct a = Account a (txnsof a) (inclbalof a) @@ -83,12 +83,12 @@ cacheLedger apats l = Ledger{journaltext="",journal=l,accountnametree=ant,accoun -- query functions that fetch transactions, balance, and -- subaccount-including balance by account name. -- This is to factor out common logic from cacheLedger and --- summariseTransactionsInDateSpan. -groupTransactions :: [Transaction] -> (Tree AccountName, - (AccountName -> [Transaction]), +-- summariseLedgerPostingsInDateSpan. +groupLedgerPostings :: [LedgerPosting] -> (Tree AccountName, + (AccountName -> [LedgerPosting]), (AccountName -> MixedAmount), (AccountName -> MixedAmount)) -groupTransactions ts = (ant,txnsof,exclbalof,inclbalof) +groupLedgerPostings ts = (ant,txnsof,exclbalof,inclbalof) where txnanames = sort $ nub $ map taccount ts ant = accountNameTreeFrom $ expandAccountNames txnanames @@ -106,18 +106,18 @@ groupTransactions ts = (ant,txnsof,exclbalof,inclbalof) -- | Add subaccount-excluding and subaccount-including balances to a tree -- of account names somewhat efficiently, given a function that looks up -- transactions by account name. -calculateBalances :: Tree AccountName -> (AccountName -> [Transaction]) -> Tree (AccountName, (MixedAmount, MixedAmount)) +calculateBalances :: Tree AccountName -> (AccountName -> [LedgerPosting]) -> Tree (AccountName, (MixedAmount, MixedAmount)) calculateBalances ant txnsof = addbalances ant where addbalances (Node a subs) = Node (a,(bal,bal+subsbal)) subs' where - bal = sumTransactions $ txnsof a + bal = sumLedgerPostings $ txnsof a subsbal = sum $ map (snd . snd . root) subs' subs' = map addbalances subs -- | 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 :: [LedgerPosting] -> Map.Map AccountName [LedgerPosting] transactionsByAccount ts = m' where sortedts = sortBy (comparing taccount) ts @@ -126,7 +126,7 @@ transactionsByAccount ts = m' -- The special account name "top" can be used to look up all transactions. ? -- m' = Map.insert "top" sortedts m -filtertxns :: [String] -> [Transaction] -> [Transaction] +filtertxns :: [String] -> [LedgerPosting] -> [LedgerPosting] filtertxns apats = filter (matchpats apats . taccount) -- | List a ledger's account names. @@ -155,8 +155,8 @@ ledgerSubAccounts l Account{aname=a} = map (ledgerAccount l) $ filter (`isSubAccountNameOf` a) $ accountnames l -- | List a ledger's "transactions", ie postings with transaction info attached. -ledgerTransactions :: Ledger -> [Transaction] -ledgerTransactions = journalTransactions . journal +ledgerLedgerPostings :: Ledger -> [LedgerPosting] +ledgerLedgerPostings = journalLedgerPostings . journal -- | Get a ledger's tree of accounts to the specified depth. ledgerAccountTree :: Int -> Ledger -> Tree Account @@ -173,7 +173,7 @@ ledgerDateSpan l | null ts = DateSpan Nothing Nothing | otherwise = DateSpan (Just $ tdate $ head ts) (Just $ addDays 1 $ tdate $ last ts) where - ts = sortBy (comparing tdate) $ ledgerTransactions l + ts = sortBy (comparing tdate) $ ledgerLedgerPostings l -- | Convenience aliases. accountnames :: Ledger -> [AccountName] @@ -194,8 +194,8 @@ accountsmatching = ledgerAccountsMatching subaccounts :: Ledger -> Account -> [Account] subaccounts = ledgerSubAccounts -transactions :: Ledger -> [Transaction] -transactions = ledgerTransactions +transactions :: Ledger -> [LedgerPosting] +transactions = ledgerLedgerPostings commodities :: Ledger -> [Commodity] commodities = nub . journalCommodities . journal diff --git a/Ledger/LedgerPosting.hs b/Ledger/LedgerPosting.hs new file mode 100644 index 000000000..5920893dc --- /dev/null +++ b/Ledger/LedgerPosting.hs @@ -0,0 +1,50 @@ +{-| + +A compound data type for efficiency. A 'LedgerPosting' is a 'Posting' with +its parent 'LedgerTransaction' \'s date and description attached. The +\"transaction\" term is pretty ingrained in the code, docs and with users, +so we've kept it. These are what we work with most of the time when doing +reports. + +-} + +module Ledger.LedgerPosting +where +import Ledger.Dates +import Ledger.Utils +import Ledger.Types +import Ledger.LedgerTransaction (showAccountName) +import Ledger.Amount + + +instance Show LedgerPosting where show=showLedgerPosting + +showLedgerPosting :: LedgerPosting -> String +showLedgerPosting (LedgerPosting _ stat d desc a amt ttype) = + s ++ unwords [showDate d,desc,a',show amt,show ttype] + where s = if stat then " *" else "" + a' = showAccountName Nothing ttype a + +-- | Convert a 'LedgerTransaction' to two or more 'LedgerPosting's. An id number +-- is attached to the transactions to preserve their grouping - it should +-- be unique per entry. +flattenLedgerTransaction :: (LedgerTransaction, Int) -> [LedgerPosting] +flattenLedgerTransaction (LedgerTransaction d _ s _ desc _ ps _, n) = + [LedgerPosting n s d desc (paccount p) (pamount p) (ptype p) | p <- ps] + +accountNamesFromLedgerPostings :: [LedgerPosting] -> [AccountName] +accountNamesFromLedgerPostings = nub . map taccount + +sumLedgerPostings :: [LedgerPosting] -> MixedAmount +sumLedgerPostings = sum . map tamount + +nulltxn :: LedgerPosting +nulltxn = LedgerPosting 0 False (parsedate "1900/1/1") "" "" nullmixedamt RegularPosting + +-- | Does the given transaction fall within the given date span ? +isLedgerPostingInDateSpan :: DateSpan -> LedgerPosting -> Bool +isLedgerPostingInDateSpan (DateSpan Nothing Nothing) _ = True +isLedgerPostingInDateSpan (DateSpan Nothing (Just e)) (LedgerPosting{tdate=d}) = d=b +isLedgerPostingInDateSpan (DateSpan (Just b) (Just e)) (LedgerPosting{tdate=d}) = d>=b && d[DATE]" or "d<=[DATE]", and return a transaction-matching predicate. -datedisplayexpr :: GenParser Char st (Transaction -> Bool) +datedisplayexpr :: GenParser Char st (LedgerPosting -> Bool) datedisplayexpr = do char 'd' op <- compareop diff --git a/Ledger/Posting.hs b/Ledger/Posting.hs index 9f2942767..bc9eb418d 100644 --- a/Ledger/Posting.hs +++ b/Ledger/Posting.hs @@ -5,7 +5,7 @@ single 'Account'. Each 'LedgerTransaction' contains two or more postings which should add up to 0. Generally, we use these with the ledger transaction's date and description -added, which we call a 'Transaction'. +added, which we call a 'LedgerPosting'. -} diff --git a/Ledger/Transaction.hs b/Ledger/Transaction.hs deleted file mode 100644 index bd085a034..000000000 --- a/Ledger/Transaction.hs +++ /dev/null @@ -1,50 +0,0 @@ -{-| - -A compound data type for efficiency. A 'Transaction' is a 'Posting' with -its parent 'LedgerTransaction' \'s date and description attached. The -\"transaction\" term is pretty ingrained in the code, docs and with users, -so we've kept it. These are what we work with most of the time when doing -reports. - --} - -module Ledger.Transaction -where -import Ledger.Dates -import Ledger.Utils -import Ledger.Types -import Ledger.LedgerTransaction (showAccountName) -import Ledger.Amount - - -instance Show Transaction where show=showTransaction - -showTransaction :: Transaction -> String -showTransaction (Transaction _ stat d desc a amt ttype) = - s ++ unwords [showDate d,desc,a',show amt,show ttype] - where s = if stat then " *" else "" - a' = showAccountName Nothing ttype a - --- | Convert a 'LedgerTransaction' to two or more 'Transaction's. An id number --- is attached to the transactions to preserve their grouping - it should --- be unique per entry. -flattenLedgerTransaction :: (LedgerTransaction, Int) -> [Transaction] -flattenLedgerTransaction (LedgerTransaction d _ s _ desc _ ps _, n) = - [Transaction n s d desc (paccount p) (pamount p) (ptype p) | p <- ps] - -accountNamesFromTransactions :: [Transaction] -> [AccountName] -accountNamesFromTransactions = nub . map taccount - -sumTransactions :: [Transaction] -> MixedAmount -sumTransactions = sum . map tamount - -nulltxn :: Transaction -nulltxn = Transaction 0 False (parsedate "1900/1/1") "" "" nullmixedamt RegularPosting - --- | 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{tdate=d}) = d=b -isTransactionInDateSpan (DateSpan (Just b) (Just e)) (Transaction{tdate=d}) = d>=b && d