mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-07 12:15:46 +03:00
renamed types: RawLedger, Entry, Transaction, EntryTransaction -> LedgerFile, LedgerEntry, LedgerTransaction, Transaction
This commit is contained in:
parent
0d8bd83b7f
commit
a1b060f4cf
@ -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
|
||||
|
@ -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
18
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
|
||||
|
@ -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
|
@ -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))
|
37
LedgerTransaction.hs
Normal file
37
LedgerTransaction.hs
Normal 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
16
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
|
||||
|
||||
|
20
Parse.hs
20
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
|
||||
|
||||
|
46
Tests.hs
46
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}}
|
||||
]
|
||||
}
|
||||
|
18
TimeLog.hs
18
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
|
||||
|
@ -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)]
|
||||
|
34
Types.hs
34
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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user