namegeddon! conform to new terminology in ledger 3, more or less

This renames RawTransaction -> Posting and Entry -> LedgerTransaction,
plus a bunch more cleanups for consistency.  So while ledger 3 has
transactions containing postings, and so do we when speaking to users,
internally we call ledger 3's transactions LedgerTransaction, and we keep
our old Transaction type as well, because it's useful and used all over
the place. To review:

- ledger 2 had Entrys containing Transactions.

- hledger 0.4 had Entrys containing RawTransactions, and Transactions
  which are a RawTransaction with its parent Entry's info added.
  Transactions are what we most work with when reporting and are
  ubiquitous in the code and docs.

- ledger 3 has Transactions containing Postings.

- hledger 0.5 now has LedgerTransactions containing Postings, with
  Transactions kept as before (a Posting plus it's parent's info).  These
  could be named PartialTransactions or TransactionPostings, but it gets
  too verbose and obscure for devs and users.
This commit is contained in:
Simon Michael 2009-04-03 10:58:05 +00:00
parent 71dd80f1b1
commit 0f1cbef9a8
18 changed files with 508 additions and 492 deletions

View File

@ -11,11 +11,11 @@ module Ledger (
module Ledger.Amount,
module Ledger.Commodity,
module Ledger.Dates,
module Ledger.Entry,
module Ledger.LedgerTransaction,
module Ledger.Ledger,
module Ledger.Parse,
module Ledger.RawLedger,
module Ledger.RawTransaction,
module Ledger.Posting,
module Ledger.TimeLog,
module Ledger.Transaction,
module Ledger.Types,
@ -27,11 +27,11 @@ import Ledger.AccountName
import Ledger.Amount
import Ledger.Commodity
import Ledger.Dates
import Ledger.Entry
import Ledger.LedgerTransaction
import Ledger.Ledger
import Ledger.Parse
import Ledger.RawLedger
import Ledger.RawTransaction
import Ledger.Posting
import Ledger.TimeLog
import Ledger.Transaction
import Ledger.Types

View File

@ -1,105 +0,0 @@
{-|
An 'Entry' represents a regular entry in the ledger file. It normally
contains two or more balanced 'RawTransaction's.
-}
module Ledger.Entry
where
import Ledger.Utils
import Ledger.Types
import Ledger.Dates
import Ledger.RawTransaction
import Ledger.Amount
instance Show Entry where show = showEntry
instance Show ModifierEntry where
show e = "= " ++ (valueexpr e) ++ "\n" ++ unlines (map show (m_transactions e))
instance Show PeriodicEntry where
show e = "~ " ++ (periodicexpr e) ++ "\n" ++ unlines (map show (p_transactions e))
nullentry = Entry {
edate=parsedate "1900/1/1",
estatus=False,
ecode="",
edescription="",
ecomment="",
etransactions=[],
epreceding_comment_lines=""
}
{-|
Show a ledger entry, formatted for the print command. ledger 2.x's
standard format looks like this:
@
yyyy/mm/dd[ *][ CODE] description......... [ ; comment...............]
account name 1..................... ...$amount1[ ; comment...............]
account name 2..................... ..$-amount1[ ; comment...............]
pcodewidth = no limit -- 10 -- mimicking ledger layout.
pdescwidth = no limit -- 20 -- I don't remember what these mean,
pacctwidth = 35 minimum, no maximum -- they were important at the time.
pamtwidth = 11
pcommentwidth = no limit -- 22
@
-}
showEntry :: Entry -> String
showEntry = showEntry' True
showEntryUnelided :: Entry -> String
showEntryUnelided = showEntry' False
showEntry' :: Bool -> Entry -> String
showEntry' elide e =
unlines $ [{-precedingcomment ++ -}description] ++ (showtxns $ etransactions e) ++ [""]
where
precedingcomment = epreceding_comment_lines e
description = concat [date, status, code, desc] -- , comment]
date = showdate $ edate e
status = if estatus e then " *" else ""
code = if (length $ ecode e) > 0 then (printf " (%s)" $ ecode e) else ""
desc = " " ++ edescription e
comment = if (length $ ecomment e) > 0 then " ; "++(ecomment e) else ""
showtxns ts
| elide && length ts == 2 = [showtxn (ts !! 0), showtxnnoamt (ts !! 1)]
| otherwise = map showtxn ts
showtxn t = showacct t ++ " " ++ (showamount $ tamount t) ++ (showcomment $ tcomment t)
showtxnnoamt t = showacct t ++ " " ++ (showcomment $ tcomment t)
showacct t = " " ++ showstatus t ++ (showaccountname $ taccount t)
showamount = printf "%12s" . showMixedAmount
showaccountname s = printf "%-34s" s
showcomment s = if (length s) > 0 then " ; "++s else ""
showdate d = printf "%-10s" (showDate d)
showstatus t = case tstatus t of
True -> "* "
False -> ""
isEntryBalanced :: Entry -> Bool
isEntryBalanced (Entry {etransactions=ts}) =
isZeroMixedAmount $ costOfMixedAmount $ sum $ map tamount $ filter isReal ts
-- | Ensure that this entry is balanced, possibly auto-filling a missing
-- amount first. We can auto-fill if there is just one non-virtual
-- transaction without an amount. The auto-filled balance will be
-- converted to cost basis if possible. If the entry can not be balanced,
-- return an error message instead.
balanceEntry :: Entry -> Either String Entry
balanceEntry e@Entry{etransactions=ts}
| length missingamounts > 1 = Left $ showerr "could not balance this entry, too many missing amounts"
| not $ isEntryBalanced e' = Left $ showerr "could not balance this entry, amounts do not balance"
| otherwise = Right e'
where
(withamounts, missingamounts) = partition hasAmount $ filter isReal ts
e' = e{etransactions=ts'}
ts' | length missingamounts == 1 = map balance ts
| otherwise = ts
where
balance t | isReal t && not (hasAmount t) = t{tamount = costOfMixedAmount (-otherstotal)}
| otherwise = t
where otherstotal = sum $ map tamount withamounts
showerr s = printf "%s:\n%s" s (showEntryUnelided e)

View File

@ -2,7 +2,7 @@
A 'Ledger' stores, for efficiency, a 'RawLedger' plus its tree of account
names, and a map from account names to 'Account's. It may also have had
uninteresting 'Entry's and 'Transaction's filtered out. It also stores
uninteresting 'LedgerTransaction's and 'Posting's filtered out. It also stores
the complete ledger file text for the ui command.
-}
@ -18,14 +18,14 @@ import Ledger.AccountName
import Ledger.Account
import Ledger.Transaction
import Ledger.RawLedger
import Ledger.Entry
import Ledger.LedgerTransaction
instance Show Ledger where
show l = printf "Ledger with %d entries, %d accounts\n%s"
((length $ entries $ rawledger l) +
(length $ modifier_entries $ rawledger l) +
(length $ periodic_entries $ rawledger l))
show l = printf "Ledger with %d transactions, %d accounts\n%s"
((length $ ledger_txns $ rawledger l) +
(length $ modifier_txns $ rawledger l) +
(length $ periodic_txns $ rawledger l))
(length $ accountnames l)
(showtree $ accountnametree l)

106
Ledger/LedgerTransaction.hs Normal file
View File

