rename Transaction to LedgerPosting

This commit is contained in:
Simon Michael 2009-12-16 07:58:06 +00:00
parent 2e9b27da0d
commit 0656d575ac
16 changed files with 114 additions and 114 deletions

View File

@ -101,7 +101,7 @@ import Ledger.Utils
import Ledger.Types import Ledger.Types
import Ledger.Amount import Ledger.Amount
import Ledger.AccountName import Ledger.AccountName
import Ledger.Transaction import Ledger.LedgerPosting
import Ledger.Ledger import Ledger.Ledger
import Options import Options
import System.IO.UTF8 import System.IO.UTF8
@ -151,7 +151,7 @@ isInteresting opts l a
emptyflag = Empty `elem` opts emptyflag = Empty `elem` opts
acct = ledgerAccount l a acct = ledgerAccount l a
notzero = not $ isZeroMixedAmount inclbalance where inclbalance = abalance acct 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 numinterestingsubs = length $ filter isInterestingTree subtrees
where where
isInterestingTree = treeany (isInteresting opts l . aname) isInterestingTree = treeany (isInteresting opts l . aname)

View File

@ -27,10 +27,10 @@ showHistogram opts args l = concatMap (printDayWith countBar) daytxns
| otherwise = i | otherwise = i
fullspan = journalDateSpan $ journal l fullspan = journalDateSpan $ journal l
days = filter (DateSpan Nothing Nothing /=) $ splitSpan interval fullspan 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 -- same as Register
-- should count raw transactions, not posting transactions -- 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 filterempties
| Empty `elem` opts = id | Empty `elem` opts = id
| otherwise = filter (not . isZeroMixedAmount . tamount) | 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 countBar ts = replicate (length ts) barchar
total = show . sumTransactions total = show . sumLedgerPostings
-- totalBar ts = replicate (sumTransactions ts) barchar -- totalBar ts = replicate (sumLedgerPostings ts) barchar

View File

