slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

lib: Clean up new code introduced for #655

Browse Source
This commit is contained in:
Alex Chen 2018-05-10 19:02:28 -06:00 committed by Simon Michael
parent 30ae991484
commit 3aa72bdf16
1 changed files with 14 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
hledger-lib/Hledger/Read/Common.hs
View File

@ -797,22 +797,22 @@ whitespaceChar = charCategory Space
multilinecommentp :: JournalParser m () multilinecommentp :: JournalParser m ()
multilinecommentp = startComment *> anyLine `skipManyTill` endComment multilinecommentp = startComment *> anyLine `skipManyTill` endComment
where where
emptylinep = lift (skipMany spacenonewline) *> newline *> pure () startComment = string "comment" >> emptyLine
startComment = string "comment" >> emptylinep endComment = eof <|> (string "end comment" >> emptyLine)
endComment = eof <|> (string "end comment" >> emptylinep) emptyLine = void $ lift (skipMany spacenonewline) *> newline
anyLine = anyChar `manyTill` newline anyLine = anyChar `manyTill` newline
emptyorcommentlinep :: JournalParser m () emptyorcommentlinep :: JournalParser m ()
emptyorcommentlinep = do emptyorcommentlinep = do
lift (skipMany spacenonewline) lift $ skipMany spacenonewline
void linecommentp <|> void newline void linecommentp <|> void newline
-- | Parse a possibly multi-line comment following a semicolon. -- | Parse a possibly multi-line comment following a semicolon.
followingcommentp :: JournalParser m Text followingcommentp :: JournalParser m Text
followingcommentp = T.unlines . map snd <$> followingcommentwithpositionsp followingcommentp = T.unlines . map snd <$> followingcommentlinesp
followingcommentwithpositionsp :: JournalParser m [(SourcePos, Text)] followingcommentlinesp :: JournalParser m [(SourcePos, Text)]
followingcommentwithpositionsp = do followingcommentlinesp = do
lift $ skipMany spacenonewline lift $ skipMany spacenonewline
samelineComment <- try commentp samelineComment <- try commentp
<|> (,) <$> (getPosition <* newline) <*> pure "" <|> (,) <$> (getPosition <* newline) <*> pure ""
@ -845,11 +845,11 @@ followingcommentandtagsp :: MonadIO m => Maybe Day
followingcommentandtagsp mdefdate = do followingcommentandtagsp mdefdate = do
-- pdbg 0 "followingcommentandtagsp" -- pdbg 0 "followingcommentandtagsp"
commentLinesWithPositions <- followingcommentwithpositionsp commentLines <- followingcommentlinesp
-- pdbg 0 $ "commentws:" ++ show commentLinesWithPositions -- pdbg 0 $ "commentws:" ++ show commentLines
-- Reparse the comment for any tags. -- Reparse the comment for any tags.
tags <- case traverse (runTextParserAt tagsp) commentLinesWithPositions of tags <- case traverse (runTextParserAt tagsp) commentLines of
Right tss -> pure $ concat tss Right tss -> pure $ concat tss
Left e -> throwError $ parseErrorPretty e Left e -> throwError $ parseErrorPretty e
@ -857,18 +857,19 @@ followingcommentandtagsp mdefdate = do
-- Use the transaction date for defaults, if provided. -- Use the transaction date for defaults, if provided.
epdates <- fmap sequence epdates <- fmap sequence
$ traverse (runErroringJournalParserAt (postingdatesp mdefdate)) $ traverse (runErroringJournalParserAt (postingdatesp mdefdate))
commentLinesWithPositions commentLines
pdates <- case epdates of pdates <- case epdates of
Right dss -> pure $ concat dss Right dss -> pure $ concat dss
Left e -> throwError e Left e -> throwError e
-- pdbg 0 $ "pdates: "++show pdates -- pdbg 0 $ "pdates: "++show pdates
let mdate = headMay $ map snd $ filter ((=="date").fst) pdates let mdate = headMay $ map snd $ filter ((=="date") .fst) pdates
mdate2 = headMay $ map snd $ filter ((=="date2").fst) pdates mdate2 = headMay $ map snd $ filter ((=="date2").fst) pdates
let strippedComment = T.unlines $ map (T.strip . snd) commentLinesWithPositions let strippedComment = T.unlines $ map (T.strip . snd) commentLines
-- pdbg 0 $ "comment:"++show strippedComment -- pdbg 0 $ "comment:"++show strippedComment
pure (strippedComment, tags, mdate, mdate2) pure (strippedComment, tags, mdate, mdate2)
where where
runTextParserAt parser (pos, txt) = runTextParserAt parser (pos, txt) =
runTextParser (setPosition pos *> parser) txt runTextParser (setPosition pos *> parser) txt