fix txn & posting comment parsing & printing; better unit tests
This commit is contained in:
parent
c911cc51ab
commit
56cf9b21cb
110
MANUAL.md
110
MANUAL.md
@ -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:
|
||||||
|
|||||||
@ -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)
|
||||||
|
|
||||||
]
|
]]
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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 =
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user