slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions 2 Packages Projects Releases Wiki Activity

parsing: parse transaction and posting metadata, though we don't use it yet

Browse Source
This commit is contained in:
Simon Michael 2010-11-13 22:17:32 +00:00
parent bb43c2c750
commit e707f97847
9 changed files with 141 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
MANUAL.markdown
View File

@ -919,12 +919,11 @@ managing memory growth.
#### File format compatibility
hledger's file format is mostly identical with that of c++ ledger version
2, with some features (like modifier and periodic entries) being accepted,
but ignored. There are also some subtle differences in parser behaviour
(eg comments may be permissible in different places.) C++ ledger version 3
has introduced additional syntax, which current hledger probably fails to
parse.
hledger's file format is mostly identical with that of c++ ledger, with
some features being accepted but ignored. (Eg modifier entries, periodic
entries, metadata, per-posting cleared flags). There are also some subtle
differences in parser behaviour (eg comments may be permissible in
different places.)
Generally, it's easy to keep a journal file that works with both hledger
and c++ledger if you avoid the more esoteric syntax. Occasionally you'll

2
hledger-lib/Hledger/Data/Posting.hs
View File

@ -19,7 +19,7 @@ import Hledger.Data.Dates (nulldate, spanContainsDate)
instance Show Posting where show = showPosting
nullposting = Posting False "" nullmixedamt "" RegularPosting Nothing
nullposting = Posting False "" nullmixedamt "" RegularPosting [] Nothing
showPosting :: Posting -> String
showPosting (Posting{paccount=a,pamount=amt,pcomment=com,ptype=t}) =

3
hledger-lib/Hledger/Data/TimeLog.hs
View File