@ -22,7 +22,7 @@ showLedgerTransactions opts args l = concatMap (showLedgerTransactionForPrint ef
txns = sortBy (comparing ltdate) $ txns = sortBy (comparing ltdate) $
ledger_txns $ ledger_txns $
filterJournalPostingsByDepth depth $ filterJournalPostingsByDepth depth $
filterJournalTransactionsByAccount apats $ filterJournalPostingsByAccount apats $
journal l journal l
depth = depthFromOpts opts depth = depthFromOpts opts
effective = Effective `elem` opts effective = Effective `elem` opts

View File

@ -34,7 +34,7 @@ showRegisterReport opts args l
| otherwise = showtxns summaryts nulltxn startbal | otherwise = showtxns summaryts nulltxn startbal
where where
interval = intervalFromOpts opts 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) filterdepth | interval == NoInterval = filter (\t -> accountNameLevel (taccount t) <= depth)
| otherwise = id | otherwise = id
filterempties filterempties
@ -42,7 +42,7 @@ showRegisterReport opts args l
| otherwise = filter (not . isZeroMixedAmount . tamount) | otherwise = filter (not . isZeroMixedAmount . tamount)
(precedingts, ts') = break (matchdisplayopt dopt) ts (precedingts, ts') = break (matchdisplayopt dopt) ts
(displayedts, _) = span (matchdisplayopt dopt) ts' (displayedts, _) = span (matchdisplayopt dopt) ts'
startbal = sumTransactions precedingts startbal = sumLedgerPostings precedingts
(apats,_) = parsePatternArgs args (apats,_) = parsePatternArgs args
matchdisplayopt Nothing _ = True matchdisplayopt Nothing _ = True
matchdisplayopt (Just e) t = (fromparse $ parsewith datedisplayexpr e) t matchdisplayopt (Just e) t = (fromparse $ parsewith datedisplayexpr e) t
@ -50,8 +50,8 @@ showRegisterReport opts args l
empty = Empty `elem` opts empty = Empty `elem` opts
depth = depthFromOpts opts depth = depthFromOpts opts
summaryts = concatMap summarisespan (zip spans [1..]) summaryts = concatMap summarisespan (zip spans [1..])
summarisespan (s,n) = summariseTransactionsInDateSpan s n depth empty (transactionsinspan s) summarisespan (s,n) = summariseLedgerPostingsInDateSpan s n depth empty (transactionsinspan s)
transactionsinspan s = filter (isTransactionInDateSpan s) displayedts transactionsinspan s = filter (isLedgerPostingInDateSpan s) displayedts
spans = splitSpan interval (ledgerDateSpan l) spans = splitSpan interval (ledgerDateSpan l)
-- | Convert a date span (representing a reporting interval) and a list of -- | 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 -- The showempty flag forces the display of a zero-transaction span
-- and also zero-transaction accounts within the span. -- and also zero-transaction accounts within the span.
summariseTransactionsInDateSpan :: DateSpan -> Int -> Int -> Bool -> [Transaction] -> [Transaction] summariseLedgerPostingsInDateSpan :: DateSpan -> Int -> Int -> Bool -> [LedgerPosting] -> [LedgerPosting]
summariseTransactionsInDateSpan (DateSpan b e) tnum depth showempty ts summariseLedgerPostingsInDateSpan (DateSpan b e) tnum depth showempty ts
| null ts && showempty = [txn] | null ts && showempty = [txn]
| null ts = [] | null ts = []
| otherwise = summaryts' | otherwise = summaryts'
@ -83,7 +83,7 @@ summariseTransactionsInDateSpan (DateSpan b e) tnum depth showempty ts
| otherwise = filter (not . isZeroMixedAmount . tamount) summaryts | otherwise = filter (not . isZeroMixedAmount . tamount) summaryts
txnanames = sort $ nub $ map taccount ts txnanames = sort $ nub $ map taccount ts
-- aggregate balances by account, like cacheLedger, then do depth-clipping -- aggregate balances by account, like cacheLedger, then do depth-clipping
(_,_,exclbalof,inclbalof) = groupTransactions ts (_,_,exclbalof,inclbalof) = groupLedgerPostings ts
clippedanames = clipAccountNames depth txnanames clippedanames = clipAccountNames depth txnanames
isclipped a = accountNameLevel a >= depth isclipped a = accountNameLevel a >= depth
balancetoshowfor a = balancetoshowfor a =
@ -104,7 +104,7 @@ showtxns (t:ts) tprev bal = this ++ showtxns ts t bal'
bal' = bal + tamount t bal' = bal + tamount t
-- | Show one transaction line and balance with or without the entry details. -- | 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" showtxn omitdesc t b = concatBottomPadded [entrydesc ++ p ++ " ", bal] ++ "\n"
where where
ledger3ishlayout = False ledger3ishlayout = False
@ -116,5 +116,5 @@ showtxn omitdesc t b = concatBottomPadded [entrydesc ++ p ++ " ", bal] ++ "\n"
desc = printf ("%-"++(show descwidth)++"s") $ elideRight descwidth de :: String desc = printf ("%-"++(show descwidth)++"s") $ elideRight descwidth de :: String
p = showPostingWithoutPrice $ Posting s a amt "" tt p = showPostingWithoutPrice $ Posting s a amt "" tt
bal = padleft 12 (showMixedAmountOrZeroWithoutPrice b) 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

View File

@ -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 -- cursor on the register screen (or best guess). Results undefined while
-- on other screens. Doesn't work. -- on other screens. Doesn't work.
currentLedgerTransaction :: AppState -> LedgerTransaction currentLedgerTransaction :: AppState -> LedgerTransaction
currentLedgerTransaction a@AppState{aledger=l,abuf=buf} = entryContainingTransaction a t currentLedgerTransaction a@AppState{aledger=l,abuf=buf} = transactionContainingLedgerPosting a t
where where
t = safehead nulltxn $ filter ismatch $ ledgerTransactions l t = safehead nulltxn $ filter ismatch $ ledgerLedgerPostings l
ismatch t = tdate t == parsedate (take 10 datedesc) ismatch t = tdate t == parsedate (take 10 datedesc)
&& take 70 (showtxn False t nullmixedamt) == (datedesc ++ acctamt) && take 70 (showtxn False t nullmixedamt) == (datedesc ++ acctamt)
datedesc = take 32 $ fromMaybe "" $ find (not . (" " `isPrefixOf`)) $ safehead "" rest : reverse above 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. -- | Get the entry which contains the given transaction.
-- Will raise an error if there are problems. -- Will raise an error if there are problems.
entryContainingTransaction :: AppState -> Transaction -> LedgerTransaction transactionContainingLedgerPosting :: AppState -> LedgerPosting -> LedgerTransaction
entryContainingTransaction AppState{aledger=l} t = ledger_txns (journal l) !! tnum t transactionContainingLedgerPosting AppState{aledger=l} t = ledger_txns (journal l) !! tnum t
-- renderers -- renderers

