From d7b68fbd7dc35005405cbeba1a55984c8b2ef745 Mon Sep 17 00:00:00 2001 From: Moritz Kiefer Date: Sun, 25 Mar 2018 15:53:44 +0200 Subject: [PATCH] Use skipMany/skipSome for parsing spacenonewline This avoids allocating the list of space characters only to then discard it. --- hledger-lib/Hledger/Data/Dates.hs | 48 ++++++++-------- hledger-lib/Hledger/Query.hs | 2 +- hledger-lib/Hledger/Read/Common.hs | 64 ++++++++++++--------- hledger-lib/Hledger/Read/CsvReader.hs | 26 ++++----- hledger-lib/Hledger/Read/JournalReader.hs | 62 ++++++++++---------- hledger-lib/Hledger/Read/TimeclockReader.hs | 6 +- hledger-lib/Hledger/Read/TimedotReader.hs | 6 +- hledger-lib/Hledger/Utils/String.hs | 2 +- hledger/Hledger/Cli/Commands/Add.hs | 4 +- 9 files changed, 116 insertions(+), 104 deletions(-) diff --git a/hledger-lib/Hledger/Data/Dates.hs b/hledger-lib/Hledger/Data/Dates.hs index c068d980f..3224d853b 100644 --- a/hledger-lib/Hledger/Data/Dates.hs +++ b/hledger-lib/Hledger/Data/Dates.hs @@ -660,7 +660,7 @@ smartdate = do smartdateonly :: SimpleTextParser SmartDate smartdateonly = do d <- smartdate - many spacenonewline + skipMany spacenonewline eof return d @@ -769,7 +769,7 @@ lastthisnextthing = do ,"this" ,"next" ] - many spacenonewline -- make the space optional for easier scripting + skipMany spacenonewline -- make the space optional for easier scripting p <- choice $ map mptext [ "day" ,"week" @@ -827,7 +827,7 @@ lastthisnextthing = do -- >>> p "every 2nd day of month 2009-" -- Right (DayOfMonth 2,DateSpan 2009/01/01-) periodexpr :: Day -> SimpleTextParser (Interval, DateSpan) -periodexpr rdate = surroundedBy (many spacenonewline) . choice $ map try [ +periodexpr rdate = surroundedBy (skipMany spacenonewline) . choice $ map try [ intervalanddateperiodexpr rdate, (,) NoInterval <$> periodexprdatespan rdate ] @@ -836,7 +836,7 @@ intervalanddateperiodexpr :: Day -> SimpleTextParser (Interval, DateSpan) intervalanddateperiodexpr rdate = do i <- reportinginterval s <- option def . try $ do - many spacenonewline + skipMany spacenonewline periodexprdatespan rdate return (i,s) @@ -853,46 +853,46 @@ reportinginterval = choice' [ do string "bimonthly" return $ Months 2, do string "every" - many spacenonewline + skipMany spacenonewline n <- nth - many spacenonewline + skipMany spacenonewline string "day" of_ "week" return $ DayOfWeek n, do string "every" - many spacenonewline + skipMany spacenonewline n <- weekday return $ DayOfWeek n, do string "every" - many spacenonewline + skipMany spacenonewline n <- nth - many spacenonewline + skipMany spacenonewline string "day" optOf_ "month" return $ DayOfMonth n, do string "every" let mnth = choice' [month, mon] >>= \(_,m,_) -> return (read m) - d_o_y <- makePermParser $ DayOfYear <$$> try (many spacenonewline *> mnth) <||> try (many spacenonewline *> nth) + d_o_y <- makePermParser $ DayOfYear <$$> try (skipMany spacenonewline *> mnth) <||> try (skipMany spacenonewline *> nth) optOf_ "year" return d_o_y, do string "every" - many spacenonewline + skipMany spacenonewline ("",m,d) <- md optOf_ "year" return $ DayOfYear (read m) (read d), do string "every" - many spacenonewline + skipMany spacenonewline n <- nth - many spacenonewline + skipMany spacenonewline wd <- weekday optOf_ "month" return $ WeekdayOfMonth n wd ] where of_ period = do - many spacenonewline + skipMany spacenonewline string "of" - many spacenonewline + skipMany spacenonewline string period optOf_ period = optional $ try $ of_ period @@ -908,13 +908,13 @@ reportinginterval = choice' [ do mptext compact' return $ intcons 1, do mptext "every" - many spacenonewline + skipMany spacenonewline mptext singular' return $ intcons 1, do mptext "every" - many spacenonewline + skipMany spacenonewline n <- fmap read $ some digitChar - many spacenonewline + skipMany spacenonewline mptext plural' return $ intcons n ] @@ -933,10 +933,10 @@ periodexprdatespan rdate = choice $ map try [ doubledatespan :: Day -> SimpleTextParser DateSpan doubledatespan rdate = do - optional (string "from" >> many spacenonewline) + optional (string "from" >> skipMany spacenonewline) b <- smartdate - many spacenonewline - optional (choice [string "to", string "-"] >> many spacenonewline) + skipMany spacenonewline + optional (choice [string "to", string "-"] >> skipMany spacenonewline) e <- smartdate return $ DateSpan (Just $ fixSmartDate rdate b) (Just $ fixSmartDate rdate e) @@ -944,7 +944,7 @@ fromdatespan :: Day -> SimpleTextParser DateSpan fromdatespan rdate = do b <- choice [ do - string "from" >> many spacenonewline + string "from" >> skipMany spacenonewline smartdate , do @@ -956,13 +956,13 @@ fromdatespan rdate = do todatespan :: Day -> SimpleTextParser DateSpan todatespan rdate = do - choice [string "to", string "-"] >> many spacenonewline + choice [string "to", string "-"] >> skipMany spacenonewline e <- smartdate return $ DateSpan Nothing (Just $ fixSmartDate rdate e) justdatespan :: Day -> SimpleTextParser DateSpan justdatespan rdate = do - optional (string "in" >> many spacenonewline) + optional (string "in" >> skipMany spacenonewline) d <- smartdate return $ spanFromSmartDate rdate d diff --git a/hledger-lib/Hledger/Query.hs b/hledger-lib/Hledger/Query.hs index 8a0074a27..527366135 100644 --- a/hledger-lib/Hledger/Query.hs +++ b/hledger-lib/Hledger/Query.hs @@ -188,7 +188,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` some spacenonewline + maybeprefixedquotedphrases = choice' [prefixedQuotedPattern, singleQuotedPattern, doubleQuotedPattern, pattern] `sepBy` skipSome spacenonewline prefixedQuotedPattern :: SimpleTextParser T.Text prefixedQuotedPattern = do not' <- fromMaybe "" `fmap` (optional $ mptext "not:") diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 39e305833..89a85579a 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -13,7 +13,7 @@ Some of these might belong in Hledger.Read.JournalReader or Hledger.Read. -} --- * module -{-# LANGUAGE CPP, DeriveDataTypeable, RecordWildCards, NamedFieldPuns, NoMonoLocalBinds, ScopedTypeVariables, FlexibleContexts, TupleSections, OverloadedStrings #-} +{-# LANGUAGE CPP, BangPatterns, DeriveDataTypeable, RecordWildCards, NamedFieldPuns, NoMonoLocalBinds, ScopedTypeVariables, FlexibleContexts, TupleSections, OverloadedStrings #-} {-# LANGUAGE LambdaCase #-} module Hledger.Read.Common @@ -228,14 +228,14 @@ parserErrorAt pos s = throwError $ sourcePosPretty pos ++ ":\n" ++ s statusp :: TextParser m Status statusp = choice' - [ many spacenonewline >> char '*' >> return Cleared - , many spacenonewline >> char '!' >> return Pending + [ skipMany spacenonewline >> char '*' >> return Cleared + , skipMany spacenonewline >> char '!' >> return Pending , return Unmarked ] "cleared status" codep :: TextParser m String -codep = try (do { some spacenonewline; char '(' "codep"; anyChar `manyTill` char ')' } ) <|> return "" +codep = try (do { skipSome spacenonewline; char '(' "codep"; anyChar `manyTill` char ')' } ) <|> return "" descriptionp :: JournalParser m String descriptionp = many (noneOf (";\n" :: [Char])) @@ -279,7 +279,7 @@ datep = do datetimep :: JournalParser m LocalTime datetimep = do day <- datep - lift $ some spacenonewline + lift $ skipSome spacenonewline h <- some digitChar let h' = read h guard $ h' >= 0 && h' <= 23 @@ -372,7 +372,7 @@ accountnamep = do spaceandamountormissingp :: Monad m => JournalParser m MixedAmount spaceandamountormissingp = try (do - lift $ some spacenonewline + lift $ skipSome spacenonewline (Mixed . (:[])) `fmap` amountp <|> return missingmixedamt ) <|> return missingmixedamt @@ -433,15 +433,27 @@ multiplierp = do return $ case multiplier of Just '*' -> True _ -> False +-- | 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 + leftsymbolamountp :: Monad m => JournalParser m Amount leftsymbolamountp = do sign <- lift signp m <- lift multiplierp c <- lift commoditysymbolp suggestedStyle <- getAmountStyle c - sp <- lift $ many spacenonewline + commodityspaced <- lift $ skipMany' spacenonewline (q,prec,mdec,mgrps) <- lift $ numberp suggestedStyle - let s = amountstyle{ascommodityside=L, ascommodityspaced=not $ null sp, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps} + let s = amountstyle{ascommodityside=L, ascommodityspaced=commodityspaced, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps} p <- priceamountp let applysign = if sign=="-" then negate else id return $ applysign $ Amount c q p s m @@ -452,12 +464,12 @@ rightsymbolamountp = do m <- lift multiplierp sign <- lift signp rawnum <- lift $ rawnumberp - sp <- lift $ many spacenonewline + commodityspaced <- lift $ skipMany' spacenonewline c <- lift commoditysymbolp suggestedStyle <- getAmountStyle c let (q,prec,mdec,mgrps) = fromRawNumber suggestedStyle (sign == "-") rawnum p <- priceamountp - let s = amountstyle{ascommodityside=R, ascommodityspaced=not $ null sp, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps} + let s = amountstyle{ascommodityside=R, ascommodityspaced=commodityspaced, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps} return $ Amount c q p s m "right-symbol amount" @@ -491,15 +503,15 @@ simplecommoditysymbolp = T.pack <$> some (noneOf nonsimplecommoditychars) priceamountp :: Monad m => JournalParser m Price priceamountp = try (do - lift (many spacenonewline) + lift (skipMany spacenonewline) char '@' try (do char '@' - lift (many spacenonewline) + lift (skipMany spacenonewline) a <- amountp -- XXX can parse more prices ad infinitum, shouldn't return $ TotalPrice a) <|> (do - lift (many spacenonewline) + lift (skipMany spacenonewline) a <- amountp -- XXX can parse more prices ad infinitum, shouldn't return $ UnitPrice a)) <|> return NoPrice @@ -507,10 +519,10 @@ priceamountp = partialbalanceassertionp :: Monad m => JournalParser m BalanceAssertion partialbalanceassertionp = try (do - lift (many spacenonewline) + lift (skipMany spacenonewline) sourcepos <- genericSourcePos <$> lift getPosition char '=' - lift (many spacenonewline) + lift (skipMany spacenonewline) a <- amountp -- XXX should restrict to a simple amount return $ Just (a, sourcepos)) <|> return Nothing @@ -518,9 +530,9 @@ partialbalanceassertionp = -- balanceassertion :: Monad m => TextParser m (Maybe MixedAmount) -- balanceassertion = -- try (do --- lift (many spacenonewline) +-- lift (skipMany spacenonewline) -- string "==" --- lift (many spacenonewline) +-- lift (skipMany spacenonewline) -- a <- amountp -- XXX should restrict to a simple amount -- return $ Just $ Mixed [a]) -- <|> return Nothing @@ -529,13 +541,13 @@ partialbalanceassertionp = fixedlotpricep :: Monad m => JournalParser m (Maybe Amount) fixedlotpricep = try (do - lift (many spacenonewline) + lift (skipMany spacenonewline) char '{' - lift (many spacenonewline) + lift (skipMany spacenonewline) char '=' - lift (many spacenonewline) + lift (skipMany spacenonewline) a <- amountp -- XXX should restrict to a simple amount - lift (many spacenonewline) + lift (skipMany spacenonewline) char '}' return $ Just a) <|> return Nothing @@ -652,7 +664,7 @@ whitespaceChar = charCategory Space multilinecommentp :: JournalParser m () multilinecommentp = do - string "comment" >> lift (many spacenonewline) >> newline + string "comment" >> lift (skipMany spacenonewline) >> newline go where go = try (eof <|> (string "end comment" >> newline >> return ())) @@ -661,15 +673,15 @@ multilinecommentp = do emptyorcommentlinep :: JournalParser m () emptyorcommentlinep = do - lift (many spacenonewline) >> (linecommentp <|> (lift (many spacenonewline) >> newline >> return "")) + lift (skipMany spacenonewline) >> (linecommentp <|> (lift (skipMany spacenonewline) >> newline >> return "")) return () -- | Parse a possibly multi-line comment following a semicolon. followingcommentp :: JournalParser m Text followingcommentp = -- ptrace "followingcommentp" - do samelinecomment <- lift (many spacenonewline) >> (try commentp <|> (newline >> return "")) - newlinecomments <- many (try (lift (some spacenonewline) >> commentp)) + do samelinecomment <- lift (skipMany spacenonewline) >> (try commentp <|> (newline >> return "")) + newlinecomments <- many (try (lift (skipSome spacenonewline) >> commentp)) return $ T.unlines $ samelinecomment:newlinecomments -- | Parse a possibly multi-line comment following a semicolon, and @@ -741,7 +753,7 @@ commentStartingWithp :: [Char] -> JournalParser m Text commentStartingWithp cs = do -- ptrace "commentStartingWith" oneOf cs - lift (many spacenonewline) + lift (skipMany spacenonewline) l <- anyChar `manyTill` (lift eolof) optional newline return $ T.pack l diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index 269a84947..d35bc956b 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/hledger-lib/Hledger/Read/CsvReader.hs @@ -435,10 +435,10 @@ blankorcommentlinep :: CsvRulesParser () blankorcommentlinep = lift (pdbg 3 "trying blankorcommentlinep") >> choiceInState [blanklinep, commentlinep] blanklinep :: CsvRulesParser () -blanklinep = lift (many spacenonewline) >> newline >> return () "blank line" +blanklinep = lift (skipMany spacenonewline) >> newline >> return () "blank line" commentlinep :: CsvRulesParser () -commentlinep = lift (many spacenonewline) >> commentcharp >> lift restofline >> return () "comment line" +commentlinep = lift (skipMany spacenonewline) >> commentcharp >> lift restofline >> return () "comment line" commentcharp :: CsvRulesParser Char commentcharp = oneOf (";#*" :: [Char]) @@ -448,7 +448,7 @@ directivep = (do lift $ pdbg 3 "trying directive" d <- fmap T.unpack $ choiceInState $ map (lift . mptext . T.pack) directives v <- (((char ':' >> lift (many spacenonewline)) <|> lift (some spacenonewline)) >> directivevalp) - <|> (optional (char ':') >> lift (many spacenonewline) >> lift eolof >> return "") + <|> (optional (char ':') >> lift (skipMany spacenonewline) >> lift eolof >> return "") return (d, v) ) "directive" @@ -471,8 +471,8 @@ fieldnamelistp = (do lift $ pdbg 3 "trying fieldnamelist" string "fields" optional $ char ':' - lift (some spacenonewline) - let separator = lift (many spacenonewline) >> char ',' >> lift (many spacenonewline) + lift (skipSome spacenonewline) + let separator = lift (skipMany spacenonewline) >> char ',' >> lift (skipMany spacenonewline) f <- fromMaybe "" <$> optional fieldnamep fs <- some $ (separator >> fromMaybe "" <$> optional fieldnamep) lift restofline @@ -529,11 +529,11 @@ assignmentseparatorp :: CsvRulesParser () assignmentseparatorp = do lift $ pdbg 3 "trying assignmentseparatorp" choice [ - -- try (lift (many spacenonewline) >> oneOf ":="), - try (lift (many spacenonewline) >> char ':'), + -- try (lift (skipMany spacenonewline) >> oneOf ":="), + try (lift (skipMany spacenonewline) >> char ':'), spaceChar ] - _ <- lift (many spacenonewline) + _ <- lift (skipMany spacenonewline) return () fieldvalp :: CsvRulesParser String @@ -544,9 +544,9 @@ fieldvalp = do conditionalblockp :: CsvRulesParser ConditionalBlock conditionalblockp = do lift $ pdbg 3 "trying conditionalblockp" - string "if" >> lift (many spacenonewline) >> optional newline + string "if" >> lift (skipMany spacenonewline) >> optional newline ms <- some recordmatcherp - as <- many (lift (some spacenonewline) >> fieldassignmentp) + as <- many (lift (skipSome spacenonewline) >> fieldassignmentp) when (null as) $ fail "start of conditional block found, but no assignment rules afterward\n(assignment rules in a conditional block should be indented)\n" return (ms, as) @@ -556,7 +556,7 @@ recordmatcherp :: CsvRulesParser [String] recordmatcherp = do lift $ pdbg 2 "trying recordmatcherp" -- pos <- currentPos - _ <- optional (matchoperatorp >> lift (many spacenonewline) >> optional newline) + _ <- optional (matchoperatorp >> lift (skipMany spacenonewline) >> optional newline) ps <- patternsp when (null ps) $ fail "start of record matcher found, but no patterns afterward\n(patterns should not be indented)\n" @@ -589,10 +589,10 @@ regexp = do -- pdbg 2 "trying fieldmatcher" -- f <- fromMaybe "all" `fmap` (optional $ do -- f' <- fieldname --- lift (many spacenonewline) +-- lift (skipMany spacenonewline) -- return f') -- char '~' --- lift (many spacenonewline) +-- lift (skipMany spacenonewline) -- ps <- patterns -- let r = "(" ++ intercalate "|" ps ++ ")" -- return (f,r) diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index d4cf5a96a..5effefd60 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -181,7 +181,7 @@ directivep = (do includedirectivep :: MonadIO m => ErroringJournalParser m () includedirectivep = do string "include" - lift (some spacenonewline) + lift (skipSome spacenonewline) filename <- lift restofline parentpos <- getPosition parentj <- get @@ -235,9 +235,9 @@ orRethrowIOError io msg = accountdirectivep :: JournalParser m () accountdirectivep = do string "account" - lift (some spacenonewline) + lift (skipSome spacenonewline) acct <- lift accountnamep -- eats single spaces - macode' :: Maybe String <- (optional $ lift $ some spacenonewline >> some digitChar) + macode' :: Maybe String <- (optional $ lift $ skipSome spacenonewline >> some digitChar) let macode :: Maybe AccountCode = read <$> macode' newline _tags <- many $ do @@ -250,7 +250,7 @@ accountdirectivep = do modify' (\j -> j{jaccounts = (acct, macode) : jaccounts j}) indentedlinep :: JournalParser m String -indentedlinep = lift (some spacenonewline) >> (rstrip <$> lift restofline) +indentedlinep = lift (skipSome spacenonewline) >> (rstrip <$> lift restofline) -- | Parse a one-line or multi-line commodity directive. -- @@ -268,9 +268,9 @@ commoditydirectivep = try commoditydirectiveonelinep <|> commoditydirectivemulti commoditydirectiveonelinep :: Monad m => JournalParser m () commoditydirectiveonelinep = do string "commodity" - lift (some spacenonewline) + lift (skipSome spacenonewline) Amount{acommodity,astyle} <- amountp - lift (many spacenonewline) + lift (skipMany spacenonewline) _ <- followingcommentp <|> (lift eolof >> return "") let comm = Commodity{csymbol=acommodity, cformat=Just astyle} modify' (\j -> j{jcommodities=M.insert acommodity comm $ jcommodities j}) @@ -281,21 +281,21 @@ commoditydirectiveonelinep = do commoditydirectivemultilinep :: Monad m => ErroringJournalParser m () commoditydirectivemultilinep = do string "commodity" - lift (some spacenonewline) + lift (skipSome spacenonewline) sym <- lift commoditysymbolp _ <- 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}) where - indented = (lift (some spacenonewline) >>) + indented = (lift (skipSome spacenonewline) >>) -- | Parse a format (sub)directive, throwing a parse error if its -- symbol does not match the one given. formatdirectivep :: Monad m => CommoditySymbol -> ErroringJournalParser m AmountStyle formatdirectivep expectedsym = do string "format" - lift (some spacenonewline) + lift (skipSome spacenonewline) pos <- getPosition Amount{acommodity,astyle} <- amountp _ <- followingcommentp <|> (lift eolof >> return "") @@ -308,7 +308,7 @@ keywordp :: String -> JournalParser m () keywordp = (() <$) . string . fromString spacesp :: JournalParser m () -spacesp = () <$ lift (some spacenonewline) +spacesp = () <$ lift (skipSome spacenonewline) -- | Backtracking parser similar to string, but allows varying amount of space between words keywordsp :: String -> JournalParser m () @@ -317,7 +317,7 @@ keywordsp = try . sequence_ . intersperse spacesp . map keywordp . words applyaccountdirectivep :: JournalParser m () applyaccountdirectivep = do keywordsp "apply account" "apply account directive" - lift (some spacenonewline) + lift (skipSome spacenonewline) parent <- lift accountnamep newline pushParentAccount parent @@ -330,7 +330,7 @@ endapplyaccountdirectivep = do aliasdirectivep :: JournalParser m () aliasdirectivep = do string "alias" - lift (some spacenonewline) + lift (skipSome spacenonewline) alias <- lift accountaliasp addAccountAlias alias @@ -342,7 +342,7 @@ basicaliasp = do -- pdbg 0 "basicaliasp" old <- rstrip <$> (some $ noneOf ("=" :: [Char])) char '=' - many spacenonewline + skipMany spacenonewline new <- rstrip <$> anyChar `manyTill` eolof -- eol in journal, eof in command lines, normally return $ BasicAlias (T.pack old) (T.pack new) @@ -352,9 +352,9 @@ regexaliasp = do char '/' re <- some $ noneOf ("/\n\r" :: [Char]) -- paranoid: don't try to read past line end char '/' - many spacenonewline + skipMany spacenonewline char '=' - many spacenonewline + skipMany spacenonewline repl <- anyChar `manyTill` eolof return $ RegexAlias re repl @@ -366,7 +366,7 @@ endaliasesdirectivep = do tagdirectivep :: JournalParser m () tagdirectivep = do string "tag" "tag directive" - lift (some spacenonewline) + lift (skipSome spacenonewline) _ <- lift $ some nonspace lift restofline return () @@ -380,7 +380,7 @@ endtagdirectivep = do defaultyeardirectivep :: JournalParser m () defaultyeardirectivep = do char 'Y' "default year" - lift (many spacenonewline) + lift (skipMany spacenonewline) y <- some digitChar let y' = read y failIfInvalidYear y @@ -389,7 +389,7 @@ defaultyeardirectivep = do defaultcommoditydirectivep :: Monad m => JournalParser m () defaultcommoditydirectivep = do char 'D' "default commodity" - lift (some spacenonewline) + lift (skipSome spacenonewline) Amount{..} <- amountp lift restofline setDefaultCommodityAndStyle (acommodity, astyle) @@ -397,11 +397,11 @@ defaultcommoditydirectivep = do marketpricedirectivep :: Monad m => JournalParser m MarketPrice marketpricedirectivep = do char 'P' "market price" - lift (many spacenonewline) + lift (skipMany spacenonewline) date <- try (do {LocalTime d _ <- datetimep; return d}) <|> datep -- a time is ignored - lift (some spacenonewline) + lift (skipSome spacenonewline) symbol <- lift commoditysymbolp - lift (many spacenonewline) + lift (skipMany spacenonewline) price <- amountp lift restofline return $ MarketPrice date symbol price @@ -409,7 +409,7 @@ marketpricedirectivep = do ignoredpricecommoditydirectivep :: JournalParser m () ignoredpricecommoditydirectivep = do char 'N' "ignored-price commodity" - lift (some spacenonewline) + lift (skipSome spacenonewline) lift commoditysymbolp lift restofline return () @@ -417,11 +417,11 @@ ignoredpricecommoditydirectivep = do commodityconversiondirectivep :: Monad m => JournalParser m () commodityconversiondirectivep = do char 'C' "commodity conversion" - lift (some spacenonewline) + lift (skipSome spacenonewline) amountp - lift (many spacenonewline) + lift (skipMany spacenonewline) char '=' - lift (many spacenonewline) + lift (skipMany spacenonewline) amountp lift restofline return () @@ -431,7 +431,7 @@ commodityconversiondirectivep = do modifiertransactionp :: MonadIO m => ErroringJournalParser m ModifierTransaction modifiertransactionp = do char '=' "modifier transaction" - lift (many spacenonewline) + lift (skipMany spacenonewline) valueexpr <- T.pack <$> lift restofline postings <- postingsp Nothing return $ ModifierTransaction valueexpr postings @@ -439,7 +439,7 @@ modifiertransactionp = do periodictransactionp :: MonadIO m => ErroringJournalParser m PeriodicTransaction periodictransactionp = do char '~' "periodic transaction" - lift (many spacenonewline) + lift (skipMany spacenonewline) periodexpr <- T.pack <$> lift restofline postings <- postingsp Nothing return $ PeriodicTransaction periodexpr postings @@ -564,7 +564,7 @@ postingsp mdate = many (try $ postingp mdate) "postings" -- linebeginningwithspaces :: Monad m => JournalParser m String -- linebeginningwithspaces = do --- sp <- lift (some spacenonewline) +-- sp <- lift (skipSome spacenonewline) -- c <- nonspace -- cs <- lift restofline -- return $ sp ++ (c:cs) ++ "\n" @@ -572,15 +572,15 @@ postingsp mdate = many (try $ postingp mdate) "postings" postingp :: MonadIO m => Maybe Day -> ErroringJournalParser m Posting postingp mtdate = do -- pdbg 0 "postingp" - lift (some spacenonewline) + lift (skipSome spacenonewline) status <- lift statusp - lift (many spacenonewline) + lift (skipMany spacenonewline) account <- modifiedaccountnamep let (ptype, account') = (accountNamePostingType account, textUnbracket account) amount <- spaceandamountormissingp massertion <- partialbalanceassertionp _ <- fixedlotpricep - lift (many spacenonewline) + lift (skipMany spacenonewline) (comment,tags,mdate,mdate2) <- try (followingcommentandtagsp mtdate) <|> (newline >> return ("",[],Nothing,Nothing)) return posting diff --git a/hledger-lib/Hledger/Read/TimeclockReader.hs b/hledger-lib/Hledger/Read/TimeclockReader.hs index 3766b0982..6dc993cd4 100644 --- a/hledger-lib/Hledger/Read/TimeclockReader.hs +++ b/hledger-lib/Hledger/Read/TimeclockReader.hs @@ -109,10 +109,10 @@ timeclockentryp :: JournalParser m TimeclockEntry timeclockentryp = do sourcepos <- genericSourcePos <$> lift getPosition code <- oneOf ("bhioO" :: [Char]) - lift (some spacenonewline) + lift (skipSome spacenonewline) datetime <- datetimep - account <- fromMaybe "" <$> optional (lift (some spacenonewline) >> modifiedaccountnamep) - description <- T.pack . fromMaybe "" <$> lift (optional (some spacenonewline >> restofline)) + account <- fromMaybe "" <$> optional (lift (skipSome spacenonewline) >> modifiedaccountnamep) + description <- T.pack . fromMaybe "" <$> lift (optional (skipSome spacenonewline >> restofline)) return $ TimeclockEntry sourcepos (read [code]) datetime account description tests_Hledger_Read_TimeclockReader = TestList [ diff --git a/hledger-lib/Hledger/Read/TimedotReader.hs b/hledger-lib/Hledger/Read/TimedotReader.hs index 9a433a5d2..1ad99db43 100644 --- a/hledger-lib/Hledger/Read/TimedotReader.hs +++ b/hledger-lib/Hledger/Read/TimedotReader.hs @@ -107,9 +107,9 @@ timedotentryp :: JournalParser m Transaction timedotentryp = do ptrace " timedotentryp" pos <- genericSourcePos <$> getPosition - lift (many spacenonewline) + lift (skipMany spacenonewline) a <- modifiedaccountnamep - lift (many spacenonewline) + lift (skipMany spacenonewline) hours <- try (followingcommentp >> return 0) <|> (timedotdurationp <* @@ -143,7 +143,7 @@ timedotnumericp :: JournalParser m Quantity timedotnumericp = do (q, _, _, _) <- lift $ numberp Nothing msymbol <- optional $ choice $ map (string . fst) timeUnits - lift (many spacenonewline) + lift (skipMany spacenonewline) let q' = case msymbol of Nothing -> q diff --git a/hledger-lib/Hledger/Utils/String.hs b/hledger-lib/Hledger/Utils/String.hs index 2265e7be2..5fb0ad35e 100644 --- a/hledger-lib/Hledger/Utils/String.hs +++ b/hledger-lib/Hledger/Utils/String.hs @@ -129,7 +129,7 @@ words' :: String -> [String] words' "" = [] words' s = map stripquotes $ fromparse $ parsewithString p s where - p = do ss <- (singleQuotedPattern <|> doubleQuotedPattern <|> pattern) `sepBy` some spacenonewline + p = do ss <- (singleQuotedPattern <|> doubleQuotedPattern <|> pattern) `sepBy` skipSome spacenonewline -- eof return ss pattern = many (noneOf whitespacechars) diff --git a/hledger/Hledger/Cli/Commands/Add.hs b/hledger/Hledger/Cli/Commands/Add.hs index bfb406f2b..69035ff42 100644 --- a/hledger/Hledger/Cli/Commands/Add.hs +++ b/hledger/Hledger/Cli/Commands/Add.hs @@ -197,7 +197,7 @@ dateAndCodeWizard EntryState{..} = do dateandcodep = do d <- smartdate c <- optional codep - many spacenonewline + skipMany spacenonewline eof return (d, T.pack $ fromMaybe "" c) -- defday = fixSmartDate today $ fromparse $ (parse smartdate "" . lowercase) defdate @@ -294,7 +294,7 @@ amountAndCommentWizard EntryState{..} = do amountandcommentp :: JournalParser Identity (Amount, Text) amountandcommentp = do a <- amountp - lift (many spacenonewline) + lift (skipMany spacenonewline) c <- T.pack <$> fromMaybe "" `fmap` optional (char ';' >> many anyChar) -- eof return (a,c)