parsing: comments can also start with # in col 0
This commit is contained in:
parent
bab6ec041b
commit
762a1b4d74
@ -34,7 +34,8 @@ module Hledger.Read.JournalReader (
|
||||
amountp',
|
||||
mamountp',
|
||||
numberp,
|
||||
emptyline
|
||||
emptyorcommentlinep,
|
||||
followingcommentp
|
||||
#ifdef TESTS
|
||||
-- * Tests
|
||||
-- disabled by default, HTF not available on windows
|
||||
@ -160,7 +161,7 @@ journal = do
|
||||
, liftM (return . addModifierTransaction) modifiertransaction
|
||||
, liftM (return . addPeriodicTransaction) periodictransaction
|
||||
, liftM (return . addHistoricalPrice) historicalpricedirective
|
||||
, emptyline >> return (return id)
|
||||
, emptyorcommentlinep >> return (return id)
|
||||
] <?> "journal transaction or directive"
|
||||
|
||||
-- cf http://ledger-cli.org/3.0/doc/ledger3.html#Command-Directives
|
||||
@ -326,7 +327,7 @@ transaction = do
|
||||
status <- status <?> "cleared flag"
|
||||
code <- codep <?> "transaction code"
|
||||
description <- descriptionp >>= return . strip
|
||||
comment <- try followingcomment <|> (newline >> return "")
|
||||
comment <- try followingcommentp <|> (newline >> return "")
|
||||
let tags = tagsInComment comment
|
||||
postings <- postings
|
||||
return $ txnTieKnot $ Transaction date edate status code description comment tags postings ""
|
||||
@ -514,7 +515,7 @@ postingp = do
|
||||
_ <- fixedlotprice
|
||||
many spacenonewline
|
||||
ctx <- getState
|
||||
comment <- try followingcomment <|> (newline >> return "")
|
||||
comment <- try followingcommentp <|> (newline >> return "")
|
||||
let tags = tagsInComment comment
|
||||
-- oh boy
|
||||
d <- maybe (return Nothing) (either (fail.show) (return.Just)) (parseWithCtx ctx date `fmap` dateValueFromTags tags)
|
||||
@ -810,23 +811,28 @@ test_numberp = do
|
||||
|
||||
-- comment parsers
|
||||
|
||||
emptyline :: GenParser Char JournalContext ()
|
||||
emptyline = do many spacenonewline
|
||||
optional $ (char ';' <?> "comment") >> many (noneOf "\n")
|
||||
newline
|
||||
return ()
|
||||
emptyorcommentlinep :: GenParser Char JournalContext ()
|
||||
emptyorcommentlinep = do
|
||||
many spacenonewline >> (comment <|> (many spacenonewline >> newline >> return ""))
|
||||
return ()
|
||||
|
||||
followingcomment :: GenParser Char JournalContext String
|
||||
followingcomment =
|
||||
-- ptrace "followingcomment"
|
||||
do samelinecomment <- many spacenonewline >> (try commentline <|> (newline >> return ""))
|
||||
newlinecomments <- many (try (many1 spacenonewline >> commentline))
|
||||
followingcommentp :: GenParser Char JournalContext String
|
||||
followingcommentp =
|
||||
-- ptrace "followingcommentp"
|
||||
do samelinecomment <- many spacenonewline >> (try semicoloncomment <|> (newline >> return ""))
|
||||
newlinecomments <- many (try (many1 spacenonewline >> semicoloncomment))
|
||||
return $ unlines $ samelinecomment:newlinecomments
|
||||
|
||||
commentline :: GenParser Char JournalContext String
|
||||
commentline = do
|
||||
-- ptrace "commentline"
|
||||
char ';'
|
||||
comment :: GenParser Char JournalContext String
|
||||
comment = commentStartingWith "#;"
|
||||
|
||||
semicoloncomment :: GenParser Char JournalContext String
|
||||
semicoloncomment = commentStartingWith ";"
|
||||
|
||||
commentStartingWith :: String -> GenParser Char JournalContext String
|
||||
commentStartingWith cs = do
|
||||
-- ptrace "commentStartingWith"
|
||||
oneOf cs
|
||||
many spacenonewline
|
||||
l <- anyChar `manyTill` eolof
|
||||
optional newline
|
||||
@ -899,7 +905,7 @@ test_Hledger_Read_JournalReader = TestList $ concat [
|
||||
test_spaceandamountormissing,
|
||||
test_tagcomment,
|
||||
test_inlinecomment,
|
||||
test_commentlines,
|
||||
test_comments,
|
||||
test_ledgerDateSyntaxToTags,
|
||||
test_postingp,
|
||||
test_transaction,
|
||||
@ -915,10 +921,10 @@ test_Hledger_Read_JournalReader = TestList $ concat [
|
||||
assertParse (parseWithCtx nullctx directive "account some:account\n")
|
||||
assertParse (parseWithCtx nullctx (directive >> directive) "!account a\nend\n")
|
||||
|
||||
,"commentline" ~: do
|
||||
assertParse (parseWithCtx nullctx commentline "; some comment \n")
|
||||
assertParse (parseWithCtx nullctx commentline " \t; x\n")
|
||||
assertParse (parseWithCtx nullctx commentline ";x")
|
||||
,"comment" ~: do
|
||||
assertParse (parseWithCtx nullctx comment "; some comment \n")
|
||||
assertParse (parseWithCtx nullctx comment " \t; x\n")
|
||||
assertParse (parseWithCtx nullctx comment "#x")
|
||||
|
||||
,"date" ~: do
|
||||
assertParse (parseWithCtx nullctx date "2011/1/1")
|
||||
|
||||
@ -56,7 +56,7 @@ import System.FilePath
|
||||
import Hledger.Data
|
||||
-- XXX too much reuse ?
|
||||
import Hledger.Read.JournalReader (
|
||||
directive, historicalpricedirective, defaultyeardirective, emptyline, datetimep,
|
||||
directive, historicalpricedirective, defaultyeardirective, emptyorcommentlinep, datetimep,
|
||||
parseJournalWith, getParentAccount
|
||||
)
|
||||
import Hledger.Utils
|
||||
@ -91,7 +91,7 @@ timelogFile = do items <- many timelogItem
|
||||
timelogItem = choice [ directive
|
||||
, liftM (return . addHistoricalPrice) historicalpricedirective
|
||||
, defaultyeardirective
|
||||
, emptyline >> return (return id)
|
||||
, emptyorcommentlinep >> return (return id)
|
||||
, liftM (return . addTimeLogEntry) timelogentry
|
||||
] <?> "timelog entry, or default year or historical price directive"
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user