mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-20 10:47:29 +03:00
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