slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

renamed types: RawLedger, Entry, Transaction, EntryTransaction -> LedgerFile, LedgerEntry, LedgerTransaction, Transaction

Browse Source
This commit is contained in:
Simon Michael 2007-07-04 09:51:37 +00:00
parent 0d8bd83b7f
commit a1b060f4cf
13 changed files with 200 additions and 200 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
Account.hs
View File

@ -4,9 +4,9 @@ import Utils
import Types import Types
import AccountName import AccountName
import Amount import Amount
import Entry import LedgerEntry
import LedgerTransaction
import Transaction import Transaction
import EntryTransaction
instance Show Account where instance Show Account where

81
EntryTransaction.hs
View File

@ -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)]

18
Ledger.hs
View File

@ -7,20 +7,20 @@ import Types
import Amount import Amount
import Account import Account
import AccountName import AccountName
import EntryTransaction import Transaction
import RawLedger import LedgerFile
rawLedgerTransactions :: RawLedger -> [EntryTransaction] rawLedgerTransactions :: LedgerFile -> [Transaction]
rawLedgerTransactions l = entryTransactionsFrom $ entries l rawLedgerTransactions l = entryTransactionsFrom $ entries l
rawLedgerAccountNamesUsed :: RawLedger -> [AccountName] rawLedgerAccountNamesUsed :: LedgerFile -> [AccountName]
rawLedgerAccountNamesUsed l = accountNamesFromTransactions $ entryTransactionsFrom $ entries l rawLedgerAccountNamesUsed l = accountNamesFromTransactions $ entryTransactionsFrom $ entries l
rawLedgerAccountNames :: RawLedger -> [AccountName] rawLedgerAccountNames :: LedgerFile -> [AccountName]
rawLedgerAccountNames = sort . expandAccountNames . rawLedgerAccountNamesUsed rawLedgerAccountNames = sort . expandAccountNames . rawLedgerAccountNamesUsed
rawLedgerAccountNameTree :: RawLedger -> Tree AccountName rawLedgerAccountNameTree :: LedgerFile -> Tree AccountName
rawLedgerAccountNameTree l = accountNameTreeFrom $ rawLedgerAccountNames l 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 -- at startup, we augment the parsed ledger entries with an account map
-- and other things useful for performance -- and other things useful for performance
cacheLedger :: RawLedger -> Ledger cacheLedger :: LedgerFile -> Ledger
cacheLedger l = cacheLedger l =
let let
ant = rawLedgerAccountNameTree l 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 -- 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 -- display functions, but those are far removed from the ledger. Keep in
-- mind if doing more arithmetic with these. -- mind if doing more arithmetic with these.
ledgerTransactions :: Ledger -> [EntryTransaction] ledgerTransactions :: Ledger -> [Transaction]
ledgerTransactions l = ledgerTransactions l =
setprecisions $ rawLedgerTransactions $ rawledger l setprecisions $ rawLedgerTransactions $ rawledger l
where where
setprecisions = map (entryTransactionSetPrecision (lprecision l)) setprecisions = map (entryTransactionSetPrecision (lprecision l))
ledgerTransactionsMatching :: ([String],[String]) -> Ledger -> [EntryTransaction] ledgerTransactionsMatching :: ([String],[String]) -> Ledger -> [Transaction]
ledgerTransactionsMatching ([],[]) l = ledgerTransactionsMatching ([".*"],[".*"]) l ledgerTransactionsMatching ([],[]) l = ledgerTransactionsMatching ([".*"],[".*"]) l
ledgerTransactionsMatching (rs,[]) l = ledgerTransactionsMatching (rs,[".*"]) l ledgerTransactionsMatching (rs,[]) l = ledgerTransactionsMatching (rs,[".*"]) l
ledgerTransactionsMatching ([],rs) l = ledgerTransactionsMatching ([".*"],rs) l ledgerTransactionsMatching ([],rs) l = ledgerTransactionsMatching ([".*"],rs) l

