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

lib: use consistent p suffix for parsers

Browse Source
This commit is contained in:
Simon Michael 2015-10-17 11:51:45 -07:00
parent 80ae8f5c50
commit bc43036117
3 changed files with 223 additions and 223 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

112
hledger-lib/Hledger/Read/CsvReader.hs
View File

@ -392,11 +392,11 @@ validateRules rules = do
rulesp :: Stream [Char] m t => ParsecT [Char] CsvRules m CsvRules rulesp :: Stream [Char] m t => ParsecT [Char] CsvRules m CsvRules
rulesp = do rulesp = do
many $ choice' many $ choice'
[blankorcommentline <?> "blank or comment line" [blankorcommentlinep <?> "blank or comment line"
,(directive >>= modifyState . addDirective) <?> "directive" ,(directivep >>= modifyState . addDirective) <?> "directive"
,(fieldnamelist >>= modifyState . setIndexesAndAssignmentsFromList) <?> "field name list" ,(fieldnamelistp >>= modifyState . setIndexesAndAssignmentsFromList) <?> "field name list"
,(fieldassignment >>= modifyState . addAssignment) <?> "field assignment" ,(fieldassignmentp >>= modifyState . addAssignment) <?> "field assignment"
,(conditionalblock >>= modifyState . addConditionalBlock) <?> "conditional block" ,(conditionalblockp >>= modifyState . addConditionalBlock) <?> "conditional block"
] ]
eof eof
r <- getState r <- getState
@ -405,23 +405,23 @@ rulesp = do
,rconditionalblocks=reverse $ rconditionalblocks r ,rconditionalblocks=reverse $ rconditionalblocks r
} }
blankorcommentline :: Stream [Char] m t => ParsecT [Char] CsvRules m () blankorcommentlinep :: Stream [Char] m t => ParsecT [Char] CsvRules m ()
blankorcommentline = pdbg 3 "trying blankorcommentline" >> choice' [blankline, commentline] blankorcommentlinep = pdbg 3 "trying blankorcommentlinep" >> choice' [blanklinep, commentlinep]
blankline :: Stream [Char] m t => ParsecT [Char] CsvRules m () blanklinep :: Stream [Char] m t => ParsecT [Char] CsvRules m ()
blankline = many spacenonewline >> newline >> return () <?> "blank line" blanklinep = many spacenonewline >> newline >> return () <?> "blank line"
commentline :: Stream [Char] m t => ParsecT [Char] CsvRules m () commentlinep :: Stream [Char] m t => ParsecT [Char] CsvRules m ()
commentline = many spacenonewline >> commentchar >> restofline >> return () <?> "comment line" commentlinep = many spacenonewline >> commentcharp >> restofline >> return () <?> "comment line"
commentchar :: Stream [Char] m t => ParsecT [Char] CsvRules m Char commentcharp :: Stream [Char] m t => ParsecT [Char] CsvRules m Char
commentchar = oneOf ";#*" commentcharp = oneOf ";#*"
directive :: Stream [Char] m t => ParsecT [Char] CsvRules m (DirectiveName, String) directivep :: Stream [Char] m t => ParsecT [Char] CsvRules m (DirectiveName, String)
directive = do directivep = do
pdbg 3 "trying directive" pdbg 3 "trying directive"
d <- choice' $ map string directives d <- choice' $ map string directives
v <- (((char ':' >> many spacenonewline) <|> many1 spacenonewline) >> directiveval) v <- (((char ':' >> many spacenonewline) <|> many1 spacenonewline) >> directivevalp)
<|> (optional (char ':') >> many spacenonewline >> eolof >> return "") <|> (optional (char ':') >> many spacenonewline >> eolof >> return "")
return (d,v) return (d,v)
<?> "directive" <?> "directive"
@ -436,46 +436,46 @@ directives =
-- ,"base-currency" -- ,"base-currency"
] ]
directiveval :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char] directivevalp :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char]
directiveval = anyChar `manyTill` eolof directivevalp = anyChar `manyTill` eolof
fieldnamelist :: Stream [Char] m t => ParsecT [Char] CsvRules m [CsvFieldName] fieldnamelistp :: Stream [Char] m t => ParsecT [Char] CsvRules m [CsvFieldName]
fieldnamelist = (do fieldnamelistp = (do
pdbg 3 "trying fieldnamelist" pdbg 3 "trying fieldnamelist"
string "fields" string "fields"
optional $ char ':' optional $ char ':'
many1 spacenonewline many1 spacenonewline
let separator = many spacenonewline >> char ',' >> many spacenonewline let separator = many spacenonewline >> char ',' >> many spacenonewline
f <- fromMaybe "" <$> optionMaybe fieldname f <- fromMaybe "" <$> optionMaybe fieldnamep
fs <- many1 $ (separator >> fromMaybe "" <$> optionMaybe fieldname) fs <- many1 $ (separator >> fromMaybe "" <$> optionMaybe fieldnamep)
restofline restofline
return $ map (map toLower) $ f:fs return $ map (map toLower) $ f:fs
) <?> "field name list" ) <?> "field name list"
fieldname :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char] fieldnamep :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char]
fieldname = quotedfieldname <|> barefieldname fieldnamep = quotedfieldnamep <|> barefieldnamep
quotedfieldname :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char] quotedfieldnamep :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char]
quotedfieldname = do quotedfieldnamep = do
char '"' char '"'
f <- many1 $ noneOf "\"\n:;#~" f <- many1 $ noneOf "\"\n:;#~"
char '"' char '"'
return f return f
barefieldname :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char] barefieldnamep :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char]
barefieldname = many1 $ noneOf " \t\n,;#~" barefieldnamep = many1 $ noneOf " \t\n,;#~"
fieldassignment :: Stream [Char] m t => ParsecT [Char] CsvRules m (JournalFieldName, FieldTemplate) fieldassignmentp :: Stream [Char] m t => ParsecT [Char] CsvRules m (JournalFieldName, FieldTemplate)
fieldassignment = do fieldassignmentp = do
pdbg 3 "trying fieldassignment" pdbg 3 "trying fieldassignment"
f <- journalfieldname f <- journalfieldnamep
assignmentseparator assignmentseparatorp
v <- fieldval v <- fieldvalp
return (f,v) return (f,v)
<?> "field assignment" <?> "field assignment"
journalfieldname :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char] journalfieldnamep :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char]
journalfieldname = pdbg 2 "trying journalfieldname" >> choice' (map string journalfieldnames) journalfieldnamep = pdbg 2 "trying journalfieldnamep" >> choice' (map string journalfieldnames)
journalfieldnames = journalfieldnames =
[-- pseudo fields: [-- pseudo fields:
@ -494,9 +494,9 @@ journalfieldnames =
,"comment" ,"comment"
] ]
assignmentseparator :: Stream [Char] m t => ParsecT [Char] CsvRules m () assignmentseparatorp :: Stream [Char] m t => ParsecT [Char] CsvRules m ()
assignmentseparator = do assignmentseparatorp = do
pdbg 3 "trying assignmentseparator" pdbg 3 "trying assignmentseparatorp"
choice [ choice [
-- try (many spacenonewline >> oneOf ":="), -- try (many spacenonewline >> oneOf ":="),
try (many spacenonewline >> char ':'), try (many spacenonewline >> char ':'),
@ -505,51 +505,51 @@ assignmentseparator = do
_ <- many spacenonewline _ <- many spacenonewline
return () return ()
fieldval :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char] fieldvalp :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char]
fieldval = do fieldvalp = do
pdbg 2 "trying fieldval" pdbg 2 "trying fieldval"
anyChar `manyTill` eolof anyChar `manyTill` eolof
conditionalblock :: Stream [Char] m t => ParsecT [Char] CsvRules m ConditionalBlock conditionalblockp :: Stream [Char] m t => ParsecT [Char] CsvRules m ConditionalBlock
conditionalblock = do conditionalblockp = do
pdbg 3 "trying conditionalblock" pdbg 3 "trying conditionalblockp"
string "if" >> many spacenonewline >> optional newline string "if" >> many spacenonewline >> optional newline
ms <- many1 recordmatcher ms <- many1 recordmatcherp
as <- many (many1 spacenonewline >> fieldassignment) as <- many (many1 spacenonewline >> fieldassignmentp)
when (null as) $ when (null as) $
fail "start of conditional block found, but no assignment rules afterward\n(assignment rules in a conditional block should be indented)\n" fail "start of conditional block found, but no assignment rules afterward\n(assignment rules in a conditional block should be indented)\n"
return (ms, as) return (ms, as)
<?> "conditional block" <?> "conditional block"
recordmatcher :: Stream [Char] m t => ParsecT [Char] CsvRules m [[Char]] recordmatcherp :: Stream [Char] m t => ParsecT [Char] CsvRules m [[Char]]
recordmatcher = do recordmatcherp = do
pdbg 2 "trying recordmatcher" pdbg 2 "trying recordmatcherp"
-- pos <- currentPos -- pos <- currentPos
_ <- optional (matchoperator >> many spacenonewline >> optional newline) _ <- optional (matchoperatorp >> many spacenonewline >> optional newline)
ps <- patterns ps <- patternsp
when (null ps) $ when (null ps) $
fail "start of record matcher found, but no patterns afterward\n(patterns should not be indented)\n" fail "start of record matcher found, but no patterns afterward\n(patterns should not be indented)\n"
return ps return ps
<?> "record matcher" <?> "record matcher"
matchoperator :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char] matchoperatorp :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char]
matchoperator = choice' $ map string matchoperatorp = choice' $ map string
["~" ["~"
-- ,"!~" -- ,"!~"
-- ,"=" -- ,"="
-- ,"!=" -- ,"!="
] ]
patterns :: Stream [Char] m t => ParsecT [Char] CsvRules m [[Char]] patternsp :: Stream [Char] m t => ParsecT [Char] CsvRules m [[Char]]
patterns = do patternsp = do
pdbg 3 "trying patterns" pdbg 3 "trying patternsp"
ps <- many regexp ps <- many regexp
return ps return ps
regexp :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char] regexp :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char]
regexp = do regexp = do
pdbg 3 "trying regexp" pdbg 3 "trying regexp"
notFollowedBy matchoperator notFollowedBy matchoperatorp
c <- nonspace c <- nonspace
cs <- anyChar `manyTill` eolof cs <- anyChar `manyTill` eolof
return $ strip $ c:cs return $ strip $ c:cs

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

