lib: refactor: weaken types of comment parsers
This commit is contained in:
		
							parent
							
								
									d1b9d9dfe6
								
							
						
					
					
						commit
						09fd8132b7
					
				| @ -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) | ||||
| 
 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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" | ||||
| 
 | ||||
|  | ||||
| @ -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, | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user