22
Entry.hs → LedgerEntry.hs
View File

@ -1,13 +1,13 @@
module Entry module LedgerEntry
where where
import Utils import Utils
import Types import Types
import Transaction import LedgerTransaction
import Amount import Amount
instance Show Entry where show = showEntryDescription instance Show LedgerEntry where show = showEntryDescription
-- for register report -- for register report
-- --
@ -26,12 +26,12 @@ showEntryDescription e = (showDate $ edate e) ++ " " ++ (showDescription $ edesc
showDate d = printf "%-10s" d showDate d = printf "%-10s" d
showDescription s = printf "%-20s" (elideRight 20 s) showDescription s = printf "%-20s" (elideRight 20 s)
isEntryBalanced :: Entry -> Bool isEntryBalanced :: LedgerEntry -> Bool
isEntryBalanced e = (sumTransactions . etransactions) e == 0 isEntryBalanced e = (sumTransactions . etransactions) e == 0
autofillEntry :: Entry -> Entry autofillEntry :: LedgerEntry -> LedgerEntry
autofillEntry e = autofillEntry e =
Entry (edate e) (estatus e) (ecode e) (edescription e) LedgerEntry (edate e) (estatus e) (ecode e) (edescription e)
(autofillTransactions (etransactions e)) (autofillTransactions (etransactions e))
-- the print command shows cleaned up ledger file entries, something like: -- the print command shows cleaned up ledger file entries, something like:
@ -46,7 +46,7 @@ autofillEntry e =
-- amtwidth = 11 -- amtwidth = 11
-- commentwidth = 20 -- commentwidth = 20
showEntry :: Entry -> String showEntry :: LedgerEntry -> String
showEntry e = showEntry e =
unlines $ ["", description] ++ (showtxns $ etransactions e) unlines $ ["", description] ++ (showtxns $ etransactions e)
where where
@ -63,12 +63,12 @@ showEntry e =
showamount = printf "%11s" . showAmountRounded showamount = printf "%11s" . showAmountRounded
showaccountname = printf "%-35s" . elideRight 35 showaccountname = printf "%-35s" . elideRight 35
showEntries :: [Entry] -> String showEntries :: [LedgerEntry] -> String
showEntries = concatMap showEntry showEntries = concatMap showEntry
entrySetPrecision :: Int -> Entry -> Entry entrySetPrecision :: Int -> LedgerEntry -> LedgerEntry
entrySetPrecision p (Entry d s c desc ts) = entrySetPrecision p (LedgerEntry d s c desc ts) =
Entry d s c desc $ map (transactionSetPrecision p) ts LedgerEntry d s c desc $ map (transactionSetPrecision p) ts
-- modifier & periodic entries -- modifier & periodic entries

8
RawLedger.hs → LedgerFile.hs
View File

@ -1,15 +1,15 @@
module RawLedger module LedgerFile
where where
import qualified Data.Map as Map import qualified Data.Map as Map
import Utils import Utils
import Types import Types
import AccountName import AccountName
import Entry import LedgerEntry
instance Show RawLedger where instance Show LedgerFile where
show l = printf "RawLedger with %d entries" show l = printf "LedgerFile with %d entries"
((length $ entries l) + ((length $ entries l) +
(length $ modifier_entries l) + (length $ modifier_entries l) +
(length $ periodic_entries l)) (length $ periodic_entries l))

37
LedgerTransaction.hs Normal file
View File

@ -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}

16
Models.hs
View File

@ -4,11 +4,11 @@ module Models (
module Currency, module Currency,
module Amount, module Amount,
module AccountName, module AccountName,
module Transaction, module LedgerTransaction,
module Entry, module LedgerEntry,
module TimeLog, module TimeLog,
module EntryTransaction, module Transaction,
module RawLedger, module LedgerFile,
module Account, module Account,
module Ledger, module Ledger,
) )
@ -19,11 +19,11 @@ import Types
import Currency import Currency
import Amount import Amount
import AccountName import AccountName
import Transaction import LedgerTransaction
import Entry import LedgerEntry
import TimeLog import TimeLog
import EntryTransaction import Transaction
import RawLedger import LedgerFile
import Account import Account
import Ledger import Ledger