View File

@ -19,7 +19,7 @@ module Ledger (
module Ledger.Journal, module Ledger.Journal,
module Ledger.Posting, module Ledger.Posting,
module Ledger.TimeLog, module Ledger.TimeLog,
module Ledger.Transaction, module Ledger.LedgerPosting,
module Ledger.Types, module Ledger.Types,
module Ledger.Utils, module Ledger.Utils,
) )
@ -36,6 +36,6 @@ import Ledger.Parse
import Ledger.Journal import Ledger.Journal
import Ledger.Posting import Ledger.Posting
import Ledger.TimeLog import Ledger.TimeLog
import Ledger.Transaction import Ledger.LedgerPosting
import Ledger.Types import Ledger.Types
import Ledger.Utils import Ledger.Utils

View File

@ -4,7 +4,7 @@ A compound data type for efficiency. An 'Account' stores
- an 'AccountName', - 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 account, excluding subaccounts
- a 'MixedAmount' representing the account balance, including subaccounts. - a 'MixedAmount' representing the account balance, including subaccounts.

View File

@ -14,7 +14,7 @@ import Ledger.Types
import Ledger.AccountName import Ledger.AccountName
import Ledger.Amount import Ledger.Amount
import Ledger.LedgerTransaction (ledgerTransactionWithDate) import Ledger.LedgerTransaction (ledgerTransactionWithDate)
import Ledger.Transaction import Ledger.LedgerPosting
import Ledger.Posting import Ledger.Posting
import Ledger.TimeLog import Ledger.TimeLog
@ -55,12 +55,12 @@ addHistoricalPrice h l0 = l0 { historical_prices = h : historical_prices l0 }
addTimeLogEntry :: TimeLogEntry -> Journal -> Journal addTimeLogEntry :: TimeLogEntry -> Journal -> Journal
addTimeLogEntry tle l0 = l0 { open_timelog_entries = tle : open_timelog_entries l0 } addTimeLogEntry tle l0 = l0 { open_timelog_entries = tle : open_timelog_entries l0 }
journalTransactions :: Journal -> [Transaction] journalLedgerPostings :: Journal -> [LedgerPosting]
journalTransactions = txnsof . ledger_txns journalLedgerPostings = txnsof . ledger_txns
where txnsof ts = concatMap flattenLedgerTransaction $ zip ts [1..] where txnsof ts = concatMap flattenLedgerTransaction $ zip ts [1..]
journalAccountNamesUsed :: Journal -> [AccountName] journalAccountNamesUsed :: Journal -> [AccountName]
journalAccountNamesUsed = accountNamesFromTransactions . journalTransactions journalAccountNamesUsed = accountNamesFromLedgerPostings . journalLedgerPostings
journalAccountNames :: Journal -> [AccountName] journalAccountNames :: Journal -> [AccountName]
journalAccountNames = sort . expandAccountNames . journalAccountNamesUsed journalAccountNames = sort . expandAccountNames . journalAccountNamesUsed
@ -74,30 +74,30 @@ journalAccountNameTree = accountNameTreeFrom . journalAccountNames
filterJournal :: DateSpan -> [String] -> Maybe Bool -> Bool -> Journal -> Journal filterJournal :: DateSpan -> [String] -> Maybe Bool -> Bool -> Journal -> Journal
filterJournal span pats clearedonly realonly = filterJournal span pats clearedonly realonly =
filterJournalPostingsByRealness realonly . filterJournalPostingsByRealness realonly .
filterJournalTransactionsByClearedStatus clearedonly . filterJournalPostingsByClearedStatus clearedonly .
filterJournalTransactionsByDate span . filterJournalLedgerTransactionsByDate span .
filterJournalTransactionsByDescription pats filterJournalLedgerTransactionsByDescription pats
-- | Keep only ledger transactions whose description matches the description patterns. -- | Keep only ledger transactions whose description matches the description patterns.
filterJournalTransactionsByDescription :: [String] -> Journal -> Journal filterJournalLedgerTransactionsByDescription :: [String] -> Journal -> Journal
filterJournalTransactionsByDescription pats (Journal ms ps ts tls hs f fp ft) = filterJournalLedgerTransactionsByDescription pats (Journal ms ps ts tls hs f fp ft) =
Journal ms ps (filter matchdesc ts) tls hs f fp ft Journal ms ps (filter matchdesc ts) tls hs f fp ft
where matchdesc = matchpats pats . ltdescription where matchdesc = matchpats pats . ltdescription
-- | Keep only ledger transactions which fall between begin and end dates. -- | Keep only ledger transactions which fall between begin and end dates.
-- We include transactions on the begin date and exclude transactions on the end -- We include transactions on the begin date and exclude transactions on the end
-- date, like ledger. An empty date string means no restriction. -- date, like ledger. An empty date string means no restriction.
filterJournalTransactionsByDate :: DateSpan -> Journal -> Journal filterJournalLedgerTransactionsByDate :: DateSpan -> Journal -> Journal
filterJournalTransactionsByDate (DateSpan begin end) (Journal ms ps ts tls hs f fp ft) = filterJournalLedgerTransactionsByDate (DateSpan begin end) (Journal ms ps ts tls hs f fp ft) =
Journal ms ps (filter matchdate ts) tls hs f fp ft Journal ms ps (filter matchdate ts) tls hs f fp ft
where where
matchdate t = maybe True (ltdate t>=) begin && maybe True (ltdate t<) end matchdate t = maybe True (ltdate t>=) begin && maybe True (ltdate t<) end
-- | Keep only ledger transactions which have the requested -- | Keep only ledger transactions which have the requested
-- cleared/uncleared status, if there is one. -- cleared/uncleared status, if there is one.
filterJournalTransactionsByClearedStatus :: Maybe Bool -> Journal -> Journal filterJournalPostingsByClearedStatus :: Maybe Bool -> Journal -> Journal
filterJournalTransactionsByClearedStatus Nothing rl = rl filterJournalPostingsByClearedStatus Nothing rl = rl
filterJournalTransactionsByClearedStatus (Just val) (Journal ms ps ts tls hs f fp ft) = filterJournalPostingsByClearedStatus (Just val) (Journal ms ps ts tls hs f fp ft) =
Journal ms ps (filter ((==val).ltstatus) 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 -- | 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} t{ltpostings=filter ((<= depth) . accountNameLevel . paccount) ps}
-- | Keep only ledger transactions which affect accounts matched by the account patterns. -- | Keep only ledger transactions which affect accounts matched by the account patterns.
filterJournalTransactionsByAccount :: [String] -> Journal -> Journal filterJournalPostingsByAccount :: [String] -> Journal -> Journal
filterJournalTransactionsByAccount apats (Journal ms ps ts tls hs f fp ft) = 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 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 -- | 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] commoditymap = Map.fromList [(s,commoditieswithsymbol s) | s <- commoditysymbols]
commoditieswithsymbol s = filter ((s==) . symbol) commodities commoditieswithsymbol s = filter ((s==) . symbol) commodities
commoditysymbols = nub $ map 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)) ++ concatMap (amounts . hamount) (historical_prices rl))
fixprice :: Amount -> Amount fixprice :: Amount -> Amount
fixprice a@Amount{price=Just _} = a 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. -- | Get just the amounts from a ledger, in the order parsed.
journalAmounts :: Journal -> [MixedAmount] journalAmounts :: Journal -> [MixedAmount]
journalAmounts = map tamount . journalTransactions journalAmounts = map tamount . journalLedgerPostings
-- | Get just the ammount commodities from a ledger, in the order parsed. -- | Get just the ammount commodities from a ledger, in the order parsed.
journalCommodities :: Journal -> [Commodity] journalCommodities :: Journal -> [Commodity]

