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 :: TextParser m SmartDate
smartdateonly = do smartdateonly = do
d <- smartdate d <- smartdate
skipMany spacenonewline skipNonNewlineSpaces
eof eof
return d return d
@ -907,7 +907,7 @@ lastthisnextthing = do
,"this" ,"this"
,"next" ,"next"
] ]
skipMany spacenonewline -- make the space optional for easier scripting skipNonNewlineSpaces -- make the space optional for easier scripting
p <- choice $ map string' [ p <- choice $ map string' [
"day" "day"
,"week" ,"week"
@ -972,7 +972,7 @@ lastthisnextthing = do
-- Right (DayOfMonth 2,DateSpan 2009-01-01..) -- Right (DayOfMonth 2,DateSpan 2009-01-01..)
periodexprp :: Day -> TextParser m (Interval, DateSpan) periodexprp :: Day -> TextParser m (Interval, DateSpan)
periodexprp rdate = do periodexprp rdate = do
skipMany spacenonewline skipNonNewlineSpaces
choice $ map try [ choice $ map try [
intervalanddateperiodexprp rdate, intervalanddateperiodexprp rdate,
(,) NoInterval <$> periodexprdatespanp rdate (,) NoInterval <$> periodexprdatespanp rdate
@ -983,7 +983,7 @@ intervalanddateperiodexprp :: Day -> TextParser m (Interval, DateSpan)
intervalanddateperiodexprp rdate = do intervalanddateperiodexprp rdate = do
i <- reportingintervalp i <- reportingintervalp
s <- option def . try $ do s <- option def . try $ do
skipMany spacenonewline skipNonNewlineSpaces
periodexprdatespanp rdate periodexprdatespanp rdate
return (i,s) return (i,s)
@ -1002,47 +1002,47 @@ reportingintervalp = choice' [
do string' "bimonthly" do string' "bimonthly"
return $ Months 2, return $ Months 2,
do string' "every" do string' "every"
skipMany spacenonewline skipNonNewlineSpaces
n <- nth n <- nth
skipMany spacenonewline skipNonNewlineSpaces
string' "day" string' "day"
of_ "week" of_ "week"
return $ DayOfWeek n, return $ DayOfWeek n,
do string' "every" do string' "every"
skipMany spacenonewline skipNonNewlineSpaces
DayOfWeek <$> weekday, DayOfWeek <$> weekday,
do string' "every" do string' "every"
skipMany spacenonewline skipNonNewlineSpaces
n <- nth n <- nth
skipMany spacenonewline skipNonNewlineSpaces
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 <- runPermutation $ d_o_y <- runPermutation $
DayOfYear <$> toPermutation (try (skipMany spacenonewline *> mnth)) DayOfYear <$> toPermutation (try (skipNonNewlineSpaces *> mnth))
<*> toPermutation (try (skipMany spacenonewline *> nth)) <*> toPermutation (try (skipNonNewlineSpaces *> nth))
optOf_ "year" optOf_ "year"
return d_o_y, return d_o_y,
do string' "every" do string' "every"
skipMany spacenonewline skipNonNewlineSpaces
("",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"
skipMany spacenonewline skipNonNewlineSpaces
n <- nth n <- nth
skipMany spacenonewline skipNonNewlineSpaces
wd <- weekday wd <- weekday
optOf_ "month" optOf_ "month"
return $ WeekdayOfMonth n wd return $ WeekdayOfMonth n wd
] ]
where where
of_ period = do of_ period = do
skipMany spacenonewline skipNonNewlineSpaces
string' "of" string' "of"
skipMany spacenonewline skipNonNewlineSpaces
string' period string' period
optOf_ period = optional $ try $ of_ period optOf_ period = optional $ try $ of_ period
@ -1058,13 +1058,13 @@ reportingintervalp = choice' [
do string' compact' do string' compact'
return $ intcons 1, return $ intcons 1,
do string' "every" do string' "every"
skipMany spacenonewline skipNonNewlineSpaces
string' singular' string' singular'
return $ intcons 1, return $ intcons 1,
do string' "every" do string' "every"
skipMany spacenonewline skipNonNewlineSpaces
n <- read <$> some digitChar n <- read <$> some digitChar
skipMany spacenonewline skipNonNewlineSpaces
string' plural' string' plural'
return $ intcons n return $ intcons n
] ]
@ -1086,17 +1086,17 @@ periodexprdatespanp rdate = choice $ map try [
-- Right DateSpan 2018-01-01..2018-04-01 -- Right DateSpan 2018-01-01..2018-04-01
doubledatespanp :: Day -> TextParser m DateSpan doubledatespanp :: Day -> TextParser m DateSpan
doubledatespanp rdate = do doubledatespanp rdate = do
optional (string' "from" >> skipMany spacenonewline) optional (string' "from" >> skipNonNewlineSpaces)
b <- smartdate b <- smartdate
skipMany spacenonewline skipNonNewlineSpaces
optional (choice [string' "to", string "..", string' "-"] >> skipMany spacenonewline) optional (choice [string' "to", string "..", string' "-"] >> skipNonNewlineSpaces)
DateSpan (Just $ fixSmartDate rdate b) . Just . fixSmartDate rdate <$> smartdate DateSpan (Just $ fixSmartDate rdate b) . Just . fixSmartDate rdate <$> smartdate
fromdatespanp :: Day -> TextParser m DateSpan fromdatespanp :: Day -> TextParser m DateSpan
fromdatespanp rdate = do fromdatespanp rdate = do
b <- choice [ b <- choice [
do do
string' "from" >> skipMany spacenonewline string' "from" >> skipNonNewlineSpaces
smartdate smartdate
, ,
do do
@ -1108,12 +1108,12 @@ fromdatespanp rdate = do
todatespanp :: Day -> TextParser m DateSpan todatespanp :: Day -> TextParser m DateSpan
todatespanp rdate = do 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 DateSpan Nothing . Just . fixSmartDate rdate <$> smartdate
justdatespanp :: Day -> TextParser m DateSpan justdatespanp :: Day -> TextParser m DateSpan
justdatespanp rdate = do justdatespanp rdate = do
optional (string' "in" >> skipMany spacenonewline) optional (string' "in" >> skipNonNewlineSpaces)
spanFromSmartDate rdate <$> smartdate spanFromSmartDate rdate <$> smartdate
-- | Make a datespan from two valid date strings parseable by parsedate -- | 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 words'' prefixes = fromparse . parsewith maybeprefixedquotedphrases -- XXX
where where
maybeprefixedquotedphrases :: SimpleTextParser [T.Text] 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 :: SimpleTextParser T.Text
prefixedQuotedPattern = do prefixedQuotedPattern = do
not' <- fromMaybe "" `fmap` (optional $ string "not:") not' <- fromMaybe "" `fmap` (optional $ string "not:")

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

@ -105,6 +105,9 @@ module Hledger.Read.Common (
singlespacedtextsatisfyingp, singlespacedtextsatisfyingp,
singlespacep, singlespacep,
skipNonNewlineSpaces,
skipNonNewlineSpaces1,
-- * tests -- * tests
tests_Common, tests_Common,
) )
@ -412,15 +415,15 @@ match' p = do
statusp :: TextParser m Status statusp :: TextParser m Status
statusp = statusp =
choice' choice'
[ skipMany spacenonewline >> char '*' >> return Cleared [ skipNonNewlineSpaces >> char '*' >> return Cleared
, skipMany spacenonewline >> char '!' >> return Pending , skipNonNewlineSpaces >> char '!' >> return Pending
, return Unmarked , return Unmarked
] ]
codep :: TextParser m Text codep :: TextParser m Text
codep = option "" $ do codep = option "" $ do
try $ do try $ do
skipSome spacenonewline skipNonNewlineSpaces1
char '(' char '('
code <- takeWhileP Nothing $ \c -> c /= ')' && c /= '\n' code <- takeWhileP Nothing $ \c -> c /= ')' && c /= '\n'
char ')' <?> "closing bracket ')' for transaction code" char ')' <?> "closing bracket ')' for transaction code"
@ -499,7 +502,7 @@ datetimep = do
datetimep' :: Maybe Year -> TextParser m LocalTime datetimep' :: Maybe Year -> TextParser m LocalTime
datetimep' mYear = do datetimep' mYear = do
day <- datep' mYear day <- datep' mYear
skipSome spacenonewline skipNonNewlineSpaces1
time <- timeOfDay time <- timeOfDay
optional timeZone -- ignoring time zones optional timeZone -- ignoring time zones
pure $ LocalTime day time pure $ LocalTime day time
@ -595,7 +598,7 @@ singlespacedtextsatisfyingp pred = do
-- | Parse one non-newline whitespace character that is not followed by another one. -- | Parse one non-newline whitespace character that is not followed by another one.
singlespacep :: TextParser m () singlespacep :: TextParser m ()
singlespacep = void spacenonewline *> notFollowedBy spacenonewline singlespacep = spacenonewline *> notFollowedBy spacenonewline
--- *** amounts --- *** amounts
@ -605,7 +608,7 @@ singlespacep = void spacenonewline *> notFollowedBy spacenonewline
spaceandamountormissingp :: JournalParser m MixedAmount spaceandamountormissingp :: JournalParser m MixedAmount
spaceandamountormissingp = spaceandamountormissingp =
option missingmixedamt $ try $ do option missingmixedamt $ try $ do
lift $ skipSome spacenonewline lift $ skipNonNewlineSpaces1
Mixed . (:[]) <$> amountp Mixed . (:[]) <$> amountp
-- | Parse a single-commodity amount, with optional symbol on the left -- | 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. -- lot date. A lot price and lot date will be ignored.
amountp :: JournalParser m Amount amountp :: JournalParser m Amount
amountp = label "amount" $ do amountp = label "amount" $ do
let spaces = lift $ skipMany spacenonewline let spaces = lift $ skipNonNewlineSpaces
amount <- amountwithoutpricep <* spaces amount <- amountwithoutpricep <* spaces
(mprice, _elotprice, _elotdate) <- runPermutation $ (mprice, _elotprice, _elotdate) <- runPermutation $
(,,) <$> toPermutationWithDefault Nothing (Just <$> priceamountp <* spaces) (,,) <$> 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. -- XXX Just like amountp but don't allow lot prices. Needed for balanceassertionp.
amountpnolotprices :: JournalParser m Amount amountpnolotprices :: JournalParser m Amount
amountpnolotprices = label "amount" $ do amountpnolotprices = label "amount" $ do
let spaces = lift $ skipMany spacenonewline let spaces = lift $ skipNonNewlineSpaces
amount <- amountwithoutpricep amount <- amountwithoutpricep
spaces spaces
mprice <- optional $ priceamountp <* spaces mprice <- optional $ priceamountp <* spaces
@ -642,7 +645,7 @@ amountwithoutpricep = do
leftsymbolamountp mult sign = label "amount" $ do leftsymbolamountp mult sign = label "amount" $ do
c <- lift commoditysymbolp c <- lift commoditysymbolp
suggestedStyle <- getAmountStyle c suggestedStyle <- getAmountStyle c
commodityspaced <- lift $ skipMany' spacenonewline commodityspaced <- lift skipNonNewlineSpaces'
sign2 <- lift $ signp sign2 <- lift $ signp
offBeforeNum <- getOffset offBeforeNum <- getOffset
ambiguousRawNum <- lift rawnumberp ambiguousRawNum <- lift rawnumberp
@ -660,7 +663,7 @@ amountwithoutpricep = do
mExponent <- lift $ optional $ try exponentp mExponent <- lift $ optional $ try exponentp
offAfterNum <- getOffset offAfterNum <- getOffset
let numRegion = (offBeforeNum, offAfterNum) let numRegion = (offBeforeNum, offAfterNum)
mSpaceAndCommodity <- lift $ optional $ try $ (,) <$> skipMany' spacenonewline <*> commoditysymbolp mSpaceAndCommodity <- lift $ optional $ try $ (,) <$> skipNonNewlineSpaces' <*> commoditysymbolp
case mSpaceAndCommodity of case mSpaceAndCommodity of
-- right symbol amount -- right symbol amount
Just (commodityspaced, c) -> do Just (commodityspaced, c) -> do
@ -709,23 +712,11 @@ mamountp' = Mixed . (:[]) . amountp'
-- | Parse a minus or plus sign followed by zero or more spaces, -- | Parse a minus or plus sign followed by zero or more spaces,
-- or nothing, returning a function that negates or does nothing. -- or nothing, returning a function that negates or does nothing.
signp :: Num a => TextParser m (a -> a) 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 :: TextParser m Bool
multiplierp = option False $ char '*' *> pure True 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 :: TextParser m CommoditySymbol
commoditysymbolp = commoditysymbolp =
quotedcommoditysymbolp <|> simplecommoditysymbolp <?> "commodity symbol" quotedcommoditysymbolp <|> simplecommoditysymbolp <?> "commodity symbol"
@ -746,7 +737,7 @@ priceamountp = label "transaction price" $ do
priceConstructor <- char '@' *> pure TotalPrice <|> pure UnitPrice priceConstructor <- char '@' *> pure TotalPrice <|> pure UnitPrice
when parenthesised $ void $ char ')' when parenthesised $ void $ char ')'
lift (skipMany spacenonewline) lift skipNonNewlineSpaces
priceAmount <- amountwithoutpricep -- <?> "unpriced amount (specifying a price)" priceAmount <- amountwithoutpricep -- <?> "unpriced amount (specifying a price)"
pure $ priceConstructor priceAmount pure $ priceConstructor priceAmount
@ -757,7 +748,7 @@ balanceassertionp = do
char '=' char '='
istotal <- fmap isJust $ optional $ try $ char '=' istotal <- fmap isJust $ optional $ try $ char '='
isinclusive <- 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, -- this amount can have a price; balance assertions ignore it,
-- but balance assignments will use it -- but balance assignments will use it
a <- amountpnolotprices <?> "amount (for a balance assertion or assignment)" a <- amountpnolotprices <?> "amount (for a balance assertion or assignment)"
@ -776,10 +767,10 @@ lotpricep :: JournalParser m ()
lotpricep = label "ledger-style lot price" $ do lotpricep = label "ledger-style lot price" $ do
char '{' char '{'
doublebrace <- option False $ char '{' >> pure True doublebrace <- option False $ char '{' >> pure True
_fixed <- fmap isJust $ optional $ lift (skipMany spacenonewline) >> char '=' _fixed <- fmap isJust $ optional $ lift skipNonNewlineSpaces >> char '='
lift (skipMany spacenonewline) lift skipNonNewlineSpaces
_a <- amountwithoutpricep _a <- amountwithoutpricep
lift (skipMany spacenonewline) lift skipNonNewlineSpaces
char '}' char '}'
when (doublebrace) $ void $ char '}' when (doublebrace) $ void $ char '}'
return () return ()
@ -789,9 +780,9 @@ lotpricep = label "ledger-style lot price" $ do
lotdatep :: JournalParser m () lotdatep :: JournalParser m ()
lotdatep = (do lotdatep = (do
char '[' char '['
lift (skipMany spacenonewline) lift skipNonNewlineSpaces
_d <- datep _d <- datep
lift (skipMany spacenonewline) lift skipNonNewlineSpaces
char ']' char ']'
return () return ()
) <?> "ledger-style lot date" ) <?> "ledger-style lot date"
@ -1037,7 +1028,7 @@ multilinecommentp = startComment *> anyLine `skipManyTill` endComment
startComment = string "comment" *> trailingSpaces startComment = string "comment" *> trailingSpaces
endComment = eof <|> string "end comment" *> trailingSpaces endComment = eof <|> string "end comment" *> trailingSpaces
trailingSpaces = skipMany spacenonewline <* newline trailingSpaces = skipNonNewlineSpaces <* newline
anyLine = void $ takeWhileP Nothing (\c -> c /= '\n') *> newline anyLine = void $ takeWhileP Nothing (\c -> c /= '\n') *> newline
{-# INLINABLE multilinecommentp #-} {-# INLINABLE multilinecommentp #-}
@ -1047,7 +1038,7 @@ multilinecommentp = startComment *> anyLine `skipManyTill` endComment
-- is semicolon, hash, or star. -- is semicolon, hash, or star.
emptyorcommentlinep :: TextParser m () emptyorcommentlinep :: TextParser m ()
emptyorcommentlinep = do emptyorcommentlinep = do
skipMany spacenonewline skipNonNewlineSpaces
skiplinecommentp <|> void newline skiplinecommentp <|> void newline
where where
skiplinecommentp :: TextParser m () skiplinecommentp :: TextParser m ()
@ -1076,13 +1067,13 @@ emptyorcommentlinep = do
-- --
followingcommentp' :: (Monoid a, Show a) => TextParser m a -> TextParser m (Text, a) followingcommentp' :: (Monoid a, Show a) => TextParser m a -> TextParser m (Text, a)
followingcommentp' contentp = do followingcommentp' contentp = do
skipMany spacenonewline skipNonNewlineSpaces
-- there can be 0 or 1 sameLine -- there can be 0 or 1 sameLine
sameLine <- try headerp *> ((:[]) <$> match' contentp) <|> pure [] sameLine <- try headerp *> ((:[]) <$> match' contentp) <|> pure []
_ <- eolof _ <- eolof
-- there can be 0 or more nextLines -- there can be 0 or more nextLines
nextLines <- many $ nextLines <- many $
try (skipSome spacenonewline *> headerp) *> match' contentp <* eolof try (skipNonNewlineSpaces1 *> headerp) *> match' contentp <* eolof
let let
-- if there's just a next-line comment, insert an empty same-line comment -- 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. -- so the next-line comment doesn't get rendered as a same-line comment.
@ -1094,7 +1085,7 @@ followingcommentp' contentp = do
pure (strippedCommentText, commentContent) pure (strippedCommentText, commentContent)
where where
headerp = char ';' *> skipMany spacenonewline headerp = char ';' *> skipNonNewlineSpaces
{-# INLINABLE followingcommentp' #-} {-# INLINABLE followingcommentp' #-}
@ -1158,7 +1149,7 @@ commenttagsp = do
if T.null name if T.null name
then commenttagsp then commenttagsp
else do else do
skipMany spacenonewline skipNonNewlineSpaces
val <- tagValue val <- tagValue
let tag = (name, val) let tag = (name, val)
(tag:) <$> commenttagsp (tag:) <$> commenttagsp
@ -1256,7 +1247,7 @@ commenttagsanddatesp mYear = do
atColon :: Text -> TextParser m ([Tag], [DateTag]) atColon :: Text -> TextParser m ([Tag], [DateTag])
atColon name = char ':' *> do atColon name = char ':' *> do
skipMany spacenonewline skipNonNewlineSpaces
(tags, dateTags) <- case name of (tags, dateTags) <- case name of
"" -> pure ([], []) "" -> pure ([], [])
"date" -> dateValue name "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] blankorcommentlinep = lift (dbgparse 8 "trying blankorcommentlinep") >> choiceInState [blanklinep, commentlinep]
blanklinep :: CsvRulesParser () blanklinep :: CsvRulesParser ()
blanklinep = lift (skipMany spacenonewline) >> newline >> return () <?> "blank line" blanklinep = lift skipNonNewlineSpaces >> newline >> return () <?> "blank line"
commentlinep :: CsvRulesParser () 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 :: CsvRulesParser Char
commentcharp = oneOf (";#*" :: [Char]) commentcharp = oneOf (";#*" :: [Char])
@ -462,7 +462,7 @@ directivep = (do
lift $ dbgparse 8 "trying directive" lift $ dbgparse 8 "trying directive"
d <- fmap T.unpack $ choiceInState $ map (lift . string . T.pack) directives d <- fmap T.unpack $ choiceInState $ map (lift . string . T.pack) directives
v <- (((char ':' >> lift (many spacenonewline)) <|> lift (some spacenonewline)) >> directivevalp) 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) return (d, v)
) <?> "directive" ) <?> "directive"
@ -485,8 +485,8 @@ fieldnamelistp = (do
lift $ dbgparse 8 "trying fieldnamelist" lift $ dbgparse 8 "trying fieldnamelist"
string "fields" string "fields"
optional $ char ':' optional $ char ':'
lift (skipSome spacenonewline) lift skipNonNewlineSpaces1
let separator = lift (skipMany spacenonewline) >> char ',' >> lift (skipMany spacenonewline) let separator = lift skipNonNewlineSpaces >> char ',' >> lift skipNonNewlineSpaces
f <- fromMaybe "" <$> optional fieldnamep f <- fromMaybe "" <$> optional fieldnamep
fs <- some $ (separator >> fromMaybe "" <$> optional fieldnamep) fs <- some $ (separator >> fromMaybe "" <$> optional fieldnamep)
lift restofline lift restofline
@ -554,8 +554,8 @@ journalfieldnames =
assignmentseparatorp :: CsvRulesParser () assignmentseparatorp :: CsvRulesParser ()
assignmentseparatorp = do assignmentseparatorp = do
lift $ dbgparse 8 "trying assignmentseparatorp" lift $ dbgparse 8 "trying assignmentseparatorp"
_ <- choiceInState [ lift (skipMany spacenonewline) >> char ':' >> lift (skipMany spacenonewline) _ <- choiceInState [ lift skipNonNewlineSpaces >> char ':' >> lift skipNonNewlineSpaces
, lift (skipSome spacenonewline) , lift skipNonNewlineSpaces1
] ]
return () return ()
@ -571,10 +571,10 @@ conditionalblockp = do
-- "if\nMATCHER" or "if \nMATCHER" or "if MATCHER" -- "if\nMATCHER" or "if \nMATCHER" or "if MATCHER"
start <- getOffset start <- getOffset
string "if" >> ( (newline >> return Nothing) string "if" >> ( (newline >> return Nothing)
<|> (lift (skipSome spacenonewline) >> optional newline)) <|> (lift skipNonNewlineSpaces1 >> optional newline))
ms <- some matcherp ms <- some matcherp
as <- catMaybes <$> as <- catMaybes <$>
many (lift (skipSome spacenonewline) >> many (lift skipNonNewlineSpaces1 >>
choice [ lift eolof >> return Nothing choice [ lift eolof >> return Nothing
, fmap Just fieldassignmentp , fmap Just fieldassignmentp
]) ])
@ -620,7 +620,7 @@ recordmatcherp :: CsvRulesParser () -> CsvRulesParser Matcher
recordmatcherp end = do recordmatcherp end = do
lift $ dbgparse 8 "trying recordmatcherp" lift $ dbgparse 8 "trying recordmatcherp"
-- pos <- currentPos -- pos <- currentPos
-- _ <- optional (matchoperatorp >> lift (skipMany spacenonewline) >> optional newline) -- _ <- optional (matchoperatorp >> lift skipNonNewlineSpaces >> optional newline)
p <- matcherprefixp p <- matcherprefixp
r <- regexp end r <- regexp end
-- when (null ps) $ -- when (null ps) $
@ -638,13 +638,13 @@ fieldmatcherp end = do
-- An optional fieldname (default: "all") -- An optional fieldname (default: "all")
-- f <- fromMaybe "all" `fmap` (optional $ do -- f <- fromMaybe "all" `fmap` (optional $ do
-- f' <- fieldnamep -- f' <- fieldnamep
-- lift (skipMany spacenonewline) -- lift skipNonNewlineSpaces
-- return f') -- return f')
p <- matcherprefixp p <- matcherprefixp
f <- csvfieldreferencep <* lift (skipMany spacenonewline) f <- csvfieldreferencep <* lift skipNonNewlineSpaces
-- optional operator.. just ~ (case insensitive infix regex) for now -- optional operator.. just ~ (case insensitive infix regex) for now
-- _op <- fromMaybe "~" <$> optional matchoperatorp -- _op <- fromMaybe "~" <$> optional matchoperatorp
lift (skipMany spacenonewline) lift skipNonNewlineSpaces
r <- regexp end r <- regexp end
return $ FieldMatcher p f r return $ FieldMatcher p f r
<?> "field matcher" <?> "field matcher"
@ -652,7 +652,7 @@ fieldmatcherp end = do
matcherprefixp :: CsvRulesParser MatcherPrefix matcherprefixp :: CsvRulesParser MatcherPrefix
matcherprefixp = do matcherprefixp = do
lift $ dbgparse 8 "trying matcherprefixp" lift $ dbgparse 8 "trying matcherprefixp"
(char '&' >> lift (skipMany spacenonewline) >> return And) <|> return None (char '&' >> lift skipNonNewlineSpaces >> return And) <|> return None
csvfieldreferencep :: CsvRulesParser CsvFieldReference csvfieldreferencep :: CsvRulesParser CsvFieldReference
csvfieldreferencep = do csvfieldreferencep = do

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

@ -247,7 +247,7 @@ directivep = (do
includedirectivep :: MonadIO m => ErroringJournalParser m () includedirectivep :: MonadIO m => ErroringJournalParser m ()
includedirectivep = do includedirectivep = do
string "include" string "include"
lift (skipSome spacenonewline) lift skipNonNewlineSpaces1
prefixedglob <- T.unpack <$> takeWhileP Nothing (/= '\n') -- don't consume newline yet prefixedglob <- T.unpack <$> takeWhileP Nothing (/= '\n') -- don't consume newline yet
parentoff <- getOffset parentoff <- getOffset
parentpos <- getSourcePos parentpos <- getSourcePos
@ -331,7 +331,7 @@ accountdirectivep = do
off <- getOffset -- XXX figure out a more precise position later off <- getOffset -- XXX figure out a more precise position later
string "account" string "account"
lift (skipSome spacenonewline) lift skipNonNewlineSpaces1
-- the account name, possibly modified by preceding alias or apply account directives -- the account name, possibly modified by preceding alias or apply account directives
acct <- modifiedaccountnamep acct <- modifiedaccountnamep
@ -339,7 +339,7 @@ accountdirectivep = do
-- maybe an account type code (ALERX) after two or more spaces -- maybe an account type code (ALERX) after two or more spaces
-- XXX added in 1.11, deprecated in 1.13, remove in 1.14 -- XXX added in 1.11, deprecated in 1.13, remove in 1.14
mtypecode :: Maybe Char <- lift $ optional $ try $ do 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" choice $ map char "ALERX"
-- maybe a comment, on this and/or following lines -- maybe a comment, on this and/or following lines
@ -402,7 +402,7 @@ addAccountDeclaration (a,cmt,tags) =
j{jdeclaredaccounts = d:decls}) j{jdeclaredaccounts = d:decls})
indentedlinep :: JournalParser m String 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. -- | Parse a one-line or multi-line commodity directive.
-- --
@ -421,11 +421,11 @@ commoditydirectiveonelinep :: JournalParser m ()
commoditydirectiveonelinep = do commoditydirectiveonelinep = do
(off, Amount{acommodity,astyle}) <- try $ do (off, Amount{acommodity,astyle}) <- try $ do
string "commodity" string "commodity"
lift (skipSome spacenonewline) lift skipNonNewlineSpaces1
off <- getOffset off <- getOffset
amount <- amountp amount <- amountp
pure $ (off, amount) pure $ (off, amount)
lift (skipMany spacenonewline) lift skipNonNewlineSpaces
_ <- lift followingcommentp _ <- lift followingcommentp
let comm = Commodity{csymbol=acommodity, cformat=Just $ dbg6 "style from commodity directive" astyle} let comm = Commodity{csymbol=acommodity, cformat=Just $ dbg6 "style from commodity directive" astyle}
if asdecimalpoint astyle == Nothing if asdecimalpoint astyle == Nothing
@ -449,21 +449,21 @@ pleaseincludedecimalpoint = chomp $ unlines [
commoditydirectivemultilinep :: JournalParser m () commoditydirectivemultilinep :: JournalParser m ()
commoditydirectivemultilinep = do commoditydirectivemultilinep = do
string "commodity" string "commodity"
lift (skipSome spacenonewline) lift skipNonNewlineSpaces1
sym <- lift commoditysymbolp sym <- lift commoditysymbolp
_ <- lift followingcommentp _ <- lift followingcommentp
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 (skipSome spacenonewline) >>) indented = (lift skipNonNewlineSpaces1 >>)
-- | 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 :: CommoditySymbol -> JournalParser m AmountStyle formatdirectivep :: CommoditySymbol -> JournalParser m AmountStyle
formatdirectivep expectedsym = do formatdirectivep expectedsym = do
string "format" string "format"
lift (skipSome spacenonewline) lift skipNonNewlineSpaces1
off <- getOffset off <- getOffset
Amount{acommodity,astyle} <- amountp Amount{acommodity,astyle} <- amountp
_ <- lift followingcommentp _ <- lift followingcommentp
@ -479,7 +479,7 @@ keywordp :: String -> JournalParser m ()
keywordp = (() <$) . string . fromString keywordp = (() <$) . string . fromString
spacesp :: JournalParser m () spacesp :: JournalParser m ()
spacesp = () <$ lift (skipSome spacenonewline) spacesp = () <$ lift skipNonNewlineSpaces1
-- | 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 ()
@ -488,7 +488,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 (skipSome spacenonewline) lift skipNonNewlineSpaces1
parent <- lift accountnamep parent <- lift accountnamep
newline newline
pushParentAccount parent pushParentAccount parent
@ -501,7 +501,7 @@ endapplyaccountdirectivep = do
aliasdirectivep :: JournalParser m () aliasdirectivep :: JournalParser m ()
aliasdirectivep = do aliasdirectivep = do
string "alias" string "alias"
lift (skipSome spacenonewline) lift skipNonNewlineSpaces1
alias <- lift accountaliasp alias <- lift accountaliasp
addAccountAlias alias addAccountAlias alias
@ -513,7 +513,7 @@ basicaliasp = do
-- dbgparse 0 "basicaliasp" -- dbgparse 0 "basicaliasp"
old <- rstrip <$> (some $ noneOf ("=" :: [Char])) old <- rstrip <$> (some $ noneOf ("=" :: [Char]))
char '=' char '='
skipMany spacenonewline skipNonNewlineSpaces
new <- rstrip <$> anySingle `manyTill` eolof -- eol in journal, eof in command lines, normally new <- rstrip <$> anySingle `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)
@ -523,9 +523,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 '/'
skipMany spacenonewline skipNonNewlineSpaces
char '=' char '='
skipMany spacenonewline skipNonNewlineSpaces
repl <- anySingle `manyTill` eolof repl <- anySingle `manyTill` eolof
return $ RegexAlias re repl return $ RegexAlias re repl
@ -537,7 +537,7 @@ endaliasesdirectivep = do
tagdirectivep :: JournalParser m () tagdirectivep :: JournalParser m ()
tagdirectivep = do tagdirectivep = do
string "tag" <?> "tag directive" string "tag" <?> "tag directive"
lift (skipSome spacenonewline) lift skipNonNewlineSpaces1
_ <- lift $ some nonspace _ <- lift $ some nonspace
lift restofline lift restofline
return () return ()
@ -551,7 +551,7 @@ endtagdirectivep = do
defaultyeardirectivep :: JournalParser m () defaultyeardirectivep :: JournalParser m ()
defaultyeardirectivep = do defaultyeardirectivep = do
char 'Y' <?> "default year" char 'Y' <?> "default year"
lift (skipMany spacenonewline) lift skipNonNewlineSpaces
y <- some digitChar y <- some digitChar
let y' = read y let y' = read y
failIfInvalidYear y failIfInvalidYear y
@ -560,7 +560,7 @@ defaultyeardirectivep = do
defaultcommoditydirectivep :: JournalParser m () defaultcommoditydirectivep :: JournalParser m ()
defaultcommoditydirectivep = do defaultcommoditydirectivep = do
char 'D' <?> "default commodity" char 'D' <?> "default commodity"
lift (skipSome spacenonewline) lift skipNonNewlineSpaces1
off <- getOffset off <- getOffset
Amount{acommodity,astyle} <- amountp Amount{acommodity,astyle} <- amountp
lift restofline lift restofline
@ -571,11 +571,11 @@ defaultcommoditydirectivep = do
marketpricedirectivep :: JournalParser m PriceDirective marketpricedirectivep :: JournalParser m PriceDirective
marketpricedirectivep = do marketpricedirectivep = do
char 'P' <?> "market price" char 'P' <?> "market price"
lift (skipMany spacenonewline) lift skipNonNewlineSpaces
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 (skipSome spacenonewline) lift skipNonNewlineSpaces1
symbol <- lift commoditysymbolp symbol <- lift commoditysymbolp
lift (skipMany spacenonewline) lift skipNonNewlineSpaces
price <- amountp price <- amountp
lift restofline lift restofline
return $ PriceDirective date symbol price return $ PriceDirective date symbol price
@ -583,7 +583,7 @@ marketpricedirectivep = do
ignoredpricecommoditydirectivep :: JournalParser m () ignoredpricecommoditydirectivep :: JournalParser m ()
ignoredpricecommoditydirectivep = do ignoredpricecommoditydirectivep = do
char 'N' <?> "ignored-price commodity" char 'N' <?> "ignored-price commodity"
lift (skipSome spacenonewline) lift skipNonNewlineSpaces1
lift commoditysymbolp lift commoditysymbolp
lift restofline lift restofline
return () return ()
@ -591,11 +591,11 @@ ignoredpricecommoditydirectivep = do
commodityconversiondirectivep :: JournalParser m () commodityconversiondirectivep :: JournalParser m ()
commodityconversiondirectivep = do commodityconversiondirectivep = do
char 'C' <?> "commodity conversion" char 'C' <?> "commodity conversion"
lift (skipSome spacenonewline) lift skipNonNewlineSpaces1
amountp amountp
lift (skipMany spacenonewline) lift skipNonNewlineSpaces
char '=' char '='
lift (skipMany spacenonewline) lift skipNonNewlineSpaces
amountp amountp
lift restofline lift restofline
return () return ()
@ -606,7 +606,7 @@ commodityconversiondirectivep = do
transactionmodifierp :: JournalParser m TransactionModifier transactionmodifierp :: JournalParser m TransactionModifier
transactionmodifierp = do transactionmodifierp = do
char '=' <?> "modifier transaction" char '=' <?> "modifier transaction"
lift (skipMany spacenonewline) lift skipNonNewlineSpaces
querytxt <- lift $ T.strip <$> descriptionp querytxt <- lift $ T.strip <$> descriptionp
(_comment, _tags) <- lift transactioncommentp -- TODO apply these to modified txns ? (_comment, _tags) <- lift transactioncommentp -- TODO apply these to modified txns ?
postings <- postingsp Nothing postings <- postingsp Nothing
@ -626,7 +626,7 @@ periodictransactionp = do
-- first line -- first line
char '~' <?> "periodic transaction" char '~' <?> "periodic transaction"
lift $ skipMany spacenonewline lift $ skipNonNewlineSpaces
-- a period expression -- a period expression
off <- getOffset off <- getOffset
@ -706,7 +706,7 @@ postingsp mTransactionYear = many (postingp mTransactionYear) <?> "postings"
-- linebeginningwithspaces :: JournalParser m String -- linebeginningwithspaces :: JournalParser m String
-- linebeginningwithspaces = do -- linebeginningwithspaces = do
-- sp <- lift (skipSome spacenonewline) -- sp <- lift skipNonNewlineSpaces1
-- c <- nonspace -- c <- nonspace
-- cs <- lift restofline -- cs <- lift restofline
-- return $ sp ++ (c:cs) ++ "\n" -- return $ sp ++ (c:cs) ++ "\n"
@ -715,17 +715,17 @@ postingp :: Maybe Year -> JournalParser m Posting
postingp mTransactionYear = do postingp mTransactionYear = do
-- lift $ dbgparse 0 "postingp" -- lift $ dbgparse 0 "postingp"
(status, account) <- try $ do (status, account) <- try $ do
lift (skipSome spacenonewline) lift skipNonNewlineSpaces1
status <- lift statusp status <- lift statusp
lift (skipMany spacenonewline) lift skipNonNewlineSpaces
account <- modifiedaccountnamep account <- modifiedaccountnamep
return (status, account) return (status, account)
let (ptype, account') = (accountNamePostingType account, textUnbracket account) let (ptype, account') = (accountNamePostingType account, textUnbracket account)
lift (skipMany spacenonewline) lift skipNonNewlineSpaces
amount <- option missingmixedamt $ Mixed . (:[]) <$> amountp amount <- option missingmixedamt $ Mixed . (:[]) <$> amountp
lift (skipMany spacenonewline) lift skipNonNewlineSpaces
massertion <- optional balanceassertionp massertion <- optional balanceassertionp
lift (skipMany spacenonewline) lift skipNonNewlineSpaces
(comment,tags,mdate,mdate2) <- lift $ postingcommentp mTransactionYear (comment,tags,mdate,mdate2) <- lift $ postingcommentp mTransactionYear
return posting return posting
{ pdate=mdate { pdate=mdate

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

@ -121,10 +121,10 @@ timeclockentryp :: JournalParser m TimeclockEntry
timeclockentryp = do timeclockentryp = do
sourcepos <- genericSourcePos <$> lift getSourcePos sourcepos <- genericSourcePos <$> lift getSourcePos
code <- oneOf ("bhioO" :: [Char]) code <- oneOf ("bhioO" :: [Char])
lift (skipSome spacenonewline) lift skipNonNewlineSpaces1
datetime <- datetimep datetime <- datetimep
account <- fromMaybe "" <$> optional (lift (skipSome spacenonewline) >> modifiedaccountnamep) account <- fromMaybe "" <$> optional (lift skipNonNewlineSpaces1 >> modifiedaccountnamep)
description <- T.pack . fromMaybe "" <$> lift (optional (skipSome spacenonewline >> restofline)) description <- T.pack . fromMaybe "" <$> lift (optional (skipNonNewlineSpaces1 >> restofline))
return $ TimeclockEntry sourcepos (read [code]) datetime account description 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 orgheadingprefixp = do
-- traceparse "orgheadingprefixp" -- traceparse "orgheadingprefixp"
skipSome (char '*') >> skipSome spacenonewline skipSome (char '*') >> skipNonNewlineSpaces1
-- | Parse a single timedot entry to one (dateless) transaction. -- | Parse a single timedot entry to one (dateless) transaction.
-- @ -- @
@ -170,9 +170,9 @@ entryp = do
lift $ traceparse "entryp" lift $ traceparse "entryp"
pos <- genericSourcePos <$> getSourcePos pos <- genericSourcePos <$> getSourcePos
notFollowedBy datelinep notFollowedBy datelinep
lift $ optional $ choice [orgheadingprefixp, skipSome spacenonewline] lift $ optional $ choice [orgheadingprefixp, skipNonNewlineSpaces1]
a <- modifiedaccountnamep a <- modifiedaccountnamep
lift (skipMany spacenonewline) lift skipNonNewlineSpaces
hours <- hours <-
try (lift followingcommentp >> return 0) try (lift followingcommentp >> return 0)
<|> (durationp <* <|> (durationp <*
@ -211,7 +211,7 @@ numericquantityp = do
-- lift $ traceparse "numericquantityp" -- lift $ traceparse "numericquantityp"
(q, _, _, _) <- lift $ numberp Nothing (q, _, _, _) <- lift $ numberp Nothing
msymbol <- optional $ choice $ map (string . fst) timeUnits msymbol <- optional $ choice $ map (string . fst) timeUnits
lift (skipMany spacenonewline) lift skipNonNewlineSpaces
let q' = let q' =
case msymbol of case msymbol of
Nothing -> q Nothing -> q
@ -249,7 +249,7 @@ emptyorcommentlinep :: [Char] -> TextParser m ()
emptyorcommentlinep cs = emptyorcommentlinep cs =
label ("empty line or comment line beginning with "++cs) $ do label ("empty line or comment line beginning with "++cs) $ do
traceparse "emptyorcommentlinep" -- XXX possible to combine label and traceparse ? traceparse "emptyorcommentlinep" -- XXX possible to combine label and traceparse ?
skipMany spacenonewline skipNonNewlineSpaces
void newline <|> void commentp void newline <|> void commentp
traceparse' "emptyorcommentlinep" traceparse' "emptyorcommentlinep"
where where

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

@ -20,10 +20,14 @@ module Hledger.Utils.Parse (
showDateParseError, showDateParseError,
nonspace, nonspace,
isNonNewlineSpace, isNonNewlineSpace,
spacenonewline,
restofline, restofline,
eolof, eolof,
spacenonewline,
skipNonNewlineSpaces,
skipNonNewlineSpaces1,
skipNonNewlineSpaces',
-- * re-exports -- * re-exports
CustomErr CustomErr
) )
@ -125,9 +129,26 @@ isNonNewlineSpace c = c /= '\n' && isSpace c
spacenonewline :: (Stream s, Char ~ Token s) => ParsecT CustomErr s m Char spacenonewline :: (Stream s, Char ~ Token s) => ParsecT CustomErr s m Char
spacenonewline = satisfy isNonNewlineSpace spacenonewline = satisfy isNonNewlineSpace
{-# INLINABLE spacenonewline #-}
restofline :: TextParser m String restofline :: TextParser m String
restofline = anySingle `manyTill` eolof 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 :: TextParser m ()
eolof = (newline >> return ()) <|> eof eolof = (newline >> return ()) <|> eof

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

@ -145,7 +145,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` skipSome spacenonewline p = do ss <- (singleQuotedPattern <|> doubleQuotedPattern <|> pattern) `sepBy` skipNonNewlineSpaces1
-- eof -- eof
return ss return ss
pattern = many (noneOf whitespacechars) pattern = many (noneOf whitespacechars)

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

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