20
Parse.hs
View File

@ -137,10 +137,10 @@ i, o, b, h
-- parsec example: http://pandoc.googlecode.com/svn/trunk/src/Text/Pandoc/Readers/RST.hs -- parsec example: http://pandoc.googlecode.com/svn/trunk/src/Text/Pandoc/Readers/RST.hs
-- sample data in Tests.hs -- sample data in Tests.hs
ledgerfile :: Parser RawLedger ledgerfile :: Parser LedgerFile
ledgerfile = ledger <|> ledgerfromtimelog ledgerfile = ledger <|> ledgerfromtimelog
ledger :: Parser RawLedger ledger :: Parser LedgerFile
ledger = do ledger = do
ledgernondatalines ledgernondatalines
-- for now these must come first, unlike ledger -- for now these must come first, unlike ledger
@ -149,7 +149,7 @@ ledger = do
-- --
entries <- (many ledgerentry) <?> "entry" entries <- (many ledgerentry) <?> "entry"
eof eof
return $ RawLedger modifier_entries periodic_entries entries return $ LedgerFile modifier_entries periodic_entries entries
ledgernondatalines :: Parser [String] ledgernondatalines :: Parser [String]
ledgernondatalines = many (ledgerdirective <|> ledgercomment <|> do {whiteSpace1; return []}) ledgernondatalines = many (ledgerdirective <|> ledgercomment <|> do {whiteSpace1; return []})
@ -178,7 +178,7 @@ ledgerperiodicentry = do
ledgernondatalines ledgernondatalines
return (PeriodicEntry periodexpr transactions) return (PeriodicEntry periodexpr transactions)
ledgerentry :: Parser Entry ledgerentry :: Parser LedgerEntry
ledgerentry = do ledgerentry = do
date <- ledgerdate date <- ledgerdate
status <- ledgerstatus status <- ledgerstatus
@ -186,7 +186,7 @@ ledgerentry = do
description <- anyChar `manyTill` ledgereol description <- anyChar `manyTill` ledgereol
transactions <- ledgertransactions transactions <- ledgertransactions
ledgernondatalines ledgernondatalines
return $ autofillEntry $ Entry date status code description transactions return $ autofillEntry $ LedgerEntry date status code description transactions
ledgerdate :: Parser String ledgerdate :: Parser String
ledgerdate = do ledgerdate = do
@ -204,10 +204,10 @@ ledgerstatus = try (do { char '*'; many1 spacenonewline; return True } ) <|> ret
ledgercode :: Parser String ledgercode :: Parser String
ledgercode = try (do { char '('; code <- anyChar `manyTill` char ')'; many1 spacenonewline; return code } ) <|> return "" 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) ledgertransactions = (ledgertransaction <?> "transaction") `manyTill` (do {newline <?> "blank line"; return ()} <|> eof)
ledgertransaction :: Parser Transaction ledgertransaction :: Parser LedgerTransaction
ledgertransaction = do ledgertransaction = do
many1 spacenonewline many1 spacenonewline
account <- ledgeraccount account <- ledgeraccount
@ -215,7 +215,7 @@ ledgertransaction = do
many spacenonewline many spacenonewline
ledgereol ledgereol
many ledgercomment 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 -- account names may have single spaces in them, and are terminated by two or more spaces
ledgeraccount :: Parser String ledgeraccount :: Parser String
@ -289,7 +289,7 @@ o 2007/03/10 17:26:02
-} -}
ledgerfromtimelog :: Parser RawLedger ledgerfromtimelog :: Parser LedgerFile
ledgerfromtimelog = do ledgerfromtimelog = do
tl <- timelog tl <- timelog
return $ ledgerFromTimeLog tl return $ ledgerFromTimeLog tl
@ -322,7 +322,7 @@ printParseResult :: Show v => Either ParseError v -> IO ()
printParseResult r = case r of Left e -> parseError e printParseResult r = case r of Left e -> parseError e
Right v -> print v Right v -> print v
parseLedgerFile :: String -> IO (Either ParseError RawLedger) parseLedgerFile :: String -> IO (Either ParseError LedgerFile)
parseLedgerFile "-" = fmap (parse ledgerfile "-") $ hGetContents stdin parseLedgerFile "-" = fmap (parse ledgerfile "-") $ hGetContents stdin
parseLedgerFile f = parseFromFile ledgerfile f parseLedgerFile f = parseFromFile ledgerfile f

