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

parse virtual and balanced virtual transactions, refactor register and transaction output

Browse Source
This commit is contained in:
Simon Michael 2008-10-16 06:00:46 +00:00
parent 014723497f
commit dce8fd0dde
8 changed files with 99 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
Ledger/Parse.hs
View File

@ -250,7 +250,9 @@ ledgercode :: Parser String
ledgercode = try (do { char '('; code <- anyChar `manyTill` char ')'; many1 spacenonewline; return code } ) <|> return ""
ledgertransactions :: Parser [RawTransaction]
ledgertransactions = (ledgertransaction <?> "transaction") `manyTill` (do {newline <?> "blank line"; return ()} <|> eof)
ledgertransactions =
((try virtualtransaction <|> try balancedvirtualtransaction <|> ledgertransaction) <?> "transaction")
`manyTill` (do {newline <?> "blank line"; return ()} <|> eof)
ledgertransaction :: Parser RawTransaction
ledgertransaction = do
@ -260,7 +262,31 @@ ledgertransaction = do
many spacenonewline
comment <- ledgercomment
restofline
return (RawTransaction account amount comment)
return (RawTransaction account amount comment RegularTransaction)
virtualtransaction :: Parser RawTransaction
virtualtransaction = do
many1 spacenonewline
char '('
account <- ledgeraccountname
char ')'
amount <- transactionamount
many spacenonewline
comment <- ledgercomment
restofline
return (RawTransaction account amount comment VirtualTransaction)
balancedvirtualtransaction :: Parser RawTransaction
balancedvirtualtransaction = do
many1 spacenonewline
char '['
account <- ledgeraccountname
char ']'
amount <- transactionamount
many spacenonewline
comment <- ledgercomment
restofline
return (RawTransaction account amount comment BalancedVirtualTransaction)
-- | account names may have single spaces inside them, and are terminated by two or more spaces
ledgeraccountname :: Parser String
@ -268,11 +294,13 @@ ledgeraccountname = do
accountname <- many1 (accountnamechar <|> singlespace)
return $ striptrailingspace accountname
where
accountnamechar = nonspace <?> "account name character"
singlespace = try (do {spacenonewline; do {notFollowedBy spacenonewline; return ' '}})
-- couldn't avoid consuming a final space sometimes, harmless
striptrailingspace s = if last s == ' ' then init s else s
accountnamechar = notFollowedBy (oneOf "()[]") >> nonspace
<?> "account name character (non-bracket, non-parenthesis, non-whitespace)"
transactionamount :: Parser Amount
transactionamount =
try (do

2
Ledger/RawLedger.hs
View File

@ -103,7 +103,7 @@ normaliseRawLedgerAmounts l@(RawLedger ms ps es f) = RawLedger ms ps es' f
es' = map normaliseEntryAmounts es
normaliseEntryAmounts (Entry d s c desc comm ts pre) = Entry d s c desc comm ts' pre
where ts' = map normaliseRawTransactionAmounts ts
normaliseRawTransactionAmounts (RawTransaction acct a c) = RawTransaction acct a' c
normaliseRawTransactionAmounts (RawTransaction acct a c t) = RawTransaction acct a' c t
where a' = normaliseAmount a
normaliseAmount (Amount c q) = Amount (firstoccurrenceof c) q
firstcommodities = nubBy samesymbol $ allcommodities

6
Ledger/RawTransaction.hs
View File

@ -13,10 +13,10 @@ import Ledger.Amount
import Ledger.AccountName
instance Show RawTransaction where show = showLedgerTransaction
instance Show RawTransaction where show = showRawTransaction
showLedgerTransaction :: RawTransaction -> String
showLedgerTransaction t = (showaccountname $ taccount t) ++ " " ++ (showamount $ tamount t)
showRawTransaction :: RawTransaction -> String
showRawTransaction t = (showaccountname $ taccount t) ++ " " ++ (showamount $ tamount t)
where
showaccountname = printf "%-22s" . elideAccountName 22
showamount = printf "%12s" . showAmountOrZero

4
Ledger/TimeLog.hs
View File

@ -58,6 +58,6 @@ entryFromTimeLogInOut i o =
intime = parsedatetime $ tldatetime i
outtime = parsedatetime $ tldatetime o
amount = hours $ realToFrac (diffUTCTime outtime intime) / 3600
txns = [RawTransaction acctname amount ""
--,RawTransaction "assets:time" (-amount) ""
txns = [RawTransaction acctname amount "" RegularTransaction
--,RawTransaction "assets:time" (-amount) "" RegularTransaction
]

10
Ledger/Transaction.hs
View File

@ -14,15 +14,17 @@ import Ledger.RawTransaction
import Ledger.Amount
instance Show Transaction where
show (Transaction eno d desc a amt) = unwords [d,desc,a,show amt]
instance Show Transaction where show=showTransaction
showTransaction :: Transaction -> String
showTransaction (Transaction eno d desc a amt ttype) = unwords [d,desc,a,show amt,show ttype]
-- | Convert a 'Entry' 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 _ _ desc _ ts _, e) =
[Transaction e d desc (taccount t) (tamount t) | t <- ts]
[Transaction e d desc (taccount t) (tamount t) (rttype t) | t <- ts]
accountNamesFromTransactions :: [Transaction] -> [AccountName]
accountNamesFromTransactions ts = nub $ map account ts
@ -30,4 +32,4 @@ accountNamesFromTransactions ts = nub $ map account ts
sumTransactions :: [Transaction] -> Amount
sumTransactions = sum . map amount
nulltxn = Transaction 0 "" "" "" nullamt
nulltxn = Transaction 0 "" "" "" nullamt RegularTransaction

9
Ledger/Types.hs
View File

@ -36,10 +36,14 @@ data Amount = Amount {
type AccountName = String
data TransactionType = RegularTransaction | VirtualTransaction | BalancedVirtualTransaction
deriving (Eq,Show)
data RawTransaction = RawTransaction {
taccount :: AccountName,
tamount :: Amount,
tcomment :: String
tcomment :: String,
rttype :: TransactionType
} deriving (Eq)
-- | a ledger "modifier" entry. Currently ignored.
@ -86,7 +90,8 @@ data Transaction = Transaction {
date :: Date,
description :: String,
account :: AccountName,
amount :: Amount
amount :: Amount,
ttype :: TransactionType
} deriving (Eq)
data Account = Account {

33
RegisterCommand.hs
View File

@ -19,28 +19,35 @@ showTransactionsWithBalances opts args l =
unlines $ showTransactionsWithBalances' ts nulltxn startingbalance
where
ts = filter matchtxn $ ledgerTransactions l
matchtxn (Transaction _ _ desc acct _) = matchLedgerPatterns False apats acct
matchtxn (Transaction _ _ desc acct _ _) = matchLedgerPatterns False apats acct
apats = fst $ parseAccountDescriptionArgs args
startingbalance = nullamt
showTransactionsWithBalances' :: [Transaction] -> Transaction -> Amount -> [String]
showTransactionsWithBalances' [] _ _ = []
showTransactionsWithBalances' (t:ts) tprev b =
(if sameentry t tprev
then [showTransactionAndBalance t b']
else [showTransactionDescriptionAndBalance t b'])
++ (showTransactionsWithBalances' ts t b')
showTransactionsWithBalances' (t:ts) tprev b = this ++ rest
where
b' = b + (amount t)
sameentry (Transaction e1 _ _ _ _) (Transaction e2 _ _ _ _) = e1 == e2
sameentry (Transaction {entryno=e1}) (Transaction {entryno=e2}) = e1 == e2
this = if sameentry t tprev
then [showTransactionWithoutDescription t b']
else [showTransactionWithDescription t b']
rest = showTransactionsWithBalances' ts t b'
showTransactionDescriptionAndBalance :: Transaction -> Amount -> String
showTransactionDescriptionAndBalance t b =
showTransactionWithDescription :: Transaction -> Amount -> String
showTransactionWithDescription t b =
(showEntryDescription $ Entry (date t) False "" (description t) "" [] "")
++ (showLedgerTransaction $ RawTransaction (account t) (amount t) "") ++ (showBalance b)
++ (showTransactionFormatted t)
++ (showBalance b)
showTransactionAndBalance :: Transaction -> Amount -> String
showTransactionAndBalance t b =
(replicate 32 ' ') ++ (showLedgerTransaction $ RawTransaction (account t) (amount t) "") ++ (showBalance b)
showTransactionWithoutDescription :: Transaction -> Amount -> String
showTransactionWithoutDescription t b =
(replicate 32 ' ')
++ (showTransactionFormatted t)
++ (showBalance b)
showTransactionFormatted :: Transaction -> String
showTransactionFormatted (Transaction eno d desc a amt ttype) =
showRawTransaction $ RawTransaction a amt "" ttype
showBalance :: Amount -> String
showBalance b = printf " %12s" (showAmountOrZero b)

42
Tests.hs
View File

@ -230,7 +230,7 @@ assertparseequal expected parsed = either printParseError (assertequal expected)
rawtransaction1_str = " expenses:food:dining $10.00\n"
rawtransaction1 = RawTransaction "expenses:food:dining" (dollars 10) ""
rawtransaction1 = RawTransaction "expenses:food:dining" (dollars 10) "" RegularTransaction
entry1_str = "\
\2007/01/28 coopportunity\n\
@ -240,8 +240,8 @@ entry1_str = "\
entry1 =
(Entry "2007/01/28" False "" "coopportunity" ""
[RawTransaction "expenses:food:groceries" (dollars 47.18) "",
RawTransaction "assets:checking" (dollars (-47.18)) ""] "")
[RawTransaction "expenses:food:groceries" (dollars 47.18) "" RegularTransaction,
RawTransaction "assets:checking" (dollars (-47.18)) "" RegularTransaction] "")
entry2_str = "\
@ -386,12 +386,14 @@ rawledger7 = RawLedger
RawTransaction {
taccount="assets:cash",
tamount=dollars 4.82,
tcomment=""
tcomment="",
rttype=RegularTransaction
},
RawTransaction {
taccount="equity:opening balances",
tamount=dollars (-4.82),
tcomment=""
tcomment="",
rttype=RegularTransaction
}
],
epreceding_comment_lines=""
@ -407,12 +409,14 @@ rawledger7 = RawLedger
RawTransaction {
taccount="expenses:vacation",
tamount=dollars 179.92,
tcomment=""
tcomment="",
rttype=RegularTransaction
},
RawTransaction {
taccount="assets:checking",
tamount=dollars (-179.92),
tcomment=""
tcomment="",
rttype=RegularTransaction
}
],
epreceding_comment_lines=""
@ -428,12 +432,14 @@ rawledger7 = RawLedger
RawTransaction {
taccount="assets:saving",
tamount=dollars 200,
tcomment=""
tcomment="",
rttype=RegularTransaction
},
RawTransaction {
taccount="assets:checking",
tamount=dollars (-200),
tcomment=""
tcomment="",
rttype=RegularTransaction
}
],
epreceding_comment_lines=""
@ -449,12 +455,14 @@ rawledger7 = RawLedger
RawTransaction {
taccount="expenses:food:dining",
tamount=dollars 4.82,
tcomment=""
tcomment="",
rttype=RegularTransaction
},
RawTransaction {
taccount="assets:cash",
tamount=dollars (-4.82),
tcomment=""
tcomment="",
rttype=RegularTransaction
}
],
epreceding_comment_lines=""
@ -470,12 +478,14 @@ rawledger7 = RawLedger
RawTransaction {
taccount="expenses:phone",
tamount=dollars 95.11,
tcomment=""
tcomment="",
rttype=RegularTransaction
},
RawTransaction {
taccount="assets:checking",
tamount=dollars (-95.11),
tcomment=""
tcomment="",
rttype=RegularTransaction
}
],
epreceding_comment_lines=""
@ -491,12 +501,14 @@ rawledger7 = RawLedger
RawTransaction {
taccount="liabilities:credit cards:discover",
tamount=dollars 80,
tcomment=""
tcomment="",
rttype=RegularTransaction
},
RawTransaction {
taccount="assets:checking",
tamount=dollars (-80),
tcomment=""
tcomment="",
rttype=RegularTransaction
}
],
epreceding_comment_lines=""