more robust comments & metadata, on postings too, and document as "tags"

This commit is contained in:
Simon Michael 2012-05-14 18:52:22 +00:00
parent 88212f26e8
commit a58a5f96ad
12 changed files with 220 additions and 158 deletions

View File

@ -259,13 +259,41 @@ 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
### Metadata ### Comments
Extra metadata (a keyword and value) or tags (just keywords) may be A semicolon in the journal file marks the start of a comment. You can
attached to transactions and postings by inserting one or more comment write general comments between transactions like so:
lines containing KEY:[VALUE]. In the example below, the transaction has a
`purpose` tag with value "`research`", and the expenses:cinema posting has ; a comment line. Whitespace before the ; is allowed.
the `fun` and `outing` tags.
Or, you can write transaction- or posting-specific comments following the
transaction's first line or the posting, on the same line and/or the
immediately following lines (indented). Some examples:
2012/5/14 a transaction ; a transaction comment
; another comment for this transaction
posting1 ; a comment for posting 1
posting2
; a comment for posting 2
; another one
A "metadata comment" is a comment containing a metadata key-value pair (tag), explained in the next section.
### Tags (metadata)
You can attach any extra data you like to transactions and postings, as
key-value pairs within a transaction or posting comment. Ledger calls
these metadata, in hledger land I like to call them tags; they are the
same thing. Here's how they work in hledger: 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 (and it can be empty).
In the example below, the transaction has a `purpose` tag with value
`research`, and the expenses:cinema posting has the `fun` and `outing`
tags.
1/1 movie ticket 1/1 movie ticket
; purpose: research ; purpose: research
@ -274,8 +302,11 @@ the `fun` and `outing` tags.
; outing: ; outing:
assets:checking assets:checking
hledger does not yet allow querying on these fields; they are parsed for Filtering reports by tag is work in progress. For the moment, you can
compatibility with ledger, but ignored. match transactions or postings' tag values by adding `tag NAME=VALUE` on
the command line. Limitations: 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 supported in the web interface yet.
### Default commodity ### Default commodity

View File

