mirror of
https://github.com/simonmichael/hledger.git
synced 2024-12-29 05:11:33 +03:00
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