View File

@ -59,7 +59,7 @@ import Ledger.Utils
import Ledger.Types import Ledger.Types
import Ledger.Account () import Ledger.Account ()
import Ledger.AccountName import Ledger.AccountName
import Ledger.Transaction import Ledger.LedgerPosting
import Ledger.Journal import Ledger.Journal
@ -75,7 +75,7 @@ instance Show Ledger where
cacheLedger :: [String] -> Journal -> Ledger cacheLedger :: [String] -> Journal -> Ledger
cacheLedger apats l = Ledger{journaltext="",journal=l,accountnametree=ant,accountmap=acctmap} cacheLedger apats l = Ledger{journaltext="",journal=l,accountnametree=ant,accountmap=acctmap}
where 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] acctmap = Map.fromList [(a, mkacct a) | a <- flatten ant]
where mkacct a = Account a (txnsof a) (inclbalof a) 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 -- query functions that fetch transactions, balance, and
-- subaccount-including balance by account name. -- subaccount-including balance by account name.
-- This is to factor out common logic from cacheLedger and -- This is to factor out common logic from cacheLedger and
-- summariseTransactionsInDateSpan. -- summariseLedgerPostingsInDateSpan.
groupTransactions :: [Transaction] -> (Tree AccountName, groupLedgerPostings :: [LedgerPosting] -> (Tree AccountName,
(AccountName -> [Transaction]), (AccountName -> [LedgerPosting]),
(AccountName -> MixedAmount), (AccountName -> MixedAmount),
(AccountName -> MixedAmount)) (AccountName -> MixedAmount))
groupTransactions ts = (ant,txnsof,exclbalof,inclbalof) groupLedgerPostings ts = (ant,txnsof,exclbalof,inclbalof)
where where
txnanames = sort $ nub $ map taccount ts txnanames = sort $ nub $ map taccount ts
ant = accountNameTreeFrom $ expandAccountNames txnanames ant = accountNameTreeFrom $ expandAccountNames txnanames
@ -106,18 +106,18 @@ groupTransactions ts = (ant,txnsof,exclbalof,inclbalof)
-- | Add subaccount-excluding and subaccount-including balances to a tree -- | Add subaccount-excluding and subaccount-including balances to a tree
-- of account names somewhat efficiently, given a function that looks up -- of account names somewhat efficiently, given a function that looks up
-- transactions by account name. -- 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 calculateBalances ant txnsof = addbalances ant
where where
addbalances (Node a subs) = Node (a,(bal,bal+subsbal)) subs' addbalances (Node a subs) = Node (a,(bal,bal+subsbal)) subs'
where where
bal = sumTransactions $ txnsof a bal = sumLedgerPostings $ txnsof a
subsbal = sum $ map (snd . snd . root) subs' subsbal = sum $ map (snd . snd . root) subs'
subs' = map addbalances subs subs' = map addbalances subs
-- | Convert a list of transactions to a map from account name to the list -- | Convert a list of transactions to a map from account name to the list
-- of all transactions in that account. -- of all transactions in that account.
transactionsByAccount :: [Transaction] -> Map.Map AccountName [Transaction] transactionsByAccount :: [LedgerPosting] -> Map.Map AccountName [LedgerPosting]
transactionsByAccount ts = m' transactionsByAccount ts = m'
where where
sortedts = sortBy (comparing taccount) ts 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. ? -- The special account name "top" can be used to look up all transactions. ?
-- m' = Map.insert "top" sortedts m -- m' = Map.insert "top" sortedts m
filtertxns :: [String] -> [Transaction] -> [Transaction] filtertxns :: [String] -> [LedgerPosting] -> [LedgerPosting]
filtertxns apats = filter (matchpats apats . taccount) filtertxns apats = filter (matchpats apats . taccount)
-- | List a ledger's account names. -- | List a ledger's account names.
@ -155,8 +155,8 @@ ledgerSubAccounts l Account{aname=a} =
map (ledgerAccount l) $ filter (`isSubAccountNameOf` a) $ accountnames l map (ledgerAccount l) $ filter (`isSubAccountNameOf` a) $ accountnames l
-- | List a ledger's "transactions", ie postings with transaction info attached. -- | List a ledger's "transactions", ie postings with transaction info attached.
ledgerTransactions :: Ledger -> [Transaction] ledgerLedgerPostings :: Ledger -> [LedgerPosting]
ledgerTransactions = journalTransactions . journal ledgerLedgerPostings = journalLedgerPostings . journal
-- | Get a ledger's tree of accounts to the specified depth. -- | Get a ledger's tree of accounts to the specified depth.
ledgerAccountTree :: Int -> Ledger -> Tree Account ledgerAccountTree :: Int -> Ledger -> Tree Account
@ -173,7 +173,7 @@ ledgerDateSpan l
| null ts = DateSpan Nothing Nothing | null ts = DateSpan Nothing Nothing
| otherwise = DateSpan (Just $ tdate $ head ts) (Just $ addDays 1 $ tdate $ last ts) | otherwise = DateSpan (Just $ tdate $ head ts) (Just $ addDays 1 $ tdate $ last ts)
where where
ts = sortBy (comparing tdate) $ ledgerTransactions l ts = sortBy (comparing tdate) $ ledgerLedgerPostings l
-- | Convenience aliases. -- | Convenience aliases.
accountnames :: Ledger -> [AccountName] accountnames :: Ledger -> [AccountName]
@ -194,8 +194,8 @@ accountsmatching = ledgerAccountsMatching
subaccounts :: Ledger -> Account -> [Account] subaccounts :: Ledger -> Account -> [Account]
subaccounts = ledgerSubAccounts subaccounts = ledgerSubAccounts
transactions :: Ledger -> [Transaction] transactions :: Ledger -> [LedgerPosting]
transactions = ledgerTransactions transactions = ledgerLedgerPostings
commodities :: Ledger -> [Commodity] commodities :: Ledger -> [Commodity]
commodities = nub . journalCommodities . journal commodities = nub . journalCommodities . journal