@ -24,10 +24,10 @@ module Hledger.Read.JournalReader (
parseJournalWith, parseJournalWith,
genericSourcePos, genericSourcePos,
getParentAccount, getParentAccount,
journal, journalp,
directive, directivep,
defaultyeardirective, defaultyeardirectivep,
marketpricedirective, marketpricedirectivep,
datetimep, datetimep,
codep, codep,
accountnamep, accountnamep,
@ -94,7 +94,7 @@ detect f s
-- | Parse and post-process a "Journal" from hledger's journal file -- | Parse and post-process a "Journal" from hledger's journal file
-- format, or give an error. -- format, or give an error.
parse :: Maybe FilePath -> Bool -> FilePath -> String -> ExceptT String IO Journal parse :: Maybe FilePath -> Bool -> FilePath -> String -> ExceptT String IO Journal
parse _ = parseJournalWith journal parse _ = parseJournalWith journalp
-- parsing utils -- parsing utils
@ -215,8 +215,8 @@ clearAccountAliases = modifyState (\(ctx@Ctx{..}) -> ctx{ctxAliases=[]})
-- | Top-level journal parser. Returns a single composite, I/O performing, -- | Top-level journal parser. Returns a single composite, I/O performing,
-- error-raising "JournalUpdate" (and final "JournalContext") which can be -- error-raising "JournalUpdate" (and final "JournalContext") which can be
-- applied to an empty journal to get the final result. -- applied to an empty journal to get the final result.
journal :: ParsecT [Char] JournalContext (ExceptT String IO) (JournalUpdate,JournalContext) journalp :: ParsecT [Char] JournalContext (ExceptT String IO) (JournalUpdate,JournalContext)
journal = do journalp = do
journalupdates <- many journalItem journalupdates <- many journalItem
eof eof
finalctx <- getState finalctx <- getState
@ -225,36 +225,36 @@ journal = do
-- As all journal line types can be distinguished by the first -- As all journal line types can be distinguished by the first
-- character, excepting transactions versus empty (blank or -- character, excepting transactions versus empty (blank or
-- comment-only) lines, can use choice w/o try -- comment-only) lines, can use choice w/o try
journalItem = choice [ directive journalItem = choice [ directivep
, liftM (return . addTransaction) transaction , liftM (return . addTransaction) transactionp
, liftM (return . addModifierTransaction) modifiertransaction , liftM (return . addModifierTransaction) modifiertransactionp
, liftM (return . addPeriodicTransaction) periodictransaction , liftM (return . addPeriodicTransaction) periodictransactionp
, liftM (return . addMarketPrice) marketpricedirective , liftM (return . addMarketPrice) marketpricedirectivep
, emptyorcommentlinep >> return (return id) , emptyorcommentlinep >> return (return id)
, multilinecommentp >> return (return id) , multilinecommentp >> return (return id)
] <?> "journal transaction or directive" ] <?> "journal transaction or directive"
-- 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 :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate directivep :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
directive = do directivep = do
optional $ char '!' optional $ char '!'
choice' [ choice' [
includedirective includedirectivep
,aliasdirective ,aliasdirectivep
,endaliasesdirective ,endaliasesdirectivep
,accountdirective ,accountdirectivep
,enddirective ,enddirectivep
,tagdirective ,tagdirectivep
,endtagdirective ,endtagdirectivep
,defaultyeardirective ,defaultyeardirectivep
,defaultcommoditydirective ,defaultcommoditydirectivep
,commodityconversiondirective ,commodityconversiondirectivep
,ignoredpricecommoditydirective ,ignoredpricecommoditydirectivep
] ]
<?> "directive" <?> "directive"
includedirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate includedirectivep :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
includedirective = do includedirectivep = do
string "include" string "include"
many1 spacenonewline many1 spacenonewline
filename <- restofline filename <- restofline
@ -265,7 +265,7 @@ includedirective = do
filepath <- expandPath curdir filename filepath <- expandPath curdir filename
txt <- readFileOrError outerPos filepath txt <- readFileOrError outerPos filepath
let inIncluded = show outerPos ++ " in included file " ++ show filename ++ ":\n" let inIncluded = show outerPos ++ " in included file " ++ show filename ++ ":\n"
r <- runParserT journal outerState filepath txt r <- runParserT journalp outerState filepath txt
case r of case r of
Right (ju, ctx) -> do Right (ju, ctx) -> do
u <- combineJournalUpdates [ return $ journalAddFile (filepath,txt) u <- combineJournalUpdates [ return $ journalAddFile (filepath,txt)
@ -285,8 +285,8 @@ journalAddFile :: (FilePath,String) -> Journal -> Journal
journalAddFile f j@Journal{files=fs} = j{files=fs++[f]} journalAddFile f j@Journal{files=fs} = j{files=fs++[f]}
-- NOTE: first encountered file to left, to avoid a reverse -- NOTE: first encountered file to left, to avoid a reverse
accountdirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate accountdirectivep :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
accountdirective = do accountdirectivep = do
string "account" string "account"
many1 spacenonewline many1 spacenonewline
parent <- accountnamep parent <- accountnamep
@ -295,15 +295,15 @@ accountdirective = do
-- return $ return id -- return $ return id
return $ ExceptT $ return $ Right id return $ ExceptT $ return $ Right id
enddirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate enddirectivep :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
enddirective = do enddirectivep = do
string "end" string "end"
popParentAccount popParentAccount
-- return (return id) -- return (return id)
return $ ExceptT $ return $ Right id return $ ExceptT $ return $ Right id
aliasdirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate aliasdirectivep :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
aliasdirective = do aliasdirectivep = do
string "alias" string "alias"
many1 spacenonewline many1 spacenonewline
alias <- accountaliasp alias <- accountaliasp
@ -334,28 +334,28 @@ regexaliasp = do
repl <- rstrip <$> anyChar `manyTill` eolof repl <- rstrip <$> anyChar `manyTill` eolof
return $ RegexAlias re repl return $ RegexAlias re repl
endaliasesdirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate endaliasesdirectivep :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
endaliasesdirective = do endaliasesdirectivep = do
string "end aliases" string "end aliases"
clearAccountAliases clearAccountAliases
return (return id) return (return id)
tagdirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate tagdirectivep :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
tagdirective = do tagdirectivep = do
string "tag" <?> "tag directive" string "tag" <?> "tag directive"
many1 spacenonewline many1 spacenonewline
_ <- many1 nonspace _ <- many1 nonspace
restofline restofline
return $ return id return $ return id
endtagdirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate endtagdirectivep :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
endtagdirective = do endtagdirectivep = do
(string "end tag" <|> string "pop") <?> "end tag or pop directive" (string "end tag" <|> string "pop") <?> "end tag or pop directive"
restofline restofline
return $ return id return $ return id
defaultyeardirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate defaultyeardirectivep :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
defaultyeardirective = do defaultyeardirectivep = do
char 'Y' <?> "default year" char 'Y' <?> "default year"
many spacenonewline many spacenonewline
y <- many1 digit y <- many1 digit
@ -364,8 +364,8 @@ defaultyeardirective = do
setYear y' setYear y'
return $ return id return $ return id
defaultcommoditydirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate defaultcommoditydirectivep :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
defaultcommoditydirective = do defaultcommoditydirectivep = do
char 'D' <?> "default commodity" char 'D' <?> "default commodity"
many1 spacenonewline many1 spacenonewline
Amount{..} <- amountp Amount{..} <- amountp
@ -373,28 +373,28 @@ defaultcommoditydirective = do
restofline restofline
return $ return id return $ return id
marketpricedirective :: ParsecT [Char] JournalContext (ExceptT String IO) MarketPrice marketpricedirectivep :: ParsecT [Char] JournalContext (ExceptT String IO) MarketPrice
marketpricedirective = do marketpricedirectivep = do
char 'P' <?> "market price" char 'P' <?> "market price"
many spacenonewline many spacenonewline
date <- try (do {LocalTime d _ <- datetimep; return d}) <|> datep -- a time is ignored date <- try (do {LocalTime d _ <- datetimep; return d}) <|> datep -- a time is ignored
many1 spacenonewline many1 spacenonewline
symbol <- commoditysymbol symbol <- commoditysymbolp
many spacenonewline many spacenonewline
price <- amountp price <- amountp
restofline restofline
return $ MarketPrice date symbol price return $ MarketPrice date symbol price
ignoredpricecommoditydirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate ignoredpricecommoditydirectivep :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
ignoredpricecommoditydirective = do ignoredpricecommoditydirectivep = do
char 'N' <?> "ignored-price commodity" char 'N' <?> "ignored-price commodity"
many1 spacenonewline many1 spacenonewline
commoditysymbol commoditysymbolp
restofline restofline
return $ return id return $ return id
commodityconversiondirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate commodityconversiondirectivep :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
commodityconversiondirective = do commodityconversiondirectivep = do
char 'C' <?> "commodity conversion" char 'C' <?> "commodity conversion"
many1 spacenonewline many1 spacenonewline
amountp amountp
@ -405,26 +405,26 @@ commodityconversiondirective = do
restofline restofline
return $ return id return $ return id
modifiertransaction :: ParsecT [Char] JournalContext (ExceptT String IO) ModifierTransaction modifiertransactionp :: ParsecT [Char] JournalContext (ExceptT String IO) ModifierTransaction
modifiertransaction = do modifiertransactionp = do
char '=' <?> "modifier transaction" char '=' <?> "modifier transaction"
many spacenonewline many spacenonewline
valueexpr <- restofline valueexpr <- restofline
postings <- postings postings <- postingsp
return $ ModifierTransaction valueexpr postings return $ ModifierTransaction valueexpr postings
periodictransaction :: ParsecT [Char] JournalContext (ExceptT String IO) PeriodicTransaction periodictransactionp :: ParsecT [Char] JournalContext (ExceptT String IO) PeriodicTransaction
periodictransaction = do periodictransactionp = do
char '~' <?> "periodic transaction" char '~' <?> "periodic transaction"
many spacenonewline many spacenonewline
periodexpr <- restofline periodexpr <- restofline
postings <- postings postings <- postingsp
return $ PeriodicTransaction periodexpr postings return $ PeriodicTransaction periodexpr postings
-- | Parse a (possibly unbalanced) transaction. -- | Parse a (possibly unbalanced) transaction.
transaction :: ParsecT [Char] JournalContext (ExceptT String IO) Transaction transactionp :: ParsecT [Char] JournalContext (ExceptT String IO) Transaction
transaction = do transactionp = do
-- ptrace "transaction" -- ptrace "transactionp"
sourcepos <- genericSourcePos <$> getPosition sourcepos <- genericSourcePos <$> getPosition
date <- datep <?> "transaction" date <- datep <?> "transaction"
edate <- optionMaybe (secondarydatep date) <?> "secondary date" edate <- optionMaybe (secondarydatep date) <?> "secondary date"
@ -434,15 +434,15 @@ transaction = do
description <- descriptionp >>= return . strip description <- descriptionp >>= return . strip
comment <- try followingcommentp <|> (newline >> return "") comment <- try followingcommentp <|> (newline >> return "")
let tags = tagsInComment comment let tags = tagsInComment comment
postings <- postings postings <- postingsp
return $ txnTieKnot $ Transaction sourcepos date edate status code description comment tags postings "" return $ txnTieKnot $ Transaction sourcepos date edate status code description comment tags postings ""
descriptionp = many (noneOf ";\n") descriptionp = many (noneOf ";\n")
#ifdef TESTS #ifdef TESTS
test_transaction = do test_transactionp = do
let s `gives` t = do let s `gives` t = do
let p = parseWithCtx nullctx transaction s let p = parseWithCtx nullctx transactionp s
assertBool $ isRight p assertBool $ isRight p
let Right t2 = p let Right t2 = p
-- same f = assertEqual (f t) (f t2) -- same f = assertEqual (f t) (f t2)
@ -495,33 +495,33 @@ test_transaction = do
tdate=parsedate "2015/01/01", tdate=parsedate "2015/01/01",
} }
assertRight $ parseWithCtx nullctx transaction $ unlines assertRight $ parseWithCtx nullctx transactionp $ unlines
["2007/01/28 coopportunity" ["2007/01/28 coopportunity"
," expenses:food:groceries $47.18" ," expenses:food:groceries $47.18"
," assets:checking $-47.18" ," assets:checking $-47.18"
,"" ,""
] ]
-- transaction should not parse just a date -- transactionp should not parse just a date
assertLeft $ parseWithCtx nullctx transaction "2009/1/1\n" assertLeft $ parseWithCtx nullctx transactionp "2009/1/1\n"
-- transaction should not parse just a date and description -- transactionp should not parse just a date and description
assertLeft $ parseWithCtx nullctx transaction "2009/1/1 a\n" assertLeft $ parseWithCtx nullctx transactionp "2009/1/1 a\n"
-- transaction should not parse a following comment as part of the description -- transactionp should not parse a following comment as part of the description
let p = parseWithCtx nullctx transaction "2009/1/1 a ;comment\n b 1\n" let p = parseWithCtx nullctx transactionp "2009/1/1 a ;comment\n b 1\n"
assertRight p assertRight p
assertEqual "a" (let Right p' = p in tdescription p') assertEqual "a" (let Right p' = p in tdescription p')
-- parse transaction with following whitespace line -- parse transaction with following whitespace line
assertRight $ parseWithCtx nullctx transaction $ unlines assertRight $ parseWithCtx nullctx transactionp $ unlines
["2012/1/1" ["2012/1/1"
," a 1" ," a 1"
," b" ," b"
," " ," "
] ]
let p = parseWithCtx nullctx transaction $ unlines let p = parseWithCtx nullctx transactionp $ unlines
["2009/1/1 x ; transaction comment" ["2009/1/1 x ; transaction comment"
," a 1 ; posting 1 comment" ," a 1 ; posting 1 comment"
," ; posting 1 comment 2" ," ; posting 1 comment 2"
@ -620,8 +620,8 @@ codep :: Stream [Char] m Char => ParsecT [Char] JournalContext m String
codep = try (do { many1 spacenonewline; char '(' <?> "codep"; code <- anyChar `manyTill` char ')'; return code } ) <|> return "" codep = try (do { many1 spacenonewline; char '(' <?> "codep"; code <- anyChar `manyTill` char ')'; return code } ) <|> return ""
-- Parse the following whitespace-beginning lines as postings, posting tags, and/or comments. -- Parse the following whitespace-beginning lines as postings, posting tags, and/or comments.
postings :: Stream [Char] m Char => ParsecT [Char] JournalContext m [Posting] postingsp :: Stream [Char] m Char => ParsecT [Char] JournalContext m [Posting]
postings = many (try postingp) <?> "postings" postingsp = many (try postingp) <?> "postings"
-- linebeginningwithspaces :: Stream [Char] m Char => ParsecT [Char] JournalContext m String -- linebeginningwithspaces :: Stream [Char] m Char => ParsecT [Char] JournalContext m String
-- linebeginningwithspaces = do -- linebeginningwithspaces = do
@ -637,9 +637,9 @@ postingp = do
many spacenonewline many spacenonewline
account <- modifiedaccountnamep account <- modifiedaccountnamep
let (ptype, account') = (accountNamePostingType account, unbracket account) let (ptype, account') = (accountNamePostingType account, unbracket account)
amount <- spaceandamountormissing amount <- spaceandamountormissingp
massertion <- partialbalanceassertion massertion <- partialbalanceassertionp
_ <- fixedlotprice _ <- fixedlotpricep
many spacenonewline many spacenonewline
ctx <- getState ctx <- getState
comment <- try followingcommentp <|> (newline >> return "") comment <- try followingcommentp <|> (newline >> return "")
@ -751,8 +751,8 @@ accountnamep = do
-- | Parse whitespace then an amount, with an optional left or right -- | Parse whitespace then an amount, with an optional left or right
-- currency symbol and optional price, or return the special -- currency symbol and optional price, or return the special
-- "missing" marker amount. -- "missing" marker amount.
spaceandamountormissing :: Stream [Char] m Char => ParsecT [Char] JournalContext m MixedAmount spaceandamountormissingp :: Stream [Char] m Char => ParsecT [Char] JournalContext m MixedAmount
spaceandamountormissing = spaceandamountormissingp =
try (do try (do
many1 spacenonewline many1 spacenonewline
(Mixed . (:[])) `fmap` amountp <|> return missingmixedamt (Mixed . (:[])) `fmap` amountp <|> return missingmixedamt
@ -765,18 +765,18 @@ assertParseEqual' parse expected = either (assertFailure.show) (`is'` expected)
is' :: (Eq a, Show a) => a -> a -> Assertion is' :: (Eq a, Show a) => a -> a -> Assertion
a `is'` e = assertEqual e a a `is'` e = assertEqual e a
test_spaceandamountormissing = do test_spaceandamountormissingp = do
assertParseEqual' (parseWithCtx nullctx spaceandamountormissing " $47.18") (Mixed [usd 47.18]) assertParseEqual' (parseWithCtx nullctx spaceandamountormissingp " $47.18") (Mixed [usd 47.18])
assertParseEqual' (parseWithCtx nullctx spaceandamountormissing "$47.18") missingmixedamt assertParseEqual' (parseWithCtx nullctx spaceandamountormissingp "$47.18") missingmixedamt
assertParseEqual' (parseWithCtx nullctx spaceandamountormissing " ") missingmixedamt assertParseEqual' (parseWithCtx nullctx spaceandamountormissingp " ") missingmixedamt
assertParseEqual' (parseWithCtx nullctx spaceandamountormissing "") missingmixedamt assertParseEqual' (parseWithCtx nullctx spaceandamountormissingp "") missingmixedamt
#endif #endif
-- | Parse a single-commodity amount, with optional symbol on the left or -- | Parse a single-commodity amount, with optional symbol on the left or
-- right, optional unit or total price, and optional (ignored) -- right, optional unit or total price, and optional (ignored)
-- ledger-style balance assertion or fixed lot price declaration. -- ledger-style balance assertion or fixed lot price declaration.
amountp :: Stream [Char] m t => ParsecT [Char] JournalContext m Amount amountp :: Stream [Char] m t => ParsecT [Char] JournalContext m Amount
amountp = try leftsymbolamount <|> try rightsymbolamount <|> nosymbolamount amountp = try leftsymbolamountp <|> try rightsymbolamountp <|> nosymbolamountp
#ifdef TESTS #ifdef TESTS
test_amountp = do test_amountp = do
@ -809,32 +809,32 @@ signp = do
return $ case sign of Just '-' -> "-" return $ case sign of Just '-' -> "-"
_ -> "" _ -> ""
leftsymbolamount :: Stream [Char] m t => ParsecT [Char] JournalContext m Amount leftsymbolamountp :: Stream [Char] m t => ParsecT [Char] JournalContext m Amount
leftsymbolamount = do leftsymbolamountp = do
sign <- signp sign <- signp
c <- commoditysymbol c <- commoditysymbolp
sp <- many spacenonewline sp <- many spacenonewline
(q,prec,mdec,mgrps) <- numberp (q,prec,mdec,mgrps) <- numberp
let s = amountstyle{ascommodityside=L, ascommodityspaced=not $ null sp, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps} let s = amountstyle{ascommodityside=L, ascommodityspaced=not $ null sp, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps}
p <- priceamount p <- priceamountp
let applysign = if sign=="-" then negate else id let applysign = if sign=="-" then negate else id
return $ applysign $ Amount c q p s return $ applysign $ Amount c q p s
<?> "left-symbol amount" <?> "left-symbol amount"
rightsymbolamount :: Stream [Char] m t => ParsecT [Char] JournalContext m Amount rightsymbolamountp :: Stream [Char] m t => ParsecT [Char] JournalContext m Amount
rightsymbolamount = do rightsymbolamountp = do
(q,prec,mdec,mgrps) <- numberp (q,prec,mdec,mgrps) <- numberp
sp <- many spacenonewline sp <- many spacenonewline
c <- commoditysymbol c <- commoditysymbolp
p <- priceamount p <- priceamountp
let s = amountstyle{ascommodityside=R, ascommodityspaced=not $ null sp, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps} let s = amountstyle{ascommodityside=R, ascommodityspaced=not $ null sp, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps}
return $ Amount c q p s return $ Amount c q p s
<?> "right-symbol amount" <?> "right-symbol amount"
nosymbolamount :: Stream [Char] m t => ParsecT [Char] JournalContext m Amount nosymbolamountp :: Stream [Char] m t => ParsecT [Char] JournalContext m Amount
nosymbolamount = do nosymbolamountp = do
(q,prec,mdec,mgrps) <- numberp (q,prec,mdec,mgrps) <- numberp
p <- priceamount p <- priceamountp
-- apply the most recently seen default commodity and style to this commodityless amount -- apply the most recently seen default commodity and style to this commodityless amount
defcs <- getDefaultCommodityAndStyle defcs <- getDefaultCommodityAndStyle
let (c,s) = case defcs of let (c,s) = case defcs of
@ -843,21 +843,21 @@ nosymbolamount = do
return $ Amount c q p s return $ Amount c q p s
<?> "no-symbol amount" <?> "no-symbol amount"
commoditysymbol :: Stream [Char] m t => ParsecT [Char] JournalContext m String commoditysymbolp :: Stream [Char] m t => ParsecT [Char] JournalContext m String
commoditysymbol = (quotedcommoditysymbol <|> simplecommoditysymbol) <?> "commodity symbol" commoditysymbolp = (quotedcommoditysymbolp <|> simplecommoditysymbolp) <?> "commodity symbol"
quotedcommoditysymbol :: Stream [Char] m t => ParsecT [Char] JournalContext m String quotedcommoditysymbolp :: Stream [Char] m t => ParsecT [Char] JournalContext m String
quotedcommoditysymbol = do quotedcommoditysymbolp = do
char '"' char '"'
s <- many1 $ noneOf ";\n\"" s <- many1 $ noneOf ";\n\""
char '"' char '"'
return s return s
simplecommoditysymbol :: Stream [Char] m t => ParsecT [Char] JournalContext m String simplecommoditysymbolp :: Stream [Char] m t => ParsecT [Char] JournalContext m String
simplecommoditysymbol = many1 (noneOf nonsimplecommoditychars) simplecommoditysymbolp = many1 (noneOf nonsimplecommoditychars)
priceamount :: Stream [Char] m t => ParsecT [Char] JournalContext m Price priceamountp :: Stream [Char] m t => ParsecT [Char] JournalContext m Price
priceamount = priceamountp =
try (do try (do
many spacenonewline many spacenonewline
char '@' char '@'
@ -872,8 +872,8 @@ priceamount =
return $ UnitPrice a)) return $ UnitPrice a))
<|> return NoPrice <|> return NoPrice
partialbalanceassertion :: Stream [Char] m t => ParsecT [Char] JournalContext m (Maybe MixedAmount) partialbalanceassertionp :: Stream [Char] m t => ParsecT [Char] JournalContext m (Maybe MixedAmount)
partialbalanceassertion = partialbalanceassertionp =
try (do try (do
many spacenonewline many spacenonewline
char '=' char '='
@ -893,8 +893,8 @@ partialbalanceassertion =
-- <|> return Nothing -- <|> return Nothing
-- http://ledger-cli.org/3.0/doc/ledger3.html#Fixing-Lot-Prices -- http://ledger-cli.org/3.0/doc/ledger3.html#Fixing-Lot-Prices
fixedlotprice :: Stream [Char] m Char => ParsecT [Char] JournalContext m (Maybe Amount) fixedlotpricep :: Stream [Char] m Char => ParsecT [Char] JournalContext m (Maybe Amount)
fixedlotprice = fixedlotpricep =
try (do try (do
many spacenonewline many spacenonewline
char '{' char '{'
@ -1004,27 +1004,27 @@ multilinecommentp = do
emptyorcommentlinep :: Stream [Char] m Char => ParsecT [Char] JournalContext m () emptyorcommentlinep :: Stream [Char] m Char => ParsecT [Char] JournalContext m ()
emptyorcommentlinep = do emptyorcommentlinep = do
many spacenonewline >> (comment <|> (many spacenonewline >> newline >> return "")) many spacenonewline >> (commentp <|> (many spacenonewline >> newline >> return ""))
return () return ()
followingcommentp :: Stream [Char] m Char => ParsecT [Char] JournalContext m String followingcommentp :: Stream [Char] m Char => ParsecT [Char] JournalContext m String
followingcommentp = followingcommentp =
-- ptrace "followingcommentp" -- ptrace "followingcommentp"
do samelinecomment <- many spacenonewline >> (try semicoloncomment <|> (newline >> return "")) do samelinecomment <- many spacenonewline >> (try semicoloncommentp <|> (newline >> return ""))
newlinecomments <- many (try (many1 spacenonewline >> semicoloncomment)) newlinecomments <- many (try (many1 spacenonewline >> semicoloncommentp))
return $ unlines $ samelinecomment:newlinecomments return $ unlines $ samelinecomment:newlinecomments
comment :: Stream [Char] m Char => ParsecT [Char] JournalContext m String commentp :: Stream [Char] m Char => ParsecT [Char] JournalContext m String
comment = commentStartingWith commentchars commentp = commentStartingWithp commentchars
commentchars :: [Char] commentchars :: [Char]
commentchars = "#;*" commentchars = "#;*"
semicoloncomment :: Stream [Char] m Char => ParsecT [Char] JournalContext m String semicoloncommentp :: Stream [Char] m Char => ParsecT [Char] JournalContext m String
semicoloncomment = commentStartingWith ";" semicoloncommentp = commentStartingWithp ";"
commentStartingWith :: Stream [Char] m Char => String -> ParsecT [Char] JournalContext m String commentStartingWithp :: Stream [Char] m Char => String -> ParsecT [Char] JournalContext m String
commentStartingWith cs = do commentStartingWithp cs = do
-- ptrace "commentStartingWith" -- ptrace "commentStartingWith"
oneOf cs oneOf cs
many spacenonewline many spacenonewline
@ -1040,23 +1040,23 @@ tagsInComment c = concatMap tagsInCommentLine $ lines c'
tagsInCommentLine :: String -> [Tag] tagsInCommentLine :: String -> [Tag]
tagsInCommentLine = catMaybes . map maybetag . map strip . splitAtElement ',' tagsInCommentLine = catMaybes . map maybetag . map strip . splitAtElement ','
where where
maybetag s = case runParser (tag <* eof) nullctx "" s of maybetag s = case runParser (tagp <* eof) nullctx "" s of
Right t -> Just t Right t -> Just t
Left _ -> Nothing Left _ -> Nothing
tag = do tagp = do
-- ptrace "tag" -- ptrace "tag"
n <- tagname n <- tagnamep
v <- tagvalue v <- tagvaluep
return (n,v) return (n,v)
tagname = do tagnamep = do
-- ptrace "tagname" -- ptrace "tagname"
n <- many1 $ noneOf ": \t" n <- many1 $ noneOf ": \t"
char ':' char ':'
return n return n
tagvalue = do tagvaluep = do
-- ptrace "tagvalue" -- ptrace "tagvalue"
v <- anyChar `manyTill` ((char ',' >> return ()) <|> eolof) v <- anyChar `manyTill` ((char ',' >> return ()) <|> eolof)
return $ strip $ reverse $ dropWhile (==',') $ reverse $ strip v return $ strip $ reverse $ dropWhile (==',') $ reverse $ strip v
@ -1100,24 +1100,24 @@ tests_Hledger_Read_JournalReader = TestList $ concat [
tests_Hledger_Read_JournalReader = TestList $ concat [ tests_Hledger_Read_JournalReader = TestList $ concat [
test_numberp, test_numberp,
test_amountp, test_amountp,
test_spaceandamountormissing, test_spaceandamountormissingp,
test_tagcomment, test_tagcomment,
test_inlinecomment, test_inlinecomment,
test_comments, test_comments,
test_ledgerDateSyntaxToTags, test_ledgerDateSyntaxToTags,
test_postingp, test_postingp,
test_transaction, test_transactionp,
[ [
"modifiertransaction" ~: do "modifiertransactionp" ~: do
assertParse (parseWithCtx nullctx modifiertransaction "= (some value expr)\n some:postings 1\n") assertParse (parseWithCtx nullctx modifiertransactionp "= (some value expr)\n some:postings 1\n")
,"periodictransaction" ~: do ,"periodictransactionp" ~: do
assertParse (parseWithCtx nullctx periodictransaction "~ (some period expr)\n some:postings 1\n") assertParse (parseWithCtx nullctx periodictransactionp "~ (some period expr)\n some:postings 1\n")
,"directive" ~: do ,"directivep" ~: do
assertParse (parseWithCtx nullctx directive "!include /some/file.x\n") assertParse (parseWithCtx nullctx directivep "!include /some/file.x\n")
assertParse (parseWithCtx nullctx directive "account some:account\n") assertParse (parseWithCtx nullctx directivep "account some:account\n")
assertParse (parseWithCtx nullctx (directive >> directive) "!account a\nend\n") assertParse (parseWithCtx nullctx (directivep >> directivep) "!account a\nend\n")
,"comment" ~: do ,"comment" ~: do
assertParse (parseWithCtx nullctx comment "; some comment \n") assertParse (parseWithCtx nullctx comment "; some comment \n")
@ -1145,28 +1145,28 @@ tests_Hledger_Read_JournalReader = TestList $ concat [
assertParseEqual (parseWithCtx nullctx p "2011/1/1 00:00-0800") startofday assertParseEqual (parseWithCtx nullctx p "2011/1/1 00:00-0800") startofday
assertParseEqual (parseWithCtx nullctx p "2011/1/1 00:00+1234") startofday assertParseEqual (parseWithCtx nullctx p "2011/1/1 00:00+1234") startofday
,"defaultyeardirective" ~: do ,"defaultyeardirectivep" ~: do
assertParse (parseWithCtx nullctx defaultyeardirective "Y 2010\n") assertParse (parseWithCtx nullctx defaultyeardirectivep "Y 2010\n")
assertParse (parseWithCtx nullctx defaultyeardirective "Y 10001\n") assertParse (parseWithCtx nullctx defaultyeardirectivep "Y 10001\n")
,"marketpricedirective" ~: ,"marketpricedirectivep" ~:
assertParseEqual (parseWithCtx nullctx marketpricedirective "P 2004/05/01 XYZ $55.00\n") (MarketPrice (parsedate "2004/05/01") "XYZ" $ usd 55) assertParseEqual (parseWithCtx nullctx marketpricedirectivep "P 2004/05/01 XYZ $55.00\n") (MarketPrice (parsedate "2004/05/01") "XYZ" $ usd 55)
,"ignoredpricecommoditydirective" ~: do ,"ignoredpricecommoditydirectivep" ~: do
assertParse (parseWithCtx nullctx ignoredpricecommoditydirective "N $\n") assertParse (parseWithCtx nullctx ignoredpricecommoditydirectivep "N $\n")
,"defaultcommoditydirective" ~: do ,"defaultcommoditydirectivep" ~: do
assertParse (parseWithCtx nullctx defaultcommoditydirective "D $1,000.0\n") assertParse (parseWithCtx nullctx defaultcommoditydirectivep "D $1,000.0\n")
,"commodityconversiondirective" ~: do ,"commodityconversiondirectivep" ~: do
assertParse (parseWithCtx nullctx commodityconversiondirective "C 1h = $50.00\n") assertParse (parseWithCtx nullctx commodityconversiondirectivep "C 1h = $50.00\n")
,"tagdirective" ~: do ,"tagdirectivep" ~: do
assertParse (parseWithCtx nullctx tagdirective "tag foo \n") assertParse (parseWithCtx nullctx tagdirectivep "tag foo \n")
,"endtagdirective" ~: do ,"endtagdirectivep" ~: do
assertParse (parseWithCtx nullctx endtagdirective "end tag \n") assertParse (parseWithCtx nullctx endtagdirectivep "end tag \n")
assertParse (parseWithCtx nullctx endtagdirective "pop \n") assertParse (parseWithCtx nullctx endtagdirectivep "pop \n")
,"accountnamep" ~: do ,"accountnamep" ~: do
assertBool "accountnamep parses a normal account name" (isRight $ parsewith accountnamep "a:b:c") assertBool "accountnamep parses a normal account name" (isRight $ parsewith accountnamep "a:b:c")
@ -1174,10 +1174,10 @@ tests_Hledger_Read_JournalReader = TestList $ concat [
assertBool "accountnamep rejects an empty leading component" (isLeft $ parsewith accountnamep ":b:c") assertBool "accountnamep rejects an empty leading component" (isLeft $ parsewith accountnamep ":b:c")
assertBool "accountnamep rejects an empty trailing component" (isLeft $ parsewith accountnamep "a:b:") assertBool "accountnamep rejects an empty trailing component" (isLeft $ parsewith accountnamep "a:b:")
,"leftsymbolamount" ~: do ,"leftsymbolamountp" ~: do
assertParseEqual (parseWithCtx nullctx leftsymbolamount "$1") (usd 1 `withPrecision` 0) assertParseEqual (parseWithCtx nullctx leftsymbolamountp "$1") (usd 1 `withPrecision` 0)
assertParseEqual (parseWithCtx nullctx leftsymbolamount "$-1") (usd (-1) `withPrecision` 0) assertParseEqual (parseWithCtx nullctx leftsymbolamountp "$-1") (usd (-1) `withPrecision` 0)
assertParseEqual (parseWithCtx nullctx leftsymbolamount "-$1") (usd (-1) `withPrecision` 0) assertParseEqual (parseWithCtx nullctx leftsymbolamountp "-$1") (usd (-1) `withPrecision` 0)
,"amount" ~: do ,"amount" ~: do
let -- | compare a parse result with an expected amount, showing the debug representation for clarity let -- | compare a parse result with an expected amount, showing the debug representation for clarity

20
hledger-lib/Hledger/Read/TimelogReader.hs
View File

@ -60,7 +60,7 @@ import System.FilePath
import Hledger.Data import Hledger.Data
-- XXX too much reuse ? -- XXX too much reuse ?
import Hledger.Read.JournalReader ( import Hledger.Read.JournalReader (
directive, marketpricedirective, defaultyeardirective, emptyorcommentlinep, datetimep, directivep, marketpricedirectivep, defaultyeardirectivep, emptyorcommentlinep, datetimep,
parseJournalWith, modifiedaccountnamep, genericSourcePos parseJournalWith, modifiedaccountnamep, genericSourcePos
) )
import Hledger.Utils import Hledger.Utils
@ -82,10 +82,10 @@ detect f s
-- format, saving the provided file path and the current time, or give an -- format, saving the provided file path and the current time, or give an
-- error. -- error.
parse :: Maybe FilePath -> Bool -> FilePath -> String -> ExceptT String IO Journal parse :: Maybe FilePath -> Bool -> FilePath -> String -> ExceptT String IO Journal
parse _ = parseJournalWith timelogFile parse _ = parseJournalWith timelogfilep
timelogFile :: ParsecT [Char] JournalContext (ExceptT String IO) (JournalUpdate, JournalContext) timelogfilep :: ParsecT [Char] JournalContext (ExceptT String IO) (JournalUpdate, JournalContext)
timelogFile = do items <- many timelogItem timelogfilep = do items <- many timelogitemp
eof eof
ctx <- getState ctx <- getState
return (liftM (foldl' (\acc new x -> new (acc x)) id) $ sequence items, ctx) return (liftM (foldl' (\acc new x -> new (acc x)) id) $ sequence items, ctx)
@ -93,16 +93,16 @@ timelogFile = do items <- many timelogItem
-- As all ledger line types can be distinguished by the first -- As all ledger line types can be distinguished by the first
-- character, excepting transactions versus empty (blank or -- character, excepting transactions versus empty (blank or
-- comment-only) lines, can use choice w/o try -- comment-only) lines, can use choice w/o try
timelogItem = choice [ directive timelogitemp = choice [ directivep
, liftM (return . addMarketPrice) marketpricedirective , liftM (return . addMarketPrice) marketpricedirectivep
, defaultyeardirective , defaultyeardirectivep
, emptyorcommentlinep >> return (return id) , emptyorcommentlinep >> return (return id)
, liftM (return . addTimeLogEntry) timelogentry , liftM (return . addTimeLogEntry) timelogentryp
] <?> "timelog entry, or default year or historical price directive" ] <?> "timelog entry, or default year or historical price directive"
-- | Parse a timelog entry. -- | Parse a timelog entry.
timelogentry :: ParsecT [Char] JournalContext (ExceptT String IO) TimeLogEntry timelogentryp :: ParsecT [Char] JournalContext (ExceptT String IO) TimeLogEntry
timelogentry = do timelogentryp = do
sourcepos <- genericSourcePos <$> getPosition sourcepos <- genericSourcePos <$> getPosition
code <- oneOf "bhioO" code <- oneOf "bhioO"
many1 spacenonewline many1 spacenonewline