allow parentheses and brackets inside account names, as ledger does

This commit is contained in:
Simon Michael 2009-05-25 17:28:41 +00:00
parent fe5498f6c2
commit 568e752484
4 changed files with 30 additions and 33 deletions

View File

@ -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

View File

@ -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 =

View File

@ -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

View File

@ -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