@ -1,10 +1,9 @@
{-| {-|
A 'Posting' represents a 'MixedAmount' being added to or subtracted from a A 'Posting' represents a change (by some 'MixedAmount') of the balance in
single 'Account'. Each 'Transaction' contains two or more postings which some 'Account'. Each 'Transaction' contains two or more postings which
should add up to 0. Postings also reference their parent transaction, so should add up to 0. Postings reference their parent transaction, so we can
we can get a date or description for a posting (from the transaction). look up the date or description there.
Strictly speaking, \"entry\" is probably a better name for these.
-} -}
@ -22,7 +21,7 @@ module Hledger.Data.Posting (
postingDate, postingDate,
isPostingInDateSpan, isPostingInDateSpan,
postingsDateSpan, postingsDateSpan,
-- * account name operations that depend on posting type -- * account name operations
accountNamesFromPostings, accountNamesFromPostings,
accountNamePostingType, accountNamePostingType,
accountNameWithoutPostingType, accountNameWithoutPostingType,
@ -36,6 +35,9 @@ module Hledger.Data.Posting (
showPosting, showPosting,
showPostingForRegister, showPostingForRegister,
-- * misc. -- * misc.
postingMetadataAsLines,
metadataAsLines,
showComment,
tests_Hledger_Data_Posting tests_Hledger_Data_Posting
) )
where where
@ -59,8 +61,8 @@ nullposting :: Posting
nullposting = Posting False "" nullmixedamt "" RegularPosting [] Nothing nullposting = Posting False "" nullmixedamt "" RegularPosting [] Nothing
showPosting :: Posting -> String showPosting :: Posting -> String
showPosting (Posting{paccount=a,pamount=amt,pcomment=com,ptype=t}) = showPosting p@Posting{paccount=a,pamount=amt,ptype=t} =
concatTopPadded [showaccountname a ++ " ", showamount amt, comment] unlines $ [concatTopPadded [showaccountname a ++ " ", showamount amt, showComment (pcomment p)]] ++ postingMetadataAsLines p
where where
ledger3ishlayout = False ledger3ishlayout = False
acctnamewidth = if ledger3ishlayout then 25 else 22 acctnamewidth = if ledger3ishlayout then 25 else 22
@ -70,7 +72,17 @@ showPosting (Posting{paccount=a,pamount=amt,pcomment=com,ptype=t}) =
VirtualPosting -> (\s -> "("++s++")", acctnamewidth-2) VirtualPosting -> (\s -> "("++s++")", acctnamewidth-2)
_ -> (id,acctnamewidth) _ -> (id,acctnamewidth)
showamount = padleft 12 . showMixedAmount showamount = padleft 12 . showMixedAmount
comment = if null com then "" else " ; " ++ com
postingMetadataAsLines :: Posting -> [String]
postingMetadataAsLines = metadataAsLines . pmetadata
metadataAsLines :: [(String, String)] -> [String]
metadataAsLines mds = map (\(k,v) -> " ; " ++ k++": "++v) mds
showComment :: String -> String
showComment s = if null s then "" else " ; " ++ s
-- XXX refactor -- XXX refactor
showPostingForRegister :: Posting -> String showPostingForRegister :: Posting -> String
showPostingForRegister (Posting{paccount=a,pamount=amt,ptype=t}) = showPostingForRegister (Posting{paccount=a,pamount=amt,ptype=t}) =
@ -122,8 +134,8 @@ isPostingInDateSpan s = spanContainsDate s . postingDate
isEmptyPosting :: Posting -> Bool isEmptyPosting :: Posting -> Bool
isEmptyPosting = isZeroMixedAmount . pamount isEmptyPosting = isZeroMixedAmount . pamount
-- | Get the minimal date span which contains all the postings, or -- | Get the minimal date span which contains all the postings, or the
-- DateSpan Nothing Nothing if there are none. -- null date span if there are none.
postingsDateSpan :: [Posting] -> DateSpan postingsDateSpan :: [Posting] -> DateSpan
postingsDateSpan [] = DateSpan Nothing Nothing postingsDateSpan [] = DateSpan Nothing Nothing
postingsDateSpan ps = DateSpan (Just $ postingDate $ head ps') (Just $ addDays 1 $ postingDate $ last ps') postingsDateSpan ps = DateSpan (Just $ postingDate $ head ps') (Just $ addDays 1 $ postingDate $ last ps')

View File