50
Ledger/LedgerPosting.hs Normal file
View File

@ -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<e
isLedgerPostingInDateSpan (DateSpan (Just b) Nothing) (LedgerPosting{tdate=d}) = d>=b
isLedgerPostingInDateSpan (DateSpan (Just b) (Just e)) (LedgerPosting{tdate=d}) = d>=b && d<e

View File

@ -558,7 +558,7 @@ timelogentry = do
-- | Parse a --display expression which is a simple date predicate, like -- | Parse a --display expression which is a simple date predicate, like
-- "d>[DATE]" or "d<=[DATE]", and return a transaction-matching predicate. -- "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 datedisplayexpr = do
char 'd' char 'd'
op <- compareop op <- compareop

View File

@ -5,7 +5,7 @@ single 'Account'. Each 'LedgerTransaction' contains two or more postings
which should add up to 0. which should add up to 0.
Generally, we use these with the ledger transaction's date and description Generally, we use these with the ledger transaction's date and description
added, which we call a 'Transaction'. added, which we call a 'LedgerPosting'.
-} -}

View File

@ -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<e
isTransactionInDateSpan (DateSpan (Just b) Nothing) (Transaction{tdate=d}) = d>=b
isTransactionInDateSpan (DateSpan (Just b) (Just e)) (Transaction{tdate=d}) = d>=b && d<e

