@@ -119,9 +119,10 @@ module Streamly.Internal.Data.Parser.ParserD
119 , takeWhile1
119 , takeWhile1
120 , dropWhile
120 , dropWhile
122− -- ** Single Element Separators
122+ -- ** Separated by elements
123 -- | Separator could be in prefix postion ('takeStartBy'), or suffix
123 -- | Separator could be in prefix postion ('takeStartBy'), or suffix
124− -- position ('takeEndBy').
124+ -- position ('takeEndBy'). See 'deintercalate', 'sepBy' etc for infix
125+ -- separator parsing, also see 'intersperseQuotedBy' fold.
126 -- These can be implemented modularly with refolds, using takeWhile and
127 -- These can be implemented modularly with refolds, using takeWhile and
127 -- satisfy.
128 -- satisfy.
@@ -134,18 +135,29 @@ module Streamly.Internal.Data.Parser.ParserD
134 , takeEitherSepBy
135 , takeEitherSepBy
137− -- ** By comparing
138+ -- ** Grouped by element comparison
138 , groupBy
139 , groupBy
139 , groupByRolling
140 , groupByRolling
140 , groupByRollingEither
141 , groupByRollingEither
142− -- ** Framing
143+ -- ** Framed by elements
144+ -- | Also see 'intersperseQuotedBy' fold.
145+ -- Framed by a one or more ocurrences of a separator around a word like
146+ -- spaces or quotes. No nesting.
147+ , wordFramedBy -- XXX Remove this? Covered by wordWithQuotes?
152+ -- Framed by separate start and end characters, potentially nested.
153+ -- blockWithQuotes allows quotes inside a block. However,
154+ -- takeFramedByGeneric can be used to express takeStartBy, takeEndBy and
155+ -- block with escaping.
143 -- , takeFramedBy
156 -- , takeFramedBy
144 , takeFramedBy_
157 , takeFramedBy_
145 , takeFramedByEsc_
158 , takeFramedByEsc_
146 , takeFramedByGeneric
159 , takeFramedByGeneric
147− , wordFramedBy
160+ , blockWithQuotes
150 -- Matching strings
162 -- Matching strings
151 -- , prefixOf -- match any prefix of a given string
163 -- , prefixOf -- match any prefix of a given string
@@ -172,10 +184,35 @@ module Streamly.Internal.Data.Parser.ParserD
172 -- , teeTill -- like manyTill but parallel
184 -- , teeTill -- like manyTill but parallel
175− -- ** Sequential Interleaving
187+ -- ** Sequential Alternative
191+ -- ** Parallel Alternatives
197+ -- * N-ary Combinators
198+ -- ** Sequential Collection
202+ -- ** Sequential Repetition
205+ -- , countBetweenTill
210+ -- ** Interleaved Repetition
176 -- Use two folds, run a primary parser, its rejected values go to the
211 -- Use two folds, run a primary parser, its rejected values go to the
177 -- secondary parser.
212 -- secondary parser.
178 , deintercalate
213 , deintercalate
179 -- , deintercalatePrefix
216 -- , deintercalatePrefix
180 -- , deintercalateSuffix
217 -- , deintercalateSuffix
@@ -196,30 +233,8 @@ module Streamly.Internal.Data.Parser.ParserD
200− -- ** Sequential Alternative
204− -- ** Parallel Alternatives
210− -- * N-ary Combinators
211− -- ** Sequential Collection
215− -- ** Sequential Repetition
218− -- , countBetweenTill
223 , manyTillP
238 , manyTillP
224 , manyTill
239 , manyTill
225 , manyThen
240 , manyThen
@@ -1024,9 +1039,9 @@ data FramedEscState s =
1024-- XXX We can remove Maybe from esc
1039-- XXX We can remove Maybe from esc
1025{-# INLINE takeFramedByGeneric #-}
1040{-# INLINE takeFramedByGeneric #-}
1026takeFramedByGeneric :: Monad m =>
1041takeFramedByGeneric :: Monad m =>
1027− Maybe (a -> Bool)
1042+ Maybe (a -> Bool) -- is escape char?
1028− -> Maybe (a -> Bool)
1043+ -> Maybe (a -> Bool) -- is frame begin?
1029− -> Maybe (a -> Bool)
1044+ -> Maybe (a -> Bool) -- is frame end?
1030 -> Fold m a b
1045 -> Fold m a b
1031 -> Parser a m b
1046 -> Parser a m b
1032takeFramedByGeneric esc begin end (Fold fstep finitial fextract) =
1047takeFramedByGeneric esc begin end (Fold fstep finitial fextract) =
@@ -1119,6 +1134,94 @@ takeFramedByGeneric esc begin end (Fold fstep finitial fextract) =
1119 Nothing -> err "takeFramedByGeneric: missing closing frame"
1134 Nothing -> err "takeFramedByGeneric: missing closing frame"
1120 extract (FrameEscEsc _ _) = err "takeFramedByGeneric: trailing escape"
1135 extract (FrameEscEsc _ _) = err "takeFramedByGeneric: trailing escape"
1137+data BlockParseState s =
1139+ | BlockUnquoted !Int !s
1140+ | BlockQuoted !Int !s
1141+ | BlockQuotedEsc !Int !s
1143+-- Blocks can be of different types e.g. {} or (). We only parse from the
1144+-- perspective of the outermost block type. The nesting of that block are
1145+-- checked. Any other block types nested inside it are opaque to us and can be
1146+-- parsed when the contents of the block are parsed.
1148+-- XXX Put a limit on nest level to keep the API safe.
1150+-- | Parse a block enclosed within open, close brackets. Block contents may be
1151+-- quoted, brackets inside quotes are ignored. Quoting characters can be used
1152+-- within quotes if escaped. A block can have a nested block inside it.
1154+-- Quote begin and end chars are the same. Block brackets and quote chars must
1155+-- not overlap. Block start and end brackets must be different for nesting
1156+-- blocks within blocks.
1158+-- >>> p = Parser.blockWithQuotes (== '\\') (== '"') '{' '}' Fold.toList
1159+-- >>> Stream.parse p $ Stream.fromList "{msg: \"hello world\"}"
1160+-- Right "msg: \"hello world\""
1162+{-# INLINE blockWithQuotes #-}
1163+blockWithQuotes :: (Monad m, Eq a) =>
1164+ (a -> Bool) -- ^ escape char
1165+ -> (a -> Bool) -- ^ quote char, to quote inside brackets
1166+ -> a -- ^ Block opening bracket
1167+ -> a -- ^ Block closing bracket
1170+blockWithQuotes isEsc isQuote bopen bclose
1171+ (Fold fstep finitial fextract) =
1172+ Parser step initial extract
1180+ FL.Partial s -> IPartial (BlockInit s)
1182+ error "blockWithQuotes: fold finished without input"
1184+ {-# INLINE process #-}
1185+ process s a nextState = do
1189+ FL.Partial s1 -> Continue 0 (nextState s1)
1190+ FL.Done b -> Done 0 b
1192+ step (BlockInit s) a =
1195+ then Continue 0 $ BlockUnquoted 1 s
1196+ else Error "blockWithQuotes: missing block start"
1197+ step (BlockUnquoted level s) a
1198+ | a == bopen = process s a (BlockUnquoted (level + 1))
1201+ then fmap (Done 0) (fextract s)
1202+ else process s a (BlockUnquoted (level - 1))
1203+ | isQuote a = process s a (BlockQuoted level)
1204+ | otherwise = process s a (BlockUnquoted level)
1205+ step (BlockQuoted level s) a
1206+ | isEsc a = process s a (BlockQuotedEsc level)
1209+ then process s a (BlockUnquoted level)
1210+ else process s a (BlockQuoted level)
1211+ step (BlockQuotedEsc level s) a = process s a (BlockQuoted level)
1213+ err = return . Error
1215+ extract (BlockInit s) = fmap (Done 0) $ fextract s
1216+ extract (BlockUnquoted level _) =
1217+ err $ "blockWithQuotes: finished at block nest level " ++ show level
1218+ extract (BlockQuoted level _) =
1219+ err $ "blockWithQuotes: finished, inside an unfinished quote, "
1220+ ++ "at block nest level " ++ show level
1221+ extract (BlockQuotedEsc level _) =
1222+ err $ "blockWithQuotes: finished, inside an unfinished quote, "
1223+ ++ "after an escape char, at block nest level " ++ show level
1122-- | @takeEndBy cond parser@ parses a token that ends by a separator chosen by
1225-- | @takeEndBy cond parser@ parses a token that ends by a separator chosen by
1123-- the supplied predicate. The separator is also taken with the token.
1226-- the supplied predicate. The separator is also taken with the token.
@@ -1500,10 +1603,10 @@ data WordFramedState s b =
1501{-# INLINE wordFramedBy #-}
1604{-# INLINE wordFramedBy #-}
1502wordFramedBy :: Monad m =>
1605wordFramedBy :: Monad m =>
1503− (a -> Bool) -- ^ Escape
1606+ (a -> Bool) -- ^ Matches escape elem?
1504− -> (a -> Bool) -- ^ left quote
1607+ -> (a -> Bool) -- ^ Matches left quote?
1505− -> (a -> Bool) -- ^ right quote
1608+ -> (a -> Bool) -- ^ matches right quote?
1506− -> (a -> Bool) -- ^ word seperator
1609+ -> (a -> Bool) -- ^ matches word separator?
1507 -> Fold m a b
1610 -> Fold m a b
1508 -> Parser a m b
1611 -> Parser a m b
1509wordFramedBy isEsc isBegin isEnd isSep
1612wordFramedBy isEsc isBegin isEnd isSep
@@ -1583,61 +1686,109 @@ wordFramedBy isEsc isBegin isEnd isSep
1583data WordQuotedState s b a =
1686data WordQuotedState s b a =
1584 WordQuotedSkipPre !s
1687 WordQuotedSkipPre !s
1585 | WordUnquotedWord !s
1688 | WordUnquotedWord !s
1586− | WordQuotedWord !s !Int a
1689+ | WordQuotedWord !s !Int !a !a
1587 | WordUnquotedEsc !s
1690 | WordUnquotedEsc !s
1588− | WordQuotedEsc !s !Int a
1691+ | WordQuotedEsc !s !Int !a !a
1589 | WordQuotedSkipPost !b
1692 | WordQuotedSkipPost !b
1591−-- | Like 'wordFramedBy' but the closing quote is determined by the opening
1694+-- | Quote and bracket aware word splitting with escaping. Like 'wordBy' but
1592−-- quote. The first quote begin starts a quote that is closed by its
1695+-- word separators within specified quotes or brackets are ignored. Quotes and
1593−-- corresponding closing quote.
1696+-- escape characters can be processed. If the end quote is different from the
1697+-- start quote it is called a bracket. The following quoting rules apply:
1699+-- * In an unquoted string a character may be preceded by an escape character.
1700+-- The escape character is removed and the character following it is treated
1701+-- literally with no special meaning e.g. e.g. h\ e\ l\ l\ o is a single word,
1703+-- * Any part of the word can be placed within quotes. Inside quotes all
1704+-- characters are treated literally with no special meaning. Quoting character
1705+-- itself cannot be used within quotes unless escape processing within quotes
1706+-- is applied to allow it.
1707+-- * Optionally escape processing for quoted part can be specified. Escape
1708+-- character has no special meaning inside quotes unless it is followed by a
1709+-- character that has a escape translation specified, in that case the escape
1710+-- character is removed, and the specified translation is applied to the
1711+-- character following it. This can be used to escape the quoting character
1712+-- itself within quotes.
1713+-- * There can be multiple quoting characters, when a quote starts, all other
1714+-- quoting characters within that quote lose any special meaning until the
1716+-- * A starting quote char without an ending char generates a parse error. An
1717+-- ending bracket char without a corresponding bracket begin is ignored.
1718+-- * Brackets can be nested.
1720+-- We should note that unquoted and quoted escape processing are different. In
1721+-- unquoted part escape character is always removed. In quoted part it is
1722+-- removed only if followed by a special meaning character. This is consistent
1723+-- with how shell performs escape processing.
1725+-- Examples of quotes - "double quotes", 'single quotes', (parens), {braces},
1726+-- ((nested) brackets).
1595−-- 'wordFramedBy' and 'wordQuotedBy' both allow multiple quote characters based
1730+-- >>> :{
1596−-- on the predicates but 'wordQuotedBy' always fixes the quote at the first
1731+-- >>> q x =
1597−-- occurrence and then it is closed only by the corresponding closing quote.
1732+-- >>> case x of
1598−-- Therefore, other quoting characters can be embedded inside it as normal
1733+-- >>> '"' -> Just x
1599−-- characters. On the other hand, 'wordFramedBy' would close the quote as soon
1734+-- >>> '\'' -> Just x
1600−-- as it encounters any of the closing quotes.
1735+-- >>> _ -> Nothing
1738+-- >>> p = Parser.wordKeepQuotes (== '\\') q isSpace Fold.toList
1739+-- >>> Stream.parse p $ Stream.fromList "a\"b'c\";'d\"e'f ghi"
1740+-- Right "a\"b'c\";'d\"e'f"
1602−-- >>> q = (`elem` ['"', '\''])
1742+-- Note that outer quotes and backslashes from the input string are consumed by
1603−-- >>> p kQ = Parser.wordQuotedBy kQ (== '\\') q q id isSpace Fold.toList
1743+-- Haskell, therefore, the actual input string passed to the parser is:
1744+-- a"b'c";'d"e'f ghi
1605−-- >>> Stream.parse (p False) $ Stream.fromList "a\"b'c\";'d\"e'f ghi"
1746+-- Similarly, when printing, double quotes are escaped by Haskell.
1606−-- Right "ab'c;d\"ef"
1608−-- >>> Stream.parse (p True) $ Stream.fromList "a\"b'c\";'d\"e'f ghi"
1748+-- Limitations:
1609−-- Right "a\"b'c\";'d\"e'f"
1611−{-# INLINE wordQuotedBy #-}
1750+-- Shell like quote processing can be performed by using quote char specific
1751+-- escape processing, single quotes with no escapes, and double quotes with
1754+-- JSON string processing can also be achieved except the "\uXXXX" style
1755+-- escaping for Unicode characters.
1757+{-# INLINE wordWithQuotes #-}
1612−wordQuotedBy :: (Monad m, Eq a) =>
1758+wordWithQuotes :: (Monad m, Eq a) =>
1613− Bool -- ^ keep the quotes in the output
1759+ Bool -- ^ Retain the quotes and escape chars in the output
1614− -> (a -> Bool) -- ^ Escape
1760+ -> (a -> a -> Maybe a) -- ^ quote char -> escaped char -> translated char
1615− -> (a -> Bool) -- ^ left quote
1761+ -> a -- ^ Matches an escape elem?
1616− -> (a -> Bool) -- ^ right quote
1762+ -> (a -> Maybe a) -- ^ If left quote, return right quote, else Nothing.
1617− -> (a -> a) -- ^ get right quote from the left quote
1763+ -> (a -> Bool) -- ^ Matches a word separator?
1618− -> (a -> Bool) -- ^ word seperator
1619 -> Fold m a b
1764 -> Fold m a b
1620 -> Parser a m b
1765 -> Parser a m b
1621−wordQuotedBy keepQuotes isEsc isBegin isEnd toRight isSep
1766+wordWithQuotes keepQuotes tr escChar toRight isSep
1622 (Fold fstep finitial fextract) =
1767 (Fold fstep finitial fextract) =
1623 Parser step initial extract
1768 Parser step initial extract
1772+ -- Can be used to generate parse error for a bracket end without a bracket
1774+ isInvalid = const False
1776+ isEsc = (== escChar)
1627 initial = do
1778 initial = do
1628 res <- finitial
1779 res <- finitial
1629 return $
1780 return $
1630 case res of
1781 case res of
1631 FL.Partial s -> IPartial (WordQuotedSkipPre s)
1782 FL.Partial s -> IPartial (WordQuotedSkipPre s)
1632 FL.Done _ ->
1783 FL.Done _ ->
1633− error "wordQuotedBy: fold done without input"
1784+ error "wordKeepQuotes: fold done without input"
1635− {-# INLINE process #-}
1786+ {-# INLINE processQuoted #-}
1636− process s a n q = do
1787+ processQuoted s a n ql qr = do
1637 res <- fstep s a
1788 res <- fstep s a
1639 $ case res of
1790 $ case res of
1640− FL.Partial s1 -> Continue 0 (WordQuotedWord s1 n q)
1791+ FL.Partial s1 -> Continue 0 (WordQuotedWord s1 n ql qr)
1641 FL.Done b -> Done 0 b
1792 FL.Done b -> Done 0 b
1643 {-# INLINE processUnquoted #-}
1794 {-# INLINE processUnquoted #-}
@@ -1651,45 +1802,59 @@ wordQuotedBy keepQuotes isEsc isBegin isEnd toRight isSep
1651 step (WordQuotedSkipPre s) a
1802 step (WordQuotedSkipPre s) a
1652 | isEsc a = return $ Continue 0 $ WordUnquotedEsc s
1803 | isEsc a = return $ Continue 0 $ WordUnquotedEsc s
1653 | isSep a = return $ Partial 0 $ WordQuotedSkipPre s
1804 | isSep a = return $ Partial 0 $ WordQuotedSkipPre s
1654− | isBegin a =
1805+ | otherwise =
1655− if keepQuotes
1808+ if keepQuotes
1656− then process s a 1 a
1809+ then processQuoted s a 1 a qr
1657− else return $ Continue 0 $ WordQuotedWord s 1 a
1810+ else return $ Continue 0 $ WordQuotedWord s 1 a qr
1658− | isEnd a =
1811+ Nothing
1659− return $ Error "wordQuotedBy: missing frame start"
1812+ | isInvalid a ->
1813+ return $ Error "wordKeepQuotes: invalid unquoted char"
1660− | otherwise = processUnquoted s a
1814+ | otherwise -> processUnquoted s a
1661 step (WordUnquotedWord s) a
1815 step (WordUnquotedWord s) a
1662 | isEsc a = return $ Continue 0 $ WordUnquotedEsc s
1816 | isEsc a = return $ Continue 0 $ WordUnquotedEsc s
1663 | isSep a = do
1817 | isSep a = do
1664 b <- fextract s
1818 b <- fextract s
1665 return $ Partial 0 $ WordQuotedSkipPost b
1819 return $ Partial 0 $ WordQuotedSkipPost b
1666 | otherwise = do
1820 | otherwise = do
1667− if isBegin a
1821+ case toRight a of
1668− then if keepQuotes
1823+ if keepQuotes
1669− then process s a 1 a
1824+ then processQuoted s a 1 a qr
1670− else return $ Continue 0 $ WordQuotedWord s 1 a
1825+ else return $ Continue 0 $ WordQuotedWord s 1 a qr
1671− else if isEnd a
1826+ Nothing ->
1672− then return $ Error "wordQuotedBy: missing frame start"
1827+ if isInvalid a
1828+ then return $ Error "wordKeepQuotes: invalid unquoted char"
1673 else processUnquoted s a
1829 else processUnquoted s a
1674− step (WordQuotedWord s n q) a
1830+ step (WordQuotedWord s n ql qr) a
1675− | isEsc a = return $ Continue 0 $ WordQuotedEsc s n q
1831+ | isEsc a = return $ Continue 0 $ WordQuotedEsc s n ql qr
1676 -- XXX Will this ever occur? Will n ever be 0?
1833 -- XXX Will this ever occur? Will n ever be 0?
1677 | n == 0 && isSep a = do
1834 | n == 0 && isSep a = do
1678 b <- fextract s
1835 b <- fextract s
1679 return $ Partial 0 $ WordQuotedSkipPost b
1836 return $ Partial 0 $ WordQuotedSkipPost b
1680 | otherwise = do
1838 | otherwise = do
1681− if a == toRight q
1839+ if a == qr
1683 if n == 1
1841 if n == 1
1684 then if keepQuotes
1842 then if keepQuotes
1685 then processUnquoted s a
1843 then processUnquoted s a
1686 else return $ Continue 0 $ WordUnquotedWord s
1844 else return $ Continue 0 $ WordUnquotedWord s
1687− else process s a (n - 1) q
1845+ else processQuoted s a (n - 1) ql qr
1688− else if a == q
1846+ else if a == ql
1689− then process s a (n + 1) q
1847+ then processQuoted s a (n + 1) ql qr
1690− else process s a n q
1848+ else processQuoted s a n ql qr
1691 step (WordUnquotedEsc s) a = processUnquoted s a
1849 step (WordUnquotedEsc s) a = processUnquoted s a
1692− step (WordQuotedEsc s n q) a = process s a n q
1850+ step (WordQuotedEsc s n ql qr) a =
1853+ res <- fstep s escChar
1855+ FL.Partial s1 -> processQuoted s1 a n ql qr
1856+ FL.Done b -> return $ Done 0 b
1857+ Just x -> processQuoted s x n ql qr
1693 step (WordQuotedSkipPost b) a =
1858 step (WordQuotedSkipPost b) a =
1695 $ if not (isSep a)
1860 $ if not (isSep a)
@@ -1700,16 +1865,53 @@ wordQuotedBy keepQuotes isEsc isBegin isEnd toRight isSep
1701 extract (WordQuotedSkipPre s) = fmap (Done 0) $ fextract s
1866 extract (WordQuotedSkipPre s) = fmap (Done 0) $ fextract s
1702 extract (WordUnquotedWord s) = fmap (Done 0) $ fextract s
1867 extract (WordUnquotedWord s) = fmap (Done 0) $ fextract s
1703− extract (WordQuotedWord s n _) =
1868+ extract (WordQuotedWord s n _ _) =
1704 if n == 0
1869 if n == 0
1705 then fmap (Done 0) $ fextract s
1870 then fmap (Done 0) $ fextract s
1706− else err "wordQuotedBy: missing frame end"
1871+ else err "wordWithQuotes: missing frame end"
1707 extract WordQuotedEsc {} =
1872 extract WordQuotedEsc {} =
1708− err "wordQuotedBy: trailing escape"
1873+ err "wordWithQuotes: trailing escape"
1709 extract (WordUnquotedEsc _) =
1874 extract (WordUnquotedEsc _) =
1710− err "wordQuotedBy: trailing escape"
1875+ err "wordWithQuotes: trailing escape"
1711 extract (WordQuotedSkipPost b) = return (Done 0 b)
1876 extract (WordQuotedSkipPost b) = return (Done 0 b)
1878+-- | 'wordWithQuotes' without processing the quotes and escape function
1879+-- supplied to escape the quote char within a quote. Can be used to parse words
1880+-- keeping the quotes and escapes intact.
1882+-- >>> wordKeepQuotes = Parser.wordWithQuotes True (\_ _ -> Nothing)
1884+{-# INLINE wordKeepQuotes #-}
1885+wordKeepQuotes :: (Monad m, Eq a) =>
1887+ -> (a -> Maybe a) -- ^ If left quote, return right quote, else Nothing.
1888+ -> (a -> Bool) -- ^ Matches a word separator?
1892+ -- Escape the quote char itself
1893+ wordWithQuotes True (\q x -> if q == x then Just x else Nothing)
1895+-- See the "Quoting Rules" section in the "bash" manual page for a primer on
1896+-- how quotes are used by shells.
1898+-- | 'wordWithQuotes' with quote processing applied and escape function
1899+-- supplied to escape the quote char within a quote. Can be ysed to parse words
1900+-- and processing the quoting and escaping at the same time.
1902+-- >>> wordProcessQuotes = Parser.wordWithQuotes False (\_ _ -> Nothing)
1904+{-# INLINE wordProcessQuotes #-}
1905+wordProcessQuotes :: (Monad m, Eq a) =>
1907+ -> (a -> Maybe a) -- ^ If left quote, return right quote, else Nothing.
1908+ -> (a -> Bool) -- ^ Matches a word separator?
1912+ -- Escape the quote char itself
1913+ wordWithQuotes False (\q x -> if q == x then Just x else Nothing)
1713{-# ANN type GroupByState Fuse #-}
1915{-# ANN type GroupByState Fuse #-}
1714data GroupByState a s
1916data GroupByState a s
1715 = GroupByInit !s
1917 = GroupByInit !s
@@ -2361,15 +2563,162 @@ lookAhead (Parser step1 initial1 _) = Parser step initial extract
2361-- all the three parsers. One parser can count the line numbers to provide the
2563-- all the three parsers. One parser can count the line numbers to provide the
2362-- line number info.
2564-- line number info.
2364−data DeintercalateState fs sp ss =
2566+{-# ANN type DeintercalateAllState Fuse #-}
2365− DeintercalateL !fs !sp
2567+data DeintercalateAllState fs sp ss =
2366− | DeintercalateR !fs !ss !Bool
2568+ DeintercalateAllInitL !fs
2569+ | DeintercalateAllL !fs !sp
2570+ | DeintercalateAllInitR !fs
2571+ | DeintercalateAllR !fs !ss
2368-- XXX rename this to intercalate
2573-- XXX rename this to intercalate
2575+-- Having deintercalateAll for accepting or rejecting entire input could be
2576+-- useful. For example, in case of JSON parsing we get an entire block of
2577+-- key-value pairs which we need to verify. This version may be simpler, more
2578+-- efficient. We could implement this as a stream operation like parseMany.
2580+-- XXX Also, it may be a good idea to provide a parse driver for a fold. For
2581+-- example, in case of csv parsing as we are feeding a line to a fold we can
2584+-- | Like 'deintercalate' but the entire input must satisfy the pattern
2585+-- otherwise the parser fails. This is many times faster than deintercalate.
2587+-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
2588+-- >>> p2 = Parser.satisfy (== '+')
2589+-- >>> p = Parser.deintercalateAll p1 p2 Fold.toList
2590+-- >>> Stream.parse p $ Stream.fromList ""
2592+-- >>> Stream.parse p $ Stream.fromList "1"
2594+-- >>> Stream.parse p $ Stream.fromList "1+"
2595+-- Left (ParseError "takeWhile1: end of input")
2596+-- >>> Stream.parse p $ Stream.fromList "1+2+3"
2597+-- Right [Left "1",Right '+',Left "2",Right '+',Left "3"]
2599+{-# INLINE deintercalateAll #-}
2600+deintercalateAll :: Monad m =>
2603+ -> Fold m (Either x y) z
2606+ (Parser stepL initialL extractL)
2607+ (Parser stepR initialR _)
2608+ (Fold fstep finitial fextract) = Parser step initial extract
2613+ error $ "deintercalate: " ++ p ++ " parser cannot "
2614+ ++ status ++ " without input"
2619+ FL.Partial fs -> return $ IPartial $ DeintercalateAllInitL fs
2620+ FL.Done c -> return $ IDone c
2622+ {-# INLINE processL #-}
2623+ processL foldAction n nextState = do
2626+ FL.Partial fs1 -> return $ Partial n (nextState fs1)
2627+ FL.Done c -> return $ Done n c
2629+ {-# INLINE runStepL #-}
2630+ runStepL fs sL a = do
2633+ Partial n s -> return $ Partial n (DeintercalateAllL fs s)
2634+ Continue n s -> return $ Continue n (DeintercalateAllL fs s)
2636+ processL (fstep fs (Left b)) n DeintercalateAllInitR
2637+ Error err -> return $ Error err
2639+ {-# INLINE processR #-}
2640+ processR foldAction n = do
2643+ FL.Partial fs1 -> do
2646+ IPartial ps -> return $ Partial n (DeintercalateAllL fs1 ps)
2647+ IDone _ -> errMsg "left" "succeed"
2648+ IError _ -> errMsg "left" "fail"
2649+ FL.Done c -> return $ Done n c
2651+ {-# INLINE runStepR #-}
2652+ runStepR fs sR a = do
2655+ Partial n s -> return $ Partial n (DeintercalateAllR fs s)
2656+ Continue n s -> return $ Continue n (DeintercalateAllR fs s)
2657+ Done n b -> processR (fstep fs (Right b)) n
2658+ Error err -> return $ Error err
2660+ step (DeintercalateAllInitL fs) a = do
2663+ IPartial s -> runStepL fs s a
2664+ IDone _ -> errMsg "left" "succeed"
2665+ IError _ -> errMsg "left" "fail"
2666+ step (DeintercalateAllL fs sL) a = runStepL fs sL a
2667+ step (DeintercalateAllInitR fs) a = do
2670+ IPartial s -> runStepR fs s a
2671+ IDone _ -> errMsg "right" "succeed"
2672+ IError _ -> errMsg "right" "fail"
2673+ step (DeintercalateAllR fs sR) a = runStepR fs sR a
2675+ {-# INLINE extractResult #-}
2676+ extractResult n fs r = do
2679+ FL.Partial fs1 -> fmap (Done n) $ fextract fs1
2680+ FL.Done c -> return (Done n c)
2681+ extract (DeintercalateAllInitL fs) = fmap (Done 0) $ fextract fs
2682+ extract (DeintercalateAllL fs sL) = do
2685+ Done n b -> extractResult n fs (Left b)
2686+ Error err -> return $ Error err
2687+ Continue n s -> return $ Continue n (DeintercalateAllL fs s)
2688+ Partial _ _ -> error "Partial in extract"
2689+ extract (DeintercalateAllInitR fs) = fmap (Done 0) $ fextract fs
2690+ extract (DeintercalateAllR _ _) =
2691+ return $ Error "deintercalateAll: input ended at 'Right' value"
2693+{-# ANN type DeintercalateState Fuse #-}
2694+data DeintercalateState b fs sp ss =
2695+ DeintercalateInitL !fs
2696+ | DeintercalateL !Int !fs !sp
2697+ | DeintercalateInitR !fs
2698+ | DeintercalateR !Int !fs !ss
2699+ | DeintercalateRL !Int !b !fs !sp
2701+-- XXX Add tests that the next character that we take after running a parser is
2702+-- correct. Especially for the parsers that maintain a count. In the stream
2703+-- finished case (extract) as well as not finished case.
2370-- | Apply two parsers alternately to an input stream. The input stream is
2705-- | Apply two parsers alternately to an input stream. The input stream is
2371-- considered an interleaving of two patterns. The two parsers represent the
2706-- considered an interleaving of two patterns. The two parsers represent the
2372−-- two patterns.
2707+-- two patterns. Parsing starts at the first parser and stops at the first
2708+-- parser. It can be used to parse a infix style pattern e.g. p1 p2 p1 . Empty
2709+-- input or single parse of the first parser is accepted.
2711+-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
2712+-- >>> p2 = Parser.satisfy (== '+')
2713+-- >>> p = Parser.deintercalate p1 p2 Fold.toList
2714+-- >>> Stream.parse p $ Stream.fromList ""
2716+-- >>> Stream.parse p $ Stream.fromList "1"
2718+-- >>> Stream.parse p $ Stream.fromList "1+"
2720+-- >>> Stream.parse p $ Stream.fromList "1+2+3"
2721+-- Right [Left "1",Right '+',Left "2",Right '+',Left "3"]
2374{-# INLINE deintercalate #-}
2723{-# INLINE deintercalate #-}
2375deintercalate :: Monad m =>
2724deintercalate :: Monad m =>
@@ -2379,7 +2728,163 @@ deintercalate :: Monad m =>
2379 -> Parser a m z
2728 -> Parser a m z
2380deintercalate
2729deintercalate
2381 (Parser stepL initialL extractL)
2730 (Parser stepL initialL extractL)
2382− (Parser stepR initialR extractR)
2731+ (Parser stepR initialR _)
2732+ (Fold fstep finitial fextract) = Parser step initial extract
2737+ error $ "deintercalate: " ++ p ++ " parser cannot "
2738+ ++ status ++ " without input"
2743+ FL.Partial fs -> return $ IPartial $ DeintercalateInitL fs
2744+ FL.Done c -> return $ IDone c
2746+ {-# INLINE processL #-}
2747+ processL foldAction n nextState = do
2750+ FL.Partial fs1 -> return $ Partial n (nextState fs1)
2751+ FL.Done c -> return $ Done n c
2753+ {-# INLINE runStepL #-}
2754+ runStepL cnt fs sL a = do
2758+ Partial n s -> return $ Continue n (DeintercalateL (cnt1 - n) fs s)
2759+ Continue n s -> return $ Continue n (DeintercalateL (cnt1 - n) fs s)
2761+ processL (fstep fs (Left b)) n DeintercalateInitR
2764+ return $ Done cnt1 xs
2766+ {-# INLINE processR #-}
2767+ processR cnt b fs n = do
2770+ IPartial ps -> return $ Continue n (DeintercalateRL cnt b fs ps)
2771+ IDone _ -> errMsg "left" "succeed"
2772+ IError _ -> errMsg "left" "fail"
2774+ {-# INLINE runStepR #-}
2775+ runStepR cnt fs sR a = do
2779+ Partial n s -> return $ Continue n (DeintercalateR (cnt1 - n) fs s)
2780+ Continue n s -> return $ Continue n (DeintercalateR (cnt1 - n) fs s)
2781+ Done n b -> processR (cnt1 - n) b fs n
2784+ return $ Done cnt1 xs
2786+ step (DeintercalateInitL fs) a = do
2789+ IPartial s -> runStepL 0 fs s a
2790+ IDone _ -> errMsg "left" "succeed"
2791+ IError _ -> errMsg "left" "fail"
2792+ step (DeintercalateL cnt fs sL) a = runStepL cnt fs sL a
2793+ step (DeintercalateInitR fs) a = do
2796+ IPartial s -> runStepR 0 fs s a
2797+ IDone _ -> errMsg "right" "succeed"
2798+ IError _ -> errMsg "right" "fail"
2799+ step (DeintercalateR cnt fs sR) a = runStepR cnt fs sR a
2800+ step (DeintercalateRL cnt bR fs sL) a = do
2804+ Partial n s -> return $ Continue n (DeintercalateRL (cnt1 - n) bR fs s)
2805+ Continue n s -> return $ Continue n (DeintercalateRL (cnt1 - n) bR fs s)
2807+ res <- fstep fs (Right bR)
2809+ FL.Partial fs1 -> do
2810+ fres <- fstep fs1 (Left bL)
2813+ return $ Partial n (DeintercalateInitR fs2)
2814+ FL.Done c -> return $ Done n c
2815+ -- XXX We could have the fold accept pairs of (bR, bL)
2816+ FL.Done _ -> error "Fold terminated consuming partial input"
2819+ return $ Done cnt1 xs
2821+ {-# INLINE extractResult #-}
2822+ extractResult n fs r = do
2825+ FL.Partial fs1 -> fmap (Done n) $ fextract fs1
2826+ FL.Done c -> return (Done n c)
2828+ extract (DeintercalateInitL fs) = fmap (Done 0) $ fextract fs
2829+ extract (DeintercalateL cnt fs sL) = do
2832+ Done n b -> extractResult n fs (Left b)
2833+ Continue n s -> return $ Continue n (DeintercalateL (cnt - n) fs s)
2834+ Partial _ _ -> error "Partial in extract"
2837+ return $ Done cnt xs
2838+ extract (DeintercalateInitR fs) = fmap (Done 0) $ fextract fs
2839+ extract (DeintercalateR cnt fs _) = fmap (Done cnt) $ fextract fs
2840+ extract (DeintercalateRL cnt bR fs sL) = do
2844+ res <- fstep fs (Right bR)
2846+ FL.Partial fs1 -> extractResult n fs1 (Left bL)
2847+ FL.Done _ -> error "Fold terminated consuming partial input"
2848+ Continue n s -> return $ Continue n (DeintercalateRL (cnt - n) bR fs s)
2849+ Partial _ _ -> error "Partial in extract"
2852+ return $ Done cnt xs
2854+{-# ANN type Deintercalate1State Fuse #-}
2855+data Deintercalate1State b fs sp ss =
2856+ Deintercalate1InitL !Int !fs !sp
2857+ | Deintercalate1InitR !fs
2858+ | Deintercalate1R !Int !fs !ss
2859+ | Deintercalate1RL !Int !b !fs !sp
2861+-- | Apply two parsers alternately to an input stream. The input stream is
2862+-- considered an interleaving of two patterns. The two parsers represent the
2863+-- two patterns. Parsing starts at the first parser and stops at the first
2864+-- parser. It can be used to parse a infix style pattern e.g. p1 p2 p1 . Empty
2865+-- input or single parse of the first parser is accepted.
2867+-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
2868+-- >>> p2 = Parser.satisfy (== '+')
2869+-- >>> p = Parser.deintercalate1 p1 p2 Fold.toList
2870+-- >>> Stream.parse p $ Stream.fromList ""
2871+-- Left (ParseError "takeWhile1: end of input")
2872+-- >>> Stream.parse p $ Stream.fromList "1"
2874+-- >>> Stream.parse p $ Stream.fromList "1+"
2876+-- >>> Stream.parse p $ Stream.fromList "1+2+3"
2877+-- Right [Left "1",Right '+',Left "2",Right '+',Left "3"]
2879+{-# INLINE deintercalate1 #-}
2880+deintercalate1 :: Monad m =>
2883+ -> Fold m (Either x y) z
2886+ (Parser stepL initialL extractL)
2887+ (Parser stepR initialR _)
2383 (Fold fstep finitial fextract) = Parser step initial extract
2888 (Fold fstep finitial fextract) = Parser step initial extract
@@ -2392,93 +2897,150 @@ deintercalate
2392 res <- finitial
2897 res <- finitial
2393 case res of
2898 case res of
2394 FL.Partial fs -> do
2899 FL.Partial fs -> do
2395− resL <- initialL
2900+ pres <- initialL
2396− case resL of
2901+ case pres of
2397− IPartial sL -> return $ IPartial $ DeintercalateL fs sL
2902+ IPartial s -> return $ IPartial $ Deintercalate1InitL 0 fs s
2398 IDone _ -> errMsg "left" "succeed"
2903 IDone _ -> errMsg "left" "succeed"
2399 IError _ -> errMsg "left" "fail"
2904 IError _ -> errMsg "left" "fail"
2400 FL.Done c -> return $ IDone c
2905 FL.Done c -> return $ IDone c
2402− step (DeintercalateL fs sL) a = do
2907+ {-# INLINE processL #-}
2908+ processL foldAction n nextState = do
2911+ FL.Partial fs1 -> return $ Partial n (nextState fs1)
2912+ FL.Done c -> return $ Done n c
2914+ {-# INLINE runStepInitL #-}
2915+ runStepInitL cnt fs sL a = do
2403 r <- stepL sL a
2917 r <- stepL sL a
2404 case r of
2918 case r of
2405− Partial n s -> return $ Partial n (DeintercalateL fs s)
2919+ Partial n s -> return $ Continue n (Deintercalate1InitL (cnt1 - n) fs s)
2406− Continue n s -> return $ Continue n (DeintercalateL fs s)
2920+ Continue n s -> return $ Continue n (Deintercalate1InitL (cnt1 - n) fs s)
2407− Done n b -> do
2921+ Done n b ->
2408− fres <- fstep fs (Left b)
2922+ processL (fstep fs (Left b)) n Deintercalate1InitR
2410− FL.Partial fs1 -> do
2415− $ Partial n (DeintercalateR fs1 sR False)
2416− IDone _ -> errMsg "right" "succeed"
2417− IError _ -> errMsg "right" "fail"
2418− FL.Done c -> return $ Done n c
2419 Error err -> return $ Error err
2923 Error err -> return $ Error err
2420− step (DeintercalateR fs sR consumed) a = do
2924+
2925+ {-# INLINE processR #-}
2926+ processR cnt b fs n = do
2929+ IPartial ps -> return $ Continue n (Deintercalate1RL cnt b fs ps)
2930+ IDone _ -> errMsg "left" "succeed"
2931+ IError _ -> errMsg "left" "fail"
2933+ {-# INLINE runStepR #-}
2934+ runStepR cnt fs sR a = do
2421 r <- stepR sR a
2936 r <- stepR sR a
2422 case r of
2937 case r of
2423− Partial n s -> return $ Partial n (DeintercalateR fs s True)
2938+ Partial n s -> return $ Continue n (Deintercalate1R (cnt1 - n) fs s)
2424− Continue n s -> return $ Continue n (DeintercalateR fs s True)
2939+ Continue n s -> return $ Continue n (Deintercalate1R (cnt1 - n) fs s)
2425− Done n b ->
2940+ Done n b -> processR (cnt1 - n) b fs n
2426− if consumed
2941+ Error _ -> do
2427− then do
2942+ xs <- fextract fs
2428− fres <- fstep fs (Right b)
2430− FL.Partial fs1 -> do
2434− return $ Partial n $ DeintercalateL fs1 sL
2435− IDone _ -> errMsg "left" "succeed"
2436− IError _ -> errMsg "left" "fail"
2437− FL.Done c -> return $ Done n c
2943+ return $ Done cnt1 xs
2438− else error "deintercalate: infinite loop"
2439− Error err -> return $ Error err
2441− {-# INLINE processResult #-}
2945+ step (Deintercalate1InitL cnt fs sL) a = runStepInitL cnt fs sL a
2442− processResult n fs r = do
2946+ step (Deintercalate1InitR fs) a = do
2949+ IPartial s -> runStepR 0 fs s a
2950+ IDone _ -> errMsg "right" "succeed"
2951+ IError _ -> errMsg "right" "fail"
2952+ step (Deintercalate1R cnt fs sR) a = runStepR cnt fs sR a
2953+ step (Deintercalate1RL cnt bR fs sL) a = do
2957+ Partial n s -> return $ Continue n (Deintercalate1RL (cnt1 - n) bR fs s)
2958+ Continue n s -> return $ Continue n (Deintercalate1RL (cnt1 - n) bR fs s)
2960+ res <- fstep fs (Right bR)
2962+ FL.Partial fs1 -> do
2963+ fres <- fstep fs1 (Left bL)
2966+ return $ Partial n (Deintercalate1InitR fs2)
2967+ FL.Done c -> return $ Done n c
2968+ -- XXX We could have the fold accept pairs of (bR, bL)
2969+ FL.Done _ -> error "Fold terminated consuming partial input"
2972+ return $ Done cnt1 xs
2974+ {-# INLINE extractResult #-}
2975+ extractResult n fs r = do
2443 res <- fstep fs r
2976 res <- fstep fs r
2444 case res of
2977 case res of
2445 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
2978 FL.Partial fs1 -> fmap (Done n) $ fextract fs1
2446 FL.Done c -> return (Done n c)
2979 FL.Done c -> return (Done n c)
2448− extract (DeintercalateL fs sL) = do
2981+ extract (Deintercalate1InitL cnt fs sL) = do
2449 r <- extractL sL
2982 r <- extractL sL
2450 case r of
2983 case r of
2451− Done n b -> processResult n fs (Left b)
2984+ Done n b -> extractResult n fs (Left b)
2452− Error err -> return $ Error err
2453− Continue n s -> return $ Continue n (DeintercalateL fs s)
2985+ Continue n s -> return $ Continue n (Deintercalate1InitL (cnt - n) fs s)
2454 Partial _ _ -> error "Partial in extract"
2986 Partial _ _ -> error "Partial in extract"
2456− extract (DeintercalateR fs sR consumed) = do
2459− Done n b -> processResult n fs (Right b)
2460 Error err -> return $ Error err
2987 Error err -> return $ Error err
2461− -- XXX Review consumed
2988+ extract (Deintercalate1InitR fs) = fmap (Done 0) $ fextract fs
2989+ extract (Deintercalate1R cnt fs _) = fmap (Done cnt) $ fextract fs
2990+ extract (Deintercalate1RL cnt bR fs sL) = do
2994+ res <- fstep fs (Right bR)
2996+ FL.Partial fs1 -> extractResult n fs1 (Left bL)
2997+ FL.Done _ -> error "Fold terminated consuming partial input"
2462− Continue n s -> return $ Continue n (DeintercalateR fs s consumed)
2998+ Continue n s -> return $ Continue n (Deintercalate1RL (cnt - n) bR fs s)
2463 Partial _ _ -> error "Partial in extract"
2999 Partial _ _ -> error "Partial in extract"
3002+ return $ Done cnt xs
3004+{-# ANN type SepByState Fuse #-}
2465data SepByState fs sp ss =
3005data SepByState fs sp ss =
2466− SepByInit !fs !sp
3006+ SepByInitL !fs
2467− | SepBySeparator !fs !ss !Bool
3007+ | SepByL !Int !fs !sp
3009+ | SepByR !Int !fs !ss
2469−-- | Run the content parser first, when it is done, the separator parser is
3011+-- | Apply two parsers alternately to an input stream. Parsing starts at the
2470−-- run, when it is done content parser is run again and so on. If none of the
3012+-- first parser and stops at the first parser. The output of the first parser
2471−-- parsers consumes an input then parser returns a failure.
3013+-- is emiited and the output of the second parser is discarded. It can be used
3014+-- to parse a infix style pattern e.g. p1 p2 p1 . Empty input or single parse
3015+-- of the first parser is accepted.
2473−-- >>> sepBy p1 p2 sink = Parser.deintercalate p1 p2 (Fold.catLefts sink)
3019+-- >>> sepBy p1 p2 f = Parser.deintercalate p1 p2 (Fold.catLefts f)
2474−-- >>> sepBy content sep sink = Parser.sepBy1 content sep sink <|> return mempty
3020+-- >>> sepBy p1 p2 f = Parser.sepBy1 p1 p2 f <|> Parser.fromEffect (Fold.extractM f)
3024+-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
3025+-- >>> p2 = Parser.satisfy (== '+')
3026+-- >>> p = Parser.sepBy p1 p2 Fold.toList
3027+-- >>> Stream.parse p $ Stream.fromList ""
3029+-- >>> Stream.parse p $ Stream.fromList "1"
3031+-- >>> Stream.parse p $ Stream.fromList "1+"
3033+-- >>> Stream.parse p $ Stream.fromList "1+2+3"
3034+-- Right ["1","2","3"]
2476{-# INLINE sepBy #-}
3036{-# INLINE sepBy #-}
2477sepBy :: Monad m =>
3037sepBy :: Monad m =>
2478 Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
3038 Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
3039+-- This has similar performance as the custom impl below.
3040+-- sepBy p1 p2 f = deintercalate p1 p2 (FL.catLefts f)
2480− (Parser pstep pinitial pextract)
3042+ (Parser stepL initialL extractL)
2481− (Parser sstep sinitial _)
3043+ (Parser stepR initialR _)
2482 (Fold fstep finitial fextract) = Parser step initial extract
3044 (Fold fstep finitial fextract) = Parser step initial extract
@@ -2490,70 +3052,101 @@ sepBy
2490 initial = do
3052 initial = do
2491 res <- finitial
3053 res <- finitial
2492 case res of
3054 case res of
2493− FL.Partial fs -> do
3055+ FL.Partial fs -> return $ IPartial $ SepByInitL fs
2496− IPartial sp -> return $ IPartial $ SepByInit fs sp
2497− IDone _ -> errMsg "content" "succeed"
2498− IError _ -> errMsg "content" "fail"
2499− FL.Done b -> return $ IDone b
3056+ FL.Done c -> return $ IDone c
2501− step (SepByInit fs sp) a = do
3058+ {-# INLINE processL #-}
2502− r <- pstep sp a
3059+ processL foldAction n nextState = do
3062+ FL.Partial fs1 -> return $ Partial n (nextState fs1)
3063+ FL.Done c -> return $ Done n c
3065+ {-# INLINE runStepL #-}
3066+ runStepL cnt fs sL a = do
2503 case r of
3069 case r of
2504− Partial n s -> return $ Partial n (SepByInit fs s)
3070+ Partial n s -> return $ Continue n (SepByL (cnt1 - n) fs s)
2505− Continue n s -> return $ Continue n (SepByInit fs s)
3071+ Continue n s -> return $ Continue n (SepByL (cnt1 - n) fs s)
2506− Done n b -> do
3072+ Done n b ->
2507− fres <- fstep fs b
3073+ processL (fstep fs b) n SepByInitR
2508− case fres of
3074+ Error _ -> do
2509− FL.Partial fs1 -> do
3075+ xs <- fextract fs
2510− resS <- sinitial
3076+ return $ Done cnt1 xs
3078+ {-# INLINE processR #-}
3079+ processR cnt fs n = do
2511− case resS of
3081+ case res of
2512− IPartial ss ->
3082+ IPartial ps -> return $ Continue n (SepByL cnt fs ps)
2513− return $ Partial n (SepBySeparator fs1 ss False)
2514− IDone _ -> errMsg "separator" "succeed"
3083+ IDone _ -> errMsg "left" "succeed"
2515− IError _ -> errMsg "separator" "fail"
3084+ IError _ -> errMsg "left" "fail"
2516− FL.Done c -> return $ Done n c
3085+
2517− Error err -> return $ Error err
3086+ {-# INLINE runStepR #-}
2518− step (SepBySeparator fs ss consumed) a = do
3087+ runStepR cnt fs sR a = do
2519− r <- sstep ss a
3088+ let cnt1 = cnt + 1
2520 case r of
3090 case r of
2521− Partial n s -> return $ Partial n (SepBySeparator fs s True)
3091+ Partial n s -> return $ Continue n (SepByR (cnt1 - n) fs s)
2522− Continue n s -> return $ Continue n (SepBySeparator fs s True)
3092+ Continue n s -> return $ Continue n (SepByR (cnt1 - n) fs s)
2523− Done n _ ->
3093+ Done n _ -> processR (cnt1 - n) fs n
2524− if consumed
3094+ Error _ -> do
2525− then do
3095+ xs <- fextract fs
2526− resP <- pinitial
3096+ return $ Done cnt1 xs
3098+ step (SepByInitL fs) a = do
2527− case resP of
3100+ case res of
2528− IPartial sp -> return $ Partial n $ SepByInit fs sp
3101+ IPartial s -> runStepL 0 fs s a
3102+ IDone _ -> errMsg "left" "succeed"
3103+ IError _ -> errMsg "left" "fail"
3104+ step (SepByL cnt fs sL) a = runStepL cnt fs sL a
3105+ step (SepByInitR fs) a = do
3108+ IPartial s -> runStepR 0 fs s a
2529− IDone _ -> errMsg "content" "succeed"
3109+ IDone _ -> errMsg "right" "succeed"
2530− IError _ -> errMsg "content" "fail"
3110+ IError _ -> errMsg "right" "fail"
2531− else error "sepBy: infinite loop"
3111+ step (SepByR cnt fs sR) a = runStepR cnt fs sR a
2532− Error err -> return $ Error err
3112+
3113+ {-# INLINE extractResult #-}
3114+ extractResult n fs r = do
3117+ FL.Partial fs1 -> fmap (Done n) $ fextract fs1
3118+ FL.Done c -> return (Done n c)
2534− extract (SepByInit fs sp) = do
3120+ extract (SepByInitL fs) = fmap (Done 0) $ fextract fs
2535− r <- pextract sp
3121+ extract (SepByL cnt fs sL) = do
2536 case r of
3123 case r of
2537− Done n b -> do
3124+ Done n b -> extractResult n fs b
2540− FL.Partial fs1 -> fmap (Done n) $ fextract fs1
2541− FL.Done c -> return (Done n c)
2542− Error err -> return $ Error err
2543− Continue n s -> return $ Continue n (SepByInit fs s)
3125+ Continue n s -> return $ Continue n (SepByL (cnt - n) fs s)
2544 Partial _ _ -> error "Partial in extract"
3126 Partial _ _ -> error "Partial in extract"
3129+ return $ Done cnt xs
2546− extract (SepBySeparator fs _ _) = fmap (Done 0) $ fextract fs
3130+ extract (SepByInitR fs) = fmap (Done 0) $ fextract fs
3131+ extract (SepByR cnt fs _) = fmap (Done cnt) $ fextract fs
3133+-- | Non-backtracking version of sepBy. Several times faster.
3134+{-# INLINE sepByAll #-}
3135+sepByAll :: Monad m =>
3136+ Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
3137+sepByAll p1 p2 f = deintercalateAll p1 p2 (FL.catLefts f)
2548-- XXX This can be implemented using refold, parse one and then continue
3139-- XXX This can be implemented using refold, parse one and then continue
2549-- collecting the rest in that.
3140-- collecting the rest in that.
2551−-- | Parse items separated by a separator parsed by the supplied parser. At
3142+{-# ANN type SepBy1State Fuse #-}
2552−-- least one item must be present for the parser to succeed.
3143+data SepBy1State fs sp ss =
2553−--
3144+ SepBy1InitL !Int !fs sp
2554−-- Note that this can go in infinite loop if both the parsers fail on some
3145+ | SepBy1L !Int !fs !sp
2555−-- input. Detection of that would make the implementation more complex.
3146+ | SepBy1InitR !fs
2556−--
3147+ | SepBy1R !Int !fs !ss
2557{-# INLINE sepBy1 #-}
3150{-# INLINE sepBy1 #-}
2558sepBy1 :: Monad m =>
3151sepBy1 :: Monad m =>
2559 Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
3152 Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
@@ -2562,6 +3155,139 @@ sepBy1 p sep sink = do
2562 f <- fromEffect $ FL.reduce sink
3155 f <- fromEffect $ FL.reduce sink
2563 f1 <- fromEffect $ FL.snoc f x
3156 f1 <- fromEffect $ FL.snoc f x
2564 many (sep >> p) f1
3157 many (sep >> p) f1
3160+-- | Like 'sepBy' but requires at least one successful parse.
3164+-- >>> sepBy1 p1 p2 f = Parser.deintercalate1 p1 p2 (Fold.catLefts f)
3168+-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList
3169+-- >>> p2 = Parser.satisfy (== '+')
3170+-- >>> p = Parser.sepBy1 p1 p2 Fold.toList
3171+-- >>> Stream.parse p $ Stream.fromList ""
3172+-- Left (ParseError "takeWhile1: end of input")
3173+-- >>> Stream.parse p $ Stream.fromList "1"
3175+-- >>> Stream.parse p $ Stream.fromList "1+"
3177+-- >>> Stream.parse p $ Stream.fromList "1+2+3"
3178+-- Right ["1","2","3"]
3180+{-# INLINE sepBy1 #-}
3181+sepBy1 :: Monad m =>
3182+ Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c
3184+ (Parser stepL initialL extractL)
3185+ (Parser stepR initialR _)
3186+ (Fold fstep finitial fextract) = Parser step initial extract
3191+ error $ "sepBy: " ++ p ++ " parser cannot "
3192+ ++ status ++ " without input"
3197+ FL.Partial fs -> do
3200+ IPartial s -> return $ IPartial $ SepBy1InitL 0 fs s
3201+ IDone _ -> errMsg "left" "succeed"
3202+ IError _ -> errMsg "left" "fail"
3203+ FL.Done c -> return $ IDone c
3205+ {-# INLINE processL #-}
3206+ processL foldAction n nextState = do
3209+ FL.Partial fs1 -> return $ Partial n (nextState fs1)
3210+ FL.Done c -> return $ Done n c
3212+ {-# INLINE runStepInitL #-}
3213+ runStepInitL cnt fs sL a = do
3217+ Partial n s -> return $ Continue n (SepBy1InitL (cnt1 - n) fs s)
3218+ Continue n s -> return $ Continue n (SepBy1InitL (cnt1 - n) fs s)
3220+ processL (fstep fs b) n SepBy1InitR
3221+ Error err -> return $ Error err
3223+ {-# INLINE runStepL #-}
3224+ runStepL cnt fs sL a = do
3228+ Partial n s -> return $ Continue n (SepBy1L (cnt1 - n) fs s)
3229+ Continue n s -> return $ Continue n (SepBy1L (cnt1 - n) fs s)
3231+ processL (fstep fs b) n SepBy1InitR
3234+ return $ Done cnt1 xs
3236+ {-# INLINE processR #-}
3237+ processR cnt fs n = do
3240+ IPartial ps -> return $ Continue n (SepBy1L cnt fs ps)
3241+ IDone _ -> errMsg "left" "succeed"
3242+ IError _ -> errMsg "left" "fail"
3244+ {-# INLINE runStepR #-}
3245+ runStepR cnt fs sR a = do
3249+ Partial n s -> return $ Continue n (SepBy1R (cnt1 - n) fs s)
3250+ Continue n s -> return $ Continue n (SepBy1R (cnt1 - n) fs s)
3251+ Done n _ -> processR (cnt1 - n) fs n
3254+ return $ Done cnt1 xs
3256+ step (SepBy1InitL cnt fs sL) a = runStepInitL cnt fs sL a
3257+ step (SepBy1L cnt fs sL) a = runStepL cnt fs sL a
3258+ step (SepBy1InitR fs) a = do
3261+ IPartial s -> runStepR 0 fs s a
3262+ IDone _ -> errMsg "right" "succeed"
3263+ IError _ -> errMsg "right" "fail"
3264+ step (SepBy1R cnt fs sR) a = runStepR cnt fs sR a
3266+ {-# INLINE extractResult #-}
3267+ extractResult n fs r = do
3270+ FL.Partial fs1 -> fmap (Done n) $ fextract fs1
3271+ FL.Done c -> return (Done n c)
3273+ extract (SepBy1InitL cnt fs sL) = do
3276+ Done n b -> extractResult n fs b
3277+ Continue n s -> return $ Continue n (SepBy1InitL (cnt - n) fs s)
3278+ Partial _ _ -> error "Partial in extract"
3279+ Error err -> return $ Error err
3280+ extract (SepBy1L cnt fs sL) = do
3283+ Done n b -> extractResult n fs b
3284+ Continue n s -> return $ Continue n (SepBy1L (cnt - n) fs s)
3285+ Partial _ _ -> error "Partial in extract"
3288+ return $ Done cnt xs
3289+ extract (SepBy1InitR fs) = fmap (Done 0) $ fextract fs
3290+ extract (SepBy1R cnt fs _) = fmap (Done cnt) $ fextract fs
2566-------------------------------------------------------------------------------
3292-------------------------------------------------------------------------------
2567-- Interleaving a collection of parsers
3293-- Interleaving a collection of parsers