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

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

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

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
+showRawTransaction :: RawTransaction -> String
-showLedgerTransaction t = (showaccountname $ taccount t) ++ " " ++ (showamount $ tamount t) 
+showRawTransaction t = (showaccountname $ taccount t) ++ " " ++ (showamount $ tamount t) 
     where
       showaccountname = printf "%-22s" . elideAccountName 22
       showamount = printf "%12s" . showAmountOrZero

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 ""
+      txns     = [RawTransaction acctname amount "" RegularTransaction
-                 --,RawTransaction "assets:time" (-amount) ""
+                 --,RawTransaction "assets:time" (-amount) "" RegularTransaction
                  ]

Ledger/Transaction.hs

@@ -14,15 +14,17 @@ import Ledger.RawTransaction
 import Ledger.Amount
 
 
-instance Show Transaction where 
+instance Show Transaction where show=showTransaction
-    show (Transaction eno d desc a amt) = unwords [d,desc,a,show amt]
+
+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

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 {

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 =
+          showTransactionsWithBalances' (t:ts) tprev b = this ++ rest
-              (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
+                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
+showTransactionWithDescription :: Transaction -> Amount -> String
-showTransactionDescriptionAndBalance t b =
+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
+showTransactionWithoutDescription :: Transaction -> Amount -> String
-showTransactionAndBalance t b =
+showTransactionWithoutDescription t b = 
-    (replicate 32 ' ') ++ (showLedgerTransaction $ RawTransaction (account t) (amount t) "") ++ (showBalance 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)

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 "expenses:food:groceries" (dollars 47.18) "" RegularTransaction, 
-      RawTransaction "assets:checking" (dollars (-47.18)) ""] "")
+      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=""