simonmichael/hledger
1
1
Fork 0
mirror of https://github.com/simonmichael/hledger.git synced 2024-11-08 07:09:28 +03:00
Code Issues Projects Releases Wiki Activity

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

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

110
MANUAL.md
View File

@ -259,62 +259,6 @@ Example:
$ hledger register checking --effective
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
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 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
You can pull in the content of additional journal files, by writing lines like this:

127
hledger-lib/Hledger/Data/Transaction.hs
View File

@ -92,33 +92,113 @@ showTransaction = showTransaction' True
showTransactionUnelided :: Transaction -> String
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' elide t =
unlines $ [description] ++ (metadataAsLines $ tmetadata t) ++ (postingsAsLines (tpostings t)) ++ [""]
unlines $ [descriptionline]
++ commentlines
++ (metadataAsLines $ tmetadata t)
++ (postingsAsLines elide t (tpostings t))
++ [""]
where
description = concat [date, status, code, desc, comment]
descriptionline = rstrip $ concat [date, status, code, desc, firstcomment]
date = showdate (tdate t) ++ maybe "" showedate (teffectivedate t)
showdate = printf "%-10s" . showDate
showedate = printf "=%s" . showdate
status = if tstatus t then " *" else ""
code = if length (tcode t) > 0 then printf " (%s)" $ tcode t else ""
desc = if null d then "" else " " ++ d where d = tdescription t
comment = if null c then "" else " ; " ++ c where c = tcomment t
postingsAsLines ps
| elide && length ps > 1 && isTransactionBalanced Nothing t -- imprecise balanced check
= (concatMap postingAsLines $ init ps) ++ postingNoAmtAsLines (last ps)
| otherwise = concatMap postingAsLines ps
where
postingAsLines p = [concatTopPadded [showacct p, " ", showamt (pamount p), showComment (pcomment p)]] ++ postingMetadataAsLines p
postingNoAmtAsLines p = [rstrip $ showacct p ++ " " ++ showComment (pcomment p)] ++ postingMetadataAsLines p
showacct p =
" " ++ 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
(firstcomment, commentlines) = commentLines $ tcomment t
-- Render a transaction or posting's comment as indented & prefixed comment lines.
commentLines :: String -> (String, [String])
commentLines s
| null s = ("", [])
| otherwise = (" ; " ++ first, map (indent . ("; "++)) rest)
where (first:rest) = lines s
postingsAsLines :: Bool -> Transaction -> [Posting] -> [String]
postingsAsLines elide t ps
| elide && length ps > 1 && isTransactionBalanced Nothing t -- imprecise balanced check
= (concatMap (postingAsLines False ps) $ init ps) ++ postingAsLines True ps (last ps)
| otherwise = concatMap (postingAsLines False ps) ps
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
-- 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 t p = p{ptransaction=Just t}
tests_Hledger_Data_Transaction = TestList [
tests_Hledger_Data_Transaction = TestList $ concat [
tests_postingAsLines,
tests_showTransactionUnelided,
[
"showTransaction" ~: do
assertEqual "show a balanced transaction, eliding last amount"
(unlines
@ -343,7 +426,7 @@ tests_Hledger_Data_Transaction = TestList [
assertEqual "show a transaction with one posting and a missing amount"
(unlines
["2007/01/28 coopportunity"
," expenses:food:groceries "
," expenses:food:groceries"
,""
])
(showTransaction
@ -356,7 +439,7 @@ tests_Hledger_Data_Transaction = TestList [
(unlines
["2010/01/01 x"
," a 1 @ $2"
," b "
," b"
,""
])
(showTransaction
@ -442,4 +525,4 @@ tests_Hledger_Data_Transaction = TestList [
] ""
assertBool "balanced virtual postings need to balance among themselves (2)" (isTransactionBalanced Nothing t)
]
]]

4
hledger-lib/Hledger/Data/Types.hs
View File

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

272
hledger-lib/Hledger/Read/JournalReader.hs
View File

@ -150,28 +150,6 @@ journal = do
, emptyline >> return (return id)
] <?> "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
directive :: GenParser Char JournalContext JournalUpdate
directive = do
@ -326,7 +304,7 @@ periodictransaction = do
postings <- postings
return $ PeriodicTransaction periodexpr postings
-- | Parse a (possibly unbalanced) ledger transaction.
-- | Parse a (possibly unbalanced) transaction.
transaction :: GenParser Char JournalContext Transaction
transaction = do
date <- date <?> "transaction"
@ -338,16 +316,76 @@ transaction = do
(description, inlinecomment, inlinemd) <-
try (do many1 spacenonewline
d <- pdescription
(c, m) <- ledgerInlineCommentOrMetadata
(c, m) <- inlinecomment
return (d,c,m))
<|> (newline >> return ("", [], []))
(nextlinecomments, nextlinemds) <- ledgerCommentsAndMetadata
let comment = intercalate "\n" $ inlinecomment ++ map (" ; "++) nextlinecomments
(nextlinecomments, nextlinemds) <- commentlines
let comment = unlines $ inlinecomment ++ nextlinecomments
mds = inlinemd ++ nextlinemds
postings <- 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
-- may be omitted if a default year has already been set.
date :: GenParser Char JournalContext Day
@ -420,42 +458,6 @@ status = try (do { many spacenonewline; char '*' <?> "status"; return True } ) <
code :: GenParser Char JournalContext String
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.
-- complicated to handle intermixed comment and metadata lines.. make me better ?
postings :: GenParser Char JournalContext [Posting]
@ -477,13 +479,35 @@ posting = do
let (ptype, account') = (accountNamePostingType account, unbracket account)
amount <- spaceandamountormissing
many spacenonewline
(inlinecomment, inlinemd) <- ledgerInlineCommentOrMetadata
(nextlinecomments, nextlinemds) <- ledgerCommentsAndMetadata
let comment = intercalate "\n" $ inlinecomment ++ map (" ; "++) nextlinecomments
(inlinecomment, inlinemd) <- inlinecomment
(nextlinecomments, nextlinemds) <- commentlines
let comment = unlines $ inlinecomment ++ nextlinecomments
mds = inlinemd ++ nextlinemds
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.
modifiedaccountname :: GenParser Char JournalContext AccountName
modifiedaccountname = do
@ -667,10 +691,7 @@ number = do
return (quantity,precision,decimalpoint,separator,separatorpositions)
<?> "number"
tests_Hledger_Read_JournalReader = TestList $ concat [
tests_amount,
tests_spaceandamountormissing,
[
tests_number = [
"number" ~: do
let s `is` n = assertParseEqual (parseWithCtx nullctx number s) n
assertFails = assertBool "" . isLeft . parseWithCtx nullctx number
@ -692,18 +713,101 @@ tests_Hledger_Read_JournalReader = TestList $ concat [
assertFails "1..1"
assertFails ".1,"
assertFails ",1."
]
,"transaction" ~: do
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
-- older comment parsers
,"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")
,"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 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
let -- | compare a parse result with a MixedAmount, showing the debug representation for clarity
assertMixedAmountParse parseresult mixedamount =

2
tests/amount-layout-vertical.test
View File

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

20
tests/comments.test
View File

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