lib: refactor: weaken types of comment parsers

This commit is contained in:
Alex Chen 2018-05-15 18:59:49 -06:00 committed by Simon Michael
parent d1b9d9dfe6
commit 09fd8132b7
4 changed files with 27 additions and 27 deletions

View File

@ -810,30 +810,30 @@ whitespaceChar = charCategory Space
--- ** comments
multilinecommentp :: JournalParser m ()
multilinecommentp :: TextParser m ()
multilinecommentp = startComment *> anyLine `skipManyTill` endComment
where
startComment = string "comment" >> emptyLine
endComment = eof <|> (string "end comment" >> emptyLine)
emptyLine = void $ lift (skipMany spacenonewline) *> newline
emptyLine = void $ skipMany spacenonewline *> newline
anyLine = anyChar `manyTill` newline
emptyorcommentlinep :: JournalParser m ()
emptyorcommentlinep :: TextParser m ()
emptyorcommentlinep = do
lift $ skipMany spacenonewline
skipMany spacenonewline
void linecommentp <|> void newline
-- | Parse a possibly multi-line comment following a semicolon.
followingcommentp :: JournalParser m Text
followingcommentp :: TextParser m Text
followingcommentp = T.unlines . map snd <$> followingcommentlinesp
followingcommentlinesp :: JournalParser m [(SourcePos, Text)]
followingcommentlinesp :: TextParser m [(SourcePos, Text)]
followingcommentlinesp = do
lift $ skipMany spacenonewline
samelineComment@(_, samelineCommentText)
<- try commentp <|> (,) <$> (getPosition <* newline) <*> pure ""
newlineComments <- many $ try $ do
lift $ skipSome spacenonewline -- leading whitespace is required
skipSome spacenonewline -- leading whitespace is required
commentp
if T.null samelineCommentText && null newlineComments
then pure []
@ -858,12 +858,12 @@ followingcommentlinesp = do
-- >>> rejp (followingcommentandtagsp (Just $ fromGregorian 2000 1 2)) "; date:3/4=5/6"
-- Right ("date:3/4=5/6\n",[("date","3/4=5/6")],Just 2000-03-04,Nothing)
--
followingcommentandtagsp :: MonadIO m => Maybe Day
-> ErroringJournalParser m (Text, [Tag], Maybe Day, Maybe Day)
followingcommentandtagsp
:: Monad m => Maybe Day -> ErroringJournalParser m (Text, [Tag], Maybe Day, Maybe Day)
followingcommentandtagsp mdefdate = do
-- pdbg 0 "followingcommentandtagsp"
commentLines <- followingcommentlinesp
commentLines <- lift followingcommentlinesp
-- pdbg 0 $ "commentws:" ++ show commentLines
-- Reparse the comment for any tags.
@ -925,23 +925,23 @@ followingcommentandtagsp mdefdate = do
-- A transaction/posting comment must start with a semicolon.
-- This parser discards the leading whitespace of the comment
-- and returns the source position of the comment's first non-whitespace character.
commentp :: JournalParser m (SourcePos, Text)
commentp :: TextParser m (SourcePos, Text)
commentp = commentStartingWithp ";"
-- A line (file-level) comment can start with a semicolon, hash,
-- or star (allowing org nodes).
-- This parser discards the leading whitespace of the comment
-- and returns the source position of the comment's first non-whitespace character.
linecommentp :: JournalParser m (SourcePos, Text)
linecommentp :: TextParser m (SourcePos, Text)
linecommentp = commentStartingWithp ";#*"
commentStartingWithp :: [Char] -> JournalParser m (SourcePos, Text)
commentStartingWithp :: [Char] -> TextParser m (SourcePos, Text)
commentStartingWithp cs = do
-- ptrace "commentStartingWith"
oneOf cs
lift (skipMany spacenonewline)
skipMany spacenonewline
startPos <- getPosition
content <- T.pack <$> anyChar `manyTill` (lift eolof)
content <- T.pack <$> anyChar `manyTill` eolof
optional newline
return (startPos, content)

View File

