fix txn & posting comment parsing & printing; better unit tests

This commit is contained in:
Simon Michael 2012-05-15 01:49:05 +00:00
parent c911cc51ab
commit 56cf9b21cb
6 changed files with 359 additions and 176 deletions

110
MANUAL.md
View File

@ -259,62 +259,6 @@ Example:
$ hledger register checking --effective $ hledger register checking --effective
2010/02/19 movie ticket assets:checking $-10 $-10 2010/02/19 movie ticket assets:checking $-10 $-10
### Comments
A semicolon in the journal file marks the start of a comment. You can
write comments on their own line between transactions, like so:
; Also known as a "journal comment". Whitespace before the ; is allowed.
You can also write transaction- or posting-specific comments following the
transaction's first line or the posting, on the same line and/or indented
on following lines. Some examples:
; a journal comment
2012/5/14 something ; and now a transaction comment
; another comment for this transaction
posting1 1 ; a comment for posting 1
posting2
; a comment for posting 2
; another comment for posting 2
; another journal comment (because not indented)
Currently `print` preserves transaction and posting comments but not
journal comments. (And currently the output is a bit broken..)
A "tag comment" is a transaction or posting comment containing a tag,
explained in the next section.
### Tags
You can attach arbitrary extra data tags to transactions and postings, and
then filter reports by tag (this is the same as Ledger's
[metadata](http://ledger-cli.org/3.0/doc/ledger3.html#Metadata) feature,
except our tag values are simple strings.) Here's how it works: each tag
is a key-value pair within its own transaction or posting comment. The
format is
; NAME: VALUE
where NAME is a word with no spaces in it and VALUE is the rest of the
line, with leading and trailing whitespace trimmed (or it can be empty).
Here's an example:
; this transaction has a "purpose" tag with value "research",
; and its expenses:cinema posting has "fun" and "outing" tags
1/1 movie ticket
; purpose: research
expenses:cinema $10
; fun:
; outing:
assets:checking
Filtering reports by tag is work in progress. For the moment, you can
match transactions' or postings' tag values by adding `tag NAME=VALUE` on
the command line. VALUE must be exact, you can't test for a tag's
existence, postings don't inherit their transaction's tags and this isn't
yet supported in the web interface.
### Default commodity ### Default commodity
You can set a default commodity or currency with a D directive. This will You can set a default commodity or currency with a D directive. This will
@ -381,6 +325,60 @@ hledger currently ignores them. They look like this:
P 2009/1/1 € $1.35 P 2009/1/1 € $1.35
P 2010/1/1 € $1.40 P 2010/1/1 € $1.40
### Comments
A semicolon in the journal file marks the start of a comment. You can
write comments on their own line between transactions, like so:
; Also known as a "journal comment". Whitespace before the ; is allowed.
You can also write transaction- or posting-specific comments following the
transaction's first line or the posting, on the same line and/or indented
on following lines. Some examples:
; a journal comment
2012/5/14 something ; and now a transaction comment
; another comment for this transaction
posting1 1 ; a comment for posting 1
posting2
; a comment for posting 2
; another comment for posting 2
; another journal comment (because not indented)
Currently `print` preserves transaction and posting comments but not
journal comments.
A "tag comment" is a transaction or posting comment containing a tag,
explained in the next section.
### Tags
You can attach arbitrary extra data tags to transactions and postings, and
then filter reports by tag (this is the same as Ledger's
[metadata](http://ledger-cli.org/3.0/doc/ledger3.html#Metadata) feature,
except our tag values are simple strings.) Here's how it works: each tag
is a key-value pair within its own transaction or posting comment. The
format is
; NAME: VALUE
where NAME is a word with no spaces in it and VALUE is the rest of the
line, with leading and trailing whitespace trimmed (or it can be empty).
Here's an example:
; this transaction has a "purpose" tag with value "research",
; and its expenses:cinema posting has "fun" and "outing" tags
1/1 movie ticket
; purpose: research
expenses:cinema $10
; fun:
; outing:
assets:checking
Filtering reports by tag is work in progress. For the moment, you can
match transactions' or postings' tag values by adding `tag
NAME=EXACTVALUE` on the command line.
### Including other files ### Including other files
You can pull in the content of additional journal files, by writing lines like this: You can pull in the content of additional journal files, by writing lines like this:

View File

@ -92,33 +92,113 @@ showTransaction = showTransaction' True
showTransactionUnelided :: Transaction -> String showTransactionUnelided :: Transaction -> String
showTransactionUnelided = showTransaction' False showTransactionUnelided = showTransaction' False
-- XXX similar to showPosting, refactor tests_showTransactionUnelided = [
"showTransactionUnelided" ~: do
let t `gives` s = assertEqual "" s (showTransactionUnelided t)
nulltransaction `gives` "0000/01/01\n\n"
nulltransaction{
tdate=parsedate "2012/05/14",
teffectivedate=Just $ parsedate "2012/05/15",
tstatus=False,
tcode="code",
tdescription="desc",
tcomment="tcomment1\ntcomment2\n",
tmetadata=[("ttag1","val1")],
tpostings=[
nullposting{
pstatus=True,
paccount="a",
pamount=Mixed [dollars 1, hours 2],
pcomment="pcomment1\npcomment2\n",
ptype=RegularPosting,
pmetadata=[("ptag1","val1"),("ptag2","val2")]
}
]
}
`gives` unlines [
"2012/05/14=2012/05/15 (code) desc ; tcomment1",
" ; tcomment2",
" ; ttag1: val1",
" $1.00",
" * a 2.0h ; pcomment1",
" ; pcomment2",
" ; ptag1: val1",
" ; ptag2: val2",
""
]
]
-- XXX overlaps showPosting
showTransaction' :: Bool -> Transaction -> String showTransaction' :: Bool -> Transaction -> String
showTransaction' elide t = showTransaction' elide t =
unlines $ [description] ++ (metadataAsLines $ tmetadata t) ++ (postingsAsLines (tpostings t)) ++ [""] unlines $ [descriptionline]
++ commentlines
++ (metadataAsLines $ tmetadata t)
++ (postingsAsLines elide t (tpostings t))
++ [""]
where where
description = concat [date, status, code, desc, comment] descriptionline = rstrip $ concat [date, status, code, desc, firstcomment]
date = showdate (tdate t) ++ maybe "" showedate (teffectivedate t) date = showdate (tdate t) ++ maybe "" showedate (teffectivedate t)
showdate = printf "%-10s" . showDate showdate = printf "%-10s" . showDate
showedate = printf "=%s" . showdate showedate = printf "=%s" . showdate
status = if tstatus t then " *" else "" status = if tstatus t then " *" else ""
code = if length (tcode t) > 0 then printf " (%s)" $ tcode t else "" code = if length (tcode t) > 0 then printf " (%s)" $ tcode t else ""
desc = if null d then "" else " " ++ d where d = tdescription t desc = if null d then "" else " " ++ d where d = tdescription t
comment = if null c then "" else " ; " ++ c where c = tcomment t (firstcomment, commentlines) = commentLines $ tcomment t
postingsAsLines ps
| elide && length ps > 1 && isTransactionBalanced Nothing t -- imprecise balanced check -- Render a transaction or posting's comment as indented & prefixed comment lines.
= (concatMap postingAsLines $ init ps) ++ postingNoAmtAsLines (last ps) commentLines :: String -> (String, [String])
| otherwise = concatMap postingAsLines ps commentLines s
where | null s = ("", [])
postingAsLines p = [concatTopPadded [showacct p, " ", showamt (pamount p), showComment (pcomment p)]] ++ postingMetadataAsLines p | otherwise = (" ; " ++ first, map (indent . ("; "++)) rest)
postingNoAmtAsLines p = [rstrip $ showacct p ++ " " ++ showComment (pcomment p)] ++ postingMetadataAsLines p where (first:rest) = lines s
showacct p =
" " ++ showstatus p ++ printf (printf "%%-%ds" w) (showAccountName Nothing (ptype p) (paccount p)) postingsAsLines :: Bool -> Transaction -> [Posting] -> [String]
where postingsAsLines elide t ps
showstatus p = if pstatus p then "* " else "" | elide && length ps > 1 && isTransactionBalanced Nothing t -- imprecise balanced check
w = maximum $ map (length . paccount) ps = (concatMap (postingAsLines False ps) $ init ps) ++ postingAsLines True ps (last ps)
showamt = | otherwise = concatMap (postingAsLines False ps) ps
padleft 12 . showMixedAmount
postingAsLines :: Bool -> [Posting] -> Posting -> [String]
postingAsLines elideamount ps p =
postinglines
++ commentlines
++ metadataAsLines (pmetadata p)
where
postinglines = map rstrip $ lines $ concatTopPadded [showacct p, " ", amount, firstcomment]
amount = if elideamount then "" else showamt (pamount p)
(firstcomment, commentlines) = commentLines $ pcomment p
showacct p =
indent $ showstatus p ++ printf (printf "%%-%ds" w) (showAccountName Nothing (ptype p) (paccount p))
where
showstatus p = if pstatus p then "* " else ""
w = maximum $ map (length . paccount) ps
showamt =
padleft 12 . showMixedAmount
tests_postingAsLines = [
"postingAsLines" ~: do
let p `gives` ls = assertEqual "" ls (postingAsLines False [p] p)
nullposting `gives` [" 0"]
nullposting{
pstatus=True,
paccount="a",
pamount=Mixed [dollars 1, hours 2],
pcomment="pcomment1\npcomment2\n",
ptype=RegularPosting,
pmetadata=[("ptag1","val1"),("ptag2","val2")]
}
`gives` [
" $1.00",
" * a 2.0h ; pcomment1",
" ; pcomment2",
" ; ptag1: val1",
" ; ptag2: val2"
]
]
indent :: String -> String
indent = (" "++)
-- | Show an account name, clipped to the given width if any, and -- | Show an account name, clipped to the given width if any, and
-- appropriately bracketed/parenthesised for the given posting type. -- appropriately bracketed/parenthesised for the given posting type.
@ -283,7 +363,10 @@ txnTieKnot t@Transaction{tpostings=ps} = t{tpostings=map (settxn t) ps}
settxn :: Transaction -> Posting -> Posting settxn :: Transaction -> Posting -> Posting
settxn t p = p{ptransaction=Just t} settxn t p = p{ptransaction=Just t}
tests_Hledger_Data_Transaction = TestList [ tests_Hledger_Data_Transaction = TestList $ concat [
tests_postingAsLines,
tests_showTransactionUnelided,
[
"showTransaction" ~: do "showTransaction" ~: do
assertEqual "show a balanced transaction, eliding last amount" assertEqual "show a balanced transaction, eliding last amount"
(unlines (unlines
@ -343,7 +426,7 @@ tests_Hledger_Data_Transaction = TestList [
assertEqual "show a transaction with one posting and a missing amount" assertEqual "show a transaction with one posting and a missing amount"
(unlines (unlines
["2007/01/28 coopportunity" ["2007/01/28 coopportunity"
," expenses:food:groceries " ," expenses:food:groceries"
,"" ,""
]) ])
(showTransaction (showTransaction
@ -356,7 +439,7 @@ tests_Hledger_Data_Transaction = TestList [
(unlines (unlines
["2010/01/01 x" ["2010/01/01 x"
," a 1 @ $2" ," a 1 @ $2"
," b " ," b"
,"" ,""
]) ])
(showTransaction (showTransaction
@ -442,4 +525,4 @@ tests_Hledger_Data_Transaction = TestList [
] "" ] ""
assertBool "balanced virtual postings need to balance among themselves (2)" (isTransactionBalanced Nothing t) assertBool "balanced virtual postings need to balance among themselves (2)" (isTransactionBalanced Nothing t)
] ]]

View File

@ -93,7 +93,7 @@ data Posting = Posting {
pstatus :: Bool, pstatus :: Bool,
paccount :: AccountName, paccount :: AccountName,
pamount :: MixedAmount, pamount :: MixedAmount,
pcomment :: String, pcomment :: String, -- ^ this posting's non-tag comment lines, as a single non-indented string
ptype :: PostingType, ptype :: PostingType,
pmetadata :: [(String,String)], pmetadata :: [(String,String)],
ptransaction :: Maybe Transaction -- ^ this posting's parent transaction (co-recursive types). ptransaction :: Maybe Transaction -- ^ this posting's parent transaction (co-recursive types).
@ -111,7 +111,7 @@ data Transaction = Transaction {
tstatus :: Bool, -- XXX tcleared ? tstatus :: Bool, -- XXX tcleared ?
tcode :: String, tcode :: String,
tdescription :: String, tdescription :: String,
tcomment :: String, tcomment :: String, -- ^ this transaction's non-tag comment lines, as a single non-indented string
tmetadata :: [(String,String)], tmetadata :: [(String,String)],
tpostings :: [Posting], -- ^ this transaction's postings (co-recursive types). tpostings :: [Posting], -- ^ this transaction's postings (co-recursive types).
tpreceding_comment_lines :: String tpreceding_comment_lines :: String

View File

@ -150,28 +150,6 @@ journal = do
, emptyline >> return (return id) , emptyline >> return (return id)
] <?> "journal transaction or directive" ] <?> "journal transaction or directive"
emptyline :: GenParser Char JournalContext ()
emptyline = do many spacenonewline
optional $ (char ';' <?> "comment") >> many (noneOf "\n")
newline
return ()
comment :: GenParser Char JournalContext String
comment = do
many1 $ char ';'
many spacenonewline
many (noneOf "\n")
<?> "comment"
commentline :: GenParser Char JournalContext String
commentline = do
many spacenonewline
s <- comment
optional newline
eof
return s
<?> "comment"
-- cf http://ledger-cli.org/3.0/doc/ledger3.html#Command-Directives -- cf http://ledger-cli.org/3.0/doc/ledger3.html#Command-Directives
directive :: GenParser Char JournalContext JournalUpdate directive :: GenParser Char JournalContext JournalUpdate
directive = do directive = do
@ -326,7 +304,7 @@ periodictransaction = do
postings <- postings postings <- postings
return $ PeriodicTransaction periodexpr postings return $ PeriodicTransaction periodexpr postings
-- | Parse a (possibly unbalanced) ledger transaction. -- | Parse a (possibly unbalanced) transaction.
transaction :: GenParser Char JournalContext Transaction transaction :: GenParser Char JournalContext Transaction
transaction = do transaction = do
date <- date <?> "transaction" date <- date <?> "transaction"
@ -338,16 +316,76 @@ transaction = do
(description, inlinecomment, inlinemd) <- (description, inlinecomment, inlinemd) <-
try (do many1 spacenonewline try (do many1 spacenonewline
d <- pdescription d <- pdescription
(c, m) <- ledgerInlineCommentOrMetadata (c, m) <- inlinecomment
return (d,c,m)) return (d,c,m))
<|> (newline >> return ("", [], [])) <|> (newline >> return ("", [], []))
(nextlinecomments, nextlinemds) <- ledgerCommentsAndMetadata (nextlinecomments, nextlinemds) <- commentlines
let comment = intercalate "\n" $ inlinecomment ++ map (" ; "++) nextlinecomments let comment = unlines $ inlinecomment ++ nextlinecomments
mds = inlinemd ++ nextlinemds mds = inlinemd ++ nextlinemds
postings <- postings postings <- postings
return $ txnTieKnot $ Transaction date edate status code description comment mds postings "" return $ txnTieKnot $ Transaction date edate status code description comment mds postings ""
tests_transaction = [
"transaction" ~: do
-- let s `gives` t = assertParseEqual (parseWithCtx nullctx transaction s) t
let s `gives` t = do
let p = parseWithCtx nullctx transaction s
assertBool "transaction parser failed" $ isRight p
let Right t2 = p
same f = assertEqual "" (f t) (f t2)
same tdate
same teffectivedate
same tstatus
same tcode
same tdescription
same tcomment
same tmetadata
same tpreceding_comment_lines
same tpostings
-- "0000/01/01\n\n" `gives` nulltransaction
unlines [
"2012/05/14=2012/05/15 (code) desc ; tcomment1",
" ; tcomment2",
" ; ttag1: val1",
" * a $1.00 ; pcomment1",
" ; pcomment2",
" ; ptag1: val1",
" ; ptag2: val2"
]
`gives`
nulltransaction{
tdate=parsedate "2012/05/14",
teffectivedate=Just $ parsedate "2012/05/15",
tstatus=False,
tcode="code",
tdescription="desc",
tcomment="tcomment1\ntcomment2\n",
tmetadata=[("ttag1","val1")],
tpostings=[
nullposting{
pstatus=True,
paccount="a",
pamount=Mixed [dollars 1],
pcomment="pcomment1\npcomment2\n",
ptype=RegularPosting,
pmetadata=[("ptag1","val1"),("ptag2","val2")],
ptransaction=Nothing
}
],
tpreceding_comment_lines=""
}
assertParseEqual (parseWithCtx nullctx transaction entry1_str) entry1
assertBool "transaction should not parse just a date"
$ isLeft $ parseWithCtx nullctx transaction "2009/1/1\n"
assertBool "transaction should require some postings"
$ isLeft $ parseWithCtx nullctx transaction "2009/1/1 a\n"
let t = parseWithCtx nullctx transaction "2009/1/1 a ;comment\n b 1\n"
assertBool "transaction should not include a comment in the description"
$ either (const False) ((== "a") . tdescription) t
]
-- | Parse a date in YYYY/MM/DD format. Fewer digits are allowed. The year -- | Parse a date in YYYY/MM/DD format. Fewer digits are allowed. The year
-- may be omitted if a default year has already been set. -- may be omitted if a default year has already been set.
date :: GenParser Char JournalContext Day date :: GenParser Char JournalContext Day
@ -420,42 +458,6 @@ status = try (do { many spacenonewline; char '*' <?> "status"; return True } ) <
code :: GenParser Char JournalContext String code :: GenParser Char JournalContext String
code = try (do { many1 spacenonewline; char '(' <?> "code"; code <- anyChar `manyTill` char ')'; return code } ) <|> return "" code = try (do { many1 spacenonewline; char '(' <?> "code"; code <- anyChar `manyTill` char ')'; return code } ) <|> return ""
type Tag = (String, String)
ledgerInlineCommentOrMetadata :: GenParser Char JournalContext ([String],[Tag])
ledgerInlineCommentOrMetadata = try (do {md <- metadatacomment; newline; return ([], [md])})
<|> (do {c <- comment; newline; return ([c], [])})
<|> (newline >> return ([], []))
ledgerCommentsAndMetadata :: GenParser Char JournalContext ([String],[Tag])
ledgerCommentsAndMetadata = do
comormds <- many $ choice' [(liftM Right metadataline)
,(do {many1 spacenonewline; c <- comment; newline; return $ Left c }) -- XXX fix commentnewline
]
return $ partitionEithers comormds
-- a comment line containing a metadata declaration, eg:
-- ; name: value
metadataline :: GenParser Char JournalContext (String,String)
metadataline = do
many1 spacenonewline
md <- metadatacomment
newline
return md
-- a comment containing a ledger-style metadata declaration, like:
-- ; name: some value
metadatacomment :: GenParser Char JournalContext (String,String)
metadatacomment = do
many1 $ char ';'
many spacenonewline
name <- many1 $ noneOf ": \t"
char ':'
many spacenonewline
value <- many (noneOf "\n")
return (name,value)
<?> "metadata comment"
-- Parse the following whitespace-beginning lines as postings, posting metadata, and/or comments. -- Parse the following whitespace-beginning lines as postings, posting metadata, and/or comments.
-- complicated to handle intermixed comment and metadata lines.. make me better ? -- complicated to handle intermixed comment and metadata lines.. make me better ?
postings :: GenParser Char JournalContext [Posting] postings :: GenParser Char JournalContext [Posting]
@ -477,13 +479,35 @@ posting = do
let (ptype, account') = (accountNamePostingType account, unbracket account) let (ptype, account') = (accountNamePostingType account, unbracket account)
amount <- spaceandamountormissing amount <- spaceandamountormissing
many spacenonewline many spacenonewline
(inlinecomment, inlinemd) <- ledgerInlineCommentOrMetadata (inlinecomment, inlinemd) <- inlinecomment
(nextlinecomments, nextlinemds) <- ledgerCommentsAndMetadata (nextlinecomments, nextlinemds) <- commentlines
let comment = intercalate "\n" $ inlinecomment ++ map (" ; "++) nextlinecomments let comment = unlines $ inlinecomment ++ nextlinecomments
mds = inlinemd ++ nextlinemds mds = inlinemd ++ nextlinemds
return (Posting status account' amount comment ptype mds Nothing) return (Posting status account' amount comment ptype mds Nothing)
tests_posting = [
"posting" ~: do
-- let s `gives` r = assertParseEqual (parseWithCtx nullctx posting s) r
let s `gives` p = do
let parse = parseWithCtx nullctx posting s
assertBool "posting parser" $ isRight parse
let Right p2 = parse
same f = assertEqual "" (f p) (f p2)
same pstatus
same paccount
same pamount
same pcomment
same ptype
same pmetadata
same ptransaction
" expenses:food:dining $10.00 ; a: a a \n ; b: b b \n"
`gives`
(Posting False "expenses:food:dining" (Mixed [dollars 10]) "" RegularPosting [("a","a a"), ("b","b b")] Nothing)
assertBool "posting parses a quoted commodity with numbers"
(isRight $ parseWithCtx nullctx posting " a 1 \"DE123\"\n")
]
-- | Parse an account name, then apply any parent account prefix and/or account aliases currently in effect. -- | Parse an account name, then apply any parent account prefix and/or account aliases currently in effect.
modifiedaccountname :: GenParser Char JournalContext AccountName modifiedaccountname :: GenParser Char JournalContext AccountName
modifiedaccountname = do modifiedaccountname = do
@ -667,10 +691,7 @@ number = do
return (quantity,precision,decimalpoint,separator,separatorpositions) return (quantity,precision,decimalpoint,separator,separatorpositions)
<?> "number" <?> "number"
tests_Hledger_Read_JournalReader = TestList $ concat [ tests_number = [
tests_amount,
tests_spaceandamountormissing,
[
"number" ~: do "number" ~: do
let s `is` n = assertParseEqual (parseWithCtx nullctx number s) n let s `is` n = assertParseEqual (parseWithCtx nullctx number s) n
assertFails = assertBool "" . isLeft . parseWithCtx nullctx number assertFails = assertBool "" . isLeft . parseWithCtx nullctx number
@ -692,18 +713,101 @@ tests_Hledger_Read_JournalReader = TestList $ concat [
assertFails "1..1" assertFails "1..1"
assertFails ".1," assertFails ".1,"
assertFails ",1." assertFails ",1."
]
,"transaction" ~: do -- older comment parsers
assertParseEqual (parseWithCtx nullctx transaction entry1_str) entry1
assertBool "transaction should not parse just a date"
$ isLeft $ parseWithCtx nullctx transaction "2009/1/1\n"
assertBool "transaction should require some postings"
$ isLeft $ parseWithCtx nullctx transaction "2009/1/1 a\n"
let t = parseWithCtx nullctx transaction "2009/1/1 a ;comment\n b 1\n"
assertBool "transaction should not include a comment in the description"
$ either (const False) ((== "a") . tdescription) t
,"modifiertransaction" ~: do emptyline :: GenParser Char JournalContext ()
emptyline = do many spacenonewline
optional $ (char ';' <?> "comment") >> many (noneOf "\n")
newline
return ()
comment :: GenParser Char JournalContext String
comment = do
many1 $ char ';'
many spacenonewline
c <- many (noneOf "\n")
return $ rstrip c
<?> "comment"
commentline :: GenParser Char JournalContext String
commentline = do
many spacenonewline
c <- comment
optional newline
eof
return c
<?> "comment"
-- newer comment parsers
type Tag = (String, String)
inlinecomment :: GenParser Char JournalContext ([String],[Tag])
inlinecomment = try (do {md <- tagcomment; newline; return ([], [md])})
<|> (do {c <- comment; newline; return ([rstrip c], [])})
<|> (newline >> return ([], []))
tests_inlinecomment = [
"inlinecomment" ~: do
let s `gives` r = assertParseEqual (parseWithCtx nullctx inlinecomment s) r
"; comment \n" `gives` (["comment"],[])
";tag: a value \n" `gives` ([],[("tag","a value")])
]
commentlines :: GenParser Char JournalContext ([String],[Tag])
commentlines = do
comormds <- many $ choice' [(liftM Right metadataline)
,(do {many1 spacenonewline; c <- comment; newline; return $ Left c }) -- XXX fix commentnewline
]
return $ partitionEithers comormds
tests_commentlines = [
"commentlines" ~: do
let s `gives` r = assertParseEqual (parseWithCtx nullctx commentlines s) r
" ; comment 1 \n ; tag1: val1 \n ;comment 2\n;unindented comment\n"
`gives` (["comment 1","comment 2"],[("tag1","val1")])
]
-- a comment line containing a metadata declaration, eg:
-- ; name: value
metadataline :: GenParser Char JournalContext (String,String)
metadataline = do
many1 spacenonewline
md <- tagcomment
newline
return md
-- a comment containing a tag, like "; name: some value"
tagcomment :: GenParser Char JournalContext (String,String)
tagcomment = do
many1 $ char ';'
many spacenonewline
name <- many1 $ noneOf ": \t"
char ':'
many spacenonewline
value <- many (noneOf "\n")
return (name, rstrip value)
<?> "metadata comment"
tests_tagcomment = [
"tagcomment" ~: do
let s `gives` r = assertParseEqual (parseWithCtx nullctx tagcomment s) r
";tag: a value \n" `gives` ("tag","a value")
]
tests_Hledger_Read_JournalReader = TestList $ concat [
tests_number,
tests_amount,
tests_spaceandamountormissing,
tests_tagcomment,
tests_inlinecomment,
tests_commentlines,
tests_posting,
tests_transaction,
[
"modifiertransaction" ~: do
assertParse (parseWithCtx nullctx modifiertransaction "= (some value expr)\n some:postings 1\n") assertParse (parseWithCtx nullctx modifiertransaction "= (some value expr)\n some:postings 1\n")
,"periodictransaction" ~: do ,"periodictransaction" ~: do
@ -770,12 +874,6 @@ tests_Hledger_Read_JournalReader = TestList $ concat [
assertBool "accountname rejects an empty leading component" (isLeft $ parsewith accountname ":b:c") assertBool "accountname rejects an empty leading component" (isLeft $ parsewith accountname ":b:c")
assertBool "accountname rejects an empty trailing component" (isLeft $ parsewith accountname "a:b:") assertBool "accountname rejects an empty trailing component" (isLeft $ parsewith accountname "a:b:")
,"posting" ~: do
assertParseEqual (parseWithCtx nullctx posting " expenses:food:dining $10.00 ; a: a a \n ; b: b b \n")
(Posting False "expenses:food:dining" (Mixed [dollars 10]) "" RegularPosting [("a","a a "), ("b","b b ")] Nothing)
assertBool "posting parses a quoted commodity with numbers"
(isRight $ parseWithCtx nullctx posting " a 1 \"DE123\"\n")
,"amount" ~: do ,"amount" ~: do
let -- | compare a parse result with a MixedAmount, showing the debug representation for clarity let -- | compare a parse result with a MixedAmount, showing the debug representation for clarity
assertMixedAmountParse parseresult mixedamount = assertMixedAmountParse parseresult mixedamount =

View File

@ -10,7 +10,7 @@ bin/hledger -f - print
2010/01/01 2010/01/01
a EUR 1 ; a euro a EUR 1 ; a euro
b USD 1 ; a dollar b USD 1 ; a dollar
EUR -1 EUR -1
c USD -1 ; a euro and a dollar c USD -1 ; a euro and a dollar
>>>=0 >>>=0

View File

@ -32,16 +32,20 @@ bin/hledger -f - print
# 3. print should preserve comments # 3. print should preserve comments
bin/hledger -f - print bin/hledger -f - print
<<< <<<
2009/1/1 x ; description comment ; isolated journal comment
a 1 ; amount comment
; middle posting comment ; pre-transaction journal comment
2009/1/1 x ; transaction comment
a 1 ; posting 1 comment
; posting 1 comment 2
b b
; trailing posting comment ; posting 2 comment
; post-entry comment ; post-transaction journal comment
>>> >>>
2009/01/01 x ; description comment 2009/01/01 x ; transaction comment
a 1 ; amount comment a 1 ; posting 1 comment
b -1 ; posting 1 comment 2
b -1 ; posting 2 comment
>>>=0 >>>=0