@ -1,8 +1,9 @@
{-| {-|
A 'Transaction' consists of two or more related 'Posting's which balance A 'Transaction' represents a movement of some commodity(ies) between two
to zero, representing a movement of some commodity(ies) between accounts, or more accounts. It consists of multiple account 'Posting's which balance
plus a date and optional metadata like description and cleared status. to zero, a date, and optional metadata like description and cleared
status.
-} -}
@ -91,9 +92,10 @@ showTransaction = showTransaction' True
showTransactionUnelided :: Transaction -> String showTransactionUnelided :: Transaction -> String
showTransactionUnelided = showTransaction' False showTransactionUnelided = showTransaction' False
-- XXX similar to showPosting, refactor
showTransaction' :: Bool -> Transaction -> String showTransaction' :: Bool -> Transaction -> String
showTransaction' elide t = showTransaction' elide t =
unlines $ [description] ++ metadata ++ showpostings (tpostings t) ++ [""] unlines $ [description] ++ (metadataAsLines $ tmetadata t) ++ (postingsAsLines (tpostings t)) ++ [""]
where where
description = concat [date, status, code, desc, comment] description = concat [date, status, code, desc, comment]
date = showdate (tdate t) ++ maybe "" showedate (teffectivedate t) date = showdate (tdate t) ++ maybe "" showedate (teffectivedate t)
@ -103,25 +105,20 @@ showTransaction' elide t =
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 comment = if null c then "" else " ; " ++ c where c = tcomment t
metadata = if null md then [] else showmetadata md where md = tmetadata t postingsAsLines ps
showmetadata md = map (\(k,v) -> " ; " ++ k++":"++v) md
showpostings ps
| elide && length ps > 1 && isTransactionBalanced Nothing t -- imprecise balanced check | elide && length ps > 1 && isTransactionBalanced Nothing t -- imprecise balanced check
= map showposting (init ps) ++ [showpostingnoamt (last ps)] = (concatMap postingAsLines $ init ps) ++ postingNoAmtAsLines (last ps)
| otherwise = map showposting ps | otherwise = concatMap postingAsLines ps
where where
showpostingnoamt p = rstrip $ showacct p ++ " " ++ showcomment (pcomment p) postingAsLines p = [concatTopPadded [showacct p, " ", showamt (pamount p), showComment (pcomment p)]] ++ postingMetadataAsLines p
showposting p = concatTopPadded [showacct p postingNoAmtAsLines p = [rstrip $ showacct p ++ " " ++ showComment (pcomment p)] ++ postingMetadataAsLines p
," " showacct p =
,showamt (pamount p) " " ++ showstatus p ++ printf (printf "%%-%ds" w) (showAccountName Nothing (ptype p) (paccount p))
,showcomment (pcomment p) where
] showstatus p = if pstatus p then "* " else ""
showacct p = " " ++ showstatus p ++ printf (printf "%%-%ds" w) (showAccountName Nothing (ptype p) (paccount p)) w = maximum $ map (length . paccount) ps
where w = maximum $ map (length . paccount) ps
showstatus p = if pstatus p then "* " else ""
showamt = showamt =
padleft 12 . showMixedAmount padleft 12 . showMixedAmount
showcomment s = if null s then "" else " ; "++s
-- | 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.

View File

