lib: use consistent p suffix for parsers
This commit is contained in:
Simon Michael
parent
80ae8f5c50
commit
bc43036117
@ -392,11 +392,11 @@ validateRules rules = do
|
||||
rulesp :: Stream [Char] m t => ParsecT [Char] CsvRules m CsvRules
|
||||
rulesp = do
|
||||
many $ choice'
|
||||
[blankorcommentline <?> "blank or comment line"
|
||||
,(directive >>= modifyState . addDirective) <?> "directive"
|
||||
,(fieldnamelist >>= modifyState . setIndexesAndAssignmentsFromList) <?> "field name list"
|
||||
,(fieldassignment >>= modifyState . addAssignment) <?> "field assignment"
|
||||
,(conditionalblock >>= modifyState . addConditionalBlock) <?> "conditional block"
|
||||
[blankorcommentlinep <?> "blank or comment line"
|
||||
,(directivep >>= modifyState . addDirective) <?> "directive"
|
||||
,(fieldnamelistp >>= modifyState . setIndexesAndAssignmentsFromList) <?> "field name list"
|
||||
,(fieldassignmentp >>= modifyState . addAssignment) <?> "field assignment"
|
||||
,(conditionalblockp >>= modifyState . addConditionalBlock) <?> "conditional block"
|
||||
]
|
||||
eof
|
||||
r <- getState
|
||||
@ -405,23 +405,23 @@ rulesp = do
|
||||
,rconditionalblocks=reverse $ rconditionalblocks r
|
||||
}
|
||||
|
||||
blankorcommentline :: Stream [Char] m t => ParsecT [Char] CsvRules m ()
|
||||
blankorcommentline = pdbg 3 "trying blankorcommentline" >> choice' [blankline, commentline]
|
||||
blankorcommentlinep :: Stream [Char] m t => ParsecT [Char] CsvRules m ()
|
||||
blankorcommentlinep = pdbg 3 "trying blankorcommentlinep" >> choice' [blanklinep, commentlinep]
|
||||
|
||||
blankline :: Stream [Char] m t => ParsecT [Char] CsvRules m ()
|
||||
blankline = many spacenonewline >> newline >> return () <?> "blank line"
|
||||
blanklinep :: Stream [Char] m t => ParsecT [Char] CsvRules m ()
|
||||
blanklinep = many spacenonewline >> newline >> return () <?> "blank line"
|
||||
|
||||
commentline :: Stream [Char] m t => ParsecT [Char] CsvRules m ()
|
||||
commentline = many spacenonewline >> commentchar >> restofline >> return () <?> "comment line"
|
||||
commentlinep :: Stream [Char] m t => ParsecT [Char] CsvRules m ()
|
||||
commentlinep = many spacenonewline >> commentcharp >> restofline >> return () <?> "comment line"
|
||||
|
||||
commentchar :: Stream [Char] m t => ParsecT [Char] CsvRules m Char
|
||||
commentchar = oneOf ";#*"
|
||||
commentcharp :: Stream [Char] m t => ParsecT [Char] CsvRules m Char
|
||||
commentcharp = oneOf ";#*"
|
||||
|
||||
directive :: Stream [Char] m t => ParsecT [Char] CsvRules m (DirectiveName, String)
|
||||
directive = do
|
||||
directivep :: Stream [Char] m t => ParsecT [Char] CsvRules m (DirectiveName, String)
|
||||
directivep = do
|
||||
pdbg 3 "trying directive"
|
||||
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 "")
|
||||
return (d,v)
|
||||
<?> "directive"
|
||||
@ -436,46 +436,46 @@ directives =
|
||||
-- ,"base-currency"
|
||||
]
|
||||
|
||||
directiveval :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char]
|
||||
directiveval = anyChar `manyTill` eolof
|
||||
directivevalp :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char]
|
||||
directivevalp = anyChar `manyTill` eolof
|
||||
|
||||
fieldnamelist :: Stream [Char] m t => ParsecT [Char] CsvRules m [CsvFieldName]
|
||||
fieldnamelist = (do
|
||||
fieldnamelistp :: Stream [Char] m t => ParsecT [Char] CsvRules m [CsvFieldName]
|
||||
fieldnamelistp = (do
|
||||
pdbg 3 "trying fieldnamelist"
|
||||
string "fields"
|
||||
optional $ char ':'
|
||||
many1 spacenonewline
|
||||
let separator = many spacenonewline >> char ',' >> many spacenonewline
|
||||
f <- fromMaybe "" <$> optionMaybe fieldname
|
||||
fs <- many1 $ (separator >> fromMaybe "" <$> optionMaybe fieldname)
|
||||
f <- fromMaybe "" <$> optionMaybe fieldnamep
|
||||
fs <- many1 $ (separator >> fromMaybe "" <$> optionMaybe fieldnamep)
|
||||
restofline
|
||||
return $ map (map toLower) $ f:fs
|
||||
) <?> "field name list"
|
||||
|
||||
fieldname :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char]
|
||||
fieldname = quotedfieldname <|> barefieldname
|
||||
fieldnamep :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char]
|
||||
fieldnamep = quotedfieldnamep <|> barefieldnamep
|
||||
|
||||
quotedfieldname :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char]
|
||||
quotedfieldname = do
|
||||
quotedfieldnamep :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char]
|
||||
quotedfieldnamep = do
|
||||
char '"'
|
||||
f <- many1 $ noneOf "\"\n:;#~"
|
||||
char '"'
|
||||
return f
|
||||
|
||||
barefieldname :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char]
|
||||
barefieldname = many1 $ noneOf " \t\n,;#~"
|
||||
barefieldnamep :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char]
|
||||
barefieldnamep = many1 $ noneOf " \t\n,;#~"
|
||||
|
||||
fieldassignment :: Stream [Char] m t => ParsecT [Char] CsvRules m (JournalFieldName, FieldTemplate)
|
||||
fieldassignment = do
|
||||
fieldassignmentp :: Stream [Char] m t => ParsecT [Char] CsvRules m (JournalFieldName, FieldTemplate)
|
||||
fieldassignmentp = do
|
||||
pdbg 3 "trying fieldassignment"
|
||||
f <- journalfieldname
|
||||
assignmentseparator
|
||||
v <- fieldval
|
||||
f <- journalfieldnamep
|
||||
assignmentseparatorp
|
||||
v <- fieldvalp
|
||||
return (f,v)
|
||||
<?> "field assignment"
|
||||
|
||||
journalfieldname :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char]
|
||||
journalfieldname = pdbg 2 "trying journalfieldname" >> choice' (map string journalfieldnames)
|
||||
journalfieldnamep :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char]
|
||||
journalfieldnamep = pdbg 2 "trying journalfieldnamep" >> choice' (map string journalfieldnames)
|
||||
|
||||
journalfieldnames =
|
||||
[-- pseudo fields:
|
||||
@ -494,9 +494,9 @@ journalfieldnames =
|
||||
,"comment"
|
||||
]
|
||||
|
||||
assignmentseparator :: Stream [Char] m t => ParsecT [Char] CsvRules m ()
|
||||
assignmentseparator = do
|
||||
pdbg 3 "trying assignmentseparator"
|
||||
assignmentseparatorp :: Stream [Char] m t => ParsecT [Char] CsvRules m ()
|
||||
assignmentseparatorp = do
|
||||
pdbg 3 "trying assignmentseparatorp"
|
||||
choice [
|
||||
-- try (many spacenonewline >> oneOf ":="),
|
||||
try (many spacenonewline >> char ':'),
|
||||
@ -505,51 +505,51 @@ assignmentseparator = do
|
||||
_ <- many spacenonewline
|
||||
return ()
|
||||
|
||||
fieldval :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char]
|
||||
fieldval = do
|
||||
fieldvalp :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char]
|
||||
fieldvalp = do
|
||||
pdbg 2 "trying fieldval"
|
||||
anyChar `manyTill` eolof
|
||||
|
||||
conditionalblock :: Stream [Char] m t => ParsecT [Char] CsvRules m ConditionalBlock
|
||||
conditionalblock = do
|
||||
pdbg 3 "trying conditionalblock"
|
||||
conditionalblockp :: Stream [Char] m t => ParsecT [Char] CsvRules m ConditionalBlock
|
||||
conditionalblockp = do
|
||||
pdbg 3 "trying conditionalblockp"
|
||||
string "if" >> many spacenonewline >> optional newline
|
||||
ms <- many1 recordmatcher
|
||||
as <- many (many1 spacenonewline >> fieldassignment)
|
||||
ms <- many1 recordmatcherp
|
||||
as <- many (many1 spacenonewline >> fieldassignmentp)
|
||||
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"
|
||||
return (ms, as)
|
||||
<?> "conditional block"
|
||||
|
||||
recordmatcher :: Stream [Char] m t => ParsecT [Char] CsvRules m [[Char]]
|
||||
recordmatcher = do
|
||||
pdbg 2 "trying recordmatcher"
|
||||
recordmatcherp :: Stream [Char] m t => ParsecT [Char] CsvRules m [[Char]]
|
||||
recordmatcherp = do
|
||||
pdbg 2 "trying recordmatcherp"
|
||||
-- pos <- currentPos
|
||||
_ <- optional (matchoperator >> many spacenonewline >> optional newline)
|
||||
ps <- patterns
|
||||
_ <- optional (matchoperatorp >> many spacenonewline >> optional newline)
|
||||
ps <- patternsp
|
||||
when (null ps) $
|
||||
fail "start of record matcher found, but no patterns afterward\n(patterns should not be indented)\n"
|
||||
return ps
|
||||
<?> "record matcher"
|
||||
|
||||
matchoperator :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char]
|
||||
matchoperator = choice' $ map string
|
||||
matchoperatorp :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char]
|
||||
matchoperatorp = choice' $ map string
|
||||
["~"
|
||||
-- ,"!~"
|
||||
-- ,"="
|
||||
-- ,"!="
|
||||
]
|
||||
|
||||
patterns :: Stream [Char] m t => ParsecT [Char] CsvRules m [[Char]]
|
||||
patterns = do
|
||||
pdbg 3 "trying patterns"
|
||||
patternsp :: Stream [Char] m t => ParsecT [Char] CsvRules m [[Char]]
|
||||
patternsp = do
|
||||
pdbg 3 "trying patternsp"
|
||||
ps <- many regexp
|
||||
return ps
|
||||
|
||||
regexp :: Stream [Char] m t => ParsecT [Char] CsvRules m [Char]
|
||||
regexp = do
|
||||
pdbg 3 "trying regexp"
|
||||
notFollowedBy matchoperator
|
||||
notFollowedBy matchoperatorp
|
||||
c <- nonspace
|
||||
cs <- anyChar `manyTill` eolof
|
||||
return $ strip $ c:cs
|
||||
|
||||
@ -24,10 +24,10 @@ module Hledger.Read.JournalReader (
|
||||
parseJournalWith,
|
||||
genericSourcePos,
|
||||
getParentAccount,
|
||||
journal,
|
||||
directive,
|
||||
defaultyeardirective,
|
||||
marketpricedirective,
|
||||
journalp,
|
||||
directivep,
|
||||
defaultyeardirectivep,
|
||||
marketpricedirectivep,
|
||||
datetimep,
|
||||
codep,
|
||||
accountnamep,
|
||||
@ -94,7 +94,7 @@ detect f s
|
||||
-- | Parse and post-process a "Journal" from hledger's journal file
|
||||
-- format, or give an error.
|
||||
parse :: Maybe FilePath -> Bool -> FilePath -> String -> ExceptT String IO Journal
|
||||
parse _ = parseJournalWith journal
|
||||
parse _ = parseJournalWith journalp
|
||||
|
||||
-- parsing utils
|
||||
|
||||
@ -215,8 +215,8 @@ clearAccountAliases = modifyState (\(ctx@Ctx{..}) -> ctx{ctxAliases=[]})
|
||||
-- | Top-level journal parser. Returns a single composite, I/O performing,
|
||||
-- error-raising "JournalUpdate" (and final "JournalContext") which can be
|
||||
-- applied to an empty journal to get the final result.
|
||||
journal :: ParsecT [Char] JournalContext (ExceptT String IO) (JournalUpdate,JournalContext)
|
||||
journal = do
|
||||
journalp :: ParsecT [Char] JournalContext (ExceptT String IO) (JournalUpdate,JournalContext)
|
||||
journalp = do
|
||||
journalupdates <- many journalItem
|
||||
eof
|
||||
finalctx <- getState
|
||||
@ -225,36 +225,36 @@ journal = do
|
||||
-- As all journal line types can be distinguished by the first
|
||||
-- character, excepting transactions versus empty (blank or
|
||||
-- comment-only) lines, can use choice w/o try
|
||||
journalItem = choice [ directive
|
||||
, liftM (return . addTransaction) transaction
|
||||
, liftM (return . addModifierTransaction) modifiertransaction
|
||||
, liftM (return . addPeriodicTransaction) periodictransaction
|
||||
, liftM (return . addMarketPrice) marketpricedirective
|
||||
journalItem = choice [ directivep
|
||||
, liftM (return . addTransaction) transactionp
|
||||
, liftM (return . addModifierTransaction) modifiertransactionp
|
||||
, liftM (return . addPeriodicTransaction) periodictransactionp
|
||||
, liftM (return . addMarketPrice) marketpricedirectivep
|
||||
, emptyorcommentlinep >> return (return id)
|
||||
, multilinecommentp >> return (return id)
|
||||
] <?> "journal transaction or directive"
|
||||
|
||||
-- cf http://ledger-cli.org/3.0/doc/ledger3.html#Command-Directives
|
||||
directive :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
|
||||
directive = do
|
||||
directivep :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
|
||||
directivep = do
|
||||
optional $ char '!'
|
||||
choice' [
|
||||
includedirective
|
||||
,aliasdirective
|
||||
,endaliasesdirective
|
||||
,accountdirective
|
||||
,enddirective
|
||||
,tagdirective
|
||||
,endtagdirective
|
||||
,defaultyeardirective
|
||||
,defaultcommoditydirective
|
||||
,commodityconversiondirective
|
||||
,ignoredpricecommoditydirective
|
||||
includedirectivep
|
||||
,aliasdirectivep
|
||||
,endaliasesdirectivep
|
||||
,accountdirectivep
|
||||
,enddirectivep
|
||||
,tagdirectivep
|
||||
,endtagdirectivep
|
||||
,defaultyeardirectivep
|
||||
,defaultcommoditydirectivep
|
||||
,commodityconversiondirectivep
|
||||
,ignoredpricecommoditydirectivep
|
||||
]
|
||||
<?> "directive"
|
||||
|
||||
includedirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
|
||||
includedirective = do
|
||||
includedirectivep :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
|
||||
includedirectivep = do
|
||||
string "include"
|
||||
many1 spacenonewline
|
||||
filename <- restofline
|
||||
@ -265,7 +265,7 @@ includedirective = do
|
||||
filepath <- expandPath curdir filename
|
||||
txt <- readFileOrError outerPos filepath
|
||||
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
|
||||
Right (ju, ctx) -> do
|
||||
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]}
|
||||
-- NOTE: first encountered file to left, to avoid a reverse
|
||||
|
||||
accountdirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
|
||||
accountdirective = do
|
||||
accountdirectivep :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
|
||||
accountdirectivep = do
|
||||
string "account"
|
||||
many1 spacenonewline
|
||||
parent <- accountnamep
|
||||
@ -295,15 +295,15 @@ accountdirective = do
|
||||
-- return $ return id
|
||||
return $ ExceptT $ return $ Right id
|
||||
|
||||
enddirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
|
||||
enddirective = do
|
||||
enddirectivep :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
|
||||
enddirectivep = do
|
||||
string "end"
|
||||
popParentAccount
|
||||
-- return (return id)
|
||||
return $ ExceptT $ return $ Right id
|
||||
|
||||
aliasdirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
|
||||
aliasdirective = do
|
||||
aliasdirectivep :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
|
||||
aliasdirectivep = do
|
||||
string "alias"
|
||||
many1 spacenonewline
|
||||
alias <- accountaliasp
|
||||
@ -334,28 +334,28 @@ regexaliasp = do
|
||||
repl <- rstrip <$> anyChar `manyTill` eolof
|
||||
return $ RegexAlias re repl
|
||||
|
||||
endaliasesdirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
|
||||
endaliasesdirective = do
|
||||
endaliasesdirectivep :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
|
||||
endaliasesdirectivep = do
|
||||
string "end aliases"
|
||||
clearAccountAliases
|
||||
return (return id)
|
||||
|
||||
tagdirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
|
||||
tagdirective = do
|
||||
tagdirectivep :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
|
||||
tagdirectivep = do
|
||||
string "tag" <?> "tag directive"
|
||||
many1 spacenonewline
|
||||
_ <- many1 nonspace
|
||||
restofline
|
||||
return $ return id
|
||||
|
||||
endtagdirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
|
||||
endtagdirective = do
|
||||
endtagdirectivep :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
|
||||
endtagdirectivep = do
|
||||
(string "end tag" <|> string "pop") <?> "end tag or pop directive"
|
||||
restofline
|
||||
return $ return id
|
||||
|
||||
defaultyeardirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
|
||||
defaultyeardirective = do
|
||||
defaultyeardirectivep :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
|
||||
defaultyeardirectivep = do
|
||||
char 'Y' <?> "default year"
|
||||
many spacenonewline
|
||||
y <- many1 digit
|
||||
@ -364,8 +364,8 @@ defaultyeardirective = do
|
||||
setYear y'
|
||||
return $ return id
|
||||
|
||||
defaultcommoditydirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
|
||||
defaultcommoditydirective = do
|
||||
defaultcommoditydirectivep :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
|
||||
defaultcommoditydirectivep = do
|
||||
char 'D' <?> "default commodity"
|
||||
many1 spacenonewline
|
||||
Amount{..} <- amountp
|
||||
@ -373,28 +373,28 @@ defaultcommoditydirective = do
|
||||
restofline
|
||||
return $ return id
|
||||
|
||||
marketpricedirective :: ParsecT [Char] JournalContext (ExceptT String IO) MarketPrice
|
||||
marketpricedirective = do
|
||||
marketpricedirectivep :: ParsecT [Char] JournalContext (ExceptT String IO) MarketPrice
|
||||
marketpricedirectivep = do
|
||||
char 'P' <?> "market price"
|
||||
many spacenonewline
|
||||
date <- try (do {LocalTime d _ <- datetimep; return d}) <|> datep -- a time is ignored
|
||||
many1 spacenonewline
|
||||
symbol <- commoditysymbol
|
||||
symbol <- commoditysymbolp
|
||||
many spacenonewline
|
||||
price <- amountp
|
||||
restofline
|
||||
return $ MarketPrice date symbol price
|
||||
|
||||
ignoredpricecommoditydirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
|
||||
ignoredpricecommoditydirective = do
|
||||
ignoredpricecommoditydirectivep :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
|
||||
ignoredpricecommoditydirectivep = do
|
||||
char 'N' <?> "ignored-price commodity"
|
||||
many1 spacenonewline
|
||||
commoditysymbol
|
||||
commoditysymbolp
|
||||
restofline
|
||||
return $ return id
|
||||
|
||||
commodityconversiondirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
|
||||
commodityconversiondirective = do
|
||||
commodityconversiondirectivep :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate
|
||||
commodityconversiondirectivep = do
|
||||
char 'C' <?> "commodity conversion"
|
||||
many1 spacenonewline
|
||||
amountp
|
||||
@ -405,26 +405,26 @@ commodityconversiondirective = do
|
||||
restofline
|
||||
return $ return id
|
||||
|
||||
modifiertransaction :: ParsecT [Char] JournalContext (ExceptT String IO) ModifierTransaction
|
||||
modifiertransaction = do
|
||||
modifiertransactionp :: ParsecT [Char] JournalContext (ExceptT String IO) ModifierTransaction
|
||||
modifiertransactionp = do
|
||||
char '=' <?> "modifier transaction"
|
||||
many spacenonewline
|
||||
valueexpr <- restofline
|
||||
postings <- postings
|
||||
postings <- postingsp
|
||||
return $ ModifierTransaction valueexpr postings
|
||||
|
||||
periodictransaction :: ParsecT [Char] JournalContext (ExceptT String IO) PeriodicTransaction
|
||||
periodictransaction = do
|
||||
periodictransactionp :: ParsecT [Char] JournalContext (ExceptT String IO) PeriodicTransaction
|
||||
periodictransactionp = do
|
||||
char '~' <?> "periodic transaction"
|
||||
many spacenonewline
|
||||
periodexpr <- restofline
|
||||
postings <- postings
|
||||
postings <- postingsp
|
||||
return $ PeriodicTransaction periodexpr postings
|
||||
|
||||
-- | Parse a (possibly unbalanced) transaction.
|
||||
transaction :: ParsecT [Char] JournalContext (ExceptT String IO) Transaction
|
||||
transaction = do
|
||||
-- ptrace "transaction"
|
||||
transactionp :: ParsecT [Char] JournalContext (ExceptT String IO) Transaction
|
||||
transactionp = do
|
||||
-- ptrace "transactionp"
|
||||
sourcepos <- genericSourcePos <$> getPosition
|
||||
date <- datep <?> "transaction"
|
||||
edate <- optionMaybe (secondarydatep date) <?> "secondary date"
|
||||
@ -434,15 +434,15 @@ transaction = do
|
||||
description <- descriptionp >>= return . strip
|
||||
comment <- try followingcommentp <|> (newline >> return "")
|
||||
let tags = tagsInComment comment
|
||||
postings <- postings
|
||||
postings <- postingsp
|
||||
return $ txnTieKnot $ Transaction sourcepos date edate status code description comment tags postings ""
|
||||
|
||||
descriptionp = many (noneOf ";\n")
|
||||
|
||||
#ifdef TESTS
|
||||
test_transaction = do
|
||||
test_transactionp = do
|
||||
let s `gives` t = do
|
||||
let p = parseWithCtx nullctx transaction s
|
||||
let p = parseWithCtx nullctx transactionp s
|
||||
assertBool $ isRight p
|
||||
let Right t2 = p
|
||||
-- same f = assertEqual (f t) (f t2)
|
||||
@ -495,33 +495,33 @@ test_transaction = do
|
||||
tdate=parsedate "2015/01/01",
|
||||
}
|
||||
|
||||
assertRight $ parseWithCtx nullctx transaction $ unlines
|
||||
assertRight $ parseWithCtx nullctx transactionp $ unlines
|
||||
["2007/01/28 coopportunity"
|
||||
," expenses:food:groceries $47.18"
|
||||
," assets:checking $-47.18"
|
||||
,""
|
||||
]
|
||||
|
||||
-- transaction should not parse just a date
|
||||
assertLeft $ parseWithCtx nullctx transaction "2009/1/1\n"
|
||||
-- transactionp should not parse just a date
|
||||
assertLeft $ parseWithCtx nullctx transactionp "2009/1/1\n"
|
||||
|
||||
-- transaction should not parse just a date and description
|
||||
assertLeft $ parseWithCtx nullctx transaction "2009/1/1 a\n"
|
||||
-- transactionp should not parse just a date and description
|
||||
assertLeft $ parseWithCtx nullctx transactionp "2009/1/1 a\n"
|
||||
|
||||
-- transaction 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"
|
||||
-- transactionp should not parse a following comment as part of the description
|
||||
let p = parseWithCtx nullctx transactionp "2009/1/1 a ;comment\n b 1\n"
|
||||
assertRight p
|
||||
assertEqual "a" (let Right p' = p in tdescription p')
|
||||
|
||||
-- parse transaction with following whitespace line
|
||||
assertRight $ parseWithCtx nullctx transaction $ unlines
|
||||
assertRight $ parseWithCtx nullctx transactionp $ unlines
|
||||
["2012/1/1"
|
||||
," a 1"
|
||||
," b"
|
||||
," "
|
||||
]
|
||||
|
||||
let p = parseWithCtx nullctx transaction $ unlines
|
||||
let p = parseWithCtx nullctx transactionp $ unlines
|
||||
["2009/1/1 x ; transaction comment"
|
||||
," a 1 ; posting 1 comment"
|
||||
," ; 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 ""
|
||||
|
||||
-- Parse the following whitespace-beginning lines as postings, posting tags, and/or comments.
|
||||
postings :: Stream [Char] m Char => ParsecT [Char] JournalContext m [Posting]
|
||||
postings = many (try postingp) <?> "postings"
|
||||
postingsp :: Stream [Char] m Char => ParsecT [Char] JournalContext m [Posting]
|
||||
postingsp = many (try postingp) <?> "postings"
|
||||
|
||||
-- linebeginningwithspaces :: Stream [Char] m Char => ParsecT [Char] JournalContext m String
|
||||
-- linebeginningwithspaces = do
|
||||
@ -637,9 +637,9 @@ postingp = do
|
||||
many spacenonewline
|
||||
account <- modifiedaccountnamep
|
||||
let (ptype, account') = (accountNamePostingType account, unbracket account)
|
||||
amount <- spaceandamountormissing
|
||||
massertion <- partialbalanceassertion
|
||||
_ <- fixedlotprice
|
||||
amount <- spaceandamountormissingp
|
||||
massertion <- partialbalanceassertionp
|
||||
_ <- fixedlotpricep
|
||||
many spacenonewline
|
||||
ctx <- getState
|
||||
comment <- try followingcommentp <|> (newline >> return "")
|
||||
@ -751,8 +751,8 @@ accountnamep = do
|
||||
-- | Parse whitespace then an amount, with an optional left or right
|
||||
-- currency symbol and optional price, or return the special
|
||||
-- "missing" marker amount.
|
||||
spaceandamountormissing :: Stream [Char] m Char => ParsecT [Char] JournalContext m MixedAmount
|
||||
spaceandamountormissing =
|
||||
spaceandamountormissingp :: Stream [Char] m Char => ParsecT [Char] JournalContext m MixedAmount
|
||||
spaceandamountormissingp =
|
||||
try (do
|
||||
many1 spacenonewline
|
||||
(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
|
||||
a `is'` e = assertEqual e a
|
||||
|
||||
test_spaceandamountormissing = do
|
||||
assertParseEqual' (parseWithCtx nullctx spaceandamountormissing " $47.18") (Mixed [usd 47.18])
|
||||
assertParseEqual' (parseWithCtx nullctx spaceandamountormissing "$47.18") missingmixedamt
|
||||
assertParseEqual' (parseWithCtx nullctx spaceandamountormissing " ") missingmixedamt
|
||||
assertParseEqual' (parseWithCtx nullctx spaceandamountormissing "") missingmixedamt
|
||||
test_spaceandamountormissingp = do
|
||||
assertParseEqual' (parseWithCtx nullctx spaceandamountormissingp " $47.18") (Mixed [usd 47.18])
|
||||
assertParseEqual' (parseWithCtx nullctx spaceandamountormissingp "$47.18") missingmixedamt
|
||||
assertParseEqual' (parseWithCtx nullctx spaceandamountormissingp " ") missingmixedamt
|
||||
assertParseEqual' (parseWithCtx nullctx spaceandamountormissingp "") missingmixedamt
|
||||
#endif
|
||||
|
||||
-- | Parse a single-commodity amount, with optional symbol on the left or
|
||||
-- right, optional unit or total price, and optional (ignored)
|
||||
-- ledger-style balance assertion or fixed lot price declaration.
|
||||
amountp :: Stream [Char] m t => ParsecT [Char] JournalContext m Amount
|
||||
amountp = try leftsymbolamount <|> try rightsymbolamount <|> nosymbolamount
|
||||
amountp = try leftsymbolamountp <|> try rightsymbolamountp <|> nosymbolamountp
|
||||
|
||||
#ifdef TESTS
|
||||
test_amountp = do
|
||||
@ -809,32 +809,32 @@ signp = do
|
||||
return $ case sign of Just '-' -> "-"
|
||||
_ -> ""
|
||||
|
||||
leftsymbolamount :: Stream [Char] m t => ParsecT [Char] JournalContext m Amount
|
||||
leftsymbolamount = do
|
||||
leftsymbolamountp :: Stream [Char] m t => ParsecT [Char] JournalContext m Amount
|
||||
leftsymbolamountp = do
|
||||
sign <- signp
|
||||
c <- commoditysymbol
|
||||
c <- commoditysymbolp
|
||||
sp <- many spacenonewline
|
||||
(q,prec,mdec,mgrps) <- numberp
|
||||
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
|
||||
return $ applysign $ Amount c q p s
|
||||
<?> "left-symbol amount"
|
||||
|
||||
rightsymbolamount :: Stream [Char] m t => ParsecT [Char] JournalContext m Amount
|
||||
rightsymbolamount = do
|
||||
rightsymbolamountp :: Stream [Char] m t => ParsecT [Char] JournalContext m Amount
|
||||
rightsymbolamountp = do
|
||||
(q,prec,mdec,mgrps) <- numberp
|
||||
sp <- many spacenonewline
|
||||
c <- commoditysymbol
|
||||
p <- priceamount
|
||||
c <- commoditysymbolp
|
||||
p <- priceamountp
|
||||
let s = amountstyle{ascommodityside=R, ascommodityspaced=not $ null sp, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps}
|
||||
return $ Amount c q p s
|
||||
<?> "right-symbol amount"
|
||||
|
||||
nosymbolamount :: Stream [Char] m t => ParsecT [Char] JournalContext m Amount
|
||||
nosymbolamount = do
|
||||
nosymbolamountp :: Stream [Char] m t => ParsecT [Char] JournalContext m Amount
|
||||
nosymbolamountp = do
|
||||
(q,prec,mdec,mgrps) <- numberp
|
||||
p <- priceamount
|
||||
p <- priceamountp
|
||||
-- apply the most recently seen default commodity and style to this commodityless amount
|
||||
defcs <- getDefaultCommodityAndStyle
|
||||
let (c,s) = case defcs of
|
||||
@ -843,21 +843,21 @@ nosymbolamount = do
|
||||
return $ Amount c q p s
|
||||
<?> "no-symbol amount"
|
||||
|
||||
commoditysymbol :: Stream [Char] m t => ParsecT [Char] JournalContext m String
|
||||
commoditysymbol = (quotedcommoditysymbol <|> simplecommoditysymbol) <?> "commodity symbol"
|
||||
commoditysymbolp :: Stream [Char] m t => ParsecT [Char] JournalContext m String
|
||||
commoditysymbolp = (quotedcommoditysymbolp <|> simplecommoditysymbolp) <?> "commodity symbol"
|
||||
|
||||
quotedcommoditysymbol :: Stream [Char] m t => ParsecT [Char] JournalContext m String
|
||||
quotedcommoditysymbol = do
|
||||
quotedcommoditysymbolp :: Stream [Char] m t => ParsecT [Char] JournalContext m String
|
||||
quotedcommoditysymbolp = do
|
||||
char '"'
|
||||
s <- many1 $ noneOf ";\n\""
|
||||
char '"'
|
||||
return s
|
||||
|
||||
simplecommoditysymbol :: Stream [Char] m t => ParsecT [Char] JournalContext m String
|
||||
simplecommoditysymbol = many1 (noneOf nonsimplecommoditychars)
|
||||
simplecommoditysymbolp :: Stream [Char] m t => ParsecT [Char] JournalContext m String
|
||||
simplecommoditysymbolp = many1 (noneOf nonsimplecommoditychars)
|
||||
|
||||
priceamount :: Stream [Char] m t => ParsecT [Char] JournalContext m Price
|
||||
priceamount =
|
||||
priceamountp :: Stream [Char] m t => ParsecT [Char] JournalContext m Price
|
||||
priceamountp =
|
||||
try (do
|
||||
many spacenonewline
|
||||
char '@'
|
||||
@ -872,8 +872,8 @@ priceamount =
|
||||
return $ UnitPrice a))
|
||||
<|> return NoPrice
|
||||
|
||||
partialbalanceassertion :: Stream [Char] m t => ParsecT [Char] JournalContext m (Maybe MixedAmount)
|
||||
partialbalanceassertion =
|
||||
partialbalanceassertionp :: Stream [Char] m t => ParsecT [Char] JournalContext m (Maybe MixedAmount)
|
||||
partialbalanceassertionp =
|
||||
try (do
|
||||
many spacenonewline
|
||||
char '='
|
||||
@ -893,8 +893,8 @@ partialbalanceassertion =
|
||||
-- <|> return Nothing
|
||||
|
||||
-- http://ledger-cli.org/3.0/doc/ledger3.html#Fixing-Lot-Prices
|
||||
fixedlotprice :: Stream [Char] m Char => ParsecT [Char] JournalContext m (Maybe Amount)
|
||||
fixedlotprice =
|
||||
fixedlotpricep :: Stream [Char] m Char => ParsecT [Char] JournalContext m (Maybe Amount)
|
||||
fixedlotpricep =
|
||||
try (do
|
||||
many spacenonewline
|
||||
char '{'
|
||||
@ -1004,27 +1004,27 @@ multilinecommentp = do
|
||||
|
||||
emptyorcommentlinep :: Stream [Char] m Char => ParsecT [Char] JournalContext m ()
|
||||
emptyorcommentlinep = do
|
||||
many spacenonewline >> (comment <|> (many spacenonewline >> newline >> return ""))
|
||||
many spacenonewline >> (commentp <|> (many spacenonewline >> newline >> return ""))
|
||||
return ()
|
||||
|
||||
followingcommentp :: Stream [Char] m Char => ParsecT [Char] JournalContext m String
|
||||
followingcommentp =
|
||||
-- ptrace "followingcommentp"
|
||||
do samelinecomment <- many spacenonewline >> (try semicoloncomment <|> (newline >> return ""))
|
||||
newlinecomments <- many (try (many1 spacenonewline >> semicoloncomment))
|
||||
do samelinecomment <- many spacenonewline >> (try semicoloncommentp <|> (newline >> return ""))
|
||||
newlinecomments <- many (try (many1 spacenonewline >> semicoloncommentp))
|
||||
return $ unlines $ samelinecomment:newlinecomments
|
||||
|
||||
comment :: Stream [Char] m Char => ParsecT [Char] JournalContext m String
|
||||
comment = commentStartingWith commentchars
|
||||
commentp :: Stream [Char] m Char => ParsecT [Char] JournalContext m String
|
||||
commentp = commentStartingWithp commentchars
|
||||
|
||||
commentchars :: [Char]
|
||||
commentchars = "#;*"
|
||||
|
||||
semicoloncomment :: Stream [Char] m Char => ParsecT [Char] JournalContext m String
|
||||
semicoloncomment = commentStartingWith ";"
|
||||
semicoloncommentp :: Stream [Char] m Char => ParsecT [Char] JournalContext m String
|
||||
semicoloncommentp = commentStartingWithp ";"
|
||||
|
||||
commentStartingWith :: Stream [Char] m Char => String -> ParsecT [Char] JournalContext m String
|
||||
commentStartingWith cs = do
|
||||
commentStartingWithp :: Stream [Char] m Char => String -> ParsecT [Char] JournalContext m String
|
||||
commentStartingWithp cs = do
|
||||
-- ptrace "commentStartingWith"
|
||||
oneOf cs
|
||||
many spacenonewline
|
||||
@ -1040,23 +1040,23 @@ tagsInComment c = concatMap tagsInCommentLine $ lines c'
|
||||
tagsInCommentLine :: String -> [Tag]
|
||||
tagsInCommentLine = catMaybes . map maybetag . map strip . splitAtElement ','
|
||||
where
|
||||
maybetag s = case runParser (tag <* eof) nullctx "" s of
|
||||
maybetag s = case runParser (tagp <* eof) nullctx "" s of
|
||||
Right t -> Just t
|
||||
Left _ -> Nothing
|
||||
|
||||
tag = do
|
||||
tagp = do
|
||||
-- ptrace "tag"
|
||||
n <- tagname
|
||||
v <- tagvalue
|
||||
n <- tagnamep
|
||||
v <- tagvaluep
|
||||
return (n,v)
|
||||
|
||||
tagname = do
|
||||
tagnamep = do
|
||||
-- ptrace "tagname"
|
||||
n <- many1 $ noneOf ": \t"
|
||||
char ':'
|
||||
return n
|
||||
|
||||
tagvalue = do
|
||||
tagvaluep = do
|
||||
-- ptrace "tagvalue"
|
||||
v <- anyChar `manyTill` ((char ',' >> return ()) <|> eolof)
|
||||
return $ strip $ reverse $ dropWhile (==',') $ reverse $ strip v
|
||||
@ -1100,24 +1100,24 @@ tests_Hledger_Read_JournalReader = TestList $ concat [
|
||||
tests_Hledger_Read_JournalReader = TestList $ concat [
|
||||
test_numberp,
|
||||
test_amountp,
|
||||
test_spaceandamountormissing,
|
||||
test_spaceandamountormissingp,
|
||||
test_tagcomment,
|
||||
test_inlinecomment,
|
||||
test_comments,
|
||||
test_ledgerDateSyntaxToTags,
|
||||
test_postingp,
|
||||
test_transaction,
|
||||
test_transactionp,
|
||||
[
|
||||
"modifiertransaction" ~: do
|
||||
assertParse (parseWithCtx nullctx modifiertransaction "= (some value expr)\n some:postings 1\n")
|
||||
"modifiertransactionp" ~: do
|
||||
assertParse (parseWithCtx nullctx modifiertransactionp "= (some value expr)\n some:postings 1\n")
|
||||
|
||||
,"periodictransaction" ~: do
|
||||
assertParse (parseWithCtx nullctx periodictransaction "~ (some period expr)\n some:postings 1\n")
|
||||
,"periodictransactionp" ~: do
|
||||
assertParse (parseWithCtx nullctx periodictransactionp "~ (some period expr)\n some:postings 1\n")
|
||||
|
||||
,"directive" ~: do
|
||||
assertParse (parseWithCtx nullctx directive "!include /some/file.x\n")
|
||||
assertParse (parseWithCtx nullctx directive "account some:account\n")
|
||||
assertParse (parseWithCtx nullctx (directive >> directive) "!account a\nend\n")
|
||||
,"directivep" ~: do
|
||||
assertParse (parseWithCtx nullctx directivep "!include /some/file.x\n")
|
||||
assertParse (parseWithCtx nullctx directivep "account some:account\n")
|
||||
assertParse (parseWithCtx nullctx (directivep >> directivep) "!account a\nend\n")
|
||||
|
||||
,"comment" ~: do
|
||||
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+1234") startofday
|
||||
|
||||
,"defaultyeardirective" ~: do
|
||||
assertParse (parseWithCtx nullctx defaultyeardirective "Y 2010\n")
|
||||
assertParse (parseWithCtx nullctx defaultyeardirective "Y 10001\n")
|
||||
,"defaultyeardirectivep" ~: do
|
||||
assertParse (parseWithCtx nullctx defaultyeardirectivep "Y 2010\n")
|
||||
assertParse (parseWithCtx nullctx defaultyeardirectivep "Y 10001\n")
|
||||
|
||||
,"marketpricedirective" ~:
|
||||
assertParseEqual (parseWithCtx nullctx marketpricedirective "P 2004/05/01 XYZ $55.00\n") (MarketPrice (parsedate "2004/05/01") "XYZ" $ usd 55)
|
||||
,"marketpricedirectivep" ~:
|
||||
assertParseEqual (parseWithCtx nullctx marketpricedirectivep "P 2004/05/01 XYZ $55.00\n") (MarketPrice (parsedate "2004/05/01") "XYZ" $ usd 55)
|
||||
|
||||
,"ignoredpricecommoditydirective" ~: do
|
||||
assertParse (parseWithCtx nullctx ignoredpricecommoditydirective "N $\n")
|
||||
,"ignoredpricecommoditydirectivep" ~: do
|
||||
assertParse (parseWithCtx nullctx ignoredpricecommoditydirectivep "N $\n")
|
||||
|
||||
,"defaultcommoditydirective" ~: do
|
||||
assertParse (parseWithCtx nullctx defaultcommoditydirective "D $1,000.0\n")
|
||||
,"defaultcommoditydirectivep" ~: do
|
||||
assertParse (parseWithCtx nullctx defaultcommoditydirectivep "D $1,000.0\n")
|
||||
|
||||
,"commodityconversiondirective" ~: do
|
||||
assertParse (parseWithCtx nullctx commodityconversiondirective "C 1h = $50.00\n")
|
||||
,"commodityconversiondirectivep" ~: do
|
||||
assertParse (parseWithCtx nullctx commodityconversiondirectivep "C 1h = $50.00\n")
|
||||
|
||||
,"tagdirective" ~: do
|
||||
assertParse (parseWithCtx nullctx tagdirective "tag foo \n")
|
||||
,"tagdirectivep" ~: do
|
||||
assertParse (parseWithCtx nullctx tagdirectivep "tag foo \n")
|
||||
|
||||
,"endtagdirective" ~: do
|
||||
assertParse (parseWithCtx nullctx endtagdirective "end tag \n")
|
||||
assertParse (parseWithCtx nullctx endtagdirective "pop \n")
|
||||
,"endtagdirectivep" ~: do
|
||||
assertParse (parseWithCtx nullctx endtagdirectivep "end tag \n")
|
||||
assertParse (parseWithCtx nullctx endtagdirectivep "pop \n")
|
||||
|
||||
,"accountnamep" ~: do
|
||||
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 trailing component" (isLeft $ parsewith accountnamep "a:b:")
|
||||
|
||||
,"leftsymbolamount" ~: do
|
||||
assertParseEqual (parseWithCtx nullctx leftsymbolamount "$1") (usd 1 `withPrecision` 0)
|
||||
assertParseEqual (parseWithCtx nullctx leftsymbolamount "$-1") (usd (-1) `withPrecision` 0)
|
||||
assertParseEqual (parseWithCtx nullctx leftsymbolamount "-$1") (usd (-1) `withPrecision` 0)
|
||||
,"leftsymbolamountp" ~: do
|
||||
assertParseEqual (parseWithCtx nullctx leftsymbolamountp "$1") (usd 1 `withPrecision` 0)
|
||||
assertParseEqual (parseWithCtx nullctx leftsymbolamountp "$-1") (usd (-1) `withPrecision` 0)
|
||||
assertParseEqual (parseWithCtx nullctx leftsymbolamountp "-$1") (usd (-1) `withPrecision` 0)
|
||||
|
||||
,"amount" ~: do
|
||||
let -- | compare a parse result with an expected amount, showing the debug representation for clarity
|
||||
|
||||
@ -60,7 +60,7 @@ import System.FilePath
|
||||
import Hledger.Data
|
||||
-- XXX too much reuse ?
|
||||
import Hledger.Read.JournalReader (
|
||||
directive, marketpricedirective, defaultyeardirective, emptyorcommentlinep, datetimep,
|
||||
directivep, marketpricedirectivep, defaultyeardirectivep, emptyorcommentlinep, datetimep,
|
||||
parseJournalWith, modifiedaccountnamep, genericSourcePos
|
||||
)
|
||||
import Hledger.Utils
|
||||
@ -82,27 +82,27 @@ detect f s
|
||||
-- format, saving the provided file path and the current time, or give an
|
||||
-- error.
|
||||
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)
|
||||
timelogFile = do items <- many timelogItem
|
||||
eof
|
||||
ctx <- getState
|
||||
return (liftM (foldl' (\acc new x -> new (acc x)) id) $ sequence items, ctx)
|
||||
timelogfilep :: ParsecT [Char] JournalContext (ExceptT String IO) (JournalUpdate, JournalContext)
|
||||
timelogfilep = do items <- many timelogitemp
|
||||
eof
|
||||
ctx <- getState
|
||||
return (liftM (foldl' (\acc new x -> new (acc x)) id) $ sequence items, ctx)
|
||||
where
|
||||
-- As all ledger line types can be distinguished by the first
|
||||
-- character, excepting transactions versus empty (blank or
|
||||
-- comment-only) lines, can use choice w/o try
|
||||
timelogItem = choice [ directive
|
||||
, liftM (return . addMarketPrice) marketpricedirective
|
||||
, defaultyeardirective
|
||||
timelogitemp = choice [ directivep
|
||||
, liftM (return . addMarketPrice) marketpricedirectivep
|
||||
, defaultyeardirectivep
|
||||
, emptyorcommentlinep >> return (return id)
|
||||
, liftM (return . addTimeLogEntry) timelogentry
|
||||
, liftM (return . addTimeLogEntry) timelogentryp
|
||||
] <?> "timelog entry, or default year or historical price directive"
|
||||
|
||||
-- | Parse a timelog entry.
|
||||
timelogentry :: ParsecT [Char] JournalContext (ExceptT String IO) TimeLogEntry
|
||||
timelogentry = do
|
||||
timelogentryp :: ParsecT [Char] JournalContext (ExceptT String IO) TimeLogEntry
|
||||
timelogentryp = do
|
||||
sourcepos <- genericSourcePos <$> getPosition
|
||||
code <- oneOf "bhioO"
|
||||
many1 spacenonewline
|
||||
|
||||
Loading…
Reference in New Issue
Block a user