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

lib: Change skipMany spacenonewline to takeWhileP Nothing isNonNewlineSpace.

Browse Source
This commit is contained in:
Stephen Morgan 2020-07-21 01:09:46 +10:00 committed by Simon Michael
parent 1c4e0c3cff
commit 081ee390ab
10 changed files with 134 additions and 122 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
hledger-lib/Hledger/Data/Dates.hs
View File

@ -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

2
hledger-lib/Hledger/Query.hs
View File

@ -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:")

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

@ -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

28
hledger-lib/Hledger/Read/CsvReader.hs
View File

@ -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

66
hledger-lib/Hledger/Read/JournalReader.hs
View File

@ -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

6
hledger-lib/Hledger/Read/TimeclockReader.hs
View File

@ -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

10
hledger-lib/Hledger/Read/TimedotReader.hs
View File

@ -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

23
hledger-lib/Hledger/Utils/Parse.hs
View File

@ -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

2
hledger-lib/Hledger/Utils/String.hs
View File

@ -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)

4
hledger/Hledger/Cli/Commands/Add.hs
View File

@ -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)