46
Tests.hs
View File

@ -65,7 +65,7 @@ parseEqual parsed other =
transaction1_str = " expenses:food:dining $10.00\n" transaction1_str = " expenses:food:dining $10.00\n"
transaction1 = Transaction "expenses:food:dining" (dollars 10) transaction1 = LedgerTransaction "expenses:food:dining" (dollars 10)
entry1_str = "\ entry1_str = "\
\2007/01/28 coopportunity\n\ \2007/01/28 coopportunity\n\
@ -74,9 +74,9 @@ entry1_str = "\
\\n" --" \\n" --"
entry1 = entry1 =
(Entry "2007/01/28" False "" "coopportunity" (LedgerEntry "2007/01/28" False "" "coopportunity"
[Transaction "expenses:food:groceries" (Amount (getcurrency "$") 47.18 2), [LedgerTransaction "expenses:food:groceries" (Amount (getcurrency "$") 47.18 2),
Transaction "assets:checking" (Amount (getcurrency "$") (-47.18) 2)]) LedgerTransaction "assets:checking" (Amount (getcurrency "$") (-47.18) 2)])
entry2_str = "\ entry2_str = "\
\2007/01/27 * joes diner\n\ \2007/01/27 * joes diner\n\
@ -206,66 +206,66 @@ ledger7_str = "\
\ assets:checking \n\ \ assets:checking \n\
\\n" --" \\n" --"
ledger7 = RawLedger ledger7 = LedgerFile
[] []
[] []
[ [
Entry { LedgerEntry {
edate="2007/01/01", estatus=False, ecode="*", edescription="opening balance", edate="2007/01/01", estatus=False, ecode="*", edescription="opening balance",
etransactions=[ etransactions=[
Transaction {taccount="assets:cash", LedgerTransaction {taccount="assets:cash",
tamount=Amount {currency=(getcurrency "$"), quantity=4.82, precision=2}}, 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}} tamount=Amount {currency=(getcurrency "$"), quantity=(-4.82), precision=2}}
] ]
} }
, ,
Entry { LedgerEntry {
edate="2007/02/01", estatus=False, ecode="*", edescription="ayres suites", edate="2007/02/01", estatus=False, ecode="*", edescription="ayres suites",
etransactions=[ etransactions=[
Transaction {taccount="expenses:vacation", LedgerTransaction {taccount="expenses:vacation",
tamount=Amount {currency=(getcurrency "$"), quantity=179.92, precision=2}}, 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}} tamount=Amount {currency=(getcurrency "$"), quantity=(-179.92), precision=2}}
] ]
} }
, ,
Entry { LedgerEntry {
edate="2007/01/02", estatus=False, ecode="*", edescription="auto transfer to savings", edate="2007/01/02", estatus=False, ecode="*", edescription="auto transfer to savings",
etransactions=[ etransactions=[
Transaction {taccount="assets:saving", LedgerTransaction {taccount="assets:saving",
tamount=Amount {currency=(getcurrency "$"), quantity=200, precision=2}}, tamount=Amount {currency=(getcurrency "$"), quantity=200, precision=2}},
Transaction {taccount="assets:checking", LedgerTransaction {taccount="assets:checking",
tamount=Amount {currency=(getcurrency "$"), quantity=(-200), precision=2}} tamount=Amount {currency=(getcurrency "$"), quantity=(-200), precision=2}}
] ]
} }
, ,
Entry { LedgerEntry {
edate="2007/01/03", estatus=False, ecode="*", edescription="poquito mas", edate="2007/01/03", estatus=False, ecode="*", edescription="poquito mas",
etransactions=[ etransactions=[
Transaction {taccount="expenses:food:dining", LedgerTransaction {taccount="expenses:food:dining",
tamount=Amount {currency=(getcurrency "$"), quantity=4.82, precision=2}}, 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}} tamount=Amount {currency=(getcurrency "$"), quantity=(-4.82), precision=2}}
] ]
} }
, ,
Entry { LedgerEntry {
edate="2007/01/03", estatus=False, ecode="*", edescription="verizon", edate="2007/01/03", estatus=False, ecode="*", edescription="verizon",
etransactions=[ etransactions=[
Transaction {taccount="expenses:phone", LedgerTransaction {taccount="expenses:phone",
tamount=Amount {currency=(getcurrency "$"), quantity=95.11, precision=2}}, 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}} tamount=Amount {currency=(getcurrency "$"), quantity=(-95.11), precision=2}}
] ]
} }
, ,
Entry { LedgerEntry {
edate="2007/01/03", estatus=False, ecode="*", edescription="discover", edate="2007/01/03", estatus=False, ecode="*", edescription="discover",
etransactions=[ etransactions=[
Transaction {taccount="liabilities:credit cards:discover", LedgerTransaction {taccount="liabilities:credit cards:discover",
tamount=Amount {currency=(getcurrency "$"), quantity=80, precision=2}}, tamount=Amount {currency=(getcurrency "$"), quantity=80, precision=2}},
Transaction {taccount="assets:checking", LedgerTransaction {taccount="assets:checking",
tamount=Amount {currency=(getcurrency "$"), quantity=(-80), precision=2}} tamount=Amount {currency=(getcurrency "$"), quantity=(-80), precision=2}}
] ]
} }