@ -36,6 +36,7 @@ where
import Control.Monad import Control.Monad
import Control.Monad.Error import Control.Monad.Error
import Data.Char (isNumber) import Data.Char (isNumber)
import Data.Either (partitionEithers)
import Data.List import Data.List
import Data.List.Split (wordsBy) import Data.List.Split (wordsBy)
import Data.Maybe import Data.Maybe
@ -332,13 +333,20 @@ transaction = do
edate <- optionMaybe (effectivedate date) <?> "effective date" edate <- optionMaybe (effectivedate date) <?> "effective date"
status <- status <?> "cleared flag" status <- status <?> "cleared flag"
code <- code <?> "transaction code" code <- code <?> "transaction code"
(description, comment) <- -- now there can be whitespace followed by a description and/or comment/metadata comment
(do {many1 spacenonewline; d <- liftM rstrip (many (noneOf ";\n")); c <- comment <|> return ""; newline; return (d, c)} <|> let pdescription = many (noneOf ";\n") >>= return . strip
do {many spacenonewline; c <- comment <|> return ""; newline; return ("", c)} (description, inlinecomment, inlinemd) <-
) <?> "description and/or comment" try (do many1 spacenonewline
md <- try metadata <|> return [] d <- pdescription
(c, m) <- ledgerInlineCommentOrMetadata
return (d,c,m))
<|> (newline >> return ("", [], []))
(nextlinecomments, nextlinemds) <- ledgerCommentsAndMetadata
let comment = intercalate "\n" $ inlinecomment ++ map (" ; "++) nextlinecomments
mds = inlinemd ++ nextlinemds
postings <- postings postings <- postings
return $ txnTieKnot $ Transaction date edate status code description comment md postings "" return $ txnTieKnot $ Transaction date edate status code description comment mds postings ""
-- | 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.
@ -412,53 +420,53 @@ 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 ""
metadata :: GenParser Char JournalContext [(String,String)] type Tag = (String, String)
metadata = many $ try metadataline
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: -- a comment line containing a metadata declaration, eg:
-- ; name: value -- ; name: value
metadataline :: GenParser Char JournalContext (String,String) metadataline :: GenParser Char JournalContext (String,String)
metadataline = do metadataline = do
many1 spacenonewline 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 ';' many1 $ char ';'
many spacenonewline many spacenonewline
name <- many1 $ noneOf ": \t" name <- many1 $ noneOf ": \t"
char ':' char ':'
many spacenonewline many spacenonewline
value <- many (noneOf "\n") value <- many (noneOf "\n")
optional newline
-- eof
return (name,value) return (name,value)
<?> "metadata line" <?> "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]
postings = do postings = many1 posting <?> "postings"
ctx <- getState
-- we'll set the correct position for sub-parses for more useful errors
pos <- getPosition
ls <- many1 $ try linebeginningwithspaces
let lsnumbered = zip ls [0..]
parses p = isRight . parseWithCtx ctx p
postinglines = filter (not . (commentline `parses`) . fst) lsnumbered
-- group any metadata lines with the posting line above
postinglinegroups :: [(String,Line)] -> [(String,Line)]
postinglinegroups [] = []
postinglinegroups ((pline,num):ls) = (unlines (pline:(map fst mdlines)), num):postinglinegroups rest
where (mdlines,rest) = span ((metadataline `parses`) . fst) ls
pstrs = postinglinegroups postinglines
parseNumberedPostingLine (str,num) = fromparse $ parseWithCtx ctx (setPosition (incSourceLine pos num) >> posting) str
when (null pstrs) $ fail "no postings"
return $ map parseNumberedPostingLine pstrs
<?> "postings"
linebeginningwithspaces :: GenParser Char JournalContext String -- linebeginningwithspaces :: GenParser Char JournalContext String
linebeginningwithspaces = do -- linebeginningwithspaces = do
sp <- many1 spacenonewline -- sp <- many1 spacenonewline
c <- nonspace -- c <- nonspace
cs <- restofline -- cs <- restofline
return $ sp ++ (c:cs) ++ "\n" -- return $ sp ++ (c:cs) ++ "\n"
posting :: GenParser Char JournalContext Posting posting :: GenParser Char JournalContext Posting
posting = do posting = do
@ -469,10 +477,12 @@ posting = do
let (ptype, account') = (accountNamePostingType account, unbracket account) let (ptype, account') = (accountNamePostingType account, unbracket account)
amount <- spaceandamountormissing amount <- spaceandamountormissing
many spacenonewline many spacenonewline
comment <- comment <|> return "" (inlinecomment, inlinemd) <- ledgerInlineCommentOrMetadata
newline (nextlinecomments, nextlinemds) <- ledgerCommentsAndMetadata
md <- metadata let comment = intercalate "\n" $ inlinecomment ++ map (" ; "++) nextlinecomments
return (Posting status account' amount comment ptype md Nothing) mds = inlinemd ++ nextlinemds
return (Posting status account' amount comment ptype mds Nothing)
-- | 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
@ -761,8 +771,8 @@ tests_Hledger_Read_JournalReader = TestList $ concat [
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 ,"posting" ~: do
assertParseEqual (parseWithCtx nullctx posting " expenses:food:dining $10.00\n") 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 [] Nothing) (Posting False "expenses:food:dining" (Mixed [dollars 10]) "" RegularPosting [("a","a a "), ("b","b b ")] Nothing)
assertBool "posting parses a quoted commodity with numbers" assertBool "posting parses a quoted commodity with numbers"
(isRight $ parseWithCtx nullctx posting " a 1 \"DE123\"\n") (isRight $ parseWithCtx nullctx posting " a 1 \"DE123\"\n")

View File

@ -96,7 +96,7 @@ tests_Hledger_Cli = TestList
] ]
,"account aliases" ~: do ,"account aliases" ~: do
Right j <- readJournal Nothing Nothing Nothing "!alias expenses = equity:draw:personal\n1/1\n (expenses:food) 1\n" j <- readJournal Nothing Nothing Nothing "!alias expenses = equity:draw:personal\n1/1\n (expenses:food) 1\n" >>= either error' return
let p = head $ tpostings $ head $ jtxns j let p = head $ tpostings $ head $ jtxns j
assertBool "" $ paccount p == "equity:draw:personal:food" assertBool "" $ paccount p == "equity:draw:personal:food"

View File

