@@ -146,6 +146,7 @@ module Streamly.Internal.Data.Parser.ParserD
146146 , takeFramedByGeneric
147147 , wordFramedBy
148148 , wordQuotedBy
149+ , blockQuotedBy
149150
150151 -- Matching strings
151152 -- , prefixOf -- match any prefix of a given string
@@ -1588,6 +1589,11 @@ data WordQuotedState s b a =
15881589 | WordQuotedEsc !s !Int !a !a
15891590 | WordQuotedSkipPost !b
15901591
1592+-- XXX If quote start and end chars are different then quotes can be nested
1593+-- without escaping. However, is there a case for the use of nested quotes?
1594+
1595+-- XXX Simplify like blockQuotedBy
1596+
15911597-- | Like 'wordFramedBy' but the closing quote is determined by the opening
15921598-- quote. The first quote begin starts a quote that is closed by its
15931599-- corresponding closing quote.
@@ -1714,6 +1720,98 @@ wordQuotedBy keepQuotes isEsc toRight isEnd isSep
17141720 err "wordQuotedBy: trailing escape"
17151721 extract (WordQuotedSkipPost b) = return (Done 0 b)
17161722
1723+data BlockParseState s =
1724+ BlockInit !s
1725+ | BlockUnquoted !Int !s
1726+ | BlockQuoted !Int !s
1727+ | BlockQuotedEsc !Int !s
1728+
1729+-- Blocks can be of different types e.g. {} or (). We only parse from the
1730+-- perspective of the outermost block type. The nesting of that block are
1731+-- checked. Any other block types nested inside it are opaque to us and can be
1732+-- parsed when the contents of the block are parsed.
1733+
1734+-- XXX Put a limit on nest level to keep the API safe.
1735+
1736+-- | Parse a block using block enclosed by open, close identifiers, block
1737+-- identifiers inside quotes are ignored. Quoting characters can be escaped. A
1738+-- block can have a nested block inside it.
1739+--
1740+-- Block chars and quote chars must not overlap. Block start and end chars must
1741+-- not be the same for nesting without escaping.
1742+--
1743+-- >>> p = Parser.blockQuotedBy '{' '}' '"' '\\' Fold.toList
1744+-- >>> Stream.parse p $ Stream.fromList "{msg: \"hello world\"}"
1745+-- Right "msg: \"hello world\""
1746+--
1747+{-# INLINE blockQuotedBy #-}
1748+blockQuotedBy :: (Monad m, Eq a) =>
1749+ a -- ^ Block opening char
1750+ -> a -- ^ Block closing char
1751+ -> a -- ^ quote char
1752+ -> a -- ^ escape char
1753+ -> Fold m a b
1754+ -> Parser a m b
1755+blockQuotedBy bopen bclose quote esc
1756+ (Fold fstep finitial fextract) =
1757+ Parser step initial extract
1758+
1759+ where
1760+
1761+ initial = do
1762+ res <- finitial
1763+ return $
1764+ case res of
1765+ FL.Partial s -> IPartial (BlockInit s)
1766+ FL.Done _ ->
1767+ error "wordQuotedBy: fold finished without input"
1768+
1769+ {-# INLINE process #-}
1770+ process s a nextState = do
1771+ res <- fstep s a
1772+ return
1773+ $ case res of
1774+ FL.Partial s1 -> Continue 0 (nextState s1)
1775+ FL.Done b -> Done 0 b
1776+
1777+ step (BlockInit s) a =
1778+ return
1779+ $ if a == bopen
1780+ then Continue 0 $ BlockUnquoted 1 s
1781+ else Error "blockQuotedBy: missing block start"
1782+ step (BlockUnquoted level s) a =
1783+ if a == bopen
1784+ then process s a (BlockUnquoted (level + 1))
1785+ else
1786+ if a == bclose
1787+ then
1788+ if level == 1
1789+ then fmap (Done 0) (fextract s)
1790+ else process s a (BlockUnquoted (level - 1))
1791+ else
1792+ if a == quote
1793+ then process s a (BlockQuoted level)
1794+ else process s a (BlockUnquoted level)
1795+ step (BlockQuoted level s) a
1796+ | a == esc = process s a (BlockQuotedEsc level)
1797+ | otherwise =
1798+ if a == quote
1799+ then process s a (BlockUnquoted level)
1800+ else process s a (BlockQuoted level)
1801+ step (BlockQuotedEsc level s) a = process s a (BlockQuoted level)
1802+
1803+ err = return . Error
1804+
1805+ extract (BlockInit s) = fmap (Done 0) $ fextract s
1806+ extract (BlockUnquoted level _) =
1807+ err $ "blockQuotedBy: finished at block nest level " ++ show level
1808+ extract (BlockQuoted level _) =
1809+ err $ "blockQuotedBy: finished, inside an unfinished quote, "
1810+ ++ "at block nest level " ++ show level
1811+ extract (BlockQuotedEsc level _) =
1812+ err $ "blockQuotedBy: finished, inside an unfinished quote, "
1813+ ++ "after an escape char, at block nest level " ++ show level
1814+
17171815{-# ANN type GroupByState Fuse #-}
17181816data GroupByState a s
17191817 = GroupByInit !s