diff --git a/Ledger/Parse.hs b/Ledger/Parse.hs index cadd52bad..492c204b8 100644 --- a/Ledger/Parse.hs +++ b/Ledger/Parse.hs @@ -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 diff --git a/Ledger/RawLedger.hs b/Ledger/RawLedger.hs index 66662ffce..b983dfb60 100644 --- a/Ledger/RawLedger.hs +++ b/Ledger/RawLedger.hs @@ -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 diff --git a/Ledger/RawTransaction.hs b/Ledger/RawTransaction.hs index a50507df2..f55d859f0 100644 --- a/Ledger/RawTransaction.hs +++ b/Ledger/RawTransaction.hs @@ -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 diff --git a/Ledger/TimeLog.hs b/Ledger/TimeLog.hs index ed81c1708..90c5e3f8c 100644 --- a/Ledger/TimeLog.hs +++ b/Ledger/TimeLog.hs @@ -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 ] diff --git a/Ledger/Transaction.hs b/Ledger/Transaction.hs index 3de529521..55bee7c08 100644 --- a/Ledger/Transaction.hs +++ b/Ledger/Transaction.hs @@ -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 diff --git a/Ledger/Types.hs b/Ledger/Types.hs index 47e8da38e..722441236 100644 --- a/Ledger/Types.hs +++ b/Ledger/Types.hs @@ -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 { diff --git a/RegisterCommand.hs b/RegisterCommand.hs index 20e3665fd..9fa0d1af4 100644 --- a/RegisterCommand.hs +++ b/RegisterCommand.hs @@ -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') - where - b' = b + (amount t) - sameentry (Transaction e1 _ _ _ _) (Transaction e2 _ _ _ _) = e1 == e2 + showTransactionsWithBalances' (t:ts) tprev b = this ++ rest + where + b' = b + (amount t) + 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) diff --git a/Tests.hs b/Tests.hs index 5bf0d4906..b6d4b03e4 100644 --- a/Tests.hs +++ b/Tests.hs @@ -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=""