18
TimeLog.hs
View File

@ -4,9 +4,9 @@ import Utils
import Types import Types
import Currency import Currency
import Amount import Amount
import Transaction import LedgerTransaction
import Entry import LedgerEntry
import RawLedger import LedgerFile
instance Show TimeLogEntry where instance Show TimeLogEntry where
show t = printf "%s %s %s" (show $ tcode t) (tdatetime t) (tcomment t) 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 instance Show TimeLog where
show tl = printf "TimeLog with %d entries" $ length $ timelog_entries tl show tl = printf "TimeLog with %d entries" $ length $ timelog_entries tl
ledgerFromTimeLog :: TimeLog -> RawLedger ledgerFromTimeLog :: TimeLog -> LedgerFile
ledgerFromTimeLog tl = ledgerFromTimeLog tl =
RawLedger [] [] (entriesFromTimeLogEntries $ timelog_entries tl) LedgerFile [] [] (entriesFromTimeLogEntries $ timelog_entries tl)
entriesFromTimeLogEntries :: [TimeLogEntry] -> [Entry] entriesFromTimeLogEntries :: [TimeLogEntry] -> [LedgerEntry]
entriesFromTimeLogEntries [clockin] = entriesFromTimeLogEntries [clockin] =
entriesFromTimeLogEntries [clockin, clockoutNowEntry] entriesFromTimeLogEntries [clockin, clockoutNowEntry]
entriesFromTimeLogEntries [clockin,clockout] = entriesFromTimeLogEntries [clockin,clockout] =
[ [
Entry { LedgerEntry {
edate = indate, edate = indate,
estatus = True, estatus = True,
ecode = "", ecode = "",
edescription = accountname, edescription = accountname,
etransactions = [ etransactions = [
Transaction accountname amount, LedgerTransaction accountname amount,
Transaction "TIME" (-amount) LedgerTransaction "TIME" (-amount)
]} ]}
] ]
where where

