@@ -1121,6 +1121,99 @@ takeFramedByGeneric esc begin end (Fold fstep finitial fextract) =
11211121 Nothing -> err "takeFramedByGeneric: missing closing frame"
11221122 extract (FrameEscEsc _ _) = err "takeFramedByGeneric: trailing escape"
11231123
1124+data BlockParseState s =
1125+ BlockInit !s
1126+ | BlockUnquoted !Int !s
1127+ | BlockQuoted !Int !s
1128+ | BlockQuotedEsc !Int !s
1129+
1130+-- Blocks can be of different types e.g. {} or (). We only parse from the
1131+-- perspective of the outermost block type. The nesting of that block are
1132+-- checked. Any other block types nested inside it are opaque to us and can be
1133+-- parsed when the contents of the block are parsed.
1134+
1135+-- XXX Put a limit on nest level to keep the API safe.
1136+
1137+-- | Parse a block enclosed within open, close brackets. Block contents may be
1138+-- quoted, brackets inside quotes are ignored. Quoting characters can be used
1139+-- within quotes if escaped. A block can have a nested block inside it.
1140+--
1141+-- Quote begin and end chars are the same. Block brackets and quote chars must
1142+-- not overlap. Block start and end brackets must be different for nesting
1143+-- blocks within blocks.
1144+--
1145+-- >>> p = Parser.blockWithQuotes (== '\\') (== '"') '{' '}' Fold.toList
1146+-- >>> Stream.parse p $ Stream.fromList "{msg: \"hello world\"}"
1147+-- Right "msg: \"hello world\""
1148+--
1149+{-# INLINE blockWithQuotes #-}
1150+blockWithQuotes :: (Monad m, Eq a) =>
1151+ (a -> Bool) -- ^ escape char
1152+ -> (a -> Bool) -- ^ quote char, to quote inside brackets
1153+ -> a -- ^ Block opening bracket
1154+ -> a -- ^ Block closing bracket
1155+ -> Fold m a b
1156+ -> Parser a m b
1157+blockWithQuotes isEsc isQuote bopen bclose
1158+ (Fold fstep finitial fextract) =
1159+ Parser step initial extract
1160+
1161+ where
1162+
1163+ initial = do
1164+ res <- finitial
1165+ return $
1166+ case res of
1167+ FL.Partial s -> IPartial (BlockInit s)
1168+ FL.Done _ ->
1169+ error "blockWithQuotes: fold finished without input"
1170+
1171+ {-# INLINE process #-}
1172+ process s a nextState = do
1173+ res <- fstep s a
1174+ return
1175+ $ case res of
1176+ FL.Partial s1 -> Continue 0 (nextState s1)
1177+ FL.Done b -> Done 0 b
1178+
1179+ step (BlockInit s) a =
1180+ return
1181+ $ if a == bopen
1182+ then Continue 0 $ BlockUnquoted 1 s
1183+ else Error "blockWithQuotes: missing block start"
1184+ step (BlockUnquoted level s) a =
1185+ if a == bopen
1186+ then process s a (BlockUnquoted (level + 1))
1187+ else
1188+ if a == bclose
1189+ then
1190+ if level == 1
1191+ then fmap (Done 0) (fextract s)
1192+ else process s a (BlockUnquoted (level - 1))
1193+ else
1194+ if isQuote a
1195+ then process s a (BlockQuoted level)
1196+ else process s a (BlockUnquoted level)
1197+ step (BlockQuoted level s) a
1198+ | isEsc a = process s a (BlockQuotedEsc level)
1199+ | otherwise =
1200+ if isQuote a
1201+ then process s a (BlockUnquoted level)
1202+ else process s a (BlockQuoted level)
1203+ step (BlockQuotedEsc level s) a = process s a (BlockQuoted level)
1204+
1205+ err = return . Error
1206+
1207+ extract (BlockInit s) = fmap (Done 0) $ fextract s
1208+ extract (BlockUnquoted level _) =
1209+ err $ "blockWithQuotes: finished at block nest level " ++ show level
1210+ extract (BlockQuoted level _) =
1211+ err $ "blockWithQuotes: finished, inside an unfinished quote, "
1212+ ++ "at block nest level " ++ show level
1213+ extract (BlockQuotedEsc level _) =
1214+ err $ "blockWithQuotes: finished, inside an unfinished quote, "
1215+ ++ "after an escape char, at block nest level " ++ show level
1216+
11241217-- | @takeEndBy cond parser@ parses a token that ends by a separator chosen by
11251218-- the supplied predicate. The separator is also taken with the token.
11261219--
@@ -1781,99 +1874,6 @@ wordStripQuotes :: (Monad m, Eq a) =>
17811874 -> Parser a m b
17821875wordStripQuotes = wordWithQuotesWith (const False) False
17831876
1784−data BlockParseState s =
1785− BlockInit !s
1786− | BlockUnquoted !Int !s
1787− | BlockQuoted !Int !s
1788− | BlockQuotedEsc !Int !s
1789−
1790−-- Blocks can be of different types e.g. {} or (). We only parse from the
1791−-- perspective of the outermost block type. The nesting of that block are
1792−-- checked. Any other block types nested inside it are opaque to us and can be
1793−-- parsed when the contents of the block are parsed.
1794−
1795−-- XXX Put a limit on nest level to keep the API safe.
1796−
1797−-- | Parse a block enclosed within open, close brackets. Block contents may be
1798−-- quoted, brackets inside quotes are ignored. Quoting characters can be used
1799−-- within quotes if escaped. A block can have a nested block inside it.
1800−--
1801−-- Quote begin and end chars are the same. Block brackets and quote chars must
1802−-- not overlap. Block start and end brackets must be different for nesting
1803−-- blocks within blocks.
1804−--
1805−-- >>> p = Parser.blockWithQuotes (== '\\') (== '"') '{' '}' Fold.toList
1806−-- >>> Stream.parse p $ Stream.fromList "{msg: \"hello world\"}"
1807−-- Right "msg: \"hello world\""
1808−--
1809−{-# INLINE blockWithQuotes #-}
1810−blockWithQuotes :: (Monad m, Eq a) =>
1811− (a -> Bool) -- ^ escape char
1812− -> (a -> Bool) -- ^ quote char, to quote inside brackets
1813− -> a -- ^ Block opening bracket
1814− -> a -- ^ Block closing bracket
1815− -> Fold m a b
1816− -> Parser a m b
1817−blockWithQuotes isEsc isQuote bopen bclose
1818− (Fold fstep finitial fextract) =
1819− Parser step initial extract
1820−
1821− where
1822−
1823− initial = do
1824− res <- finitial
1825− return $
1826− case res of
1827− FL.Partial s -> IPartial (BlockInit s)
1828− FL.Done _ ->
1829− error "blockWithQuotes: fold finished without input"
1830−
1831− {-# INLINE process #-}
1832− process s a nextState = do
1833− res <- fstep s a
1834− return
1835− $ case res of
1836− FL.Partial s1 -> Continue 0 (nextState s1)
1837− FL.Done b -> Done 0 b
1838−
1839− step (BlockInit s) a =
1840− return
1841− $ if a == bopen
1842− then Continue 0 $ BlockUnquoted 1 s
1843− else Error "blockWithQuotes: missing block start"
1844− step (BlockUnquoted level s) a =
1845− if a == bopen
1846− then process s a (BlockUnquoted (level + 1))
1847− else
1848− if a == bclose
1849− then
1850− if level == 1
1851− then fmap (Done 0) (fextract s)
1852− else process s a (BlockUnquoted (level - 1))
1853− else
1854− if isQuote a
1855− then process s a (BlockQuoted level)
1856− else process s a (BlockUnquoted level)
1857− step (BlockQuoted level s) a
1858− | isEsc a = process s a (BlockQuotedEsc level)
1859− | otherwise =
1860− if isQuote a
1861− then process s a (BlockUnquoted level)
1862− else process s a (BlockQuoted level)
1863− step (BlockQuotedEsc level s) a = process s a (BlockQuoted level)
1864−
1865− err = return . Error
1866−
1867− extract (BlockInit s) = fmap (Done 0) $ fextract s
1868− extract (BlockUnquoted level _) =
1869− err $ "blockWithQuotes: finished at block nest level " ++ show level
1870− extract (BlockQuoted level _) =
1871− err $ "blockWithQuotes: finished, inside an unfinished quote, "
1872− ++ "at block nest level " ++ show level
1873− extract (BlockQuotedEsc level _) =
1874− err $ "blockWithQuotes: finished, inside an unfinished quote, "
1875− ++ "after an escape char, at block nest level " ++ show level
1876−
18771877{-# ANN type GroupByState Fuse #-}
18781878data GroupByState a s
18791879 = GroupByInit !s