@ -0,0 +1,106 @@
{-|
A 'LedgerTransaction' represents a regular transaction in the ledger
file. It normally contains two or more balanced 'Posting's.
-}
module Ledger.LedgerTransaction
where
import Ledger.Utils
import Ledger.Types
import Ledger.Dates
import Ledger.Posting
import Ledger.Amount
instance Show LedgerTransaction where show = showLedgerTransaction
instance Show ModifierTransaction where
show t = "= " ++ (mtvalueexpr t) ++ "\n" ++ unlines (map show (mtpostings t))
instance Show PeriodicTransaction where
show t = "~ " ++ (ptperiodicexpr t) ++ "\n" ++ unlines (map show (ptpostings t))
nullentry = LedgerTransaction {
ltdate=parsedate "1900/1/1",
ltstatus=False,
ltcode="",
ltdescription="",
ltcomment="",
ltpostings=[],
ltpreceding_comment_lines=""
}
{-|
Show a ledger entry, formatted for the print command. ledger 2.x's
standard format looks like this:
@
yyyy/mm/dd[ *][ CODE] description......... [ ; comment...............]
account name 1..................... ...$amount1[ ; comment...............]
account name 2..................... ..$-amount1[ ; comment...............]
pcodewidth = no limit -- 10 -- mimicking ledger layout.
pdescwidth = no limit -- 20 -- I don't remember what these mean,
pacctwidth = 35 minimum, no maximum -- they were important at the time.
pamtwidth = 11
pcommentwidth = no limit -- 22
@
-}
showLedgerTransaction :: LedgerTransaction -> String
showLedgerTransaction = showLedgerTransaction' True
showLedgerTransactionUnelided :: LedgerTransaction -> String
showLedgerTransactionUnelided = showLedgerTransaction' False
showLedgerTransaction' :: Bool -> LedgerTransaction -> String
showLedgerTransaction' elide t =
unlines $ [{-precedingcomment ++ -}description] ++ (showpostings $ ltpostings t) ++ [""]
where
precedingcomment = ltpreceding_comment_lines t
description = concat [date, status, code, desc] -- , comment]
date = showdate $ ltdate t
status = if ltstatus t then " *" else ""
code = if (length $ ltcode t) > 0 then (printf " (%s)" $ ltcode t) else ""
desc = " " ++ ltdescription t
comment = if (length $ ltcomment t) > 0 then " ; "++(ltcomment t) else ""
showdate d = printf "%-10s" (showDate d)
showpostings ps
| elide && length ps == 2 = [showposting (ps !! 0), showpostingnoamt (ps !! 1)]
| otherwise = map showposting ps
where
showposting p = showacct p ++ " " ++ (showamount $ pamount p) ++ (showcomment $ pcomment p)
showpostingnoamt p = showacct p ++ " " ++ (showcomment $ pcomment p)
showacct p = " " ++ showstatus p ++ (showaccountname $ paccount p)
showamount = printf "%12s" . showMixedAmount
showaccountname s = printf "%-34s" s
showcomment s = if (length s) > 0 then " ; "++s else ""
showstatus p = case pstatus p of
True -> "* "
False -> ""
isLedgerTransactionBalanced :: LedgerTransaction -> Bool
isLedgerTransactionBalanced (LedgerTransaction {ltpostings=ps}) =
isZeroMixedAmount $ costOfMixedAmount $ sum $ map pamount $ filter isReal ps
-- | Ensure that this entry is balanced, possibly auto-filling a missing
-- amount first. We can auto-fill if there is just one non-virtual
-- transaction without an amount. The auto-filled balance will be
-- converted to cost basis if possible. If the entry can not be balanced,
-- return an error message instead.
balanceLedgerTransaction :: LedgerTransaction -> Either String LedgerTransaction
balanceLedgerTransaction t@LedgerTransaction{ltpostings=ps}
| length missingamounts > 1 = Left $ showerr "could not balance this entry, too many missing amounts"
| not $ isLedgerTransactionBalanced t' = Left $ showerr "could not balance this entry, amounts do not balance"
| otherwise = Right t'
where
(withamounts, missingamounts) = partition hasAmount $ filter isReal ps
t' = t{ltpostings=ps'}
ps' | length missingamounts == 1 = map balance ps
| otherwise = ps
where
balance p | isReal p && not (hasAmount p) = p{pamount = costOfMixedAmount (-otherstotal)}
| otherwise = p
where otherstotal = sum $ map pamount withamounts
showerr s = printf "%s:\n%s" s (showLedgerTransactionUnelided t)

View File