View File

@ -134,7 +134,7 @@ data FilterSpec = FilterSpec {
,whichdate :: WhichDate -- ^ which dates to use (transaction or effective) ,whichdate :: WhichDate -- ^ which dates to use (transaction or effective)
} }
data Transaction = Transaction { data LedgerPosting = LedgerPosting {
tnum :: Int, tnum :: Int,
tstatus :: Bool, -- ^ posting status tstatus :: Bool, -- ^ posting status
tdate :: Day, -- ^ transaction date tdate :: Day, -- ^ transaction date
@ -146,7 +146,7 @@ data Transaction = Transaction {
data Account = Account { data Account = Account {
aname :: AccountName, aname :: AccountName,
atransactions :: [Transaction], -- ^ transactions in this account apostings :: [LedgerPosting], -- ^ transactions in this account
abalance :: MixedAmount -- ^ sum of transactions in this account and subaccounts abalance :: MixedAmount -- ^ sum of transactions in this account and subaccounts
} }

View File

@ -800,9 +800,9 @@ tests = [
let a = ledgerAccount l "assets" let a = ledgerAccount l "assets"
map aname (ledgerSubAccounts l a) `is` ["assets:bank","assets:cash"] map aname (ledgerSubAccounts l a) `is` ["assets:bank","assets:cash"]
,"summariseTransactionsInDateSpan" ~: do ,"summariseLedgerPostingsInDateSpan" ~: do
let gives (b,e,tnum,depth,showempty,ts) = let gives (b,e,tnum,depth,showempty,ts) =
(summariseTransactionsInDateSpan (mkdatespan b e) tnum depth showempty ts `is`) (summariseLedgerPostingsInDateSpan (mkdatespan b e) tnum depth showempty ts `is`)
let ts = let ts =
[ [
nulltxn{tdescription="desc",taccount="expenses:food:groceries",tamount=Mixed [dollars 1]} nulltxn{tdescription="desc",taccount="expenses:food:groceries",tamount=Mixed [dollars 1]}

View File

@ -56,7 +56,7 @@ library
Ledger.Posting Ledger.Posting
Ledger.Parse Ledger.Parse
Ledger.TimeLog Ledger.TimeLog
Ledger.Transaction Ledger.LedgerPosting
Ledger.Types Ledger.Types
Ledger.Utils Ledger.Utils
Build-Depends: Build-Depends:
@ -95,7 +95,7 @@ executable hledger
Ledger.Journal Ledger.Journal
Ledger.Posting Ledger.Posting
Ledger.TimeLog Ledger.TimeLog
Ledger.Transaction Ledger.LedgerPosting
Ledger.Types Ledger.Types
Ledger.Utils Ledger.Utils
Options Options