@ -74,6 +74,7 @@ entryFromTimeLogInOut i o
tcode = "",
tdescription = showtime itod ++ "-" ++ showtime otod,
tcomment = "",
tmetadata = [],
tpostings = ps,
tpreceding_comment_lines=""
}
@ -87,7 +88,7 @@ entryFromTimeLogInOut i o
hrs = elapsedSeconds (toutc otime) (toutc itime) / 3600 where toutc = localTimeToUTC utc
amount = Mixed [hours hrs]
ps = [Posting{pstatus=False,paccount=acctname,pamount=amount,
pcomment="",ptype=VirtualPosting,ptransaction=Just t}]
pcomment="",ptype=VirtualPosting,pmetadata=[],ptransaction=Just t}]
tests_TimeLog = TestList [

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

@ -31,6 +31,7 @@ nulltransaction = Transaction {
tcode="",
tdescription="",
tcomment="",
tmetadata=[],
tpostings=[],
tpreceding_comment_lines=""
}
@ -183,9 +184,9 @@ tests_Transaction = TestList [
," assets:checking"
,""
])
(let t = Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting (Just t)
,Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting (Just t)
(let t = Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" []
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting [] (Just t)
,Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting [] (Just t)
] ""
in showTransaction t)
@ -197,9 +198,9 @@ tests_Transaction = TestList [
," assets:checking $-47.18"
,""
])
(let t = Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting (Just t)
,Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting (Just t)
(let t = Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" []
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting [] (Just t)
,Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting [] (Just t)
] ""
in showTransactionUnelided t)
@ -213,9 +214,9 @@ tests_Transaction = TestList [
,""
])
(showTransaction
(txnTieKnot $ Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting Nothing
,Posting False "assets:checking" (Mixed [dollars (-47.19)]) "" RegularPosting Nothing
(txnTieKnot $ Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" []
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting [] Nothing
,Posting False "assets:checking" (Mixed [dollars (-47.19)]) "" RegularPosting [] Nothing
] ""))
,"showTransaction" ~: do
@ -226,8 +227,8 @@ tests_Transaction = TestList [
,""
])
(showTransaction
(txnTieKnot $ Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting Nothing
(txnTieKnot $ Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" []
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting [] Nothing
] ""))
,"showTransaction" ~: do
@ -238,8 +239,8 @@ tests_Transaction = TestList [
,""
])
(showTransaction
(txnTieKnot $ Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""
[Posting False "expenses:food:groceries" missingamt "" RegularPosting Nothing
(txnTieKnot $ Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" []
[Posting False "expenses:food:groceries" missingamt "" RegularPosting [] Nothing
] ""))
,"showTransaction" ~: do
@ -251,9 +252,9 @@ tests_Transaction = TestList [
,""
])
(showTransaction
(txnTieKnot $ Transaction (parsedate "2010/01/01") Nothing False "" "x" ""
[Posting False "a" (Mixed [Amount unknown 1 (Just $ Mixed [Amount dollar{precision=0} 2 Nothing])]) "" RegularPosting Nothing
,Posting False "b" missingamt "" RegularPosting Nothing
(txnTieKnot $ Transaction (parsedate "2010/01/01") Nothing False "" "x" "" []
[Posting False "a" (Mixed [Amount unknown 1 (Just $ Mixed [Amount dollar{precision=0} 2 Nothing])]) "" RegularPosting [] Nothing
,Posting False "b" missingamt "" RegularPosting [] Nothing
] ""))
]

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

@ -79,6 +79,7 @@ data Posting = Posting {
pamount :: MixedAmount,
pcomment :: String,
ptype :: PostingType,
pmetadata :: [(String,String)],
ptransaction :: Maybe Transaction -- ^ this posting's parent transaction (co-recursive types).
-- Tying this knot gets tedious, Maybe makes it easier/optional.
}
@ -86,7 +87,7 @@ data Posting = Posting {
-- The equality test for postings ignores the parent transaction's
-- identity, to avoid infinite loops.
instance Eq Posting where
(==) (Posting a1 b1 c1 d1 e1 _) (Posting a2 b2 c2 d2 e2 _) = a1==a2 && b1==b2 && c1==c2 && d1==d2 && e1==e2
(==) (Posting a1 b1 c1 d1 e1 f1 _) (Posting a2 b2 c2 d2 e2 f2 _) = a1==a2 && b1==b2 && c1==c2 && d1==d2 && e1==e2 && f1==f2
data Transaction = Transaction {
tdate :: Day,
@ -95,6 +96,7 @@ data Transaction = Transaction {
tcode :: String,
tdescription :: String,
tcomment :: String,
tmetadata :: [(String,String)],
tpostings :: [Posting], -- ^ this transaction's postings (co-recursive types).
tpreceding_comment_lines :: String
} deriving (Eq)

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

@ -329,9 +329,10 @@ ledgerTransaction = do
(do {many1 spacenonewline; d <- liftM rstrip (many (noneOf ";\n")); c <- ledgercomment <|> return ""; newline; return (d, c)} <|>
do {many spacenonewline; c <- ledgercomment <|> return ""; newline; return ("", c)}
) <?> "description and/or comment"
md <- try ledgermetadata <|> return []
postings <- ledgerpostings
let t = txnTieKnot $ Transaction date edate status code description comment postings ""
case balanceTransaction t of
let t = txnTieKnot $ Transaction date edate status code description comment md postings ""
case Right t of -- balanceTransaction t of
Right t' -> return t'
Left err -> fail err
@ -390,20 +391,44 @@ ledgerstatus = try (do { many1 spacenonewline; char '*' <?> "status"; return Tru
ledgercode :: GenParser Char JournalContext String
ledgercode = try (do { many1 spacenonewline; char '(' <?> "code"; code <- anyChar `manyTill` char ')'; return code } ) <|> return ""
ledgermetadata :: GenParser Char JournalContext [(String,String)]
ledgermetadata = many ledgermetadataline
-- a comment line containing a metadata declaration, eg:
-- ; name: value
ledgermetadataline :: GenParser Char JournalContext (String,String)
ledgermetadataline = do
many1 spacenonewline
many1 $ char ';'
many spacenonewline
name <- many1 $ noneOf ": \t"
char ':'
many spacenonewline
value <- many (noneOf "\n")
optional newline
-- eof
return (name,value)
<?> "metadata line"
-- Parse the following whitespace-beginning lines as postings, posting metadata, and/or comments.
-- complicated to handle intermixed comment and metadata lines.. make me better ?
ledgerpostings :: GenParser Char JournalContext [Posting]
ledgerpostings = do
-- complicated to handle intermixed comment lines.. please make me better.
ctx <- getState
let parses p = isRight . parseWithCtx ctx p
-- parse the following non-comment whitespace-beginning lines as postings
-- make sure the sub-parse starts from the current position, for useful errors
-- pass current position to the sub-parses for more useful errors
pos <- getPosition
ls <- many1 $ try linebeginningwithspaces
let ls' = filter (not . (ledgercommentline `parses`)) ls
when (null ls') $ fail "no postings"
return $ map (fromparse . parseWithCtx ctx (setPosition pos >> ledgerposting)) ls'
let parses p = isRight . parseWithCtx ctx p
postinglines = filter (not . (ledgercommentline `parses`)) ls
postinglinegroups :: [String] -> [String]
postinglinegroups [] = []
postinglinegroups (pline:ls) = (unlines $ pline:mdlines):postinglinegroups rest
where (mdlines,rest) = span (ledgermetadataline `parses`) ls
pstrs = postinglinegroups postinglines
when (null pstrs) $ fail "no postings"
return $ map (fromparse . parseWithCtx ctx (setPosition pos >> ledgerposting)) pstrs
<?> "postings"
linebeginningwithspaces :: GenParser Char JournalContext String
linebeginningwithspaces = do
sp <- many1 spacenonewline
@ -421,7 +446,8 @@ ledgerposting = do
many spacenonewline
comment <- ledgercomment <|> return ""
newline
return (Posting status account' amount comment ptype Nothing)
md <- ledgermetadata
return (Posting status account' amount comment ptype md Nothing)
-- qualify with the parent account from parsing context
transactionaccountname :: GenParser Char JournalContext AccountName
@ -611,7 +637,7 @@ tests_JournalReader = TestList [
,"ledgerposting" ~: do
assertParseEqual (parseWithCtx nullctx ledgerposting " expenses:food:dining $10.00\n")
(Posting False "expenses:food:dining" (Mixed [dollars 10]) "" RegularPosting Nothing)
(Posting False "expenses:food:dining" (Mixed [dollars 10]) "" RegularPosting [] Nothing)
assertBool "ledgerposting parses a quoted commodity with numbers"
(isRight $ parseWithCtx nullctx ledgerposting " a 1 \"DE123\"\n")
@ -645,7 +671,7 @@ entry1_str = unlines
]
entry1 =
txnTieKnot $ Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" ""
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting Nothing,
Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting Nothing] ""
txnTieKnot $ Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" []
[Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting [] Nothing,
Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting [] Nothing] ""

3
hledger/Hledger/Cli/Convert.hs
View File

@ -295,6 +295,7 @@ transactionFromCsvRecord rules fields =
tdescription=newdesc,
tcomment=comment,
tpreceding_comment_lines=precomment,
tmetadata=[],
tpostings=[
Posting {
pstatus=False,
@ -302,6 +303,7 @@ transactionFromCsvRecord rules fields =
pamount=amount,
pcomment="",
ptype=RegularPosting,
pmetadata=[],
ptransaction=Just t
},
Posting {
@ -310,6 +312,7 @@ transactionFromCsvRecord rules fields =
pamount=(-amount),
pcomment="",
ptype=RegularPosting,
pmetadata=[],
ptransaction=Just t
}
]

82
hledger/Hledger/Cli/Tests.hs
View File

@ -272,19 +272,19 @@ tests = TestList [
,"balanceTransaction" ~: do
assertBool "detect unbalanced entry, sign error"
(isLeft $ balanceTransaction
(Transaction (parsedate "2007/01/28") Nothing False "" "test" ""
[Posting False "a" (Mixed [dollars 1]) "" RegularPosting Nothing,
Posting False "b" (Mixed [dollars 1]) "" RegularPosting Nothing
(Transaction (parsedate "2007/01/28") Nothing False "" "test" "" []
[Posting False "a" (Mixed [dollars 1]) "" RegularPosting [] Nothing,
Posting False "b" (Mixed [dollars 1]) "" RegularPosting [] Nothing
] ""))
assertBool "detect unbalanced entry, multiple missing amounts"
(isLeft $ balanceTransaction
(Transaction (parsedate "2007/01/28") Nothing False "" "test" ""
[Posting False "a" missingamt "" RegularPosting Nothing,
Posting False "b" missingamt "" RegularPosting Nothing
(Transaction (parsedate "2007/01/28") Nothing False "" "test" "" []
[Posting False "a" missingamt "" RegularPosting [] Nothing,
Posting False "b" missingamt "" RegularPosting [] Nothing
] ""))
let e = balanceTransaction (Transaction (parsedate "2007/01/28") Nothing False "" "test" ""
[Posting False "a" (Mixed [dollars 1]) "" RegularPosting Nothing,
Posting False "b" missingamt "" RegularPosting Nothing
let e = balanceTransaction (Transaction (parsedate "2007/01/28") Nothing False "" "test" "" []
[Posting False "a" (Mixed [dollars 1]) "" RegularPosting [] Nothing,
Posting False "b" missingamt "" RegularPosting [] Nothing
] "")
assertBool "one missing amount should be ok" (isRight e)
assertEqual "balancing amount is added"
@ -339,41 +339,41 @@ tests = TestList [
"my assets" `isAccountNamePrefixOf` "assets:bank" `is` False
,"isTransactionBalanced" ~: do
let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" ""
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting (Just t)
,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting (Just t)
let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" "" []
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting [] (Just t)
,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting [] (Just t)
] ""
assertBool "detect balanced" (isTransactionBalanced t)
let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" ""
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting (Just t)
,Posting False "c" (Mixed [dollars (-1.01)]) "" RegularPosting (Just t)
let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" "" []
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting [] (Just t)
,Posting False "c" (Mixed [dollars (-1.01)]) "" RegularPosting [] (Just t)
] ""
assertBool "detect unbalanced" (not $ isTransactionBalanced t)
let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" ""
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting (Just t)
let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" "" []
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting [] (Just t)
] ""
assertBool "detect unbalanced, one posting" (not $ isTransactionBalanced t)
let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" ""
[Posting False "b" (Mixed [dollars 0]) "" RegularPosting (Just t)
let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" "" []
[Posting False "b" (Mixed [dollars 0]) "" RegularPosting [] (Just t)
] ""
assertBool "one zero posting is considered balanced for now" (isTransactionBalanced t)
let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" ""
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting (Just t)
,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting (Just t)
,Posting False "d" (Mixed [dollars 100]) "" VirtualPosting (Just t)
let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" "" []
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting [] (Just t)
,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting [] (Just t)
,Posting False "d" (Mixed [dollars 100]) "" VirtualPosting [] (Just t)
] ""
assertBool "virtual postings don't need to balance" (isTransactionBalanced t)
let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" ""
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting (Just t)
,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting (Just t)
,Posting False "d" (Mixed [dollars 100]) "" BalancedVirtualPosting (Just t)
let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" "" []
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting [] (Just t)
,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting [] (Just t)
,Posting False "d" (Mixed [dollars 100]) "" BalancedVirtualPosting [] (Just t)
] ""
assertBool "balanced virtual postings need to balance among themselves" (not $ isTransactionBalanced t)
let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" ""
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting (Just t)
,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting (Just t)
,Posting False "d" (Mixed [dollars 100]) "" BalancedVirtualPosting (Just t)
,Posting False "e" (Mixed [dollars (-100)]) "" BalancedVirtualPosting (Just t)
let t = Transaction (parsedate "2009/01/01") Nothing False "" "a" "" []
[Posting False "b" (Mixed [dollars 1.00]) "" RegularPosting [] (Just t)
,Posting False "c" (Mixed [dollars (-1.00)]) "" RegularPosting [] (Just t)
,Posting False "d" (Mixed [dollars 100]) "" BalancedVirtualPosting [] (Just t)
,Posting False "e" (Mixed [dollars (-100)]) "" BalancedVirtualPosting [] (Just t)
] ""
assertBool "balanced virtual postings need to balance among themselves (2)" (isTransactionBalanced t)
@ -894,6 +894,7 @@ journal7 = Journal
tcode="*",
tdescription="opening balance",
tcomment="",
tmetadata=[],
tpostings=[
Posting {
pstatus=False,
@ -901,6 +902,7 @@ journal7 = Journal
pamount=(Mixed [dollars 4.82]),
pcomment="",
ptype=RegularPosting,
pmetadata=[],
ptransaction=Nothing
},
Posting {
@ -909,6 +911,7 @@ journal7 = Journal
pamount=(Mixed [dollars (-4.82)]),
pcomment="",
ptype=RegularPosting,
pmetadata=[],
ptransaction=Nothing
}
],
@ -922,6 +925,7 @@ journal7 = Journal
tcode="*",
tdescription="ayres suites",
tcomment="",
tmetadata=[],
tpostings=[
Posting {
pstatus=False,
@ -929,6 +933,7 @@ journal7 = Journal
pamount=(Mixed [dollars 179.92]),
pcomment="",
ptype=RegularPosting,
pmetadata=[],
ptransaction=Nothing
},
Posting {
@ -937,6 +942,7 @@ journal7 = Journal
pamount=(Mixed [dollars (-179.92)]),
pcomment="",
ptype=RegularPosting,
pmetadata=[],
ptransaction=Nothing
}
],
@ -950,6 +956,7 @@ journal7 = Journal
tcode="*",
tdescription="auto transfer to savings",
tcomment="",
tmetadata=[],
tpostings=[
Posting {
pstatus=False,
@ -957,6 +964,7 @@ journal7 = Journal
pamount=(Mixed [dollars 200]),
pcomment="",
ptype=RegularPosting,
pmetadata=[],
ptransaction=Nothing
},
Posting {
@ -965,6 +973,7 @@ journal7 = Journal
pamount=(Mixed [dollars (-200)]),
pcomment="",
ptype=RegularPosting,
pmetadata=[],
ptransaction=Nothing
}
],
@ -978,6 +987,7 @@ journal7 = Journal
tcode="*",
tdescription="poquito mas",
tcomment="",
tmetadata=[],
tpostings=[
Posting {
pstatus=False,
@ -985,6 +995,7 @@ journal7 = Journal
pamount=(Mixed [dollars 4.82]),
pcomment="",
ptype=RegularPosting,
pmetadata=[],
ptransaction=Nothing
},
Posting {
@ -993,6 +1004,7 @@ journal7 = Journal
pamount=(Mixed [dollars (-4.82)]),
pcomment="",
ptype=RegularPosting,
pmetadata=[],
ptransaction=Nothing
}
],
@ -1006,6 +1018,7 @@ journal7 = Journal
tcode="*",
tdescription="verizon",
tcomment="",
tmetadata=[],
tpostings=[
Posting {
pstatus=False,
@ -1013,6 +1026,7 @@ journal7 = Journal
pamount=(Mixed [dollars 95.11]),
pcomment="",
ptype=RegularPosting,
pmetadata=[],
ptransaction=Nothing
},
Posting {
@ -1021,6 +1035,7 @@ journal7 = Journal
pamount=(Mixed [dollars (-95.11)]),
pcomment="",
ptype=RegularPosting,
pmetadata=[],
ptransaction=Nothing
}
],
@ -1034,6 +1049,7 @@ journal7 = Journal
tcode="*",
tdescription="discover",
tcomment="",
tmetadata=[],
tpostings=[
Posting {
pstatus=False,
@ -1041,6 +1057,7 @@ journal7 = Journal
pamount=(Mixed [dollars 80]),
pcomment="",
ptype=RegularPosting,
pmetadata=[],
ptransaction=Nothing
},
Posting {
@ -1049,6 +1066,7 @@ journal7 = Journal
pamount=(Mixed [dollars (-80)]),
pcomment="",
ptype=RegularPosting,
pmetadata=[],
ptransaction=Nothing
}
],

19
tests/metadata.test Normal file
View File

@ -0,0 +1,19 @@
# we currently should parse and ignore ledger-style metadata attributes
#
bin/hledger -f - print
<<<
2010/01/01
; txndata1: txn val 1
; txndata2: txn val 2
a 1
; posting1data1: posting1 val 1
; posting1data2:
b -1
; posting2data1:
; posting2nonmetadata:
>>>
2010/01/01
a 1
b -1
>>>2