@ -22,7 +22,7 @@ import Ledger.Utils
import Ledger.Types
import Ledger.Dates
import Ledger.Amount
import Ledger.Entry
import Ledger.LedgerTransaction
import Ledger.Commodity
import Ledger.TimeLog
import Ledger.RawLedger
@ -86,13 +86,13 @@ parseLedger reftime inname intxt = do
-- comment-only) lines, can use choice w/o try
ledgerFile :: GenParser Char LedgerFileCtx (ErrorT String IO (RawLedger -> RawLedger))
ledgerFile = do entries <- many1 ledgerAnyEntry
ledgerFile = do ledger_txns <- many1 ledgerItem
eof
return $ liftM (foldr1 (.)) $ sequence entries
where ledgerAnyEntry = choice [ ledgerDirective
, liftM (return . addEntry) ledgerEntry
, liftM (return . addModifierEntry) ledgerModifierEntry
, liftM (return . addPeriodicEntry) ledgerPeriodicEntry
return $ liftM (foldr1 (.)) $ sequence ledger_txns
where ledgerItem = choice [ ledgerDirective
, liftM (return . addLedgerTransaction) ledgerTransaction
, liftM (return . addModifierTransaction) ledgerModifierTransaction
, liftM (return . addPeriodicTransaction) ledgerPeriodicTransaction
, liftM (return . addHistoricalPrice) ledgerHistoricalPrice
, ledgerDefaultYear
, emptyLine >> return (return id)
@ -262,21 +262,21 @@ ledgercomment =
)
<|> return "" <?> "comment"
ledgerModifierEntry :: GenParser Char LedgerFileCtx ModifierEntry
ledgerModifierEntry = do
char '=' <?> "modifier entry"
ledgerModifierTransaction :: GenParser Char LedgerFileCtx ModifierTransaction
ledgerModifierTransaction = do
char '=' <?> "modifier transaction"
many spacenonewline
valueexpr <- restofline
transactions <- ledgertransactions
return $ ModifierEntry valueexpr transactions
postings <- ledgerpostings
return $ ModifierTransaction valueexpr postings
ledgerPeriodicEntry :: GenParser Char LedgerFileCtx PeriodicEntry
ledgerPeriodicEntry = do
ledgerPeriodicTransaction :: GenParser Char LedgerFileCtx PeriodicTransaction
ledgerPeriodicTransaction = do
char '~' <?> "entry"
many spacenonewline
periodexpr <- restofline
transactions <- ledgertransactions
return $ PeriodicEntry periodexpr transactions
postings <- ledgerpostings
return $ PeriodicTransaction periodexpr postings
ledgerHistoricalPrice :: GenParser Char LedgerFileCtx HistoricalPrice
ledgerHistoricalPrice = do
@ -303,8 +303,8 @@ ledgerDefaultYear = do
-- | Try to parse a ledger entry. If we successfully parse an entry, ensure it is balanced,
-- and if we cannot, raise an error.
ledgerEntry :: GenParser Char LedgerFileCtx Entry
ledgerEntry = do
ledgerTransaction :: GenParser Char LedgerFileCtx LedgerTransaction
ledgerTransaction = do
date <- ledgerdate <?> "entry"
status <- ledgerstatus
code <- ledgercode
@ -314,10 +314,10 @@ ledgerEntry = do
description <- many (noneOf "\n") <?> "description"
comment <- ledgercomment
restofline
transactions <- ledgertransactions
let e = Entry date status code description comment transactions ""
case balanceEntry e of
Right e' -> return e'
postings <- ledgerpostings
let t = LedgerTransaction date status code description comment postings ""
case balanceLedgerTransaction t of
Right t' -> return t'
Left err -> error err
ledgerdate :: GenParser Char LedgerFileCtx Day
@ -358,14 +358,14 @@ ledgerstatus = try (do { char '*'; many1 spacenonewline; return True } ) <|> ret
ledgercode :: GenParser Char st String
ledgercode = try (do { char '('; code <- anyChar `manyTill` char ')'; many1 spacenonewline; return code } ) <|> return ""
ledgertransactions :: GenParser Char LedgerFileCtx [RawTransaction]
ledgertransactions = many $ try ledgertransaction
ledgerpostings :: GenParser Char LedgerFileCtx [Posting]
ledgerpostings = many $ try ledgerposting
ledgertransaction :: GenParser Char LedgerFileCtx RawTransaction
ledgertransaction = many1 spacenonewline >> choice [ normaltransaction, virtualtransaction, balancedvirtualtransaction ]
ledgerposting :: GenParser Char LedgerFileCtx Posting
ledgerposting = many1 spacenonewline >> choice [ normalposting, virtualposting, balancedvirtualposting ]
normaltransaction :: GenParser Char LedgerFileCtx RawTransaction
normaltransaction = do
normalposting :: GenParser Char LedgerFileCtx Posting
normalposting = do
status <- ledgerstatus
account <- transactionaccountname
amount <- transactionamount
@ -373,10 +373,10 @@ normaltransaction = do
comment <- ledgercomment
restofline
parent <- getParentAccount
return (RawTransaction status account amount comment RegularTransaction)
return (Posting status account amount comment RegularPosting)
virtualtransaction :: GenParser Char LedgerFileCtx RawTransaction
virtualtransaction = do
virtualposting :: GenParser Char LedgerFileCtx Posting
virtualposting = do
status <- ledgerstatus
char '('
account <- transactionaccountname
@ -386,10 +386,10 @@ virtualtransaction = do
comment <- ledgercomment
restofline
parent <- getParentAccount
return (RawTransaction status account amount comment VirtualTransaction)
return (Posting status account amount comment VirtualPosting)
balancedvirtualtransaction :: GenParser Char LedgerFileCtx RawTransaction
balancedvirtualtransaction = do
balancedvirtualposting :: GenParser Char LedgerFileCtx Posting
balancedvirtualposting = do
status <- ledgerstatus
char '['
account <- transactionaccountname
@ -398,7 +398,7 @@ balancedvirtualtransaction = do
many spacenonewline
comment <- ledgercomment
restofline
return (RawTransaction status account amount comment BalancedVirtualTransaction)
return (Posting status account amount comment BalancedVirtualPosting)
-- Qualify with the parent account from parsing context
transactionaccountname :: GenParser Char LedgerFileCtx AccountName
@ -571,15 +571,15 @@ datedisplayexpr = do
char '['
(y,m,d) <- smartdate
char ']'
let edate = parsedate $ printf "%04s/%02s/%02s" y m d
let ltdate = parsedate $ printf "%04s/%02s/%02s" y m d
let matcher = \(Transaction{date=tdate}) ->
case op of
"<" -> tdate < edate
"<=" -> tdate <= edate
"=" -> tdate == edate
"==" -> tdate == edate -- just in case
">=" -> tdate >= edate
">" -> tdate > edate
"<" -> tdate < ltdate
"<=" -> tdate <= ltdate
"=" -> tdate == ltdate
"==" -> tdate == ltdate -- just in case
">=" -> tdate >= ltdate
">" -> tdate > ltdate
return matcher
compareop = choice $ map (try . string) ["<=",">=","==","<","=",">"]

35
Ledger/Posting.hs Normal file
View File

@ -0,0 +1,35 @@
{-|
A 'Posting' represents a single transaction line within a ledger
entry. We call it raw to distinguish from the cached 'Transaction'.
-}
module Ledger.Posting
where
import Ledger.Utils
import Ledger.Types
import Ledger.Amount
import Ledger.AccountName
instance Show Posting where show = showPosting
nullrawposting = Posting False "" nullmixedamt "" RegularPosting
showPosting :: Posting -> String
showPosting (Posting s a amt _ ttype) =
concatTopPadded [showaccountname a ++ " ", showamount amt]
where
showaccountname = printf "%-22s" . bracket . elideAccountName width
(bracket,width) = case ttype of
BalancedVirtualPosting -> (\s -> "["++s++"]", 20)
VirtualPosting -> (\s -> "("++s++")", 20)
otherwise -> (id,22)
showamount = padleft 12 . showMixedAmountOrZero
isReal :: Posting -> Bool
isReal p = ptype p == RegularPosting
hasAmount :: Posting -> Bool
hasAmount = (/= missingamt) . pamount

View File

@ -13,39 +13,39 @@ import Ledger.Utils
import Ledger.Types
import Ledger.AccountName
import Ledger.Amount
import Ledger.Entry
import Ledger.LedgerTransaction
import Ledger.Transaction
import Ledger.RawTransaction
import Ledger.Posting
import Ledger.TimeLog
instance Show RawLedger where
show l = printf "RawLedger with %d entries, %d accounts: %s"
((length $ entries l) +
(length $ modifier_entries l) +
(length $ periodic_entries l))
show l = printf "RawLedger with %d transactions, %d accounts: %s"
((length $ ledger_txns l) +
(length $ modifier_txns l) +
(length $ periodic_txns l))
(length accounts)
(show accounts)
-- ++ (show $ rawLedgerTransactions l)
where accounts = flatten $ rawLedgerAccountNameTree l
rawLedgerEmpty :: RawLedger
rawLedgerEmpty = RawLedger { modifier_entries = []
, periodic_entries = []
, entries = []
rawLedgerEmpty = RawLedger { modifier_txns = []
, periodic_txns = []
, ledger_txns = []
, open_timelog_entries = []
, historical_prices = []
, final_comment_lines = []
}
addEntry :: Entry -> RawLedger -> RawLedger
addEntry e l0 = l0 { entries = e : (entries l0) }
addLedgerTransaction :: LedgerTransaction -> RawLedger -> RawLedger
addLedgerTransaction t l0 = l0 { ledger_txns = t : (ledger_txns l0) }
addModifierEntry :: ModifierEntry -> RawLedger -> RawLedger
addModifierEntry me l0 = l0 { modifier_entries = me : (modifier_entries l0) }
addModifierTransaction :: ModifierTransaction -> RawLedger -> RawLedger
addModifierTransaction mt l0 = l0 { modifier_txns = mt : (modifier_txns l0) }
addPeriodicEntry :: PeriodicEntry -> RawLedger -> RawLedger
addPeriodicEntry pe l0 = l0 { periodic_entries = pe : (periodic_entries l0) }
addPeriodicTransaction :: PeriodicTransaction -> RawLedger -> RawLedger
addPeriodicTransaction pt l0 = l0 { periodic_txns = pt : (periodic_txns l0) }
addHistoricalPrice :: HistoricalPrice -> RawLedger -> RawLedger
addHistoricalPrice h l0 = l0 { historical_prices = h : (historical_prices l0) }
@ -54,8 +54,8 @@ addTimeLogEntry :: TimeLogEntry -> RawLedger -> RawLedger
addTimeLogEntry tle l0 = l0 { open_timelog_entries = tle : (open_timelog_entries l0) }
rawLedgerTransactions :: RawLedger -> [Transaction]
rawLedgerTransactions = txnsof . entries
where txnsof es = concat $ map flattenEntry $ zip es [1..]
rawLedgerTransactions = txnsof . ledger_txns
where txnsof ts = concat $ map flattenLedgerTransaction $ zip ts [1..]
rawLedgerAccountNamesUsed :: RawLedger -> [AccountName]
rawLedgerAccountNamesUsed = accountNamesFromTransactions . rawLedgerTransactions
@ -66,58 +66,58 @@ rawLedgerAccountNames = sort . expandAccountNames . rawLedgerAccountNamesUsed
rawLedgerAccountNameTree :: RawLedger -> Tree AccountName
rawLedgerAccountNameTree l = accountNameTreeFrom $ rawLedgerAccountNames l
-- | Remove ledger entries we are not interested in.
-- | Remove ledger transactions we are not interested in.
-- Keep only those which fall between the begin and end dates, and match
-- the description pattern, and are cleared or real if those options are active.
filterRawLedger :: DateSpan -> [String] -> Bool -> Bool -> RawLedger -> RawLedger
filterRawLedger span pats clearedonly realonly =
filterRawLedgerTransactionsByRealness realonly .
filterRawLedgerEntriesByClearedStatus clearedonly .
filterRawLedgerEntriesByDate span .
filterRawLedgerEntriesByDescription pats
filterRawLedgerPostingsByRealness realonly .
filterRawLedgerTransactionsByClearedStatus clearedonly .
filterRawLedgerTransactionsByDate span .
filterRawLedgerTransactionsByDescription pats
-- | Keep only entries whose description matches the description patterns.
filterRawLedgerEntriesByDescription :: [String] -> RawLedger -> RawLedger
filterRawLedgerEntriesByDescription pats (RawLedger ms ps es tls hs f) =
RawLedger ms ps (filter matchdesc es) tls hs f
where matchdesc = matchpats pats . edescription
-- | Keep only ledger transactions whose description matches the description patterns.
filterRawLedgerTransactionsByDescription :: [String] -> RawLedger -> RawLedger
filterRawLedgerTransactionsByDescription pats (RawLedger ms ps ts tls hs f) =
RawLedger ms ps (filter matchdesc ts) tls hs f
where matchdesc = matchpats pats . ltdescription
-- | Keep only entries which fall between begin and end dates.
-- We include entries on the begin date and exclude entries on the end
-- | Keep only ledger transactions which fall between begin and end dates.
-- We include transactions on the begin date and exclude transactions on the end
-- date, like ledger. An empty date string means no restriction.
filterRawLedgerEntriesByDate :: DateSpan -> RawLedger -> RawLedger
filterRawLedgerEntriesByDate (DateSpan begin end) (RawLedger ms ps es tls hs f) =
RawLedger ms ps (filter matchdate es) tls hs f
filterRawLedgerTransactionsByDate :: DateSpan -> RawLedger -> RawLedger
filterRawLedgerTransactionsByDate (DateSpan begin end) (RawLedger ms ps ts tls hs f) =
RawLedger ms ps (filter matchdate ts) tls hs f
where
matchdate e = (maybe True (edate e>=) begin) && (maybe True (edate e<) end)
matchdate t = (maybe True (ltdate t>=) begin) && (maybe True (ltdate t<) end)
-- | Keep only entries with cleared status, if the flag is true, otherwise
-- | Keep only ledger transactions with cleared status, if the flag is true, otherwise
-- do no filtering.
filterRawLedgerEntriesByClearedStatus :: Bool -> RawLedger -> RawLedger
filterRawLedgerEntriesByClearedStatus False l = l
filterRawLedgerEntriesByClearedStatus True (RawLedger ms ps es tls hs f) =
RawLedger ms ps (filter estatus es) tls hs f
filterRawLedgerTransactionsByClearedStatus :: Bool -> RawLedger -> RawLedger
filterRawLedgerTransactionsByClearedStatus False l = l
filterRawLedgerTransactionsByClearedStatus True (RawLedger ms ps ts tls hs f) =
RawLedger ms ps (filter ltstatus ts) tls hs f
-- | Strip out any virtual transactions, if the flag is true, otherwise do
-- | Strip out any virtual postings, if the flag is true, otherwise do
-- no filtering.
filterRawLedgerTransactionsByRealness :: Bool -> RawLedger -> RawLedger
filterRawLedgerTransactionsByRealness False l = l
filterRawLedgerTransactionsByRealness True (RawLedger ms ps es tls hs f) =
RawLedger ms ps (map filtertxns es) tls hs f
where filtertxns e@Entry{etransactions=ts} = e{etransactions=filter isReal ts}
filterRawLedgerPostingsByRealness :: Bool -> RawLedger -> RawLedger
filterRawLedgerPostingsByRealness False l = l
filterRawLedgerPostingsByRealness True (RawLedger mts pts ts tls hs f) =
RawLedger mts pts (map filtertxns ts) tls hs f
where filtertxns t@LedgerTransaction{ltpostings=ps} = t{ltpostings=filter isReal ps}
-- | Strip out any transactions to accounts deeper than the specified depth
-- (and any entries which have no transactions as a result).
filterRawLedgerTransactionsByDepth :: Int -> RawLedger -> RawLedger
filterRawLedgerTransactionsByDepth depth (RawLedger ms ps es tls hs f) =
RawLedger ms ps (filter (not . null . etransactions) $ map filtertxns es) tls hs f
where filtertxns e@Entry{etransactions=ts} =
e{etransactions=filter ((<= depth) . accountNameLevel . taccount) ts}
-- | Strip out any postings to accounts deeper than the specified depth
-- (and any ledger transactions which have no postings as a result).
filterRawLedgerPostingsByDepth :: Int -> RawLedger -> RawLedger
filterRawLedgerPostingsByDepth depth (RawLedger mts pts ts tls hs f) =
RawLedger mts pts (filter (not . null . ltpostings) $ map filtertxns ts) tls hs f
where filtertxns t@LedgerTransaction{ltpostings=ps} =
t{ltpostings=filter ((<= depth) . accountNameLevel . paccount) ps}
-- | Keep only entries which affect accounts matched by the account patterns.
filterRawLedgerEntriesByAccount :: [String] -> RawLedger -> RawLedger
filterRawLedgerEntriesByAccount apats (RawLedger ms ps es tls hs f) =
RawLedger ms ps (filter (any (matchpats apats . taccount) . etransactions) es) tls hs f
-- | Keep only ledger transactions which affect accounts matched by the account patterns.
filterRawLedgerTransactionsByAccount :: [String] -> RawLedger -> RawLedger
filterRawLedgerTransactionsByAccount apats (RawLedger ms ps ts tls hs f) =
RawLedger ms ps (filter (any (matchpats apats . paccount) . ltpostings) ts) tls hs f
-- | Give all a ledger's amounts their canonical display settings. That
-- is, in each commodity, amounts will use the display settings of the
@ -125,10 +125,10 @@ filterRawLedgerEntriesByAccount apats (RawLedger ms ps es tls hs f) =
-- detected. Also, amounts are converted to cost basis if that flag is
-- active.
canonicaliseAmounts :: Bool -> RawLedger -> RawLedger
canonicaliseAmounts costbasis l@(RawLedger ms ps es tls hs f) = RawLedger ms ps (map fixentry es) tls hs f
canonicaliseAmounts costbasis l@(RawLedger ms ps ts tls hs f) = RawLedger ms ps (map fixledgertransaction ts) tls hs f
where
fixentry (Entry d s c de co ts pr) = Entry d s c de co (map fixrawtransaction ts) pr
fixrawtransaction (RawTransaction s ac a c t) = RawTransaction s ac (fixmixedamount a) c t
fixledgertransaction (LedgerTransaction d s c de co ts pr) = LedgerTransaction d s c de co (map fixrawposting ts) pr
fixrawposting (Posting s ac a c t) = Posting s ac (fixmixedamount a) c t
fixmixedamount (Mixed as) = Mixed $ map fixamount as
fixamount = fixcommodity . (if costbasis then costOfAmount else id)
fixcommodity a = a{commodity=c} where c = canonicalcommoditymap ! (symbol $ commodity a)
@ -157,7 +157,7 @@ rawLedgerPrecisions = map precision . rawLedgerCommodities
-- | Close any open timelog sessions using the provided current time.
rawLedgerConvertTimeLog :: LocalTime -> RawLedger -> RawLedger
rawLedgerConvertTimeLog t l0 = l0 { entries = convertedTimeLog ++ entries l0
rawLedgerConvertTimeLog t l0 = l0 { ledger_txns = convertedTimeLog ++ ledger_txns l0
, open_timelog_entries = []
}
where convertedTimeLog = entriesFromTimeLogEntries t $ open_timelog_entries l0

View File

@ -1,35 +0,0 @@
{-|
A 'RawTransaction' represents a single transaction line within a ledger
entry. We call it raw to distinguish from the cached 'Transaction'.
-}
module Ledger.RawTransaction
where
import Ledger.Utils
import Ledger.Types
import Ledger.Amount
import Ledger.AccountName
instance Show RawTransaction where show = showRawTransaction
nullrawtxn = RawTransaction False "" nullmixedamt "" RegularTransaction
showRawTransaction :: RawTransaction -> String
showRawTransaction (RawTransaction s a amt _ ttype) =
concatTopPadded [showaccountname a ++ " ", showamount amt]
where
showaccountname = printf "%-22s" . bracket . elideAccountName width
(bracket,width) = case ttype of
BalancedVirtualTransaction -> (\s -> "["++s++"]", 20)
VirtualTransaction -> (\s -> "("++s++")", 20)
otherwise -> (id,22)
showamount = padleft 12 . showMixedAmountOrZero
isReal :: RawTransaction -> Bool
isReal t = rttype t == RegularTransaction
hasAmount :: RawTransaction -> Bool
hasAmount = (/= missingamt) . tamount

View File

@ -13,7 +13,7 @@ import Ledger.Types
import Ledger.Dates
import Ledger.Commodity
import Ledger.Amount
import Ledger.Entry
import Ledger.LedgerTransaction
instance Show TimeLogEntry where
show t = printf "%s %s %s" (show $ tlcode t) (show $ tldatetime t) (tlcomment t)
@ -21,10 +21,10 @@ instance Show TimeLogEntry where
instance Show TimeLog where
show tl = printf "TimeLog with %d entries" $ length $ timelog_entries tl
-- | Convert time log entries to ledger entries. When there is no
-- | Convert time log entries to ledger transactions. When there is no
-- clockout, add one with the provided current time. Sessions crossing
-- midnight are split into days to give accurate per-day totals.
entriesFromTimeLogEntries :: LocalTime -> [TimeLogEntry] -> [Entry]
entriesFromTimeLogEntries :: LocalTime -> [TimeLogEntry] -> [LedgerTransaction]
entriesFromTimeLogEntries _ [] = []
entriesFromTimeLogEntries now [i]
| odate > idate = [entryFromTimeLogInOut i o'] ++ entriesFromTimeLogEntries now [i',o]
@ -48,20 +48,20 @@ entriesFromTimeLogEntries now (i:o:rest)
-- | Convert a timelog clockin and clockout entry to an equivalent ledger
-- entry, representing the time expenditure. Note this entry is not balanced,
-- since we omit the \"assets:time\" transaction for simpler output.
entryFromTimeLogInOut :: TimeLogEntry -> TimeLogEntry -> Entry
entryFromTimeLogInOut :: TimeLogEntry -> TimeLogEntry -> LedgerTransaction
entryFromTimeLogInOut i o
| otime >= itime = e
| otime >= itime = t
| otherwise =
error $ "clock-out time less than clock-in time in:\n" ++ showEntry e
error $ "clock-out time less than clock-in time in:\n" ++ showLedgerTransaction t
where
e = Entry {
edate = idate,
estatus = True,
ecode = "",
edescription = showtime itod ++ "-" ++ showtime otod,
ecomment = "",
etransactions = txns,
epreceding_comment_lines=""
t = LedgerTransaction {
ltdate = idate,
ltstatus = True,
ltcode = "",
ltdescription = showtime itod ++ "-" ++ showtime otod,
ltcomment = "",
ltpostings = ps,
ltpreceding_comment_lines=""
}
showtime = take 5 . show
acctname = tlcomment i
@ -73,6 +73,6 @@ entryFromTimeLogInOut i o
odate = localDay otime
hrs = elapsedSeconds (toutc otime) (toutc itime) / 3600 where toutc = localTimeToUTC utc
amount = Mixed [hours hrs]
txns = [RawTransaction False acctname amount "" RegularTransaction
--,RawTransaction "assets:time" (-amount) "" RegularTransaction
ps = [Posting False acctname amount "" RegularPosting
--,Posting "assets:time" (-amount) "" RegularPosting
]

View File

@ -1,6 +1,6 @@
{-|
A 'Transaction' is a 'RawTransaction' with its parent 'Entry' \'s date and
A 'Transaction' is a 'Posting' with its parent 'LedgerTransaction' \'s date and
description attached. These are what we actually query when doing reports.
-}
@ -10,8 +10,8 @@ where
import Ledger.Utils
import Ledger.Types
import Ledger.Dates
import Ledger.Entry
import Ledger.RawTransaction
import Ledger.LedgerTransaction
import Ledger.Posting
import Ledger.Amount
@ -22,12 +22,12 @@ showTransaction (Transaction eno stat d desc a amt ttype) =
s ++ unwords [showDate d,desc,a,show amt,show ttype]
where s = if stat then " *" else ""
-- | Convert a 'Entry' to two or more 'Transaction's. An id number
-- | 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.
flattenEntry :: (Entry, Int) -> [Transaction]
flattenEntry (Entry d s _ desc _ ts _, e) =
[Transaction e s d desc (taccount t) (tamount t) (rttype t) | t <- ts]
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 ts = nub $ map account ts
@ -35,4 +35,4 @@ accountNamesFromTransactions ts = nub $ map account ts
sumTransactions :: [Transaction] -> MixedAmount
sumTransactions = sum . map amount
nulltxn = Transaction 0 False (parsedate "1900/1/1") "" "" nullmixedamt RegularTransaction
nulltxn = Transaction 0 False (parsedate "1900/1/1") "" "" nullmixedamt RegularPosting

View File

@ -4,6 +4,23 @@ This is the next layer up from Ledger.Utils. All main data types are
defined here to avoid import cycles; see the corresponding modules for
documentation.
On the current use of terminology:
- ledger 2 has Entrys containing Transactions.
- hledger 0.4 has Entrys containing RawTransactions, and Transactions
which are a RawTransaction with its parent Entry's info added.
Transactions are what we most work with when reporting and are
ubiquitous in the code and docs.
- ledger 3 has Transactions containing Postings.
- hledger 0.5 has LedgerTransactions containing Postings, with
Transactions kept just as in hledger 0.4 (a Posting with it's parent's
info added). They could be named PartialTransactions or
TransactionPostings, but that just gets too verbose and obscure for devs
and users.
-}
module Ledger.Types
@ -41,37 +58,35 @@ data Amount = Amount {
newtype MixedAmount = Mixed [Amount] deriving (Eq)
data TransactionType = RegularTransaction | VirtualTransaction | BalancedVirtualTransaction
data PostingType = RegularPosting | VirtualPosting | BalancedVirtualPosting
deriving (Eq,Show)
data RawTransaction = RawTransaction {
tstatus :: Bool,
taccount :: AccountName,
tamount :: MixedAmount,
tcomment :: String,
rttype :: TransactionType
data Posting = Posting {
pstatus :: Bool,
paccount :: AccountName,
pamount :: MixedAmount,
pcomment :: String,
ptype :: PostingType
} deriving (Eq)
-- | a ledger "modifier" entry. Currently ignored.
data ModifierEntry = ModifierEntry {
valueexpr :: String,
m_transactions :: [RawTransaction]
data ModifierTransaction = ModifierTransaction {
mtvalueexpr :: String,
mtpostings :: [Posting]
} deriving (Eq)
-- | a ledger "periodic" entry. Currently ignored.
data PeriodicEntry = PeriodicEntry {
periodicexpr :: String,
p_transactions :: [RawTransaction]
data PeriodicTransaction = PeriodicTransaction {
ptperiodicexpr :: String,
ptpostings :: [Posting]
} deriving (Eq)
data Entry = Entry {
edate :: Day,
estatus :: Bool,
ecode :: String,
edescription :: String,
ecomment :: String,
etransactions :: [RawTransaction],
epreceding_comment_lines :: String
data LedgerTransaction = LedgerTransaction {
ltdate :: Day,
ltstatus :: Bool,
ltcode :: String,
ltdescription :: String,
ltcomment :: String,
ltpostings :: [Posting],
ltpreceding_comment_lines :: String
} deriving (Eq)
data HistoricalPrice = HistoricalPrice {
@ -82,9 +97,9 @@ data HistoricalPrice = HistoricalPrice {
} deriving (Eq,Show)
data RawLedger = RawLedger {
modifier_entries :: [ModifierEntry],
periodic_entries :: [PeriodicEntry],
entries :: [Entry],
modifier_txns :: [ModifierTransaction],
periodic_txns :: [PeriodicTransaction],
ledger_txns :: [LedgerTransaction],
open_timelog_entries :: [TimeLogEntry],
historical_prices :: [HistoricalPrice],
final_comment_lines :: String
@ -101,13 +116,13 @@ data TimeLog = TimeLog {
} deriving (Eq)
data Transaction = Transaction {
entryno :: Int,
tnum :: Int,
status :: Bool,
date :: Day,
description :: String,
account :: AccountName,
amount :: MixedAmount,
ttype :: TransactionType
ttype :: PostingType
} deriving (Eq)
data Account = Account {

View File

@ -27,7 +27,7 @@ usagehdr = printf (
"\n" ++
"COMMAND is one of (may be abbreviated):\n" ++
" balance - show account balances\n" ++
" print - show formatted ledger entries\n" ++
" print - show formatted ledger transactions\n" ++
" register - show register transactions\n" ++
#ifdef VTY
" ui - run a simple curses-based text ui\n" ++
@ -57,11 +57,11 @@ usage = usageInfo usagehdr options ++ usageftr
options :: [OptDescr Opt]
options = [
Option ['f'] ["file"] (ReqArg File "FILE") filehelp
,Option ['b'] ["begin"] (ReqArg Begin "DATE") "report on entries on or after this date"
,Option ['e'] ["end"] (ReqArg End "DATE") "report on entries prior to this date"
,Option ['p'] ["period"] (ReqArg Period "EXPR") ("report on entries during the specified period\n" ++
,Option ['b'] ["begin"] (ReqArg Begin "DATE") "report on transactions on or after this date"
,Option ['e'] ["end"] (ReqArg End "DATE") "report on transactions prior to this date"
,Option ['p'] ["period"] (ReqArg Period "EXPR") ("report on transactions during the specified period\n" ++
"and/or with the specified reporting interval\n")
,Option ['C'] ["cleared"] (NoArg Cleared) "report only on cleared entries"
,Option ['C'] ["cleared"] (NoArg Cleared) "report only on cleared transactions"
,Option ['B'] ["cost","basis"] (NoArg CostBasis) "report cost of commodities"
,Option [] ["depth"] (ReqArg Depth "N") "hide accounts/transactions deeper than this"
,Option ['d'] ["display"] (ReqArg Display "EXPR") ("show only transactions matching simple EXPR\n" ++

View File

@ -10,16 +10,16 @@ import Ledger
import Options
-- | Print ledger entries in standard format.
-- | Print ledger transactions in standard format.
print' :: [Opt] -> [String] -> Ledger -> IO ()
print' opts args l = putStr $ showEntries opts args l
print' opts args l = putStr $ showLedgerTransactions opts args l
showEntries :: [Opt] -> [String] -> Ledger -> String
showEntries opts args l = concatMap showEntry $ filteredentries
showLedgerTransactions :: [Opt] -> [String] -> Ledger -> String
showLedgerTransactions opts args l = concatMap showLedgerTransaction $ filteredtxns
where
filteredentries = entries $
filterRawLedgerTransactionsByDepth depth $
filterRawLedgerEntriesByAccount apats $
filteredtxns = ledger_txns $
filterRawLedgerPostingsByDepth depth $
filterRawLedgerTransactionsByAccount apats $
rawledger l
depth = depthFromOpts opts
(apats,_) = parseAccountDescriptionArgs opts args

View File

@ -62,7 +62,7 @@ showRegisterReport opts args l
-- As usual with date spans the end date is exclusive, but for display
-- purposes we show the previous day as end date, like ledger.
--
-- A unique entryno value is provided so that the new transactions will be
-- A unique tnum value is provided so that the new transactions will be
-- grouped as one entry.
--
-- When a depth argument is present, transactions to accounts of greater
@ -71,12 +71,12 @@ showRegisterReport opts args l
-- The showempty flag forces the display of a zero-transaction span
-- and also zero-transaction accounts within the span.
summariseTransactionsInDateSpan :: DateSpan -> Int -> Int -> Bool -> [Transaction] -> [Transaction]
summariseTransactionsInDateSpan (DateSpan b e) entryno depth showempty ts
summariseTransactionsInDateSpan (DateSpan b e) tnum depth showempty ts
| null ts && showempty = [txn]
| null ts = []
| otherwise = summaryts'
where
txn = nulltxn{entryno=entryno, date=b', description="- "++(showDate $ addDays (-1) e')}
txn = nulltxn{tnum=tnum, date=b', description="- "++(showDate $ addDays (-1) e')}
b' = fromMaybe (date $ head ts) b
e' = fromMaybe (date $ last ts) e
summaryts'
@ -108,17 +108,17 @@ showtxns [] _ _ = ""
showtxns (t@Transaction{amount=a}:ts) tprev bal = this ++ showtxns ts t bal'
where
this = showtxn (t `issame` tprev) t bal'
issame t1 t2 = entryno t1 == entryno t2
issame t1 t2 = tnum t1 == tnum t2
bal' = bal + amount t
-- | Show one transaction line and balance with or without the entry details.
showtxn :: Bool -> Transaction -> MixedAmount -> String
showtxn omitdesc t b = concatBottomPadded [entrydesc ++ txn ++ " ", bal] ++ "\n"
showtxn omitdesc t b = concatBottomPadded [entrydesc ++ p ++ " ", bal] ++ "\n"
where
entrydesc = if omitdesc then replicate 32 ' ' else printf "%s %s " date desc
date = showDate $ da
desc = printf "%-20s" $ elideRight 20 de :: String
txn = showRawTransaction $ RawTransaction s a amt "" tt
p = showPosting $ Posting s a amt "" tt
bal = padleft 12 (showMixedAmountOrZero b)
Transaction{status=s,date=da,description=de,account=a,amount=amt,ttype=tt} = t

298
Tests.hs
View File

@ -351,28 +351,28 @@ tests = [
]
,"balanceEntry" ~: do
,"balanceLedgerTransaction" ~: do
assertBool "detect unbalanced entry, sign error"
(isLeft $ balanceEntry
(Entry (parsedate "2007/01/28") False "" "test" ""
[RawTransaction False "a" (Mixed [dollars 1]) "" RegularTransaction,
RawTransaction False "b" (Mixed [dollars 1]) "" RegularTransaction
(isLeft $ balanceLedgerTransaction
(LedgerTransaction (parsedate "2007/01/28") False "" "test" ""
[Posting False "a" (Mixed [dollars 1]) "" RegularPosting,
Posting False "b" (Mixed [dollars 1]) "" RegularPosting
] ""))
assertBool "detect unbalanced entry, multiple missing amounts"
(isLeft $ balanceEntry
(Entry (parsedate "2007/01/28") False "" "test" ""
[RawTransaction False "a" missingamt "" RegularTransaction,
RawTransaction False "b" missingamt "" RegularTransaction
(isLeft $ balanceLedgerTransaction
(LedgerTransaction (parsedate "2007/01/28") False "" "test" ""
[Posting False "a" missingamt "" RegularPosting,
Posting False "b" missingamt "" RegularPosting
] ""))
let e = balanceEntry (Entry (parsedate "2007/01/28") False "" "test" ""
[RawTransaction False "a" (Mixed [dollars 1]) "" RegularTransaction,
RawTransaction False "b" missingamt "" RegularTransaction
let e = balanceLedgerTransaction (LedgerTransaction (parsedate "2007/01/28") False "" "test" ""
[Posting False "a" (Mixed [dollars 1]) "" RegularPosting,
Posting False "b" missingamt "" RegularPosting
] "")
assertBool "one missing amount should be ok" (isRight e)
assertEqual "balancing amount is added"
(Mixed [dollars (-1)])
(case e of
Right e' -> (tamount $ last $ etransactions e')
Right e' -> (pamount $ last $ ltpostings e')
Left _ -> error "should not happen")
,"cacheLedger" ~: do
@ -401,7 +401,7 @@ tests = [
clockout t = TimeLogEntry 'o' t ""
mktime d s = LocalTime d $ fromMaybe midnight $ parseTime defaultTimeLocale "%H:%M:%S" s
showtime t = formatTime defaultTimeLocale "%H:%M" t
assertEntriesGiveStrings name es ss = assertEqual name ss (map edescription $ entriesFromTimeLogEntries now es)
assertEntriesGiveStrings name es ss = assertEqual name ss (map ltdescription $ entriesFromTimeLogEntries now es)
assertEntriesGiveStrings "started yesterday, split session at midnight"
[clockin (mktime yesterday "23:00:00") ""]
@ -446,17 +446,17 @@ tests = [
,"default year" ~: do
rl <- rawledgerfromstring defaultyear_ledger_str
(edate $ head $ entries rl) `is` fromGregorian 2009 1 1
(ltdate $ head $ ledger_txns rl) `is` fromGregorian 2009 1 1
return ()
,"ledgerEntry" ~: do
parseWithCtx ledgerEntry entry1_str `parseis` entry1
,"ledgerTransaction" ~: do
parseWithCtx ledgerTransaction entry1_str `parseis` entry1
,"ledgerHistoricalPrice" ~: do
parseWithCtx ledgerHistoricalPrice price1_str `parseis` price1
,"ledgertransaction" ~: do
parseWithCtx ledgertransaction rawtransaction1_str `parseis` rawtransaction1
,"ledgerposting" ~: do
parseWithCtx ledgerposting rawposting1_str `parseis` rawposting1
,"parsedate" ~: do
parsedate "2008/02/03" `is` parsetimewith "%Y/%m/%d" "2008/02/03" sampledate
@ -478,7 +478,7 @@ tests = [
do
let args = ["expenses"]
l <- sampleledgerwithopts [] args
showEntries [] args l `is` unlines
showLedgerTransactions [] args l `is` unlines
["2008/06/03 * eat & shop"
," expenses:food $1"
," expenses:supplies $1"
@ -489,7 +489,7 @@ tests = [
, "print report with depth arg" ~:
do
l <- sampleledger
showEntries [Depth "2"] [] l `is` unlines
showLedgerTransactions [Depth "2"] [] l `is` unlines
["2008/01/01 income"
," income:salary $-1"
,""
@ -674,8 +674,8 @@ tests = [
(map aname $ subAccounts l a) `is` ["assets:bank","assets:cash"]
,"summariseTransactionsInDateSpan" ~: do
let (b,e,entryno,depth,showempty,ts) `gives` summaryts =
summariseTransactionsInDateSpan (mkdatespan b e) entryno depth showempty ts `is` summaryts
let (b,e,tnum,depth,showempty,ts) `gives` summaryts =
summariseTransactionsInDateSpan (mkdatespan b e) tnum depth showempty ts `is` summaryts
let ts =
[
nulltxn{description="desc",account="expenses:food:groceries",amount=Mixed [dollars 1]}
@ -780,9 +780,9 @@ defaultyear_ledger_str = unlines
write_sample_ledger = writeFile "sample.ledger" sample_ledger_str
rawtransaction1_str = " expenses:food:dining $10.00\n"
rawposting1_str = " expenses:food:dining $10.00\n"
rawtransaction1 = RawTransaction False "expenses:food:dining" (Mixed [dollars 10]) "" RegularTransaction
rawposting1 = Posting False "expenses:food:dining" (Mixed [dollars 10]) "" RegularPosting
entry1_str = unlines
["2007/01/28 coopportunity"
@ -792,9 +792,9 @@ entry1_str = unlines
]
entry1 =
(Entry (parsedate "2007/01/28") False "" "coopportunity" ""
[RawTransaction False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularTransaction,
RawTransaction False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularTransaction] "")
(LedgerTransaction (parsedate "2007/01/28") False "" "coopportunity" ""
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting,
Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting] "")
entry2_str = unlines
@ -940,154 +940,154 @@ rawledger7 = RawLedger
[]
[]
[
Entry {
edate= parsedate "2007/01/01",
estatus=False,
ecode="*",
edescription="opening balance",
ecomment="",
etransactions=[
RawTransaction {
tstatus=False,
taccount="assets:cash",
tamount=(Mixed [dollars 4.82]),
tcomment="",
rttype=RegularTransaction
LedgerTransaction {
ltdate= parsedate "2007/01/01",
ltstatus=False,
ltcode="*",
ltdescription="opening balance",
ltcomment="",
ltpostings=[
Posting {
pstatus=False,
paccount="assets:cash",
pamount=(Mixed [dollars 4.82]),
pcomment="",
ptype=RegularPosting
},
RawTransaction {
tstatus=False,
taccount="equity:opening balances",
tamount=(Mixed [dollars (-4.82)]),
tcomment="",
rttype=RegularTransaction
Posting {
pstatus=False,
paccount="equity:opening balances",
pamount=(Mixed [dollars (-4.82)]),
pcomment="",
ptype=RegularPosting
}
],
epreceding_comment_lines=""
ltpreceding_comment_lines=""
}
,
Entry {
edate= parsedate "2007/02/01",
estatus=False,
ecode="*",
edescription="ayres suites",
ecomment="",
etransactions=[
RawTransaction {
tstatus=False,
taccount="expenses:vacation",
tamount=(Mixed [dollars 179.92]),
tcomment="",
rttype=RegularTransaction
LedgerTransaction {
ltdate= parsedate "2007/02/01",
ltstatus=False,
ltcode="*",
ltdescription="ayres suites",
ltcomment="",
ltpostings=[
Posting {
pstatus=False,
paccount="expenses:vacation",
pamount=(Mixed [dollars 179.92]),
pcomment="",
ptype=RegularPosting
},
RawTransaction {
tstatus=False,
taccount="assets:checking",
tamount=(Mixed [dollars (-179.92)]),
tcomment="",
rttype=RegularTransaction
Posting {
pstatus=False,
paccount="assets:checking",
pamount=(Mixed [dollars (-179.92)]),
pcomment="",
ptype=RegularPosting
}
],
epreceding_comment_lines=""
ltpreceding_comment_lines=""
}
,
Entry {
edate=parsedate "2007/01/02",
estatus=False,
ecode="*",
edescription="auto transfer to savings",
ecomment="",
etransactions=[
RawTransaction {
tstatus=False,
taccount="assets:saving",
tamount=(Mixed [dollars 200]),
tcomment="",
rttype=RegularTransaction
LedgerTransaction {
ltdate=parsedate "2007/01/02",
ltstatus=False,
ltcode="*",
ltdescription="auto transfer to savings",
ltcomment="",
ltpostings=[
Posting {
pstatus=False,
paccount="assets:saving",
pamount=(Mixed [dollars 200]),
pcomment="",
ptype=RegularPosting
},
RawTransaction {
tstatus=False,
taccount="assets:checking",
tamount=(Mixed [dollars (-200)]),
tcomment="",
rttype=RegularTransaction
Posting {
pstatus=False,
paccount="assets:checking",
pamount=(Mixed [dollars (-200)]),
pcomment="",
ptype=RegularPosting
}
],
epreceding_comment_lines=""
ltpreceding_comment_lines=""
}
,
Entry {
edate=parsedate "2007/01/03",
estatus=False,
ecode="*",
edescription="poquito mas",
ecomment="",
etransactions=[
RawTransaction {
tstatus=False,
taccount="expenses:food:dining",
tamount=(Mixed [dollars 4.82]),
tcomment="",
rttype=RegularTransaction
LedgerTransaction {
ltdate=parsedate "2007/01/03",
ltstatus=False,
ltcode="*",
ltdescription="poquito mas",
ltcomment="",
ltpostings=[
Posting {
pstatus=False,
paccount="expenses:food:dining",
pamount=(Mixed [dollars 4.82]),
pcomment="",
ptype=RegularPosting
},
RawTransaction {
tstatus=False,
taccount="assets:cash",
tamount=(Mixed [dollars (-4.82)]),
tcomment="",
rttype=RegularTransaction
Posting {
pstatus=False,
paccount="assets:cash",
pamount=(Mixed [dollars (-4.82)]),
pcomment="",
ptype=RegularPosting
}
],
epreceding_comment_lines=""
ltpreceding_comment_lines=""
}
,
Entry {
edate=parsedate "2007/01/03",
estatus=False,
ecode="*",
edescription="verizon",
ecomment="",
etransactions=[
RawTransaction {
tstatus=False,
taccount="expenses:phone",
tamount=(Mixed [dollars 95.11]),
tcomment="",
rttype=RegularTransaction
LedgerTransaction {
ltdate=parsedate "2007/01/03",
ltstatus=False,
ltcode="*",
ltdescription="verizon",
ltcomment="",
ltpostings=[
Posting {
pstatus=False,
paccount="expenses:phone",
pamount=(Mixed [dollars 95.11]),
pcomment="",
ptype=RegularPosting
},
RawTransaction {
tstatus=False,
taccount="assets:checking",
tamount=(Mixed [dollars (-95.11)]),
tcomment="",
rttype=RegularTransaction
Posting {
pstatus=False,
paccount="assets:checking",
pamount=(Mixed [dollars (-95.11)]),
pcomment="",
ptype=RegularPosting
}
],
epreceding_comment_lines=""
ltpreceding_comment_lines=""
}
,
Entry {
edate=parsedate "2007/01/03",
estatus=False,
ecode="*",
edescription="discover",
ecomment="",
etransactions=[
RawTransaction {
tstatus=False,
taccount="liabilities:credit cards:discover",
tamount=(Mixed [dollars 80]),
tcomment="",
rttype=RegularTransaction
LedgerTransaction {
ltdate=parsedate "2007/01/03",
ltstatus=False,
ltcode="*",
ltdescription="discover",
ltcomment="",
ltpostings=[
Posting {
pstatus=False,
paccount="liabilities:credit cards:discover",
pamount=(Mixed [dollars 80]),
pcomment="",
ptype=RegularPosting
},
RawTransaction {
tstatus=False,
taccount="assets:checking",
tamount=(Mixed [dollars (-80)]),
tcomment="",
rttype=RegularTransaction
Posting {
pstatus=False,
paccount="assets:checking",
pamount=(Mixed [dollars (-80)]),
pcomment="",
ptype=RegularPosting
}
],
epreceding_comment_lines=""
ltpreceding_comment_lines=""
}
]
[]
@ -1129,7 +1129,7 @@ rawLedgerWithAmounts as =
RawLedger
[]
[]
[nullentry{edescription=a,etransactions=[nullrawtxn{tamount=parse a}]} | a <- as]
[nullentry{ltdescription=a,ltpostings=[nullrawposting{pamount=parse a}]} | a <- as]
[]
[]
""

View File

@ -44,8 +44,8 @@ data Loc = Loc {
-- | The screens available within the user interface.
data Screen = BalanceScreen -- ^ like hledger balance, shows accounts
| RegisterScreen -- ^ like hledger register, shows transactions
| PrintScreen -- ^ like hledger print, shows entries
| RegisterScreen -- ^ like hledger register, shows transaction-postings
| PrintScreen -- ^ like hledger print, shows ledger transactions
| LedgerScreen -- ^ shows the raw ledger
deriving (Eq,Show)
@ -221,7 +221,7 @@ updateData :: AppState -> AppState
updateData a@AppState{aopts=opts,aargs=args,aledger=l}
| scr == BalanceScreen = a{abuf=lines $ showBalanceReport opts [] l, aargs=[]}
| scr == RegisterScreen = a{abuf=lines $ showRegisterReport opts args l}
| scr == PrintScreen = a{abuf=lines $ showEntries opts args l}
| scr == PrintScreen = a{abuf=lines $ showLedgerTransactions opts args l}
| scr == LedgerScreen = a{abuf=lines $ rawledgertext l}
where scr = screen a
@ -233,11 +233,11 @@ backout a
drilldown :: AppState -> AppState
drilldown a
| screen a == BalanceScreen = enter RegisterScreen a{aargs=[currentAccountName a]}
| screen a == RegisterScreen = scrollToEntry e $ enter PrintScreen a
| screen a == RegisterScreen = scrollToLedgerTransaction e $ enter PrintScreen a
| screen a == PrintScreen = a
-- screen a == PrintScreen = enter LedgerScreen a
-- screen a == LedgerScreen = a
where e = currentEntry a
where e = currentLedgerTransaction a
-- | Get the account name currently highlighted by the cursor on the
-- balance screen. Results undefined while on other screens.
@ -265,10 +265,10 @@ accountNameAt buf lineno = accountNameFromComponents anamecomponents
-- | If on the print screen, move the cursor to highlight the specified entry
-- (or a reasonable guess). Doesn't work.
scrollToEntry :: Entry -> AppState -> AppState
scrollToEntry e a@AppState{abuf=buf} = setCursorY cy $ setScrollY sy a
scrollToLedgerTransaction :: LedgerTransaction -> AppState -> AppState
scrollToLedgerTransaction e a@AppState{abuf=buf} = setCursorY cy $ setScrollY sy a
where
entryfirstline = head $ lines $ showEntry $ e
entryfirstline = head $ lines $ showLedgerTransaction $ e
halfph = pageHeight a `div` 2
y = fromMaybe 0 $ findIndex (== entryfirstline) buf
sy = max 0 $ y - halfph
@ -277,8 +277,8 @@ scrollToEntry e a@AppState{abuf=buf} = setCursorY cy $ setScrollY sy a
-- | Get the entry containing the transaction currently highlighted by the
-- cursor on the register screen (or best guess). Results undefined while
-- on other screens. Doesn't work.
currentEntry :: AppState -> Entry
currentEntry a@AppState{aledger=l,abuf=buf} = entryContainingTransaction a t
currentLedgerTransaction :: AppState -> LedgerTransaction
currentLedgerTransaction a@AppState{aledger=l,abuf=buf} = entryContainingTransaction a t
where
t = safehead nulltxn $ filter ismatch $ ledgerTransactions l
ismatch t = date t == (parsedate $ take 10 datedesc)
@ -291,8 +291,8 @@ currentEntry a@AppState{aledger=l,abuf=buf} = entryContainingTransaction a t
-- | Get the entry which contains the given transaction.
-- Will raise an error if there are problems.
entryContainingTransaction :: AppState -> Transaction -> Entry
entryContainingTransaction AppState{aledger=l} t = (entries $ rawledger l) !! entryno t
entryContainingTransaction :: AppState -> Transaction -> LedgerTransaction
entryContainingTransaction AppState{aledger=l} t = (ledger_txns $ rawledger l) !! tnum t
-- renderers

View File

@ -56,7 +56,7 @@ web opts args l =
,dir "balance" $ withDataFn (look "a") $ \a -> templatise $ balancereport [a]
,dir "balance" $ templatise $ balancereport []
]
printreport apats = showEntries opts (apats ++ args) l
printreport apats = showLedgerTransactions opts (apats ++ args) l
registerreport apats = showRegisterReport opts (apats ++ args) l
balancereport [] = showBalanceReport opts args l
balancereport apats = showBalanceReport opts (apats ++ args) l'

View File

@ -36,10 +36,10 @@ Library
Ledger.Amount
Ledger.Commodity
Ledger.Dates
Ledger.Entry
Ledger.LedgerTransaction
Ledger.RawLedger
Ledger.Ledger
Ledger.RawTransaction
Ledger.Posting
Ledger.Parse
Ledger.TimeLog
Ledger.Transaction
@ -68,11 +68,11 @@ Executable hledger
Ledger.Amount
Ledger.Commodity
Ledger.Dates
Ledger.Entry
Ledger.LedgerTransaction
Ledger.Ledger
Ledger.Parse
Ledger.RawLedger
Ledger.RawTransaction
Ledger.Posting
Ledger.TimeLog
Ledger.Transaction
Ledger.Types