90
Transaction.hs
View File

@ -1,37 +1,81 @@
module Transaction module Transaction
where where
import Utils import Utils
import Types import Types
import AccountName import AccountName
import LedgerEntry
import LedgerTransaction
import Amount 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
showTransaction :: Transaction -> String flattenEntry :: LedgerEntry -> [Transaction]
showTransaction t = (showaccountname $ taccount t) ++ " " ++ (showamount $ tamount t) flattenEntry e = [(e,t) | t <- etransactions e]
entryTransactionSetPrecision :: Int -> Transaction -> Transaction
entryTransactionSetPrecision p (e, LedgerTransaction a amt) = (e, LedgerTransaction a amt{precision=p})
accountNamesFromTransactions :: [Transaction] -> [AccountName]
accountNamesFromTransactions ts = nub $ map account ts
entryTransactionsFrom :: [LedgerEntry] -> [Transaction]
entryTransactionsFrom es = concat $ map flattenEntry es
sumEntryTransactions :: [Transaction] -> Amount
sumEntryTransactions ets =
sumTransactions $ map transaction ets
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 where
showaccountname = printf "%-22s" . elideRight 22 dummyt = (LedgerEntry "" False "" "" [], LedgerTransaction "" (dollars 0))
showamount = printf "%11s" . showAmountRoundedOrZero 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)
elideRight width s = showTransactionDescriptionAndBalance :: Transaction -> Amount -> String
case length s > width of showTransactionDescriptionAndBalance t b =
True -> take (width - 2) s ++ ".." (showEntryDescription $ entry t) ++ (showTransaction $ transaction t) ++ (showBalance b)
False -> s
autofillTransactions :: [Transaction] -> [Transaction] showTransactionAndBalance :: Transaction -> Amount -> String
autofillTransactions ts = showTransactionAndBalance t b =
let (ns, as) = partition isNormal ts (replicate 32 ' ') ++ (showTransaction $ transaction t) ++ (showBalance b)
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 :: [Transaction] -> Amount showBalance :: Amount -> String
sumTransactions = sum . map tamount showBalance b = printf " %12s" (showAmountRoundedOrZero b)
transactionSetPrecision :: Int -> Transaction -> Transaction transactionsWithAccountName :: AccountName -> [Transaction] -> [Transaction]
transactionSetPrecision p (Transaction a amt) = Transaction a amt{precision=p} 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)]

32
Types.hs
View File