@ -158,8 +158,8 @@ addJournalItemP =
, modifiertransactionp >>= modify' . addModifierTransaction
, periodictransactionp >>= modify' . addPeriodicTransaction
, marketpricedirectivep >>= modify' . addMarketPrice
, void emptyorcommentlinep
, void multilinecommentp
, void (lift emptyorcommentlinep)
, void (lift multilinecommentp)
] <?> "transaction or directive"
--- ** directives
@ -281,7 +281,7 @@ commoditydirectiveonelinep = do
pos <- getPosition
Amount{acommodity,astyle} <- amountp
lift (skipMany spacenonewline)
_ <- followingcommentp <|> (lift eolof >> return "")
_ <- lift followingcommentp <|> (lift eolof >> return "")
let comm = Commodity{csymbol=acommodity, cformat=Just $ dbg2 "style from commodity directive" astyle}
if asdecimalpoint astyle == Nothing
then parserErrorAt pos pleaseincludedecimalpoint
@ -298,7 +298,7 @@ commoditydirectivemultilinep = do
string "commodity"
lift (skipSome spacenonewline)
sym <- lift commoditysymbolp
_ <- followingcommentp <|> (lift eolof >> return "")
_ <- lift followingcommentp <|> (lift eolof >> return "")
mformat <- lastMay <$> many (indented $ formatdirectivep sym)
let comm = Commodity{csymbol=sym, cformat=mformat}
modify' (\j -> j{jcommodities=M.insert sym comm $ jcommodities j})
@ -313,7 +313,7 @@ formatdirectivep expectedsym = do
lift (skipSome spacenonewline)
pos <- getPosition
Amount{acommodity,astyle} <- amountp
_ <- followingcommentp <|> (lift eolof >> return "")
_ <- lift followingcommentp <|> (lift eolof >> return "")
if acommodity==expectedsym
then
if asdecimalpoint astyle == Nothing
@ -463,7 +463,7 @@ periodictransactionp = do
char '~' <?> "periodic transaction"
lift (skipMany spacenonewline)
periodexpr <- T.pack . strip <$> descriptionp
_ <- try followingcommentp <|> (newline >> return "")
_ <- try (lift followingcommentp) <|> (newline >> return "")
postings <- postingsp Nothing
return $ PeriodicTransaction periodexpr postings
@ -478,7 +478,7 @@ transactionp = do
status <- lift statusp <?> "cleared status"
code <- T.pack <$> lift codep <?> "transaction code"
description <- T.pack . strip <$> descriptionp
comment <- try followingcommentp <|> (newline >> return "")
comment <- try (lift followingcommentp) <|> (newline >> return "")
let tags = commentTags comment
postings <- postingsp (Just date)
pos' <- getPosition

View File

@ -100,7 +100,7 @@ timeclockfilep = do many timeclockitemp
-- character, excepting transactions versus empty (blank or
-- comment-only) lines, can use choice w/o try
timeclockitemp = choice [
void emptyorcommentlinep
void (lift emptyorcommentlinep)
, timeclockentryp >>= \e -> modify' (\j -> j{jparsetimeclockentries = e : jparsetimeclockentries j})
] <?> "timeclock entry, or default year or historical price directive"

View File

@ -77,7 +77,7 @@ timedotfilep = do many timedotfileitemp
timedotfileitemp = do
ptrace "timedotfileitemp"
choice [
void emptyorcommentlinep
void $ lift emptyorcommentlinep
,timedotdayp >>= \ts -> modify' (addTransactions ts)
] <?> "timedot day entry, or default year or comment line or blank line"
@ -95,7 +95,7 @@ timedotdayp :: JournalParser m [Transaction]
timedotdayp = do
ptrace " timedotdayp"
d <- datep <* lift eolof
es <- catMaybes <$> many (const Nothing <$> try emptyorcommentlinep <|>
es <- catMaybes <$> many (const Nothing <$> try (lift emptyorcommentlinep) <|>
Just <$> (notFollowedBy datep >> timedotentryp))
return $ map (\t -> t{tdate=d}) es -- <$> many timedotentryp
@ -111,9 +111,9 @@ timedotentryp = do
a <- modifiedaccountnamep
lift (skipMany spacenonewline)
hours <-
try (followingcommentp >> return 0)
try (lift followingcommentp >> return 0)
<|> (timedotdurationp <*
(try followingcommentp <|> (newline >> return "")))
(try (lift followingcommentp) <|> (newline >> return "")))
let t = nulltransaction{
tsourcepos = pos,
tstatus = Cleared,