@ -1,12 +0,0 @@
bin/hledger -f - print
<<<
2009/01/01 x
a 1
b
; comment line after postings
>>>
2009/01/01 x
a 1
b -1
>>>=0

View File

@ -1,12 +0,0 @@
bin/hledger -f - print
<<<
2009/01/01 x
; comment line within postings
a 1
b
>>>
2009/01/01 x
a 1
b -1
>>>=0

74
tests/comments.test Normal file
View File

@ -0,0 +1,74 @@
# comment tests
# 1.
bin/hledger -f - print
<<<
2009/01/01 x ; transaction comment 1
; transaction comment 2
a 1
b
>>>
2009/01/01 x ; transaction comment 1
; transaction comment 2
a 1
b -1
>>>=0
# 2.
bin/hledger -f - print
<<<
2009/01/01 x
a 1
b
; comment line after postings
>>>
2009/01/01 x
a 1
b -1
>>>=0
# 3. print should preserve comments
bin/hledger -f - print
<<<
2009/1/1 x ; description comment
a 1 ; amount comment
; middle posting comment
b
; trailing posting comment
; post-entry comment
>>>
2009/01/01 x ; description comment
a 1 ; amount comment
b -1
>>>=0
# 4. a posting comment should appear in print
bin/hledger -f - print
<<<
2010/01/01 x
a 1 ; comment
b -1
>>>
2010/01/01 x
a 1 ; comment
b -1
>>>2
>>>=0
# 5. a posting comment should not appear in register
bin/hledger -f - register
<<<
2010/1/1 x
a 1 ; comment
b
>>>
2010/01/01 x a 1 1
b -1 0
>>>2
>>>=0

View File

@ -1,22 +1,26 @@
# 1. we currently parse metadata tags on transactions and postings, printing # 1. we parse metadata tags in transaction and posting comments. Currently,
# the former and ignoring the latter # - they can be on the same line and/or separate lines
# - they are always printed on separate lines
bin/hledger -f - print bin/hledger -f - print
<<< <<<
2010/01/01 2010/01/01 ; txntag1: txn val 1
; txndata1: txn val 1 ; txntag2: txn val 2
; txndata2: txn val 2
a 1 a 1
; posting1data1: posting1 val 1 ; posting1tag1: posting 1 val 1
; posting1data2: ; posting1tag2:
b -1 b -1 ; posting-2-tag-1: posting 2 val 1
; posting2data1: ; posting-2-tag-2:
; non-metadata: ; non-metadata:
>>> >>>
2010/01/01 2010/01/01
; txndata1:txn val 1 ; txntag1: txn val 1
; txndata2:txn val 2 ; txntag2: txn val 2
a 1 a 1
; posting1tag1: posting 1 val 1
; posting1tag2:
b -1 b -1
; posting-2-tag-1: posting 2 val 1
; posting-2-tag-2:
>>>2 >>>2
>>>=0 >>>=0
@ -39,7 +43,7 @@ bin/hledger -f - print tag foo=bar
f -1 f -1
>>> >>>
2010/01/01 2010/01/01
; foo:bar ; foo: bar
a 1 a 1
b -1 b -1

View File

@ -1,14 +0,0 @@
# a posting comment should appear in print
bin/hledger -f - print
<<<
2010/01/01 x
a 1 ; comment
b -1
>>>
2010/01/01 x
a 1 ; comment
b -1
>>>2
>>>=0

View File

@ -1,16 +0,0 @@
# let's have print preserve comments as far as possible
# we preserve line-end comments but not full line comments
bin/hledger -f - print
<<<
2009/1/1 x ; description comment
a 1 ; amount comment
; middle posting comment
b
; trailing posting comment
; post-entry comment
>>>
2009/01/01 x ; description comment
a 1 ; amount comment
b -1
>>>=0

View File

@ -1,12 +0,0 @@
# a posting comment should not appear in register
bin/hledger -f - register
<<<
2010/1/1 x
a 1 ; comment
b
>>>
2010/01/01 x a 1 1
b -1 0
>>>2
>>>=0