rename Transaction to LedgerPosting
This commit is contained in:
		
							parent
							
								
									2e9b27da0d
								
							
						
					
					
						commit
						0656d575ac
					
				| @ -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) | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
| @ -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 | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -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 | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
| @ -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. | ||||||
|  | |||||||
| @ -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] | ||||||
|  | |||||||
| @ -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
									
								
							
							
						
						
									
										50
									
								
								Ledger/LedgerPosting.hs
									
									
									
									
									
										Normal 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 | ||||||
|  | 
 | ||||||
| @ -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 | ||||||
|  | |||||||
| @ -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'. | ||||||
| 
 | 
 | ||||||
| -} | -} | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -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 |  | ||||||
| 
 |  | ||||||
| @ -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 | ||||||
|     } |     } | ||||||
| 
 | 
 | ||||||
|  | |||||||
							
								
								
									
										4
									
								
								Tests.hs
									
									
									
									
									
								
							
							
						
						
									
										4
									
								
								Tests.hs
									
									
									
									
									
								
							| @ -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]} | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user