From 09fd8132b799b70ef76ec5f835a43c2226e1678e Mon Sep 17 00:00:00 2001 From: Alex Chen Date: Tue, 15 May 2018 18:59:49 -0600 Subject: [PATCH] lib: refactor: weaken types of comment parsers --- hledger-lib/Hledger/Read/Common.hs | 30 ++++++++++----------- hledger-lib/Hledger/Read/JournalReader.hs | 14 +++++----- hledger-lib/Hledger/Read/TimeclockReader.hs | 2 +- hledger-lib/Hledger/Read/TimedotReader.hs | 8 +++--- 4 files changed, 27 insertions(+), 27 deletions(-) diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index b191d6bb5..d14a35be3 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -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) diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 9cb5643c0..f01df37bf 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -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 diff --git a/hledger-lib/Hledger/Read/TimeclockReader.hs b/hledger-lib/Hledger/Read/TimeclockReader.hs index 07a61692a..e44321453 100644 --- a/hledger-lib/Hledger/Read/TimeclockReader.hs +++ b/hledger-lib/Hledger/Read/TimeclockReader.hs @@ -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" diff --git a/hledger-lib/Hledger/Read/TimedotReader.hs b/hledger-lib/Hledger/Read/TimedotReader.hs index 375fe9423..04f4149bb 100644 --- a/hledger-lib/Hledger/Read/TimedotReader.hs +++ b/hledger-lib/Hledger/Read/TimedotReader.hs @@ -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,