mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-20 02:37:12 +03:00
lib: Change skipMany spacenonewline to takeWhileP Nothing isNonNewlineSpace.
This commit is contained in:
Stephen Morgan
Simon Michael
parent
1c4e0c3cff
commit
081ee390ab
@ -781,7 +781,7 @@ smartdate = do
|
||||
smartdateonly :: TextParser m SmartDate
|
||||
smartdateonly = do
|
||||
d <- smartdate
|
||||
skipMany spacenonewline
|
||||
skipNonNewlineSpaces
|
||||
eof
|
||||
return d
|
||||
|
||||
@ -907,7 +907,7 @@ lastthisnextthing = do
|
||||
,"this"
|
||||
,"next"
|
||||
]
|
||||
skipMany spacenonewline -- make the space optional for easier scripting
|
||||
skipNonNewlineSpaces -- make the space optional for easier scripting
|
||||
p <- choice $ map string' [
|
||||
"day"
|
||||
,"week"
|
||||
@ -972,7 +972,7 @@ lastthisnextthing = do
|
||||
-- Right (DayOfMonth 2,DateSpan 2009-01-01..)
|
||||
periodexprp :: Day -> TextParser m (Interval, DateSpan)
|
||||
periodexprp rdate = do
|
||||
skipMany spacenonewline
|
||||
skipNonNewlineSpaces
|
||||
choice $ map try [
|
||||
intervalanddateperiodexprp rdate,
|
||||
(,) NoInterval <$> periodexprdatespanp rdate
|
||||
@ -983,7 +983,7 @@ intervalanddateperiodexprp :: Day -> TextParser m (Interval, DateSpan)
|
||||
intervalanddateperiodexprp rdate = do
|
||||
i <- reportingintervalp
|
||||
s <- option def . try $ do
|
||||
skipMany spacenonewline
|
||||
skipNonNewlineSpaces
|
||||
periodexprdatespanp rdate
|
||||
return (i,s)
|
||||
|
||||
@ -1002,47 +1002,47 @@ reportingintervalp = choice' [
|
||||
do string' "bimonthly"
|
||||
return $ Months 2,
|
||||
do string' "every"
|
||||
skipMany spacenonewline
|
||||
skipNonNewlineSpaces
|
||||
n <- nth
|
||||
skipMany spacenonewline
|
||||
skipNonNewlineSpaces
|
||||
string' "day"
|
||||
of_ "week"
|
||||
return $ DayOfWeek n,
|
||||
do string' "every"
|
||||
skipMany spacenonewline
|
||||
skipNonNewlineSpaces
|
||||
DayOfWeek <$> weekday,
|
||||
do string' "every"
|
||||
skipMany spacenonewline
|
||||
skipNonNewlineSpaces
|
||||
n <- nth
|
||||
skipMany spacenonewline
|
||||
skipNonNewlineSpaces
|
||||
string' "day"
|
||||
optOf_ "month"
|
||||
return $ DayOfMonth n,
|
||||
do string' "every"
|
||||
let mnth = choice' [month, mon] >>= \(_,m,_) -> return (read m)
|
||||
d_o_y <- runPermutation $
|
||||
DayOfYear <$> toPermutation (try (skipMany spacenonewline *> mnth))
|
||||
<*> toPermutation (try (skipMany spacenonewline *> nth))
|
||||
DayOfYear <$> toPermutation (try (skipNonNewlineSpaces *> mnth))
|
||||
<*> toPermutation (try (skipNonNewlineSpaces *> nth))
|
||||
optOf_ "year"
|
||||
return d_o_y,
|
||||
do string' "every"
|
||||
skipMany spacenonewline
|
||||
skipNonNewlineSpaces
|
||||
("",m,d) <- md
|
||||
optOf_ "year"
|
||||
return $ DayOfYear (read m) (read d),
|
||||
do string' "every"
|
||||
skipMany spacenonewline
|
||||
skipNonNewlineSpaces
|
||||
n <- nth
|
||||
skipMany spacenonewline
|
||||
skipNonNewlineSpaces
|
||||
wd <- weekday
|
||||
optOf_ "month"
|
||||
return $ WeekdayOfMonth n wd
|
||||
]
|
||||
where
|
||||
of_ period = do
|
||||
skipMany spacenonewline
|
||||
skipNonNewlineSpaces
|
||||
string' "of"
|
||||
skipMany spacenonewline
|
||||
skipNonNewlineSpaces
|
||||
string' period
|
||||
|
||||
optOf_ period = optional $ try $ of_ period
|
||||
@ -1058,13 +1058,13 @@ reportingintervalp = choice' [
|
||||
do string' compact'
|
||||
return $ intcons 1,
|
||||
do string' "every"
|
||||
skipMany spacenonewline
|
||||
skipNonNewlineSpaces
|
||||
string' singular'
|
||||
return $ intcons 1,
|
||||
do string' "every"
|
||||
skipMany spacenonewline
|
||||
skipNonNewlineSpaces
|
||||
n <- read <$> some digitChar
|
||||
skipMany spacenonewline
|
||||
skipNonNewlineSpaces
|
||||
string' plural'
|
||||
return $ intcons n
|
||||
]
|
||||
@ -1086,17 +1086,17 @@ periodexprdatespanp rdate = choice $ map try [
|
||||
-- Right DateSpan 2018-01-01..2018-04-01
|
||||
doubledatespanp :: Day -> TextParser m DateSpan
|
||||
doubledatespanp rdate = do
|
||||
optional (string' "from" >> skipMany spacenonewline)
|
||||
optional (string' "from" >> skipNonNewlineSpaces)
|
||||
b <- smartdate
|
||||
skipMany spacenonewline
|
||||
optional (choice [string' "to", string "..", string' "-"] >> skipMany spacenonewline)
|
||||
skipNonNewlineSpaces
|
||||
optional (choice [string' "to", string "..", string' "-"] >> skipNonNewlineSpaces)
|
||||
DateSpan (Just $ fixSmartDate rdate b) . Just . fixSmartDate rdate <$> smartdate
|
||||
|
||||
fromdatespanp :: Day -> TextParser m DateSpan
|
||||
fromdatespanp rdate = do
|
||||
b <- choice [
|
||||
do
|
||||
string' "from" >> skipMany spacenonewline
|
||||
string' "from" >> skipNonNewlineSpaces
|
||||
smartdate
|
||||
,
|
||||
do
|
||||
@ -1108,12 +1108,12 @@ fromdatespanp rdate = do
|
||||
|
||||
todatespanp :: Day -> TextParser m DateSpan
|
||||
todatespanp rdate = do
|
||||
choice [string' "to", string' "until", string "..", string' "-"] >> skipMany spacenonewline
|
||||
choice [string' "to", string' "until", string "..", string' "-"] >> skipNonNewlineSpaces
|
||||
DateSpan Nothing . Just . fixSmartDate rdate <$> smartdate
|
||||
|
||||
justdatespanp :: Day -> TextParser m DateSpan
|
||||
justdatespanp rdate = do
|
||||
optional (string' "in" >> skipMany spacenonewline)
|
||||
optional (string' "in" >> skipNonNewlineSpaces)
|
||||
spanFromSmartDate rdate <$> smartdate
|
||||
|
||||
-- | Make a datespan from two valid date strings parseable by parsedate
|
||||
|
||||
@ -196,7 +196,7 @@ words'' :: [T.Text] -> T.Text -> [T.Text]
|
||||
words'' prefixes = fromparse . parsewith maybeprefixedquotedphrases -- XXX
|
||||
where
|
||||
maybeprefixedquotedphrases :: SimpleTextParser [T.Text]
|
||||
maybeprefixedquotedphrases = choice' [prefixedQuotedPattern, singleQuotedPattern, doubleQuotedPattern, pattern] `sepBy` skipSome spacenonewline
|
||||
maybeprefixedquotedphrases = choice' [prefixedQuotedPattern, singleQuotedPattern, doubleQuotedPattern, pattern] `sepBy` skipNonNewlineSpaces1
|
||||
prefixedQuotedPattern :: SimpleTextParser T.Text
|
||||
prefixedQuotedPattern = do
|
||||
not' <- fromMaybe "" `fmap` (optional $ string "not:")
|
||||
|
||||
@ -105,6 +105,9 @@ module Hledger.Read.Common (
|
||||
singlespacedtextsatisfyingp,
|
||||
singlespacep,
|
||||
|
||||
skipNonNewlineSpaces,
|
||||
skipNonNewlineSpaces1,
|
||||
|
||||
-- * tests
|
||||
tests_Common,
|
||||
)
|
||||
@ -412,15 +415,15 @@ match' p = do
|
||||
statusp :: TextParser m Status
|
||||
statusp =
|
||||
choice'
|
||||
[ skipMany spacenonewline >> char '*' >> return Cleared
|
||||
, skipMany spacenonewline >> char '!' >> return Pending
|
||||
[ skipNonNewlineSpaces >> char '*' >> return Cleared
|
||||
, skipNonNewlineSpaces >> char '!' >> return Pending
|
||||
, return Unmarked
|
||||
]
|
||||
|
||||
codep :: TextParser m Text
|
||||
codep = option "" $ do
|
||||
try $ do
|
||||
skipSome spacenonewline
|
||||
skipNonNewlineSpaces1
|
||||
char '('
|
||||
code <- takeWhileP Nothing $ \c -> c /= ')' && c /= '\n'
|
||||
char ')' <?> "closing bracket ')' for transaction code"
|
||||
@ -499,7 +502,7 @@ datetimep = do
|
||||
datetimep' :: Maybe Year -> TextParser m LocalTime
|
||||
datetimep' mYear = do
|
||||
day <- datep' mYear
|
||||
skipSome spacenonewline
|
||||
skipNonNewlineSpaces1
|
||||
time <- timeOfDay
|
||||
optional timeZone -- ignoring time zones
|
||||
pure $ LocalTime day time
|
||||
@ -595,7 +598,7 @@ singlespacedtextsatisfyingp pred = do
|
||||
|
||||
-- | Parse one non-newline whitespace character that is not followed by another one.
|
||||
singlespacep :: TextParser m ()
|
||||
singlespacep = void spacenonewline *> notFollowedBy spacenonewline
|
||||
singlespacep = spacenonewline *> notFollowedBy spacenonewline
|
||||
|
||||
--- *** amounts
|
||||
|
||||
@ -605,7 +608,7 @@ singlespacep = void spacenonewline *> notFollowedBy spacenonewline
|
||||
spaceandamountormissingp :: JournalParser m MixedAmount
|
||||
spaceandamountormissingp =
|
||||
option missingmixedamt $ try $ do
|
||||
lift $ skipSome spacenonewline
|
||||
lift $ skipNonNewlineSpaces1
|
||||
Mixed . (:[]) <$> amountp
|
||||
|
||||
-- | Parse a single-commodity amount, with optional symbol on the left
|
||||
@ -614,7 +617,7 @@ spaceandamountormissingp =
|
||||
-- lot date. A lot price and lot date will be ignored.
|
||||
amountp :: JournalParser m Amount
|
||||
amountp = label "amount" $ do
|
||||
let spaces = lift $ skipMany spacenonewline
|
||||
let spaces = lift $ skipNonNewlineSpaces
|
||||
amount <- amountwithoutpricep <* spaces
|
||||
(mprice, _elotprice, _elotdate) <- runPermutation $
|
||||
(,,) <$> toPermutationWithDefault Nothing (Just <$> priceamountp <* spaces)
|
||||
@ -625,7 +628,7 @@ amountp = label "amount" $ do
|
||||
-- XXX Just like amountp but don't allow lot prices. Needed for balanceassertionp.
|
||||
amountpnolotprices :: JournalParser m Amount
|
||||
amountpnolotprices = label "amount" $ do
|
||||
let spaces = lift $ skipMany spacenonewline
|
||||
let spaces = lift $ skipNonNewlineSpaces
|
||||
amount <- amountwithoutpricep
|
||||
spaces
|
||||
mprice <- optional $ priceamountp <* spaces
|
||||
@ -642,7 +645,7 @@ amountwithoutpricep = do
|
||||
leftsymbolamountp mult sign = label "amount" $ do
|
||||
c <- lift commoditysymbolp
|
||||
suggestedStyle <- getAmountStyle c
|
||||
commodityspaced <- lift $ skipMany' spacenonewline
|
||||
commodityspaced <- lift skipNonNewlineSpaces'
|
||||
sign2 <- lift $ signp
|
||||
offBeforeNum <- getOffset
|
||||
ambiguousRawNum <- lift rawnumberp
|
||||
@ -660,7 +663,7 @@ amountwithoutpricep = do
|
||||
mExponent <- lift $ optional $ try exponentp
|
||||
offAfterNum <- getOffset
|
||||
let numRegion = (offBeforeNum, offAfterNum)
|
||||
mSpaceAndCommodity <- lift $ optional $ try $ (,) <$> skipMany' spacenonewline <*> commoditysymbolp
|
||||
mSpaceAndCommodity <- lift $ optional $ try $ (,) <$> skipNonNewlineSpaces' <*> commoditysymbolp
|
||||
case mSpaceAndCommodity of
|
||||
-- right symbol amount
|
||||
Just (commodityspaced, c) -> do
|
||||
@ -709,23 +712,11 @@ mamountp' = Mixed . (:[]) . amountp'
|
||||
-- | Parse a minus or plus sign followed by zero or more spaces,
|
||||
-- or nothing, returning a function that negates or does nothing.
|
||||
signp :: Num a => TextParser m (a -> a)
|
||||
signp = ((char '-' *> pure negate <|> char '+' *> pure id) <* many spacenonewline) <|> pure id
|
||||
signp = ((char '-' *> pure negate <|> char '+' *> pure id) <* skipNonNewlineSpaces) <|> pure id
|
||||
|
||||
multiplierp :: TextParser m Bool
|
||||
multiplierp = option False $ char '*' *> pure True
|
||||
|
||||
-- | This is like skipMany but it returns True if at least one element
|
||||
-- was skipped. This is helpful if you’re just using many to check if
|
||||
-- the resulting list is empty or not.
|
||||
skipMany' :: MonadPlus m => m a -> m Bool
|
||||
skipMany' p = go False
|
||||
where
|
||||
go !isNull = do
|
||||
more <- option False (True <$ p)
|
||||
if more
|
||||
then go True
|
||||
else pure isNull
|
||||
|
||||
commoditysymbolp :: TextParser m CommoditySymbol
|
||||
commoditysymbolp =
|
||||
quotedcommoditysymbolp <|> simplecommoditysymbolp <?> "commodity symbol"
|
||||
@ -746,7 +737,7 @@ priceamountp = label "transaction price" $ do
|
||||
priceConstructor <- char '@' *> pure TotalPrice <|> pure UnitPrice
|
||||
when parenthesised $ void $ char ')'
|
||||
|
||||
lift (skipMany spacenonewline)
|
||||
lift skipNonNewlineSpaces
|
||||
priceAmount <- amountwithoutpricep -- <?> "unpriced amount (specifying a price)"
|
||||
|
||||
pure $ priceConstructor priceAmount
|
||||
@ -757,7 +748,7 @@ balanceassertionp = do
|
||||
char '='
|
||||
istotal <- fmap isJust $ optional $ try $ char '='
|
||||
isinclusive <- fmap isJust $ optional $ try $ char '*'
|
||||
lift (skipMany spacenonewline)
|
||||
lift skipNonNewlineSpaces
|
||||
-- this amount can have a price; balance assertions ignore it,
|
||||
-- but balance assignments will use it
|
||||
a <- amountpnolotprices <?> "amount (for a balance assertion or assignment)"
|
||||
@ -776,10 +767,10 @@ lotpricep :: JournalParser m ()
|
||||
lotpricep = label "ledger-style lot price" $ do
|
||||
char '{'
|
||||
doublebrace <- option False $ char '{' >> pure True
|
||||
_fixed <- fmap isJust $ optional $ lift (skipMany spacenonewline) >> char '='
|
||||
lift (skipMany spacenonewline)
|
||||
_fixed <- fmap isJust $ optional $ lift skipNonNewlineSpaces >> char '='
|
||||
lift skipNonNewlineSpaces
|
||||
_a <- amountwithoutpricep
|
||||
lift (skipMany spacenonewline)
|
||||
lift skipNonNewlineSpaces
|
||||
char '}'
|
||||
when (doublebrace) $ void $ char '}'
|
||||
return ()
|
||||
@ -789,9 +780,9 @@ lotpricep = label "ledger-style lot price" $ do
|
||||
lotdatep :: JournalParser m ()
|
||||
lotdatep = (do
|
||||
char '['
|
||||
lift (skipMany spacenonewline)
|
||||
lift skipNonNewlineSpaces
|
||||
_d <- datep
|
||||
lift (skipMany spacenonewline)
|
||||
lift skipNonNewlineSpaces
|
||||
char ']'
|
||||
return ()
|
||||
) <?> "ledger-style lot date"
|
||||
@ -1037,7 +1028,7 @@ multilinecommentp = startComment *> anyLine `skipManyTill` endComment
|
||||
startComment = string "comment" *> trailingSpaces
|
||||
endComment = eof <|> string "end comment" *> trailingSpaces
|
||||
|
||||
trailingSpaces = skipMany spacenonewline <* newline
|
||||
trailingSpaces = skipNonNewlineSpaces <* newline
|
||||
anyLine = void $ takeWhileP Nothing (\c -> c /= '\n') *> newline
|
||||
|
||||
{-# INLINABLE multilinecommentp #-}
|
||||
@ -1047,7 +1038,7 @@ multilinecommentp = startComment *> anyLine `skipManyTill` endComment
|
||||
-- is semicolon, hash, or star.
|
||||
emptyorcommentlinep :: TextParser m ()
|
||||
emptyorcommentlinep = do
|
||||
skipMany spacenonewline
|
||||
skipNonNewlineSpaces
|
||||
skiplinecommentp <|> void newline
|
||||
where
|
||||
skiplinecommentp :: TextParser m ()
|
||||
@ -1076,13 +1067,13 @@ emptyorcommentlinep = do
|
||||
--
|
||||
followingcommentp' :: (Monoid a, Show a) => TextParser m a -> TextParser m (Text, a)
|
||||
followingcommentp' contentp = do
|
||||
skipMany spacenonewline
|
||||
skipNonNewlineSpaces
|
||||
-- there can be 0 or 1 sameLine
|
||||
sameLine <- try headerp *> ((:[]) <$> match' contentp) <|> pure []
|
||||
_ <- eolof
|
||||
-- there can be 0 or more nextLines
|
||||
nextLines <- many $
|
||||
try (skipSome spacenonewline *> headerp) *> match' contentp <* eolof
|
||||
try (skipNonNewlineSpaces1 *> headerp) *> match' contentp <* eolof
|
||||
let
|
||||
-- if there's just a next-line comment, insert an empty same-line comment
|
||||
-- so the next-line comment doesn't get rendered as a same-line comment.
|
||||
@ -1094,7 +1085,7 @@ followingcommentp' contentp = do
|
||||
pure (strippedCommentText, commentContent)
|
||||
|
||||
where
|
||||
headerp = char ';' *> skipMany spacenonewline
|
||||
headerp = char ';' *> skipNonNewlineSpaces
|
||||
|
||||
{-# INLINABLE followingcommentp' #-}
|
||||
|
||||
@ -1158,7 +1149,7 @@ commenttagsp = do
|
||||
if T.null name
|
||||
then commenttagsp
|
||||
else do
|
||||
skipMany spacenonewline
|
||||
skipNonNewlineSpaces
|
||||
val <- tagValue
|
||||
let tag = (name, val)
|
||||
(tag:) <$> commenttagsp
|
||||
@ -1256,7 +1247,7 @@ commenttagsanddatesp mYear = do
|
||||
|
||||
atColon :: Text -> TextParser m ([Tag], [DateTag])
|
||||
atColon name = char ':' *> do
|
||||
skipMany spacenonewline
|
||||
skipNonNewlineSpaces
|
||||
(tags, dateTags) <- case name of
|
||||
"" -> pure ([], [])
|
||||
"date" -> dateValue name
|
||||
|
||||
@ -449,10 +449,10 @@ blankorcommentlinep :: CsvRulesParser ()
|
||||
blankorcommentlinep = lift (dbgparse 8 "trying blankorcommentlinep") >> choiceInState [blanklinep, commentlinep]
|
||||
|
||||
blanklinep :: CsvRulesParser ()
|
||||
blanklinep = lift (skipMany spacenonewline) >> newline >> return () <?> "blank line"
|
||||
blanklinep = lift skipNonNewlineSpaces >> newline >> return () <?> "blank line"
|
||||
|
||||
commentlinep :: CsvRulesParser ()
|
||||
commentlinep = lift (skipMany spacenonewline) >> commentcharp >> lift restofline >> return () <?> "comment line"
|
||||
commentlinep = lift skipNonNewlineSpaces >> commentcharp >> lift restofline >> return () <?> "comment line"
|
||||
|
||||
commentcharp :: CsvRulesParser Char
|
||||
commentcharp = oneOf (";#*" :: [Char])
|
||||
@ -462,7 +462,7 @@ directivep = (do
|
||||
lift $ dbgparse 8 "trying directive"
|
||||
d <- fmap T.unpack $ choiceInState $ map (lift . string . T.pack) directives
|
||||
v <- (((char ':' >> lift (many spacenonewline)) <|> lift (some spacenonewline)) >> directivevalp)
|
||||
<|> (optional (char ':') >> lift (skipMany spacenonewline) >> lift eolof >> return "")
|
||||
<|> (optional (char ':') >> lift skipNonNewlineSpaces >> lift eolof >> return "")
|
||||
return (d, v)
|
||||
) <?> "directive"
|
||||
|
||||
@ -485,8 +485,8 @@ fieldnamelistp = (do
|
||||
lift $ dbgparse 8 "trying fieldnamelist"
|
||||
string "fields"
|
||||
optional $ char ':'
|
||||
lift (skipSome spacenonewline)
|
||||
let separator = lift (skipMany spacenonewline) >> char ',' >> lift (skipMany spacenonewline)
|
||||
lift skipNonNewlineSpaces1
|
||||
let separator = lift skipNonNewlineSpaces >> char ',' >> lift skipNonNewlineSpaces
|
||||
f <- fromMaybe "" <$> optional fieldnamep
|
||||
fs <- some $ (separator >> fromMaybe "" <$> optional fieldnamep)
|
||||
lift restofline
|
||||
@ -554,8 +554,8 @@ journalfieldnames =
|
||||
assignmentseparatorp :: CsvRulesParser ()
|
||||
assignmentseparatorp = do
|
||||
lift $ dbgparse 8 "trying assignmentseparatorp"
|
||||
_ <- choiceInState [ lift (skipMany spacenonewline) >> char ':' >> lift (skipMany spacenonewline)
|
||||
, lift (skipSome spacenonewline)
|
||||
_ <- choiceInState [ lift skipNonNewlineSpaces >> char ':' >> lift skipNonNewlineSpaces
|
||||
, lift skipNonNewlineSpaces1
|
||||
]
|
||||
return ()
|
||||
|
||||
@ -571,10 +571,10 @@ conditionalblockp = do
|
||||
-- "if\nMATCHER" or "if \nMATCHER" or "if MATCHER"
|
||||
start <- getOffset
|
||||
string "if" >> ( (newline >> return Nothing)
|
||||
<|> (lift (skipSome spacenonewline) >> optional newline))
|
||||
<|> (lift skipNonNewlineSpaces1 >> optional newline))
|
||||
ms <- some matcherp
|
||||
as <- catMaybes <$>
|
||||
many (lift (skipSome spacenonewline) >>
|
||||
many (lift skipNonNewlineSpaces1 >>
|
||||
choice [ lift eolof >> return Nothing
|
||||
, fmap Just fieldassignmentp
|
||||
])
|
||||
@ -620,7 +620,7 @@ recordmatcherp :: CsvRulesParser () -> CsvRulesParser Matcher
|
||||
recordmatcherp end = do
|
||||
lift $ dbgparse 8 "trying recordmatcherp"
|
||||
-- pos <- currentPos
|
||||
-- _ <- optional (matchoperatorp >> lift (skipMany spacenonewline) >> optional newline)
|
||||
-- _ <- optional (matchoperatorp >> lift skipNonNewlineSpaces >> optional newline)
|
||||
p <- matcherprefixp
|
||||
r <- regexp end
|
||||
-- when (null ps) $
|
||||
@ -638,13 +638,13 @@ fieldmatcherp end = do
|
||||
-- An optional fieldname (default: "all")
|
||||
-- f <- fromMaybe "all" `fmap` (optional $ do
|
||||
-- f' <- fieldnamep
|
||||
-- lift (skipMany spacenonewline)
|
||||
-- lift skipNonNewlineSpaces
|
||||
-- return f')
|
||||
p <- matcherprefixp
|
||||
f <- csvfieldreferencep <* lift (skipMany spacenonewline)
|
||||
f <- csvfieldreferencep <* lift skipNonNewlineSpaces
|
||||
-- optional operator.. just ~ (case insensitive infix regex) for now
|
||||
-- _op <- fromMaybe "~" <$> optional matchoperatorp
|
||||
lift (skipMany spacenonewline)
|
||||
lift skipNonNewlineSpaces
|
||||
r <- regexp end
|
||||
return $ FieldMatcher p f r
|
||||
<?> "field matcher"
|
||||
@ -652,7 +652,7 @@ fieldmatcherp end = do
|
||||
matcherprefixp :: CsvRulesParser MatcherPrefix
|
||||
matcherprefixp = do
|
||||
lift $ dbgparse 8 "trying matcherprefixp"
|
||||
(char '&' >> lift (skipMany spacenonewline) >> return And) <|> return None
|
||||
(char '&' >> lift skipNonNewlineSpaces >> return And) <|> return None
|
||||
|
||||
csvfieldreferencep :: CsvRulesParser CsvFieldReference
|
||||
csvfieldreferencep = do
|
||||
|
||||
@ -247,7 +247,7 @@ directivep = (do
|
||||
includedirectivep :: MonadIO m => ErroringJournalParser m ()
|
||||
includedirectivep = do
|
||||
string "include"
|
||||
lift (skipSome spacenonewline)
|
||||
lift skipNonNewlineSpaces1
|
||||
prefixedglob <- T.unpack <$> takeWhileP Nothing (/= '\n') -- don't consume newline yet
|
||||
parentoff <- getOffset
|
||||
parentpos <- getSourcePos
|
||||
@ -331,7 +331,7 @@ accountdirectivep = do
|
||||
off <- getOffset -- XXX figure out a more precise position later
|
||||
|
||||
string "account"
|
||||
lift (skipSome spacenonewline)
|
||||
lift skipNonNewlineSpaces1
|
||||
|
||||
-- the account name, possibly modified by preceding alias or apply account directives
|
||||
acct <- modifiedaccountnamep
|
||||
@ -339,7 +339,7 @@ accountdirectivep = do
|
||||
-- maybe an account type code (ALERX) after two or more spaces
|
||||
-- XXX added in 1.11, deprecated in 1.13, remove in 1.14
|
||||
mtypecode :: Maybe Char <- lift $ optional $ try $ do
|
||||
skipSome spacenonewline -- at least one more space in addition to the one consumed by modifiedaccountp
|
||||
skipNonNewlineSpaces1 -- at least one more space in addition to the one consumed by modifiedaccountp
|
||||
choice $ map char "ALERX"
|
||||
|
||||
-- maybe a comment, on this and/or following lines
|
||||
@ -402,7 +402,7 @@ addAccountDeclaration (a,cmt,tags) =
|
||||
j{jdeclaredaccounts = d:decls})
|
||||
|
||||
indentedlinep :: JournalParser m String
|
||||
indentedlinep = lift (skipSome spacenonewline) >> (rstrip <$> lift restofline)
|
||||
indentedlinep = lift skipNonNewlineSpaces1 >> (rstrip <$> lift restofline)
|
||||
|
||||
-- | Parse a one-line or multi-line commodity directive.
|
||||
--
|
||||
@ -421,11 +421,11 @@ commoditydirectiveonelinep :: JournalParser m ()
|
||||
commoditydirectiveonelinep = do
|
||||
(off, Amount{acommodity,astyle}) <- try $ do
|
||||
string "commodity"
|
||||
lift (skipSome spacenonewline)
|
||||
lift skipNonNewlineSpaces1
|
||||
off <- getOffset
|
||||
amount <- amountp
|
||||
pure $ (off, amount)
|
||||
lift (skipMany spacenonewline)
|
||||
lift skipNonNewlineSpaces
|
||||
_ <- lift followingcommentp
|
||||
let comm = Commodity{csymbol=acommodity, cformat=Just $ dbg6 "style from commodity directive" astyle}
|
||||
if asdecimalpoint astyle == Nothing
|
||||
@ -449,21 +449,21 @@ pleaseincludedecimalpoint = chomp $ unlines [
|
||||
commoditydirectivemultilinep :: JournalParser m ()
|
||||
commoditydirectivemultilinep = do
|
||||
string "commodity"
|
||||
lift (skipSome spacenonewline)
|
||||
lift skipNonNewlineSpaces1
|
||||
sym <- lift commoditysymbolp
|
||||
_ <- lift followingcommentp
|
||||
mformat <- lastMay <$> many (indented $ formatdirectivep sym)
|
||||
let comm = Commodity{csymbol=sym, cformat=mformat}
|
||||
modify' (\j -> j{jcommodities=M.insert sym comm $ jcommodities j})
|
||||
where
|
||||
indented = (lift (skipSome spacenonewline) >>)
|
||||
indented = (lift skipNonNewlineSpaces1 >>)
|
||||
|
||||
-- | Parse a format (sub)directive, throwing a parse error if its
|
||||
-- symbol does not match the one given.
|
||||
formatdirectivep :: CommoditySymbol -> JournalParser m AmountStyle
|
||||
formatdirectivep expectedsym = do
|
||||
string "format"
|
||||
lift (skipSome spacenonewline)
|
||||
lift skipNonNewlineSpaces1
|
||||
off <- getOffset
|
||||
Amount{acommodity,astyle} <- amountp
|
||||
_ <- lift followingcommentp
|
||||
@ -479,7 +479,7 @@ keywordp :: String -> JournalParser m ()
|
||||
keywordp = (() <$) . string . fromString
|
||||
|
||||
spacesp :: JournalParser m ()
|
||||
spacesp = () <$ lift (skipSome spacenonewline)
|
||||
spacesp = () <$ lift skipNonNewlineSpaces1
|
||||
|
||||
-- | Backtracking parser similar to string, but allows varying amount of space between words
|
||||
keywordsp :: String -> JournalParser m ()
|
||||
@ -488,7 +488,7 @@ keywordsp = try . sequence_ . intersperse spacesp . map keywordp . words
|
||||
applyaccountdirectivep :: JournalParser m ()
|
||||
applyaccountdirectivep = do
|
||||
keywordsp "apply account" <?> "apply account directive"
|
||||
lift (skipSome spacenonewline)
|
||||
lift skipNonNewlineSpaces1
|
||||
parent <- lift accountnamep
|
||||
newline
|
||||
pushParentAccount parent
|
||||
@ -501,7 +501,7 @@ endapplyaccountdirectivep = do
|
||||
aliasdirectivep :: JournalParser m ()
|
||||
aliasdirectivep = do
|
||||
string "alias"
|
||||
lift (skipSome spacenonewline)
|
||||
lift skipNonNewlineSpaces1
|
||||
alias <- lift accountaliasp
|
||||
addAccountAlias alias
|
||||
|
||||
@ -513,7 +513,7 @@ basicaliasp = do
|
||||
-- dbgparse 0 "basicaliasp"
|
||||
old <- rstrip <$> (some $ noneOf ("=" :: [Char]))
|
||||
char '='
|
||||
skipMany spacenonewline
|
||||
skipNonNewlineSpaces
|
||||
new <- rstrip <$> anySingle `manyTill` eolof -- eol in journal, eof in command lines, normally
|
||||
return $ BasicAlias (T.pack old) (T.pack new)
|
||||
|
||||
@ -523,9 +523,9 @@ regexaliasp = do
|
||||
char '/'
|
||||
re <- some $ noneOf ("/\n\r" :: [Char]) -- paranoid: don't try to read past line end
|
||||
char '/'
|
||||
skipMany spacenonewline
|
||||
skipNonNewlineSpaces
|
||||
char '='
|
||||
skipMany spacenonewline
|
||||
skipNonNewlineSpaces
|
||||
repl <- anySingle `manyTill` eolof
|
||||
return $ RegexAlias re repl
|
||||
|
||||
@ -537,7 +537,7 @@ endaliasesdirectivep = do
|
||||
tagdirectivep :: JournalParser m ()
|
||||
tagdirectivep = do
|
||||
string "tag" <?> "tag directive"
|
||||
lift (skipSome spacenonewline)
|
||||
lift skipNonNewlineSpaces1
|
||||
_ <- lift $ some nonspace
|
||||
lift restofline
|
||||
return ()
|
||||
@ -551,7 +551,7 @@ endtagdirectivep = do
|
||||
defaultyeardirectivep :: JournalParser m ()
|
||||
defaultyeardirectivep = do
|
||||
char 'Y' <?> "default year"
|
||||
lift (skipMany spacenonewline)
|
||||
lift skipNonNewlineSpaces
|
||||
y <- some digitChar
|
||||
let y' = read y
|
||||
failIfInvalidYear y
|
||||
@ -560,7 +560,7 @@ defaultyeardirectivep = do
|
||||
defaultcommoditydirectivep :: JournalParser m ()
|
||||
defaultcommoditydirectivep = do
|
||||
char 'D' <?> "default commodity"
|
||||
lift (skipSome spacenonewline)
|
||||
lift skipNonNewlineSpaces1
|
||||
off <- getOffset
|
||||
Amount{acommodity,astyle} <- amountp
|
||||
lift restofline
|
||||
@ -571,11 +571,11 @@ defaultcommoditydirectivep = do
|
||||
marketpricedirectivep :: JournalParser m PriceDirective
|
||||
marketpricedirectivep = do
|
||||
char 'P' <?> "market price"
|
||||
lift (skipMany spacenonewline)
|
||||
lift skipNonNewlineSpaces
|
||||
date <- try (do {LocalTime d _ <- datetimep; return d}) <|> datep -- a time is ignored
|
||||
lift (skipSome spacenonewline)
|
||||
lift skipNonNewlineSpaces1
|
||||
symbol <- lift commoditysymbolp
|
||||
lift (skipMany spacenonewline)
|
||||
lift skipNonNewlineSpaces
|
||||
price <- amountp
|
||||
lift restofline
|
||||
return $ PriceDirective date symbol price
|
||||
@ -583,7 +583,7 @@ marketpricedirectivep = do
|
||||
ignoredpricecommoditydirectivep :: JournalParser m ()
|
||||
ignoredpricecommoditydirectivep = do
|
||||
char 'N' <?> "ignored-price commodity"
|
||||
lift (skipSome spacenonewline)
|
||||
lift skipNonNewlineSpaces1
|
||||
lift commoditysymbolp
|
||||
lift restofline
|
||||
return ()
|
||||
@ -591,11 +591,11 @@ ignoredpricecommoditydirectivep = do
|
||||
commodityconversiondirectivep :: JournalParser m ()
|
||||
commodityconversiondirectivep = do
|
||||
char 'C' <?> "commodity conversion"
|
||||
lift (skipSome spacenonewline)
|
||||
lift skipNonNewlineSpaces1
|
||||
amountp
|
||||
lift (skipMany spacenonewline)
|
||||
lift skipNonNewlineSpaces
|
||||
char '='
|
||||
lift (skipMany spacenonewline)
|
||||
lift skipNonNewlineSpaces
|
||||
amountp
|
||||
lift restofline
|
||||
return ()
|
||||
@ -606,7 +606,7 @@ commodityconversiondirectivep = do
|
||||
transactionmodifierp :: JournalParser m TransactionModifier
|
||||
transactionmodifierp = do
|
||||
char '=' <?> "modifier transaction"
|
||||
lift (skipMany spacenonewline)
|
||||
lift skipNonNewlineSpaces
|
||||
querytxt <- lift $ T.strip <$> descriptionp
|
||||
(_comment, _tags) <- lift transactioncommentp -- TODO apply these to modified txns ?
|
||||
postings <- postingsp Nothing
|
||||
@ -626,7 +626,7 @@ periodictransactionp = do
|
||||
|
||||
-- first line
|
||||
char '~' <?> "periodic transaction"
|
||||
lift $ skipMany spacenonewline
|
||||
lift $ skipNonNewlineSpaces
|
||||
-- a period expression
|
||||
off <- getOffset
|
||||
|
||||
@ -706,7 +706,7 @@ postingsp mTransactionYear = many (postingp mTransactionYear) <?> "postings"
|
||||
|
||||
-- linebeginningwithspaces :: JournalParser m String
|
||||
-- linebeginningwithspaces = do
|
||||
-- sp <- lift (skipSome spacenonewline)
|
||||
-- sp <- lift skipNonNewlineSpaces1
|
||||
-- c <- nonspace
|
||||
-- cs <- lift restofline
|
||||
-- return $ sp ++ (c:cs) ++ "\n"
|
||||
@ -715,17 +715,17 @@ postingp :: Maybe Year -> JournalParser m Posting
|
||||
postingp mTransactionYear = do
|
||||
-- lift $ dbgparse 0 "postingp"
|
||||
(status, account) <- try $ do
|
||||
lift (skipSome spacenonewline)
|
||||
lift skipNonNewlineSpaces1
|
||||
status <- lift statusp
|
||||
lift (skipMany spacenonewline)
|
||||
lift skipNonNewlineSpaces
|
||||
account <- modifiedaccountnamep
|
||||
return (status, account)
|
||||
let (ptype, account') = (accountNamePostingType account, textUnbracket account)
|
||||
lift (skipMany spacenonewline)
|
||||
lift skipNonNewlineSpaces
|
||||
amount <- option missingmixedamt $ Mixed . (:[]) <$> amountp
|
||||
lift (skipMany spacenonewline)
|
||||
lift skipNonNewlineSpaces
|
||||
massertion <- optional balanceassertionp
|
||||
lift (skipMany spacenonewline)
|
||||
lift skipNonNewlineSpaces
|
||||
(comment,tags,mdate,mdate2) <- lift $ postingcommentp mTransactionYear
|
||||
return posting
|
||||
{ pdate=mdate
|
||||
|
||||
@ -121,10 +121,10 @@ timeclockentryp :: JournalParser m TimeclockEntry
|
||||
timeclockentryp = do
|
||||
sourcepos <- genericSourcePos <$> lift getSourcePos
|
||||
code <- oneOf ("bhioO" :: [Char])
|
||||
lift (skipSome spacenonewline)
|
||||
lift skipNonNewlineSpaces1
|
||||
datetime <- datetimep
|
||||
account <- fromMaybe "" <$> optional (lift (skipSome spacenonewline) >> modifiedaccountnamep)
|
||||
description <- T.pack . fromMaybe "" <$> lift (optional (skipSome spacenonewline >> restofline))
|
||||
account <- fromMaybe "" <$> optional (lift skipNonNewlineSpaces1 >> modifiedaccountnamep)
|
||||
description <- T.pack . fromMaybe "" <$> lift (optional (skipNonNewlineSpaces1 >> restofline))
|
||||
return $ TimeclockEntry sourcepos (read [code]) datetime account description
|
||||
|
||||
|
||||
|
||||
@ -159,7 +159,7 @@ commentlinesp = do
|
||||
|
||||
orgheadingprefixp = do
|
||||
-- traceparse "orgheadingprefixp"
|
||||
skipSome (char '*') >> skipSome spacenonewline
|
||||
skipSome (char '*') >> skipNonNewlineSpaces1
|
||||
|
||||
-- | Parse a single timedot entry to one (dateless) transaction.
|
||||
-- @
|
||||
@ -170,9 +170,9 @@ entryp = do
|
||||
lift $ traceparse "entryp"
|
||||
pos <- genericSourcePos <$> getSourcePos
|
||||
notFollowedBy datelinep
|
||||
lift $ optional $ choice [orgheadingprefixp, skipSome spacenonewline]
|
||||
lift $ optional $ choice [orgheadingprefixp, skipNonNewlineSpaces1]
|
||||
a <- modifiedaccountnamep
|
||||
lift (skipMany spacenonewline)
|
||||
lift skipNonNewlineSpaces
|
||||
hours <-
|
||||
try (lift followingcommentp >> return 0)
|
||||
<|> (durationp <*
|
||||
@ -211,7 +211,7 @@ numericquantityp = do
|
||||
-- lift $ traceparse "numericquantityp"
|
||||
(q, _, _, _) <- lift $ numberp Nothing
|
||||
msymbol <- optional $ choice $ map (string . fst) timeUnits
|
||||
lift (skipMany spacenonewline)
|
||||
lift skipNonNewlineSpaces
|
||||
let q' =
|
||||
case msymbol of
|
||||
Nothing -> q
|
||||
@ -249,7 +249,7 @@ emptyorcommentlinep :: [Char] -> TextParser m ()
|
||||
emptyorcommentlinep cs =
|
||||
label ("empty line or comment line beginning with "++cs) $ do
|
||||
traceparse "emptyorcommentlinep" -- XXX possible to combine label and traceparse ?
|
||||
skipMany spacenonewline
|
||||
skipNonNewlineSpaces
|
||||
void newline <|> void commentp
|
||||
traceparse' "emptyorcommentlinep"
|
||||
where
|
||||
|
||||
@ -20,10 +20,14 @@ module Hledger.Utils.Parse (
|
||||
showDateParseError,
|
||||
nonspace,
|
||||
isNonNewlineSpace,
|
||||
spacenonewline,
|
||||
restofline,
|
||||
eolof,
|
||||
|
||||
spacenonewline,
|
||||
skipNonNewlineSpaces,
|
||||
skipNonNewlineSpaces1,
|
||||
skipNonNewlineSpaces',
|
||||
|
||||
-- * re-exports
|
||||
CustomErr
|
||||
)
|
||||
@ -125,9 +129,26 @@ isNonNewlineSpace c = c /= '\n' && isSpace c
|
||||
|
||||
spacenonewline :: (Stream s, Char ~ Token s) => ParsecT CustomErr s m Char
|
||||
spacenonewline = satisfy isNonNewlineSpace
|
||||
{-# INLINABLE spacenonewline #-}
|
||||
|
||||
restofline :: TextParser m String
|
||||
restofline = anySingle `manyTill` eolof
|
||||
|
||||
-- Skip many non-newline spaces.
|
||||
skipNonNewlineSpaces :: (Stream s, Token s ~ Char) => ParsecT CustomErr s m ()
|
||||
skipNonNewlineSpaces = () <$ takeWhileP Nothing isNonNewlineSpace
|
||||
{-# INLINABLE skipNonNewlineSpaces #-}
|
||||
|
||||
-- Skip many non-newline spaces, failing if there are none.
|
||||
skipNonNewlineSpaces1 :: (Stream s, Token s ~ Char) => ParsecT CustomErr s m ()
|
||||
skipNonNewlineSpaces1 = () <$ takeWhile1P Nothing isNonNewlineSpace
|
||||
{-# INLINABLE skipNonNewlineSpaces1 #-}
|
||||
|
||||
-- Skip many non-newline spaces, returning True if any have been skipped.
|
||||
skipNonNewlineSpaces' :: (Stream s, Token s ~ Char) => ParsecT CustomErr s m Bool
|
||||
skipNonNewlineSpaces' = True <$ skipNonNewlineSpaces1 <|> pure False
|
||||
{-# INLINABLE skipNonNewlineSpaces' #-}
|
||||
|
||||
|
||||
eolof :: TextParser m ()
|
||||
eolof = (newline >> return ()) <|> eof
|
||||
|
||||
@ -145,7 +145,7 @@ words' :: String -> [String]
|
||||
words' "" = []
|
||||
words' s = map stripquotes $ fromparse $ parsewithString p s
|
||||
where
|
||||
p = do ss <- (singleQuotedPattern <|> doubleQuotedPattern <|> pattern) `sepBy` skipSome spacenonewline
|
||||
p = do ss <- (singleQuotedPattern <|> doubleQuotedPattern <|> pattern) `sepBy` skipNonNewlineSpaces1
|
||||
-- eof
|
||||
return ss
|
||||
pattern = many (noneOf whitespacechars)
|
||||
|
||||
@ -279,7 +279,7 @@ dateAndCodeWizard PrevInput{..} EntryState{..} = do
|
||||
dateandcodep = do
|
||||
d <- smartdate
|
||||
c <- optional codep
|
||||
skipMany spacenonewline
|
||||
skipNonNewlineSpaces
|
||||
eof
|
||||
return (d, fromMaybe "" c)
|
||||
-- defday = fixSmartDate today $ fromparse $ (parse smartdate "" . lowercase) defdate
|
||||
@ -356,7 +356,7 @@ amountAndCommentWizard PrevInput{..} EntryState{..} = do
|
||||
amountandcommentp :: JournalParser Identity (Amount, Text)
|
||||
amountandcommentp = do
|
||||
a <- amountp
|
||||
lift (skipMany spacenonewline)
|
||||
lift skipNonNewlineSpaces
|
||||
c <- T.pack <$> fromMaybe "" `fmap` optional (char ';' >> many anySingle)
|
||||
-- eof
|
||||
return (a,c)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user