@ -18,10 +18,10 @@ hledger
TimeLogEntry TimeLogEntry
Ledger Ledger
Account Account
EntryTransaction
RawLedger
Entry
Transaction Transaction
LedgerFile
LedgerEntry
LedgerTransaction
AccountName AccountName
Amount Amount
Currency Currency
@ -50,19 +50,19 @@ data Amount = Amount {
-- out the chart of accounts -- out the chart of accounts
type AccountName = String type AccountName = String
-- a flow of some amount to some account (see also EntryTransaction) -- a flow of some amount to some account (see also Transaction)
data Transaction = Transaction { data LedgerTransaction = LedgerTransaction {
taccount :: AccountName, taccount :: AccountName,
tamount :: Amount tamount :: Amount
} deriving (Eq) } deriving (Eq)
-- a ledger entry, with two or more balanced transactions -- a ledger entry, with two or more balanced transactions
data Entry = Entry { data LedgerEntry = LedgerEntry {
edate :: Date, edate :: Date,
estatus :: EntryStatus, estatus :: EntryStatus,
ecode :: String, ecode :: String,
edescription :: String, edescription :: String,
etransactions :: [Transaction] etransactions :: [LedgerTransaction]
} deriving (Eq) } deriving (Eq)
type EntryStatus = Bool type EntryStatus = Bool
@ -70,13 +70,13 @@ type EntryStatus = Bool
-- an "=" automated entry (ignored) -- an "=" automated entry (ignored)
data ModifierEntry = ModifierEntry { data ModifierEntry = ModifierEntry {
valueexpr :: String, valueexpr :: String,
m_transactions :: [Transaction] m_transactions :: [LedgerTransaction]
} deriving (Eq) } deriving (Eq)
-- a "~" periodic entry (ignored) -- a "~" periodic entry (ignored)
data PeriodicEntry = PeriodicEntry { data PeriodicEntry = PeriodicEntry {
periodexpr :: String, periodexpr :: String,
p_transactions :: [Transaction] p_transactions :: [LedgerTransaction]
} deriving (Eq) } deriving (Eq)
-- we also parse timeclock.el timelogs -- we also parse timeclock.el timelogs
@ -91,28 +91,28 @@ data TimeLog = TimeLog {
} deriving (Eq) } deriving (Eq)
-- a parsed ledger file -- a parsed ledger file
data RawLedger = RawLedger { data LedgerFile = LedgerFile {
modifier_entries :: [ModifierEntry], modifier_entries :: [ModifierEntry],
periodic_entries :: [PeriodicEntry], periodic_entries :: [PeriodicEntry],
entries :: [Entry] entries :: [LedgerEntry]
} deriving (Eq) } deriving (Eq)
-- We convert Transactions into EntryTransactions, which are (entry, -- We convert Transactions into EntryTransactions, which are (entry,
-- transaction) pairs, since I couldn't see how to have transactions -- transaction) pairs, since I couldn't see how to have transactions
-- reference their entry like in OO. These are referred to as just -- reference their entry like in OO. These are referred to as just
-- "transactions" in modules above EntryTransaction. -- "transactions" in modules above Transaction.
type EntryTransaction = (Entry,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 { data Account = Account {
aname :: AccountName, aname :: AccountName,
atransactions :: [EntryTransaction], -- excludes sub-accounts atransactions :: [Transaction], -- excludes sub-accounts
abalance :: Amount -- includes sub-accounts abalance :: Amount -- includes sub-accounts
} }
-- a ledger with account info cached for faster queries -- a ledger with account info cached for faster queries
data Ledger = Ledger { data Ledger = Ledger {
rawledger :: RawLedger, rawledger :: LedgerFile,
accountnametree :: Tree AccountName, accountnametree :: Tree AccountName,
accounts :: Map.Map AccountName Account, accounts :: Map.Map AccountName Account,
lprecision :: Int lprecision :: Int

4
hledger.hs
View File

@ -75,7 +75,7 @@ doWithLedger :: [Flag] -> (Ledger -> IO ()) -> IO ()
doWithLedger opts cmd = do doWithLedger opts cmd = do
ledgerFilePath opts >>= parseLedgerFile >>= doWithParsed cmd ledgerFilePath opts >>= parseLedgerFile >>= doWithParsed cmd
doWithParsed :: (Ledger -> IO ()) -> (Either ParseError RawLedger) -> IO () doWithParsed :: (Ledger -> IO ()) -> (Either ParseError LedgerFile) -> IO ()
doWithParsed cmd parsed = do doWithParsed cmd parsed = do
case parsed of Left e -> parseError e case parsed of Left e -> parseError e
Right l -> cmd $ cacheLedger l Right l -> cmd $ cacheLedger l
@ -85,7 +85,7 @@ doWithParsed cmd parsed = do
interactive testing: interactive testing:
*Main> p <- ledgerFilePath [File "./test.dat"] >>= parseLedgerFile *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 l = cacheLedger r
*Main> let ant = accountnametree l *Main> let ant = accountnametree l
*Main> let at = accounts l *Main> let at = accounts l