From 568e7524844bfad813360d2c74f873ac827289d4 Mon Sep 17 00:00:00 2001
From: Simon Michael <simon@joyful.com>
Date: Mon, 25 May 2009 17:28:41 +0000
Subject: [PATCH] allow parentheses and brackets inside account names, as
 ledger does

---
 Ledger/AccountName.hs |  5 +++++
 Ledger/Parse.hs       | 42 +++++++++---------------------------------
 Ledger/Posting.hs     |  6 ++++++
 Tests.hs              | 10 ++++++++++
 4 files changed, 30 insertions(+), 33 deletions(-)

diff --git a/Ledger/AccountName.hs b/Ledger/AccountName.hs
index 33a3a6627..5b91f4f19 100644
--- a/Ledger/AccountName.hs
+++ b/Ledger/AccountName.hs
@@ -23,6 +23,11 @@ accountNameFromComponents = concat . intersperse [acctsepchar]
 accountLeafName :: AccountName -> String
 accountLeafName = last . accountNameComponents
 
+unbracket :: String -> String
+unbracket s
+    | (head s == '[' && last s == ']') || (head s == '(' && last s == ')') = init $ tail s
+    | otherwise = s
+
 accountNameLevel :: AccountName -> Int
 accountNameLevel "" = 0
 accountNameLevel a = (length $ filter (==acctsepchar) a) + 1
diff --git a/Ledger/Parse.hs b/Ledger/Parse.hs
index 9b8c56e90..4c37492ab 100644
--- a/Ledger/Parse.hs
+++ b/Ledger/Parse.hs
@@ -23,8 +23,10 @@ import Data.Time.Calendar
 import Ledger.Utils
 import Ledger.Types
 import Ledger.Dates
+import Ledger.AccountName
 import Ledger.Amount
 import Ledger.LedgerTransaction
+import Ledger.Posting
 import Ledger.Commodity
 import Ledger.TimeLog
 import Ledger.RawLedger
@@ -362,43 +364,17 @@ ledgerpostings :: GenParser Char LedgerFileCtx [Posting]
 ledgerpostings = many1 $ try ledgerposting
 
 ledgerposting :: GenParser Char LedgerFileCtx Posting
-ledgerposting = many1 spacenonewline >> choice [ normalposting, virtualposting, balancedvirtualposting ]
-
-normalposting :: GenParser Char LedgerFileCtx Posting
-normalposting = do
+ledgerposting = do
+  many1 spacenonewline
   status <- ledgerstatus
   account <- transactionaccountname
+  let (ptype, account') = (postingTypeFromAccountName account, unbracket account)
   amount <- postingamount
   many spacenonewline
   comment <- ledgercomment
   restofline
   parent <- getParentAccount
-  return (Posting status account amount comment RegularPosting)
-
-virtualposting :: GenParser Char LedgerFileCtx Posting
-virtualposting = do
-  status <- ledgerstatus
-  char '('
-  account <- transactionaccountname
-  char ')'
-  amount <- postingamount
-  many spacenonewline
-  comment <- ledgercomment
-  restofline
-  parent <- getParentAccount
-  return (Posting status account amount comment VirtualPosting)
-
-balancedvirtualposting :: GenParser Char LedgerFileCtx Posting
-balancedvirtualposting = do
-  status <- ledgerstatus
-  char '['
-  account <- transactionaccountname
-  char ']'
-  amount <- postingamount
-  many spacenonewline
-  comment <- ledgercomment
-  restofline
-  return (Posting status account amount comment BalancedVirtualPosting)
+  return (Posting status account' amount comment ptype)
 
 -- Qualify with the parent account from parsing context
 transactionaccountname :: GenParser Char LedgerFileCtx AccountName
@@ -407,15 +383,15 @@ transactionaccountname = liftM2 (++) getParentAccount ledgeraccountname
 -- | account names may have single spaces inside them, and are terminated by two or more spaces
 ledgeraccountname :: GenParser Char st String
 ledgeraccountname = do
-    accountname <- many1 (accountnamechar <|> singlespace)
+    accountname <- many1 (nonspace <|> singlespace)
     return $ striptrailingspace accountname
     where 
       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)"
+-- accountnamechar = notFollowedBy (oneOf "()[]") >> nonspace
+--     <?> "account name character (non-bracket, non-parenthesis, non-whitespace)"
 
 postingamount :: GenParser Char st MixedAmount
 postingamount =
diff --git a/Ledger/Posting.hs b/Ledger/Posting.hs
index 8a0f9adb7..4e8320e1b 100644
--- a/Ledger/Posting.hs
+++ b/Ledger/Posting.hs
@@ -43,3 +43,9 @@ isBalancedVirtual p = ptype p == BalancedVirtualPosting
 
 hasAmount :: Posting -> Bool
 hasAmount = (/= missingamt) . pamount
+
+postingTypeFromAccountName a
+    | head a == '[' && last a == ']' = BalancedVirtualPosting
+    | head a == '(' && last a == ')' = VirtualPosting
+    | otherwise = RegularPosting
+
diff --git a/Tests.hs b/Tests.hs
index c610e0d18..6ecd1c399 100644
--- a/Tests.hs
+++ b/Tests.hs
@@ -141,6 +141,16 @@ hledger: could not balance this transaction, amounts do not add up to zero:
 
 
 --@
+
+@
+$ printf "2009-01-01 x\n  a  2\n  b (b) b  -1\n  c\n" | hledger -f - print 2>&1; true
+2009/01/01 x
+    a                                              2
+    b (b) b                                       -1
+    c
+
+@
+
 -}
 -- other test tools:
 -- http://hackage.haskell.org/cgi-bin/hackage-scripts/package/test-framework