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

Use skipMany/skipSome for parsing spacenonewline

Browse Source 
This avoids allocating the list of space characters only to then
discard it.
This commit is contained in:
Moritz Kiefer 2018-03-25 15:53:44 +02:00 committed by Simon Michael
parent addd9b5385
commit d7b68fbd7d
9 changed files with 116 additions and 104 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -660,7 +660,7 @@ smartdate = do
smartdateonly :: SimpleTextParser SmartDate smartdateonly :: SimpleTextParser SmartDate
smartdateonly = do smartdateonly = do
d <- smartdate d <- smartdate
many spacenonewline skipMany spacenonewline
eof eof
return d return d
@ -769,7 +769,7 @@ lastthisnextthing = do
,"this" ,"this"
,"next" ,"next"
] ]
many spacenonewline -- make the space optional for easier scripting skipMany spacenonewline -- make the space optional for easier scripting
p <- choice $ map mptext [ p <- choice $ map mptext [
"day" "day"
,"week" ,"week"
@ -827,7 +827,7 @@ lastthisnextthing = do
-- >>> p "every 2nd day of month 2009-" -- >>> p "every 2nd day of month 2009-"
-- Right (DayOfMonth 2,DateSpan 2009/01/01-) -- Right (DayOfMonth 2,DateSpan 2009/01/01-)
periodexpr :: Day -> SimpleTextParser (Interval, DateSpan) periodexpr :: Day -> SimpleTextParser (Interval, DateSpan)
periodexpr rdate = surroundedBy (many spacenonewline) . choice $ map try [ periodexpr rdate = surroundedBy (skipMany spacenonewline) . choice $ map try [
intervalanddateperiodexpr rdate, intervalanddateperiodexpr rdate,
(,) NoInterval <$> periodexprdatespan rdate (,) NoInterval <$> periodexprdatespan rdate
] ]
@ -836,7 +836,7 @@ intervalanddateperiodexpr :: Day -> SimpleTextParser (Interval, DateSpan)
intervalanddateperiodexpr rdate = do intervalanddateperiodexpr rdate = do
i <- reportinginterval i <- reportinginterval
s <- option def . try $ do s <- option def . try $ do
many spacenonewline skipMany spacenonewline
periodexprdatespan rdate periodexprdatespan rdate
return (i,s) return (i,s)
@ -853,46 +853,46 @@ reportinginterval = choice' [
do string "bimonthly" do string "bimonthly"
return $ Months 2, return $ Months 2,
do string "every" do string "every"
many spacenonewline skipMany spacenonewline
n <- nth n <- nth
many spacenonewline skipMany spacenonewline
string "day" string "day"
of_ "week" of_ "week"
return $ DayOfWeek n, return $ DayOfWeek n,
do string "every" do string "every"
many spacenonewline skipMany spacenonewline
n <- weekday n <- weekday
return $ DayOfWeek n, return $ DayOfWeek n,
do string "every" do string "every"
many spacenonewline skipMany spacenonewline
n <- nth n <- nth
many spacenonewline skipMany spacenonewline
string "day" string "day"
optOf_ "month" optOf_ "month"
return $ DayOfMonth n, return $ DayOfMonth n,
do string "every" do string "every"
let mnth = choice' [month, mon] >>= \(_,m,_) -> return (read m) 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" optOf_ "year"
return d_o_y, return d_o_y,
do string "every" do string "every"
many spacenonewline skipMany spacenonewline
("",m,d) <- md ("",m,d) <- md
optOf_ "year" optOf_ "year"
return $ DayOfYear (read m) (read d), return $ DayOfYear (read m) (read d),
do string "every" do string "every"
many spacenonewline skipMany spacenonewline
n <- nth n <- nth
many spacenonewline skipMany spacenonewline
wd <- weekday wd <- weekday
optOf_ "month" optOf_ "month"
return $ WeekdayOfMonth n wd return $ WeekdayOfMonth n wd
] ]
where where
of_ period = do of_ period = do
many spacenonewline skipMany spacenonewline
string "of" string "of"
many spacenonewline skipMany spacenonewline
string period string period
optOf_ period = optional $ try $ of_ period optOf_ period = optional $ try $ of_ period
@ -908,13 +908,13 @@ reportinginterval = choice' [
do mptext compact' do mptext compact'
return $ intcons 1, return $ intcons 1,
do mptext "every" do mptext "every"
many spacenonewline skipMany spacenonewline
mptext singular' mptext singular'
return $ intcons 1, return $ intcons 1,
do mptext "every" do mptext "every"
many spacenonewline skipMany spacenonewline
n <- fmap read $ some digitChar n <- fmap read $ some digitChar
many spacenonewline skipMany spacenonewline
mptext plural' mptext plural'
return $ intcons n return $ intcons n
] ]
@ -933,10 +933,10 @@ periodexprdatespan rdate = choice $ map try [
doubledatespan :: Day -> SimpleTextParser DateSpan doubledatespan :: Day -> SimpleTextParser DateSpan
doubledatespan rdate = do doubledatespan rdate = do
optional (string "from" >> many spacenonewline) optional (string "from" >> skipMany spacenonewline)
b <- smartdate b <- smartdate
many spacenonewline skipMany spacenonewline
optional (choice [string "to", string "-"] >> many spacenonewline) optional (choice [string "to", string "-"] >> skipMany spacenonewline)
e <- smartdate e <- smartdate
return $ DateSpan (Just $ fixSmartDate rdate b) (Just $ fixSmartDate rdate e) return $ DateSpan (Just $ fixSmartDate rdate b) (Just $ fixSmartDate rdate e)
@ -944,7 +944,7 @@ fromdatespan :: Day -> SimpleTextParser DateSpan
fromdatespan rdate = do fromdatespan rdate = do
b <- choice [ b <- choice [
do do
string "from" >> many spacenonewline string "from" >> skipMany spacenonewline
smartdate smartdate
, ,
do do
@ -956,13 +956,13 @@ fromdatespan rdate = do
todatespan :: Day -> SimpleTextParser DateSpan todatespan :: Day -> SimpleTextParser DateSpan
todatespan rdate = do todatespan rdate = do
choice [string "to", string "-"] >> many spacenonewline choice [string "to", string "-"] >> skipMany spacenonewline
e <- smartdate e <- smartdate
return $ DateSpan Nothing (Just $ fixSmartDate rdate e) return $ DateSpan Nothing (Just $ fixSmartDate rdate e)
justdatespan :: Day -> SimpleTextParser DateSpan justdatespan :: Day -> SimpleTextParser DateSpan
justdatespan rdate = do justdatespan rdate = do
optional (string "in" >> many spacenonewline) optional (string "in" >> skipMany spacenonewline)
d <- smartdate d <- smartdate
return $ spanFromSmartDate rdate d return $ spanFromSmartDate rdate d

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

@ -188,7 +188,7 @@ words'' :: [T.Text] -> T.Text -> [T.Text]
words'' prefixes = fromparse . parsewith maybeprefixedquotedphrases -- XXX words'' prefixes = fromparse . parsewith maybeprefixedquotedphrases -- XXX
where where
maybeprefixedquotedphrases :: SimpleTextParser [T.Text] 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 :: SimpleTextParser T.Text
prefixedQuotedPattern = do prefixedQuotedPattern = do
not' <- fromMaybe "" `fmap` (optional $ mptext "not:") not' <- fromMaybe "" `fmap` (optional $ mptext "not:")

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

@ -13,7 +13,7 @@ Some of these might belong in Hledger.Read.JournalReader or Hledger.Read.
-} -}
--- * module --- * module
{-# LANGUAGE CPP, DeriveDataTypeable, RecordWildCards, NamedFieldPuns, NoMonoLocalBinds, ScopedTypeVariables, FlexibleContexts, TupleSections, OverloadedStrings #-} {-# LANGUAGE CPP, BangPatterns, DeriveDataTypeable, RecordWildCards, NamedFieldPuns, NoMonoLocalBinds, ScopedTypeVariables, FlexibleContexts, TupleSections, OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
module Hledger.Read.Common module Hledger.Read.Common
@ -228,14 +228,14 @@ parserErrorAt pos s = throwError $ sourcePosPretty pos ++ ":\n" ++ s
statusp :: TextParser m Status statusp :: TextParser m Status
statusp = statusp =
choice' choice'
[ many spacenonewline >> char '*' >> return Cleared [ skipMany spacenonewline >> char '*' >> return Cleared
, many spacenonewline >> char '!' >> return Pending , skipMany spacenonewline >> char '!' >> return Pending
, return Unmarked , return Unmarked
] ]
<?> "cleared status" <?> "cleared status"
codep :: TextParser m String 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 :: JournalParser m String
descriptionp = many (noneOf (";\n" :: [Char])) descriptionp = many (noneOf (";\n" :: [Char]))
@ -279,7 +279,7 @@ datep = do
datetimep :: JournalParser m LocalTime datetimep :: JournalParser m LocalTime
datetimep = do datetimep = do
day <- datep day <- datep
lift $ some spacenonewline lift $ skipSome spacenonewline
h <- some digitChar h <- some digitChar
let h' = read h let h' = read h
guard $ h' >= 0 && h' <= 23 guard $ h' >= 0 && h' <= 23
@ -372,7 +372,7 @@ accountnamep = do
spaceandamountormissingp :: Monad m => JournalParser m MixedAmount spaceandamountormissingp :: Monad m => JournalParser m MixedAmount
spaceandamountormissingp = spaceandamountormissingp =
try (do try (do
lift $ some spacenonewline lift $ skipSome spacenonewline
(Mixed . (:[])) `fmap` amountp <|> return missingmixedamt (Mixed . (:[])) `fmap` amountp <|> return missingmixedamt
) <|> return missingmixedamt ) <|> return missingmixedamt
@ -433,15 +433,27 @@ multiplierp = do
return $ case multiplier of Just '*' -> True return $ case multiplier of Just '*' -> True
_ -> False _ -> 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 :: Monad m => JournalParser m Amount
leftsymbolamountp = do leftsymbolamountp = do
sign <- lift signp sign <- lift signp
m <- lift multiplierp m <- lift multiplierp
c <- lift commoditysymbolp c <- lift commoditysymbolp
suggestedStyle <- getAmountStyle c suggestedStyle <- getAmountStyle c
sp <- lift $ many spacenonewline commodityspaced <- lift $ skipMany' spacenonewline
(q,prec,mdec,mgrps) <- lift $ numberp suggestedStyle (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 p <- priceamountp
let applysign = if sign=="-" then negate else id let applysign = if sign=="-" then negate else id
return $ applysign $ Amount c q p s m return $ applysign $ Amount c q p s m
@ -452,12 +464,12 @@ rightsymbolamountp = do
m <- lift multiplierp m <- lift multiplierp
sign <- lift signp sign <- lift signp
rawnum <- lift $ rawnumberp rawnum <- lift $ rawnumberp
sp <- lift $ many spacenonewline commodityspaced <- lift $ skipMany' spacenonewline
c <- lift commoditysymbolp c <- lift commoditysymbolp
suggestedStyle <- getAmountStyle c suggestedStyle <- getAmountStyle c
let (q,prec,mdec,mgrps) = fromRawNumber suggestedStyle (sign == "-") rawnum let (q,prec,mdec,mgrps) = fromRawNumber suggestedStyle (sign == "-") rawnum
p <- priceamountp 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 return $ Amount c q p s m
<?> "right-symbol amount" <?> "right-symbol amount"
@ -491,15 +503,15 @@ simplecommoditysymbolp = T.pack <$> some (noneOf nonsimplecommoditychars)
priceamountp :: Monad m => JournalParser m Price priceamountp :: Monad m => JournalParser m Price
priceamountp = priceamountp =
try (do try (do
lift (many spacenonewline) lift (skipMany spacenonewline)
char '@' char '@'
try (do try (do
char '@' char '@'
lift (many spacenonewline) lift (skipMany spacenonewline)
a <- amountp -- XXX can parse more prices ad infinitum, shouldn't a <- amountp -- XXX can parse more prices ad infinitum, shouldn't
return $ TotalPrice a) return $ TotalPrice a)
<|> (do <|> (do
lift (many spacenonewline) lift (skipMany spacenonewline)
a <- amountp -- XXX can parse more prices ad infinitum, shouldn't a <- amountp -- XXX can parse more prices ad infinitum, shouldn't
return $ UnitPrice a)) return $ UnitPrice a))
<|> return NoPrice <|> return NoPrice
@ -507,10 +519,10 @@ priceamountp =
partialbalanceassertionp :: Monad m => JournalParser m BalanceAssertion partialbalanceassertionp :: Monad m => JournalParser m BalanceAssertion
partialbalanceassertionp = partialbalanceassertionp =
try (do try (do
lift (many spacenonewline) lift (skipMany spacenonewline)
sourcepos <- genericSourcePos <$> lift getPosition sourcepos <- genericSourcePos <$> lift getPosition
char '=' char '='
lift (many spacenonewline) lift (skipMany spacenonewline)
a <- amountp -- XXX should restrict to a simple amount a <- amountp -- XXX should restrict to a simple amount
return $ Just (a, sourcepos)) return $ Just (a, sourcepos))
<|> return Nothing <|> return Nothing
@ -518,9 +530,9 @@ partialbalanceassertionp =
-- balanceassertion :: Monad m => TextParser m (Maybe MixedAmount) -- balanceassertion :: Monad m => TextParser m (Maybe MixedAmount)
-- balanceassertion = -- balanceassertion =
-- try (do -- try (do
-- lift (many spacenonewline) -- lift (skipMany spacenonewline)
-- string "==" -- string "=="
-- lift (many spacenonewline) -- lift (skipMany spacenonewline)
-- a <- amountp -- XXX should restrict to a simple amount -- a <- amountp -- XXX should restrict to a simple amount
-- return $ Just $ Mixed [a]) -- return $ Just $ Mixed [a])
-- <|> return Nothing -- <|> return Nothing
@ -529,13 +541,13 @@ partialbalanceassertionp =
fixedlotpricep :: Monad m => JournalParser m (Maybe Amount) fixedlotpricep :: Monad m => JournalParser m (Maybe Amount)
fixedlotpricep = fixedlotpricep =
try (do try (do
lift (many spacenonewline) lift (skipMany spacenonewline)
char '{' char '{'
lift (many spacenonewline) lift (skipMany spacenonewline)
char '=' char '='
lift (many spacenonewline) lift (skipMany spacenonewline)
a <- amountp -- XXX should restrict to a simple amount a <- amountp -- XXX should restrict to a simple amount
lift (many spacenonewline) lift (skipMany spacenonewline)
char '}' char '}'
return $ Just a) return $ Just a)
<|> return Nothing <|> return Nothing
@ -652,7 +664,7 @@ whitespaceChar = charCategory Space
multilinecommentp :: JournalParser m () multilinecommentp :: JournalParser m ()
multilinecommentp = do multilinecommentp = do
string "comment" >> lift (many spacenonewline) >> newline string "comment" >> lift (skipMany spacenonewline) >> newline
go go
where where
go = try (eof <|> (string "end comment" >> newline >> return ())) go = try (eof <|> (string "end comment" >> newline >> return ()))
@ -661,15 +673,15 @@ multilinecommentp = do
emptyorcommentlinep :: JournalParser m () emptyorcommentlinep :: JournalParser m ()
emptyorcommentlinep = do emptyorcommentlinep = do
lift (many spacenonewline) >> (linecommentp <|> (lift (many spacenonewline) >> newline >> return "")) lift (skipMany spacenonewline) >> (linecommentp <|> (lift (skipMany spacenonewline) >> newline >> return ""))
return () return ()
-- | Parse a possibly multi-line comment following a semicolon. -- | Parse a possibly multi-line comment following a semicolon.
followingcommentp :: JournalParser m Text followingcommentp :: JournalParser m Text
followingcommentp = followingcommentp =
-- ptrace "followingcommentp" -- ptrace "followingcommentp"
do samelinecomment <- lift (many spacenonewline) >> (try commentp <|> (newline >> return "")) do samelinecomment <- lift (skipMany spacenonewline) >> (try commentp <|> (newline >> return ""))
newlinecomments <- many (try (lift (some spacenonewline) >> commentp)) newlinecomments <- many (try (lift (skipSome spacenonewline) >> commentp))
return $ T.unlines $ samelinecomment:newlinecomments return $ T.unlines $ samelinecomment:newlinecomments
-- | Parse a possibly multi-line comment following a semicolon, and -- | Parse a possibly multi-line comment following a semicolon, and
@ -741,7 +753,7 @@ commentStartingWithp :: [Char] -> JournalParser m Text
commentStartingWithp cs = do commentStartingWithp cs = do
-- ptrace "commentStartingWith" -- ptrace "commentStartingWith"
oneOf cs oneOf cs
lift (many spacenonewline) lift (skipMany spacenonewline)
l <- anyChar `manyTill` (lift eolof) l <- anyChar `manyTill` (lift eolof)
optional newline optional newline
return $ T.pack l return $ T.pack l

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

@ -435,10 +435,10 @@ blankorcommentlinep :: CsvRulesParser ()
blankorcommentlinep = lift (pdbg 3 "trying blankorcommentlinep") >> choiceInState [blanklinep, commentlinep] blankorcommentlinep = lift (pdbg 3 "trying blankorcommentlinep") >> choiceInState [blanklinep, commentlinep]
blanklinep :: CsvRulesParser () blanklinep :: CsvRulesParser ()
blanklinep = lift (many spacenonewline) >> newline >> return () <?> "blank line" blanklinep = lift (skipMany spacenonewline) >> newline >> return () <?> "blank line"
commentlinep :: CsvRulesParser () 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 :: CsvRulesParser Char
commentcharp = oneOf (";#*" :: [Char]) commentcharp = oneOf (";#*" :: [Char])
@ -448,7 +448,7 @@ directivep = (do
lift $ pdbg 3 "trying directive" lift $ pdbg 3 "trying directive"
d <- fmap T.unpack $ choiceInState $ map (lift . mptext . T.pack) directives d <- fmap T.unpack $ choiceInState $ map (lift . mptext . T.pack) directives
v <- (((char ':' >> lift (many spacenonewline)) <|> lift (some spacenonewline)) >> directivevalp) 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) return (d, v)
) <?> "directive" ) <?> "directive"
@ -471,8 +471,8 @@ fieldnamelistp = (do
lift $ pdbg 3 "trying fieldnamelist" lift $ pdbg 3 "trying fieldnamelist"
string "fields" string "fields"
optional $ char ':' optional $ char ':'
lift (some spacenonewline) lift (skipSome spacenonewline)
let separator = lift (many spacenonewline) >> char ',' >> lift (many spacenonewline) let separator = lift (skipMany spacenonewline) >> char ',' >> lift (skipMany spacenonewline)
f <- fromMaybe "" <$> optional fieldnamep f <- fromMaybe "" <$> optional fieldnamep
fs <- some $ (separator >> fromMaybe "" <$> optional fieldnamep) fs <- some $ (separator >> fromMaybe "" <$> optional fieldnamep)
lift restofline lift restofline
@ -529,11 +529,11 @@ assignmentseparatorp :: CsvRulesParser ()
assignmentseparatorp = do assignmentseparatorp = do
lift $ pdbg 3 "trying assignmentseparatorp" lift $ pdbg 3 "trying assignmentseparatorp"
choice [ choice [
-- try (lift (many spacenonewline) >> oneOf ":="), -- try (lift (skipMany spacenonewline) >> oneOf ":="),
try (lift (many spacenonewline) >> char ':'), try (lift (skipMany spacenonewline) >> char ':'),
spaceChar spaceChar
] ]
_ <- lift (many spacenonewline) _ <- lift (skipMany spacenonewline)
return () return ()
fieldvalp :: CsvRulesParser String fieldvalp :: CsvRulesParser String
@ -544,9 +544,9 @@ fieldvalp = do
conditionalblockp :: CsvRulesParser ConditionalBlock conditionalblockp :: CsvRulesParser ConditionalBlock
conditionalblockp = do conditionalblockp = do
lift $ pdbg 3 "trying conditionalblockp" lift $ pdbg 3 "trying conditionalblockp"
string "if" >> lift (many spacenonewline) >> optional newline string "if" >> lift (skipMany spacenonewline) >> optional newline
ms <- some recordmatcherp ms <- some recordmatcherp
as <- many (lift (some spacenonewline) >> fieldassignmentp) as <- many (lift (skipSome spacenonewline) >> fieldassignmentp)
when (null as) $ 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" 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) return (ms, as)
@ -556,7 +556,7 @@ recordmatcherp :: CsvRulesParser [String]
recordmatcherp = do recordmatcherp = do
lift $ pdbg 2 "trying recordmatcherp" lift $ pdbg 2 "trying recordmatcherp"
-- pos <- currentPos -- pos <- currentPos
_ <- optional (matchoperatorp >> lift (many spacenonewline) >> optional newline) _ <- optional (matchoperatorp >> lift (skipMany spacenonewline) >> optional newline)
ps <- patternsp ps <- patternsp
when (null ps) $ when (null ps) $
fail "start of record matcher found, but no patterns afterward\n(patterns should not be indented)\n" 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" -- pdbg 2 "trying fieldmatcher"
-- f <- fromMaybe "all" `fmap` (optional $ do -- f <- fromMaybe "all" `fmap` (optional $ do
-- f' <- fieldname -- f' <- fieldname
-- lift (many spacenonewline) -- lift (skipMany spacenonewline)
-- return f') -- return f')
-- char '~' -- char '~'
-- lift (many spacenonewline) -- lift (skipMany spacenonewline)
-- ps <- patterns -- ps <- patterns
-- let r = "(" ++ intercalate "|" ps ++ ")" -- let r = "(" ++ intercalate "|" ps ++ ")"
-- return (f,r) -- return (f,r)

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

@ -181,7 +181,7 @@ directivep = (do
includedirectivep :: MonadIO m => ErroringJournalParser m () includedirectivep :: MonadIO m => ErroringJournalParser m ()
includedirectivep = do includedirectivep = do
string "include" string "include"
lift (some spacenonewline) lift (skipSome spacenonewline)
filename <- lift restofline filename <- lift restofline
parentpos <- getPosition parentpos <- getPosition
parentj <- get parentj <- get
@ -235,9 +235,9 @@ orRethrowIOError io msg =
accountdirectivep :: JournalParser m () accountdirectivep :: JournalParser m ()
accountdirectivep = do accountdirectivep = do
string "account" string "account"
lift (some spacenonewline) lift (skipSome spacenonewline)
acct <- lift accountnamep -- eats single spaces 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' let macode :: Maybe AccountCode = read <$> macode'
newline newline
_tags <- many $ do _tags <- many $ do
@ -250,7 +250,7 @@ accountdirectivep = do
modify' (\j -> j{jaccounts = (acct, macode) : jaccounts j}) modify' (\j -> j{jaccounts = (acct, macode) : jaccounts j})
indentedlinep :: JournalParser m String 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. -- | Parse a one-line or multi-line commodity directive.
-- --
@ -268,9 +268,9 @@ commoditydirectivep = try commoditydirectiveonelinep <|> commoditydirectivemulti
commoditydirectiveonelinep :: Monad m => JournalParser m () commoditydirectiveonelinep :: Monad m => JournalParser m ()
commoditydirectiveonelinep = do commoditydirectiveonelinep = do
string "commodity" string "commodity"
lift (some spacenonewline) lift (skipSome spacenonewline)
Amount{acommodity,astyle} <- amountp Amount{acommodity,astyle} <- amountp
lift (many spacenonewline) lift (skipMany spacenonewline)
_ <- followingcommentp <|> (lift eolof >> return "") _ <- followingcommentp <|> (lift eolof >> return "")
let comm = Commodity{csymbol=acommodity, cformat=Just astyle} let comm = Commodity{csymbol=acommodity, cformat=Just astyle}
modify' (\j -> j{jcommodities=M.insert acommodity comm $ jcommodities j}) modify' (\j -> j{jcommodities=M.insert acommodity comm $ jcommodities j})
@ -281,21 +281,21 @@ commoditydirectiveonelinep = do
commoditydirectivemultilinep :: Monad m => ErroringJournalParser m () commoditydirectivemultilinep :: Monad m => ErroringJournalParser m ()
commoditydirectivemultilinep = do commoditydirectivemultilinep = do
string "commodity" string "commodity"
lift (some spacenonewline) lift (skipSome spacenonewline)
sym <- lift commoditysymbolp sym <- lift commoditysymbolp
_ <- followingcommentp <|> (lift eolof >> return "") _ <- followingcommentp <|> (lift eolof >> return "")
mformat <- lastMay <$> many (indented $ formatdirectivep sym) mformat <- lastMay <$> many (indented $ formatdirectivep sym)
let comm = Commodity{csymbol=sym, cformat=mformat} let comm = Commodity{csymbol=sym, cformat=mformat}
modify' (\j -> j{jcommodities=M.insert sym comm $ jcommodities j}) modify' (\j -> j{jcommodities=M.insert sym comm $ jcommodities j})
where where
indented = (lift (some spacenonewline) >>) indented = (lift (skipSome spacenonewline) >>)
-- | Parse a format (sub)directive, throwing a parse error if its -- | Parse a format (sub)directive, throwing a parse error if its
-- symbol does not match the one given. -- symbol does not match the one given.
formatdirectivep :: Monad m => CommoditySymbol -> ErroringJournalParser m AmountStyle formatdirectivep :: Monad m => CommoditySymbol -> ErroringJournalParser m AmountStyle
formatdirectivep expectedsym = do formatdirectivep expectedsym = do
string "format" string "format"
lift (some spacenonewline) lift (skipSome spacenonewline)
pos <- getPosition pos <- getPosition
Amount{acommodity,astyle} <- amountp Amount{acommodity,astyle} <- amountp
_ <- followingcommentp <|> (lift eolof >> return "") _ <- followingcommentp <|> (lift eolof >> return "")
@ -308,7 +308,7 @@ keywordp :: String -> JournalParser m ()
keywordp = (() <$) . string . fromString keywordp = (() <$) . string . fromString
spacesp :: JournalParser m () spacesp :: JournalParser m ()
spacesp = () <$ lift (some spacenonewline) spacesp = () <$ lift (skipSome spacenonewline)
-- | Backtracking parser similar to string, but allows varying amount of space between words -- | Backtracking parser similar to string, but allows varying amount of space between words
keywordsp :: String -> JournalParser m () keywordsp :: String -> JournalParser m ()
@ -317,7 +317,7 @@ keywordsp = try . sequence_ . intersperse spacesp . map keywordp . words
applyaccountdirectivep :: JournalParser m () applyaccountdirectivep :: JournalParser m ()
applyaccountdirectivep = do applyaccountdirectivep = do
keywordsp "apply account" <?> "apply account directive" keywordsp "apply account" <?> "apply account directive"
lift (some spacenonewline) lift (skipSome spacenonewline)
parent <- lift accountnamep parent <- lift accountnamep
newline newline
pushParentAccount parent pushParentAccount parent
@ -330,7 +330,7 @@ endapplyaccountdirectivep = do
aliasdirectivep :: JournalParser m () aliasdirectivep :: JournalParser m ()
aliasdirectivep = do aliasdirectivep = do
string "alias" string "alias"
lift (some spacenonewline) lift (skipSome spacenonewline)
alias <- lift accountaliasp alias <- lift accountaliasp
addAccountAlias alias addAccountAlias alias
@ -342,7 +342,7 @@ basicaliasp = do
-- pdbg 0 "basicaliasp" -- pdbg 0 "basicaliasp"
old <- rstrip <$> (some $ noneOf ("=" :: [Char])) old <- rstrip <$> (some $ noneOf ("=" :: [Char]))
char '=' char '='
many spacenonewline skipMany spacenonewline
new <- rstrip <$> anyChar `manyTill` eolof -- eol in journal, eof in command lines, normally new <- rstrip <$> anyChar `manyTill` eolof -- eol in journal, eof in command lines, normally
return $ BasicAlias (T.pack old) (T.pack new) return $ BasicAlias (T.pack old) (T.pack new)
@ -352,9 +352,9 @@ regexaliasp = do
char '/' char '/'
re <- some $ noneOf ("/\n\r" :: [Char]) -- paranoid: don't try to read past line end re <- some $ noneOf ("/\n\r" :: [Char]) -- paranoid: don't try to read past line end
char '/' char '/'
many spacenonewline skipMany spacenonewline
char '=' char '='
many spacenonewline skipMany spacenonewline
repl <- anyChar `manyTill` eolof repl <- anyChar `manyTill` eolof
return $ RegexAlias re repl return $ RegexAlias re repl
@ -366,7 +366,7 @@ endaliasesdirectivep = do
tagdirectivep :: JournalParser m () tagdirectivep :: JournalParser m ()
tagdirectivep = do tagdirectivep = do
string "tag" <?> "tag directive" string "tag" <?> "tag directive"
lift (some spacenonewline) lift (skipSome spacenonewline)
_ <- lift $ some nonspace _ <- lift $ some nonspace
lift restofline lift restofline
return () return ()
@ -380,7 +380,7 @@ endtagdirectivep = do
defaultyeardirectivep :: JournalParser m () defaultyeardirectivep :: JournalParser m ()
defaultyeardirectivep = do defaultyeardirectivep = do
char 'Y' <?> "default year" char 'Y' <?> "default year"
lift (many spacenonewline) lift (skipMany spacenonewline)
y <- some digitChar y <- some digitChar
let y' = read y let y' = read y
failIfInvalidYear y failIfInvalidYear y
@ -389,7 +389,7 @@ defaultyeardirectivep = do
defaultcommoditydirectivep :: Monad m => JournalParser m () defaultcommoditydirectivep :: Monad m => JournalParser m ()
defaultcommoditydirectivep = do defaultcommoditydirectivep = do
char 'D' <?> "default commodity" char 'D' <?> "default commodity"
lift (some spacenonewline) lift (skipSome spacenonewline)
Amount{..} <- amountp Amount{..} <- amountp
lift restofline lift restofline
setDefaultCommodityAndStyle (acommodity, astyle) setDefaultCommodityAndStyle (acommodity, astyle)
@ -397,11 +397,11 @@ defaultcommoditydirectivep = do
marketpricedirectivep :: Monad m => JournalParser m MarketPrice marketpricedirectivep :: Monad m => JournalParser m MarketPrice
marketpricedirectivep = do marketpricedirectivep = do
char 'P' <?> "market price" char 'P' <?> "market price"
lift (many spacenonewline) lift (skipMany spacenonewline)
date <- try (do {LocalTime d _ <- datetimep; return d}) <|> datep -- a time is ignored date <- try (do {LocalTime d _ <- datetimep; return d}) <|> datep -- a time is ignored
lift (some spacenonewline) lift (skipSome spacenonewline)
symbol <- lift commoditysymbolp symbol <- lift commoditysymbolp
lift (many spacenonewline) lift (skipMany spacenonewline)
price <- amountp price <- amountp
lift restofline lift restofline
return $ MarketPrice date symbol price return $ MarketPrice date symbol price
@ -409,7 +409,7 @@ marketpricedirectivep = do
ignoredpricecommoditydirectivep :: JournalParser m () ignoredpricecommoditydirectivep :: JournalParser m ()
ignoredpricecommoditydirectivep = do ignoredpricecommoditydirectivep = do
char 'N' <?> "ignored-price commodity" char 'N' <?> "ignored-price commodity"
lift (some spacenonewline) lift (skipSome spacenonewline)
lift commoditysymbolp lift commoditysymbolp
lift restofline lift restofline
return () return ()
@ -417,11 +417,11 @@ ignoredpricecommoditydirectivep = do
commodityconversiondirectivep :: Monad m => JournalParser m () commodityconversiondirectivep :: Monad m => JournalParser m ()
commodityconversiondirectivep = do commodityconversiondirectivep = do
char 'C' <?> "commodity conversion" char 'C' <?> "commodity conversion"
lift (some spacenonewline) lift (skipSome spacenonewline)
amountp amountp
lift (many spacenonewline) lift (skipMany spacenonewline)
char '=' char '='
lift (many spacenonewline) lift (skipMany spacenonewline)
amountp amountp
lift restofline lift restofline
return () return ()
@ -431,7 +431,7 @@ commodityconversiondirectivep = do
modifiertransactionp :: MonadIO m => ErroringJournalParser m ModifierTransaction modifiertransactionp :: MonadIO m => ErroringJournalParser m ModifierTransaction
modifiertransactionp = do modifiertransactionp = do
char '=' <?> "modifier transaction" char '=' <?> "modifier transaction"
lift (many spacenonewline) lift (skipMany spacenonewline)
valueexpr <- T.pack <$> lift restofline valueexpr <- T.pack <$> lift restofline
postings <- postingsp Nothing postings <- postingsp Nothing
return $ ModifierTransaction valueexpr postings return $ ModifierTransaction valueexpr postings
@ -439,7 +439,7 @@ modifiertransactionp = do
periodictransactionp :: MonadIO m => ErroringJournalParser m PeriodicTransaction periodictransactionp :: MonadIO m => ErroringJournalParser m PeriodicTransaction
periodictransactionp = do periodictransactionp = do
char '~' <?> "periodic transaction" char '~' <?> "periodic transaction"
lift (many spacenonewline) lift (skipMany spacenonewline)
periodexpr <- T.pack <$> lift restofline periodexpr <- T.pack <$> lift restofline
postings <- postingsp Nothing postings <- postingsp Nothing
return $ PeriodicTransaction periodexpr postings return $ PeriodicTransaction periodexpr postings
@ -564,7 +564,7 @@ postingsp mdate = many (try $ postingp mdate) <?> "postings"
-- linebeginningwithspaces :: Monad m => JournalParser m String -- linebeginningwithspaces :: Monad m => JournalParser m String
-- linebeginningwithspaces = do -- linebeginningwithspaces = do
-- sp <- lift (some spacenonewline) -- sp <- lift (skipSome spacenonewline)
-- c <- nonspace -- c <- nonspace
-- cs <- lift restofline -- cs <- lift restofline
-- return $ sp ++ (c:cs) ++ "\n" -- 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 :: MonadIO m => Maybe Day -> ErroringJournalParser m Posting
postingp mtdate = do postingp mtdate = do
-- pdbg 0 "postingp" -- pdbg 0 "postingp"
lift (some spacenonewline) lift (skipSome spacenonewline)
status <- lift statusp status <- lift statusp
lift (many spacenonewline) lift (skipMany spacenonewline)
account <- modifiedaccountnamep account <- modifiedaccountnamep
let (ptype, account') = (accountNamePostingType account, textUnbracket account) let (ptype, account') = (accountNamePostingType account, textUnbracket account)
amount <- spaceandamountormissingp amount <- spaceandamountormissingp
massertion <- partialbalanceassertionp massertion <- partialbalanceassertionp
_ <- fixedlotpricep _ <- fixedlotpricep
lift (many spacenonewline) lift (skipMany spacenonewline)
(comment,tags,mdate,mdate2) <- (comment,tags,mdate,mdate2) <-
try (followingcommentandtagsp mtdate) <|> (newline >> return ("",[],Nothing,Nothing)) try (followingcommentandtagsp mtdate) <|> (newline >> return ("",[],Nothing,Nothing))
return posting return posting

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

@ -109,10 +109,10 @@ timeclockentryp :: JournalParser m TimeclockEntry
timeclockentryp = do timeclockentryp = do
sourcepos <- genericSourcePos <$> lift getPosition sourcepos <- genericSourcePos <$> lift getPosition
code <- oneOf ("bhioO" :: [Char]) code <- oneOf ("bhioO" :: [Char])
lift (some spacenonewline) lift (skipSome spacenonewline)
datetime <- datetimep datetime <- datetimep
account <- fromMaybe "" <$> optional (lift (some spacenonewline) >> modifiedaccountnamep) account <- fromMaybe "" <$> optional (lift (skipSome spacenonewline) >> modifiedaccountnamep)
description <- T.pack . fromMaybe "" <$> lift (optional (some spacenonewline >> restofline)) description <- T.pack . fromMaybe "" <$> lift (optional (skipSome spacenonewline >> restofline))
return $ TimeclockEntry sourcepos (read [code]) datetime account description return $ TimeclockEntry sourcepos (read [code]) datetime account description
tests_Hledger_Read_TimeclockReader = TestList [ tests_Hledger_Read_TimeclockReader = TestList [

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

@ -107,9 +107,9 @@ timedotentryp :: JournalParser m Transaction
timedotentryp = do timedotentryp = do
ptrace " timedotentryp" ptrace " timedotentryp"
pos <- genericSourcePos <$> getPosition pos <- genericSourcePos <$> getPosition
lift (many spacenonewline) lift (skipMany spacenonewline)
a <- modifiedaccountnamep a <- modifiedaccountnamep
lift (many spacenonewline) lift (skipMany spacenonewline)
hours <- hours <-
try (followingcommentp >> return 0) try (followingcommentp >> return 0)
<|> (timedotdurationp <* <|> (timedotdurationp <*
@ -143,7 +143,7 @@ timedotnumericp :: JournalParser m Quantity
timedotnumericp = do timedotnumericp = do
(q, _, _, _) <- lift $ numberp Nothing (q, _, _, _) <- lift $ numberp Nothing
msymbol <- optional $ choice $ map (string . fst) timeUnits msymbol <- optional $ choice $ map (string . fst) timeUnits
lift (many spacenonewline) lift (skipMany spacenonewline)
let q' = let q' =
case msymbol of case msymbol of
Nothing -> q Nothing -> q

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

@ -129,7 +129,7 @@ words' :: String -> [String]
words' "" = [] words' "" = []
words' s = map stripquotes $ fromparse $ parsewithString p s words' s = map stripquotes $ fromparse $ parsewithString p s
where where
p = do ss <- (singleQuotedPattern <|> doubleQuotedPattern <|> pattern) `sepBy` some spacenonewline p = do ss <- (singleQuotedPattern <|> doubleQuotedPattern <|> pattern) `sepBy` skipSome spacenonewline
-- eof -- eof
return ss return ss
pattern = many (noneOf whitespacechars) pattern = many (noneOf whitespacechars)

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

@ -197,7 +197,7 @@ dateAndCodeWizard EntryState{..} = do
dateandcodep = do dateandcodep = do
d <- smartdate d <- smartdate
c <- optional codep c <- optional codep
many spacenonewline skipMany spacenonewline
eof eof
return (d, T.pack $ fromMaybe "" c) return (d, T.pack $ fromMaybe "" c)
-- defday = fixSmartDate today $ fromparse $ (parse smartdate "" . lowercase) defdate -- defday = fixSmartDate today $ fromparse $ (parse smartdate "" . lowercase) defdate
@ -294,7 +294,7 @@ amountAndCommentWizard EntryState{..} = do
amountandcommentp :: JournalParser Identity (Amount, Text) amountandcommentp :: JournalParser Identity (Amount, Text)
amountandcommentp = do amountandcommentp = do
a <- amountp a <- amountp
lift (many spacenonewline) lift (skipMany spacenonewline)
c <- T.pack <$> fromMaybe "" `fmap` optional (char ';' >> many anyChar) c <- T.pack <$> fromMaybe "" `fmap` optional (char ';' >> many anyChar)
-- eof -- eof
return (a,c) return (a,c)