From a1b060f4cf819a4b191017732ccdb76731406425 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Wed, 4 Jul 2007 09:51:37 +0000 Subject: [PATCH] renamed types: RawLedger, Entry, Transaction, EntryTransaction -> LedgerFile, LedgerEntry, LedgerTransaction, Transaction --- Account.hs | 4 +- EntryTransaction.hs | 81 ------------------------------ Ledger.hs | 18 +++---- Entry.hs => LedgerEntry.hs | 22 ++++----- RawLedger.hs => LedgerFile.hs | 8 +-- LedgerTransaction.hs | 37 ++++++++++++++ Models.hs | 16 +++--- Parse.hs | 20 ++++---- Tests.hs | 46 +++++++++--------- TimeLog.hs | 18 +++---- Transaction.hs | 92 ++++++++++++++++++++++++++--------- Types.hs | 34 ++++++------- hledger.hs | 4 +- 13 files changed, 200 insertions(+), 200 deletions(-) delete mode 100644 EntryTransaction.hs rename Entry.hs => LedgerEntry.hs (82%) rename RawLedger.hs => LedgerFile.hs (64%) create mode 100644 LedgerTransaction.hs diff --git a/Account.hs b/Account.hs index 786fe765b..c5a090cf9 100644 --- a/Account.hs +++ b/Account.hs @@ -4,9 +4,9 @@ import Utils import Types import AccountName import Amount -import Entry +import LedgerEntry +import LedgerTransaction import Transaction -import EntryTransaction instance Show Account where diff --git a/EntryTransaction.hs b/EntryTransaction.hs deleted file mode 100644 index 396365117..000000000 --- a/EntryTransaction.hs +++ /dev/null @@ -1,81 +0,0 @@ -module EntryTransaction -where -import Utils -import Types -import AccountName -import Entry -import Transaction -import Amount -import Currency - - -entry (e,t) = e -transaction (e,t) = t -date (e,t) = edate e -status (e,t) = estatus e -code (e,t) = ecode e -description (e,t) = edescription e -account (e,t) = taccount t -amount (e,t) = tamount t - -flattenEntry :: Entry -> [EntryTransaction] -flattenEntry e = [(e,t) | t <- etransactions e] - -entryTransactionSetPrecision :: Int -> EntryTransaction -> EntryTransaction -entryTransactionSetPrecision p (e, Transaction a amt) = (e, Transaction a amt{precision=p}) - -accountNamesFromTransactions :: [EntryTransaction] -> [AccountName] -accountNamesFromTransactions ts = nub $ map account ts - -entryTransactionsFrom :: [Entry] -> [EntryTransaction] -entryTransactionsFrom es = concat $ map flattenEntry es - -sumEntryTransactions :: [EntryTransaction] -> Amount -sumEntryTransactions ets = - sumTransactions $ map transaction ets - -matchTransactionAccount :: Regex -> EntryTransaction -> Bool -matchTransactionAccount r t = - case matchRegex r (account t) of - Nothing -> False - otherwise -> True - -matchTransactionDescription :: Regex -> EntryTransaction -> Bool -matchTransactionDescription r t = - case matchRegex r (description t) of - Nothing -> False - otherwise -> True - --- for register command - -showTransactionsWithBalances :: [EntryTransaction] -> Amount -> String -showTransactionsWithBalances [] _ = [] -showTransactionsWithBalances ts b = - unlines $ showTransactionsWithBalances' ts dummyt b - where - dummyt = (Entry "" False "" "" [], Transaction "" (dollars 0)) - showTransactionsWithBalances' [] _ _ = [] - showTransactionsWithBalances' (t:ts) tprev b = - (if (entry t /= (entry tprev)) - then [showTransactionDescriptionAndBalance t b'] - else [showTransactionAndBalance t b']) - ++ (showTransactionsWithBalances' ts t b') - where b' = b + (amount t) - -showTransactionDescriptionAndBalance :: EntryTransaction -> Amount -> String -showTransactionDescriptionAndBalance t b = - (showEntryDescription $ entry t) ++ (showTransaction $ transaction t) ++ (showBalance b) - -showTransactionAndBalance :: EntryTransaction -> Amount -> String -showTransactionAndBalance t b = - (replicate 32 ' ') ++ (showTransaction $ transaction t) ++ (showBalance b) - -showBalance :: Amount -> String -showBalance b = printf " %12s" (showAmountRoundedOrZero b) - -transactionsWithAccountName :: AccountName -> [EntryTransaction] -> [EntryTransaction] -transactionsWithAccountName a ts = [t | t <- ts, account t == a] - -transactionsWithOrBelowAccountName :: AccountName -> [EntryTransaction] -> [EntryTransaction] -transactionsWithOrBelowAccountName a ts = - [t | t <- ts, account t == a || a `isAccountNamePrefixOf` (account t)] diff --git a/Ledger.hs b/Ledger.hs index 0104e17af..21fec8322 100644 --- a/Ledger.hs +++ b/Ledger.hs @@ -7,20 +7,20 @@ import Types import Amount import Account import AccountName -import EntryTransaction -import RawLedger +import Transaction +import LedgerFile -rawLedgerTransactions :: RawLedger -> [EntryTransaction] +rawLedgerTransactions :: LedgerFile -> [Transaction] rawLedgerTransactions l = entryTransactionsFrom $ entries l -rawLedgerAccountNamesUsed :: RawLedger -> [AccountName] +rawLedgerAccountNamesUsed :: LedgerFile -> [AccountName] rawLedgerAccountNamesUsed l = accountNamesFromTransactions $ entryTransactionsFrom $ entries l -rawLedgerAccountNames :: RawLedger -> [AccountName] +rawLedgerAccountNames :: LedgerFile -> [AccountName] rawLedgerAccountNames = sort . expandAccountNames . rawLedgerAccountNamesUsed -rawLedgerAccountNameTree :: RawLedger -> Tree AccountName +rawLedgerAccountNameTree :: LedgerFile -> Tree AccountName rawLedgerAccountNameTree l = accountNameTreeFrom $ rawLedgerAccountNames l @@ -33,7 +33,7 @@ instance Show Ledger where -- at startup, we augment the parsed ledger entries with an account map -- and other things useful for performance -cacheLedger :: RawLedger -> Ledger +cacheLedger :: LedgerFile -> Ledger cacheLedger l = let ant = rawLedgerAccountNameTree l @@ -65,13 +65,13 @@ ledgerAccount l a = (accounts l) ! a -- amount, to help with report output. It should perhaps be done in the -- display functions, but those are far removed from the ledger. Keep in -- mind if doing more arithmetic with these. -ledgerTransactions :: Ledger -> [EntryTransaction] +ledgerTransactions :: Ledger -> [Transaction] ledgerTransactions l = setprecisions $ rawLedgerTransactions $ rawledger l where setprecisions = map (entryTransactionSetPrecision (lprecision l)) -ledgerTransactionsMatching :: ([String],[String]) -> Ledger -> [EntryTransaction] +ledgerTransactionsMatching :: ([String],[String]) -> Ledger -> [Transaction] ledgerTransactionsMatching ([],[]) l = ledgerTransactionsMatching ([".*"],[".*"]) l ledgerTransactionsMatching (rs,[]) l = ledgerTransactionsMatching (rs,[".*"]) l ledgerTransactionsMatching ([],rs) l = ledgerTransactionsMatching ([".*"],rs) l diff --git a/Entry.hs b/LedgerEntry.hs similarity index 82% rename from Entry.hs rename to LedgerEntry.hs index def8f3085..fb8df53b8 100644 --- a/Entry.hs +++ b/LedgerEntry.hs @@ -1,13 +1,13 @@ -module Entry +module LedgerEntry where import Utils import Types -import Transaction +import LedgerTransaction import Amount -instance Show Entry where show = showEntryDescription +instance Show LedgerEntry where show = showEntryDescription -- for register report -- @@ -26,12 +26,12 @@ showEntryDescription e = (showDate $ edate e) ++ " " ++ (showDescription $ edesc showDate d = printf "%-10s" d showDescription s = printf "%-20s" (elideRight 20 s) -isEntryBalanced :: Entry -> Bool +isEntryBalanced :: LedgerEntry -> Bool isEntryBalanced e = (sumTransactions . etransactions) e == 0 -autofillEntry :: Entry -> Entry +autofillEntry :: LedgerEntry -> LedgerEntry autofillEntry e = - Entry (edate e) (estatus e) (ecode e) (edescription e) + LedgerEntry (edate e) (estatus e) (ecode e) (edescription e) (autofillTransactions (etransactions e)) -- the print command shows cleaned up ledger file entries, something like: @@ -46,7 +46,7 @@ autofillEntry e = -- amtwidth = 11 -- commentwidth = 20 -showEntry :: Entry -> String +showEntry :: LedgerEntry -> String showEntry e = unlines $ ["", description] ++ (showtxns $ etransactions e) where @@ -63,12 +63,12 @@ showEntry e = showamount = printf "%11s" . showAmountRounded showaccountname = printf "%-35s" . elideRight 35 -showEntries :: [Entry] -> String +showEntries :: [LedgerEntry] -> String showEntries = concatMap showEntry -entrySetPrecision :: Int -> Entry -> Entry -entrySetPrecision p (Entry d s c desc ts) = - Entry d s c desc $ map (transactionSetPrecision p) ts +entrySetPrecision :: Int -> LedgerEntry -> LedgerEntry +entrySetPrecision p (LedgerEntry d s c desc ts) = + LedgerEntry d s c desc $ map (transactionSetPrecision p) ts -- modifier & periodic entries diff --git a/RawLedger.hs b/LedgerFile.hs similarity index 64% rename from RawLedger.hs rename to LedgerFile.hs index 6555c81cb..3ca941b18 100644 --- a/RawLedger.hs +++ b/LedgerFile.hs @@ -1,15 +1,15 @@ -module RawLedger +module LedgerFile where import qualified Data.Map as Map import Utils import Types import AccountName -import Entry +import LedgerEntry -instance Show RawLedger where - show l = printf "RawLedger with %d entries" +instance Show LedgerFile where + show l = printf "LedgerFile with %d entries" ((length $ entries l) + (length $ modifier_entries l) + (length $ periodic_entries l)) diff --git a/LedgerTransaction.hs b/LedgerTransaction.hs new file mode 100644 index 000000000..54f3a7d12 --- /dev/null +++ b/LedgerTransaction.hs @@ -0,0 +1,37 @@ + +module LedgerTransaction +where +import Utils +import Types +import AccountName +import Amount + + +instance Show LedgerTransaction where show = showTransaction + +showTransaction :: LedgerTransaction -> String +showTransaction t = (showaccountname $ taccount t) ++ " " ++ (showamount $ tamount t) + where + showaccountname = printf "%-22s" . elideRight 22 + showamount = printf "%11s" . showAmountRoundedOrZero + +elideRight width s = + case length s > width of + True -> take (width - 2) s ++ ".." + False -> s + +autofillTransactions :: [LedgerTransaction] -> [LedgerTransaction] +autofillTransactions ts = + let (ns, as) = partition isNormal ts + where isNormal t = (symbol $ currency $ tamount t) /= "AUTO" in + case (length as) of + 0 -> ns + 1 -> ns ++ [balanceTransaction $ head as] + where balanceTransaction t = t{tamount = -(sumTransactions ns)} + otherwise -> error "too many blank transactions in this entry" + +sumTransactions :: [LedgerTransaction] -> Amount +sumTransactions = sum . map tamount + +transactionSetPrecision :: Int -> LedgerTransaction -> LedgerTransaction +transactionSetPrecision p (LedgerTransaction a amt) = LedgerTransaction a amt{precision=p} diff --git a/Models.hs b/Models.hs index 2e4883823..fccfea544 100644 --- a/Models.hs +++ b/Models.hs @@ -4,11 +4,11 @@ module Models ( module Currency, module Amount, module AccountName, - module Transaction, - module Entry, + module LedgerTransaction, + module LedgerEntry, module TimeLog, - module EntryTransaction, - module RawLedger, + module Transaction, + module LedgerFile, module Account, module Ledger, ) @@ -19,11 +19,11 @@ import Types import Currency import Amount import AccountName -import Transaction -import Entry +import LedgerTransaction +import LedgerEntry import TimeLog -import EntryTransaction -import RawLedger +import Transaction +import LedgerFile import Account import Ledger diff --git a/Parse.hs b/Parse.hs index 8bdbf4a00..699b84df8 100644 --- a/Parse.hs +++ b/Parse.hs @@ -137,10 +137,10 @@ i, o, b, h -- parsec example: http://pandoc.googlecode.com/svn/trunk/src/Text/Pandoc/Readers/RST.hs -- sample data in Tests.hs -ledgerfile :: Parser RawLedger +ledgerfile :: Parser LedgerFile ledgerfile = ledger <|> ledgerfromtimelog -ledger :: Parser RawLedger +ledger :: Parser LedgerFile ledger = do ledgernondatalines -- for now these must come first, unlike ledger @@ -149,7 +149,7 @@ ledger = do -- entries <- (many ledgerentry) "entry" eof - return $ RawLedger modifier_entries periodic_entries entries + return $ LedgerFile modifier_entries periodic_entries entries ledgernondatalines :: Parser [String] ledgernondatalines = many (ledgerdirective <|> ledgercomment <|> do {whiteSpace1; return []}) @@ -178,7 +178,7 @@ ledgerperiodicentry = do ledgernondatalines return (PeriodicEntry periodexpr transactions) -ledgerentry :: Parser Entry +ledgerentry :: Parser LedgerEntry ledgerentry = do date <- ledgerdate status <- ledgerstatus @@ -186,7 +186,7 @@ ledgerentry = do description <- anyChar `manyTill` ledgereol transactions <- ledgertransactions ledgernondatalines - return $ autofillEntry $ Entry date status code description transactions + return $ autofillEntry $ LedgerEntry date status code description transactions ledgerdate :: Parser String ledgerdate = do @@ -204,10 +204,10 @@ ledgerstatus = try (do { char '*'; many1 spacenonewline; return True } ) <|> ret ledgercode :: Parser String ledgercode = try (do { char '('; code <- anyChar `manyTill` char ')'; many1 spacenonewline; return code } ) <|> return "" -ledgertransactions :: Parser [Transaction] +ledgertransactions :: Parser [LedgerTransaction] ledgertransactions = (ledgertransaction "transaction") `manyTill` (do {newline "blank line"; return ()} <|> eof) -ledgertransaction :: Parser Transaction +ledgertransaction :: Parser LedgerTransaction ledgertransaction = do many1 spacenonewline account <- ledgeraccount @@ -215,7 +215,7 @@ ledgertransaction = do many spacenonewline ledgereol many ledgercomment - return (Transaction account amount) + return (LedgerTransaction account amount) -- account names may have single spaces in them, and are terminated by two or more spaces ledgeraccount :: Parser String @@ -289,7 +289,7 @@ o 2007/03/10 17:26:02 -} -ledgerfromtimelog :: Parser RawLedger +ledgerfromtimelog :: Parser LedgerFile ledgerfromtimelog = do tl <- timelog return $ ledgerFromTimeLog tl @@ -322,7 +322,7 @@ printParseResult :: Show v => Either ParseError v -> IO () printParseResult r = case r of Left e -> parseError e Right v -> print v -parseLedgerFile :: String -> IO (Either ParseError RawLedger) +parseLedgerFile :: String -> IO (Either ParseError LedgerFile) parseLedgerFile "-" = fmap (parse ledgerfile "-") $ hGetContents stdin parseLedgerFile f = parseFromFile ledgerfile f diff --git a/Tests.hs b/Tests.hs index 6d4a059a9..b116a8a92 100644 --- a/Tests.hs +++ b/Tests.hs @@ -65,7 +65,7 @@ parseEqual parsed other = transaction1_str = " expenses:food:dining $10.00\n" -transaction1 = Transaction "expenses:food:dining" (dollars 10) +transaction1 = LedgerTransaction "expenses:food:dining" (dollars 10) entry1_str = "\ \2007/01/28 coopportunity\n\ @@ -74,9 +74,9 @@ entry1_str = "\ \\n" --" entry1 = - (Entry "2007/01/28" False "" "coopportunity" - [Transaction "expenses:food:groceries" (Amount (getcurrency "$") 47.18 2), - Transaction "assets:checking" (Amount (getcurrency "$") (-47.18) 2)]) + (LedgerEntry "2007/01/28" False "" "coopportunity" + [LedgerTransaction "expenses:food:groceries" (Amount (getcurrency "$") 47.18 2), + LedgerTransaction "assets:checking" (Amount (getcurrency "$") (-47.18) 2)]) entry2_str = "\ \2007/01/27 * joes diner\n\ @@ -206,66 +206,66 @@ ledger7_str = "\ \ assets:checking \n\ \\n" --" -ledger7 = RawLedger +ledger7 = LedgerFile [] [] [ - Entry { + LedgerEntry { edate="2007/01/01", estatus=False, ecode="*", edescription="opening balance", etransactions=[ - Transaction {taccount="assets:cash", + LedgerTransaction {taccount="assets:cash", tamount=Amount {currency=(getcurrency "$"), quantity=4.82, precision=2}}, - Transaction {taccount="equity:opening balances", + LedgerTransaction {taccount="equity:opening balances", tamount=Amount {currency=(getcurrency "$"), quantity=(-4.82), precision=2}} ] } , - Entry { + LedgerEntry { edate="2007/02/01", estatus=False, ecode="*", edescription="ayres suites", etransactions=[ - Transaction {taccount="expenses:vacation", + LedgerTransaction {taccount="expenses:vacation", tamount=Amount {currency=(getcurrency "$"), quantity=179.92, precision=2}}, - Transaction {taccount="assets:checking", + LedgerTransaction {taccount="assets:checking", tamount=Amount {currency=(getcurrency "$"), quantity=(-179.92), precision=2}} ] } , - Entry { + LedgerEntry { edate="2007/01/02", estatus=False, ecode="*", edescription="auto transfer to savings", etransactions=[ - Transaction {taccount="assets:saving", + LedgerTransaction {taccount="assets:saving", tamount=Amount {currency=(getcurrency "$"), quantity=200, precision=2}}, - Transaction {taccount="assets:checking", + LedgerTransaction {taccount="assets:checking", tamount=Amount {currency=(getcurrency "$"), quantity=(-200), precision=2}} ] } , - Entry { + LedgerEntry { edate="2007/01/03", estatus=False, ecode="*", edescription="poquito mas", etransactions=[ - Transaction {taccount="expenses:food:dining", + LedgerTransaction {taccount="expenses:food:dining", tamount=Amount {currency=(getcurrency "$"), quantity=4.82, precision=2}}, - Transaction {taccount="assets:cash", + LedgerTransaction {taccount="assets:cash", tamount=Amount {currency=(getcurrency "$"), quantity=(-4.82), precision=2}} ] } , - Entry { + LedgerEntry { edate="2007/01/03", estatus=False, ecode="*", edescription="verizon", etransactions=[ - Transaction {taccount="expenses:phone", + LedgerTransaction {taccount="expenses:phone", tamount=Amount {currency=(getcurrency "$"), quantity=95.11, precision=2}}, - Transaction {taccount="assets:checking", + LedgerTransaction {taccount="assets:checking", tamount=Amount {currency=(getcurrency "$"), quantity=(-95.11), precision=2}} ] } , - Entry { + LedgerEntry { edate="2007/01/03", estatus=False, ecode="*", edescription="discover", etransactions=[ - Transaction {taccount="liabilities:credit cards:discover", + LedgerTransaction {taccount="liabilities:credit cards:discover", tamount=Amount {currency=(getcurrency "$"), quantity=80, precision=2}}, - Transaction {taccount="assets:checking", + LedgerTransaction {taccount="assets:checking", tamount=Amount {currency=(getcurrency "$"), quantity=(-80), precision=2}} ] } diff --git a/TimeLog.hs b/TimeLog.hs index e8cf037ba..3ecaff3c5 100644 --- a/TimeLog.hs +++ b/TimeLog.hs @@ -4,9 +4,9 @@ import Utils import Types import Currency import Amount -import Transaction -import Entry -import RawLedger +import LedgerTransaction +import LedgerEntry +import LedgerFile instance Show TimeLogEntry where show t = printf "%s %s %s" (show $ tcode t) (tdatetime t) (tcomment t) @@ -14,25 +14,25 @@ instance Show TimeLogEntry where instance Show TimeLog where show tl = printf "TimeLog with %d entries" $ length $ timelog_entries tl -ledgerFromTimeLog :: TimeLog -> RawLedger +ledgerFromTimeLog :: TimeLog -> LedgerFile ledgerFromTimeLog tl = - RawLedger [] [] (entriesFromTimeLogEntries $ timelog_entries tl) + LedgerFile [] [] (entriesFromTimeLogEntries $ timelog_entries tl) -entriesFromTimeLogEntries :: [TimeLogEntry] -> [Entry] +entriesFromTimeLogEntries :: [TimeLogEntry] -> [LedgerEntry] entriesFromTimeLogEntries [clockin] = entriesFromTimeLogEntries [clockin, clockoutNowEntry] entriesFromTimeLogEntries [clockin,clockout] = [ - Entry { + LedgerEntry { edate = indate, estatus = True, ecode = "", edescription = accountname, etransactions = [ - Transaction accountname amount, - Transaction "TIME" (-amount) + LedgerTransaction accountname amount, + LedgerTransaction "TIME" (-amount) ]} ] where diff --git a/Transaction.hs b/Transaction.hs index 4e68c87a6..65a136a04 100644 --- a/Transaction.hs +++ b/Transaction.hs @@ -1,37 +1,81 @@ - module Transaction where import Utils import Types import AccountName +import LedgerEntry +import LedgerTransaction import Amount +import Currency -instance Show Transaction where show = showTransaction +entry (e,t) = e +transaction (e,t) = t +date (e,t) = edate e +status (e,t) = estatus e +code (e,t) = ecode e +description (e,t) = edescription e +account (e,t) = taccount t +amount (e,t) = tamount t + +flattenEntry :: LedgerEntry -> [Transaction] +flattenEntry e = [(e,t) | t <- etransactions e] -showTransaction :: Transaction -> String -showTransaction t = (showaccountname $ taccount t) ++ " " ++ (showamount $ tamount t) - where - showaccountname = printf "%-22s" . elideRight 22 - showamount = printf "%11s" . showAmountRoundedOrZero +entryTransactionSetPrecision :: Int -> Transaction -> Transaction +entryTransactionSetPrecision p (e, LedgerTransaction a amt) = (e, LedgerTransaction a amt{precision=p}) -elideRight width s = - case length s > width of - True -> take (width - 2) s ++ ".." - False -> s +accountNamesFromTransactions :: [Transaction] -> [AccountName] +accountNamesFromTransactions ts = nub $ map account ts -autofillTransactions :: [Transaction] -> [Transaction] -autofillTransactions ts = - let (ns, as) = partition isNormal ts - where isNormal t = (symbol $ currency $ tamount t) /= "AUTO" in - case (length as) of - 0 -> ns - 1 -> ns ++ [balanceTransaction $ head as] - where balanceTransaction t = t{tamount = -(sumTransactions ns)} - otherwise -> error "too many blank transactions in this entry" +entryTransactionsFrom :: [LedgerEntry] -> [Transaction] +entryTransactionsFrom es = concat $ map flattenEntry es -sumTransactions :: [Transaction] -> Amount -sumTransactions = sum . map tamount +sumEntryTransactions :: [Transaction] -> Amount +sumEntryTransactions ets = + sumTransactions $ map transaction ets -transactionSetPrecision :: Int -> Transaction -> Transaction -transactionSetPrecision p (Transaction a amt) = Transaction a amt{precision=p} +matchTransactionAccount :: Regex -> Transaction -> Bool +matchTransactionAccount r t = + case matchRegex r (account t) of + Nothing -> False + otherwise -> True + +matchTransactionDescription :: Regex -> Transaction -> Bool +matchTransactionDescription r t = + case matchRegex r (description t) of + Nothing -> False + otherwise -> True + +-- for register command + +showTransactionsWithBalances :: [Transaction] -> Amount -> String +showTransactionsWithBalances [] _ = [] +showTransactionsWithBalances ts b = + unlines $ showTransactionsWithBalances' ts dummyt b + where + dummyt = (LedgerEntry "" False "" "" [], LedgerTransaction "" (dollars 0)) + showTransactionsWithBalances' [] _ _ = [] + showTransactionsWithBalances' (t:ts) tprev b = + (if (entry t /= (entry tprev)) + then [showTransactionDescriptionAndBalance t b'] + else [showTransactionAndBalance t b']) + ++ (showTransactionsWithBalances' ts t b') + where b' = b + (amount t) + +showTransactionDescriptionAndBalance :: Transaction -> Amount -> String +showTransactionDescriptionAndBalance t b = + (showEntryDescription $ entry t) ++ (showTransaction $ transaction t) ++ (showBalance b) + +showTransactionAndBalance :: Transaction -> Amount -> String +showTransactionAndBalance t b = + (replicate 32 ' ') ++ (showTransaction $ transaction t) ++ (showBalance b) + +showBalance :: Amount -> String +showBalance b = printf " %12s" (showAmountRoundedOrZero b) + +transactionsWithAccountName :: AccountName -> [Transaction] -> [Transaction] +transactionsWithAccountName a ts = [t | t <- ts, account t == a] + +transactionsWithOrBelowAccountName :: AccountName -> [Transaction] -> [Transaction] +transactionsWithOrBelowAccountName a ts = + [t | t <- ts, account t == a || a `isAccountNamePrefixOf` (account t)] diff --git a/Types.hs b/Types.hs index c438d6be4..62f09c948 100644 --- a/Types.hs +++ b/Types.hs @@ -18,10 +18,10 @@ hledger TimeLogEntry Ledger Account - EntryTransaction - RawLedger - Entry - Transaction + Transaction + LedgerFile + LedgerEntry + LedgerTransaction AccountName Amount Currency @@ -50,19 +50,19 @@ data Amount = Amount { -- out the chart of accounts type AccountName = String --- a flow of some amount to some account (see also EntryTransaction) -data Transaction = Transaction { +-- a flow of some amount to some account (see also Transaction) +data LedgerTransaction = LedgerTransaction { taccount :: AccountName, tamount :: Amount } deriving (Eq) -- a ledger entry, with two or more balanced transactions -data Entry = Entry { +data LedgerEntry = LedgerEntry { edate :: Date, estatus :: EntryStatus, ecode :: String, edescription :: String, - etransactions :: [Transaction] + etransactions :: [LedgerTransaction] } deriving (Eq) type EntryStatus = Bool @@ -70,13 +70,13 @@ type EntryStatus = Bool -- an "=" automated entry (ignored) data ModifierEntry = ModifierEntry { valueexpr :: String, - m_transactions :: [Transaction] + m_transactions :: [LedgerTransaction] } deriving (Eq) -- a "~" periodic entry (ignored) data PeriodicEntry = PeriodicEntry { periodexpr :: String, - p_transactions :: [Transaction] + p_transactions :: [LedgerTransaction] } deriving (Eq) -- we also parse timeclock.el timelogs @@ -91,28 +91,28 @@ data TimeLog = TimeLog { } deriving (Eq) -- a parsed ledger file -data RawLedger = RawLedger { +data LedgerFile = LedgerFile { modifier_entries :: [ModifierEntry], periodic_entries :: [PeriodicEntry], - entries :: [Entry] + entries :: [LedgerEntry] } deriving (Eq) -- We convert Transactions into EntryTransactions, which are (entry, -- transaction) pairs, since I couldn't see how to have transactions -- reference their entry like in OO. These are referred to as just --- "transactions" in modules above EntryTransaction. -type EntryTransaction = (Entry,Transaction) +-- "transactions" in modules above Transaction. +type Transaction = (LedgerEntry,LedgerTransaction) --- all information for a particular account, derived from a RawLedger +-- all information for a particular account, derived from a LedgerFile data Account = Account { aname :: AccountName, - atransactions :: [EntryTransaction], -- excludes sub-accounts + atransactions :: [Transaction], -- excludes sub-accounts abalance :: Amount -- includes sub-accounts } -- a ledger with account info cached for faster queries data Ledger = Ledger { - rawledger :: RawLedger, + rawledger :: LedgerFile, accountnametree :: Tree AccountName, accounts :: Map.Map AccountName Account, lprecision :: Int diff --git a/hledger.hs b/hledger.hs index 4d68f036c..94c1f00dd 100644 --- a/hledger.hs +++ b/hledger.hs @@ -75,7 +75,7 @@ doWithLedger :: [Flag] -> (Ledger -> IO ()) -> IO () doWithLedger opts cmd = do ledgerFilePath opts >>= parseLedgerFile >>= doWithParsed cmd -doWithParsed :: (Ledger -> IO ()) -> (Either ParseError RawLedger) -> IO () +doWithParsed :: (Ledger -> IO ()) -> (Either ParseError LedgerFile) -> IO () doWithParsed cmd parsed = do case parsed of Left e -> parseError e Right l -> cmd $ cacheLedger l @@ -85,7 +85,7 @@ doWithParsed cmd parsed = do interactive testing: *Main> p <- ledgerFilePath [File "./test.dat"] >>= parseLedgerFile -*Main> let r = either (\_ -> RawLedger [] [] []) id p +*Main> let r = either (\_ -> LedgerFile [] [] []) id p *Main> let l = cacheLedger r *Main> let ant = accountnametree l *Main> let at = accounts l