lib: refactor: weaken types of comment parsers

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
+followingcommentandtagsp
-                         -> ErroringJournalParser m (Text, [Tag], Maybe Day, Maybe Day)
+  :: 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)
 

hledger-lib/Hledger/Read/JournalReader.hs

@@ -158,8 +158,8 @@ addJournalItemP =
     , modifiertransactionp  >>= modify' . addModifierTransaction
     , periodictransactionp  >>= modify' . addPeriodicTransaction
     , marketpricedirectivep >>= modify' . addMarketPrice
-    , void emptyorcommentlinep
+    , void (lift emptyorcommentlinep)
-    , void multilinecommentp
+    , 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

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"
 

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,