git.iko.soy/streamly
on master help sign in
Use parserK by default and rewrite to ParserD
dde9041Harendra Kumar
benchmark/Chart.hs+7
compare with master
unifiedsplit
@@ -30,6 +30,7 @@ data BenchType
30 | NestedConcurrent
30 | NestedConcurrent
31 | ParserD
31 | ParserD
32 | ParserK
32 | ParserK
33+ | Parser
33 | Base
34 | Base
34 | FileIO
35 | FileIO
35 | Array
36 | Array
@@ -84,6 +85,7 @@ parseBench = do
84 Just "nested-concurrent" -> setBenchType NestedConcurrent
85 Just "nested-concurrent" -> setBenchType NestedConcurrent
85 Just "parserD" -> setBenchType ParserD
86 Just "parserD" -> setBenchType ParserD
86 Just "parserK" -> setBenchType ParserK
87 Just "parserK" -> setBenchType ParserK
88+ Just "parser" -> setBenchType Parser
87 Just "base" -> setBenchType Base
89 Just "base" -> setBenchType Base
88 Just "fileio" -> setBenchType FileIO
90 Just "fileio" -> setBenchType FileIO
89 Just "array-cmp" -> setBenchType ArrayCmp
91 Just "array-cmp" -> setBenchType ArrayCmp
@@ -374,6 +376,11 @@ main = do
374 (makeGraphs "parserK")
376 (makeGraphs "parserK")
375 "charts/parserK/results.csv"
377 "charts/parserK/results.csv"
376 "charts/parserK"
378 "charts/parserK"
379+ Parser -> benchShow opts cfg
380+ { title = Just "Parser" }
381+ (makeGraphs "parser")
382+ "charts/parser/results.csv"
383+ "charts/parser"
377 FileIO -> benchShow opts cfg
384 FileIO -> benchShow opts cfg
378 { title = Just "File IO" }
385 { title = Just "File IO" }
379 (makeGraphs "fileIO")
386 (makeGraphs "fileIO")
benchmark/Streamly/Benchmark/Data/Parser.hsnew file+229
@@ -0,0 +1,229 @@
1+-- |
2+-- Module : Streamly.Benchmark.Data.Parser
3+-- Copyright : (c) 2020 Composewell Technologies
4+--
5+-- License : MIT
6+-- Maintainer : streamly@composewell.com
7+
8+{-# LANGUAGE FlexibleContexts #-}
9+{-# OPTIONS_GHC -fspec-constr-recursive=4 #-}
10+
11+module Main
12+ (
13+ main
14+ ) where
15+
16+import Control.DeepSeq (NFData(..))
17+import Control.Monad.Catch (MonadCatch)
18+import Data.Foldable (asum)
19+import System.Random (randomRIO)
20+import Prelude hiding (any, all, take, sequence, sequenceA, takeWhile)
21+
22+import qualified Data.Traversable as TR
23+import qualified Control.Applicative as AP
24+import qualified Streamly as S hiding (runStream)
25+import qualified Streamly.Prelude as S
26+import qualified Streamly.Internal.Data.Fold as FL
27+import qualified Streamly.Internal.Data.Parser as PR
28+import qualified Streamly.Internal.Prelude as IP
29+
30+import Gauge
31+import Streamly hiding (runStream)
32+import Streamly.Benchmark.Common
33+
34+-------------------------------------------------------------------------------
35+-- Utilities
36+-------------------------------------------------------------------------------
37+
38+-- XXX these can be moved to the common module
39+
40+{-# INLINE sourceUnfoldrM #-}
41+sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
42+sourceUnfoldrM value n = S.unfoldrM step n
43+ where
44+ step cnt =
45+ if cnt > n + value
46+ then return Nothing
47+ else return (Just (cnt, cnt + 1))
48+
49+-- | Takes a fold method, and uses it with a default source.
50+{-# INLINE benchIOSink #-}
51+benchIOSink
52+ :: (IsStream t, NFData b)
53+ => Int -> String -> (t IO Int -> IO b) -> Benchmark
54+benchIOSink value name f =
55+ bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldrM value
56+
57+-------------------------------------------------------------------------------
58+-- Parsers
59+-------------------------------------------------------------------------------
60+
61+{-# INLINE any #-}
62+any :: (MonadCatch m, Ord a) => a -> SerialT m a -> m Bool
63+any value = IP.parse (PR.any (> value))
64+
65+{-# INLINE all #-}
66+all :: (MonadCatch m, Ord a) => a -> SerialT m a -> m Bool
67+all value = IP.parse (PR.all (<= value))
68+
69+{-# INLINE take #-}
70+take :: MonadCatch m => Int -> SerialT m a -> m ()
71+take value = IP.parse (PR.take value FL.drain)
72+
73+{-# INLINE takeWhile #-}
74+takeWhile :: MonadCatch m => Int -> SerialT m Int -> m ()
75+takeWhile value = IP.parse (PR.takeWhile (<= value) FL.drain)
76+
77+{-# INLINE many #-}
78+many :: MonadCatch m => SerialT m Int -> m Int
79+many = IP.parse (PR.many FL.length (PR.satisfy (> 0)))
80+
81+{-# INLINE manyAlt #-}
82+manyAlt :: MonadCatch m => SerialT m Int -> m Int
83+manyAlt xs = do
84+ x <- IP.parse (AP.many (PR.satisfy (> 0))) xs
85+ return $ Prelude.length x
86+
87+{-# INLINE some #-}
88+some :: MonadCatch m => SerialT m Int -> m Int
89+some = IP.parse (PR.some FL.length (PR.satisfy (> 0)))
90+
91+{-# INLINE someAlt #-}
92+someAlt :: MonadCatch m => SerialT m Int -> m Int
93+someAlt xs = do
94+ x <- IP.parse (AP.some (PR.satisfy (> 0))) xs
95+ return $ Prelude.length x
96+
97+{-# INLINE manyTill #-}
98+manyTill :: MonadCatch m => Int -> SerialT m Int -> m Int
99+manyTill value =
100+ IP.parse (PR.manyTill FL.length (PR.satisfy (> 0)) (PR.satisfy (== value)))
101+
102+{-# INLINE splitAllAny #-}
103+splitAllAny :: MonadCatch m
104+ => Int -> SerialT m Int -> m (Bool, Bool)
105+splitAllAny value =
106+ IP.parse ((,) <$> PR.all (<= (value `div` 2)) <*> PR.any (> value))
107+
108+{-# INLINE splitWithAllAny #-}
109+splitWithAllAny :: MonadCatch m
110+ => Int -> SerialT m Int -> m (Bool, Bool)
111+splitWithAllAny value =
112+ IP.parse (PR.splitWith (,) (PR.all (<= (value `div` 2))) (PR.any (> value)))
113+
114+{-# INLINE teeAllAny #-}
115+teeAllAny :: (MonadCatch m, Ord a)
116+ => a -> SerialT m a -> m (Bool, Bool)
117+teeAllAny value =
118+ IP.parse (PR.teeWith (,) (PR.all (<= value)) (PR.any (> value)))
119+
120+{-# INLINE teeFstAllAny #-}
121+teeFstAllAny :: (MonadCatch m, Ord a)
122+ => a -> SerialT m a -> m (Bool, Bool)
123+teeFstAllAny value =
124+ IP.parse (PR.teeWithFst (,) (PR.all (<= value)) (PR.any (> value)))
125+
126+{-# INLINE shortestAllAny #-}
127+shortestAllAny :: (MonadCatch m, Ord a)
128+ => a -> SerialT m a -> m Bool
129+shortestAllAny value =
130+ IP.parse (PR.shortest (PR.all (<= value)) (PR.any (> value)))
131+
132+{-# INLINE longestAllAny #-}
133+longestAllAny :: (MonadCatch m, Ord a)
134+ => a -> SerialT m a -> m Bool
135+longestAllAny value =
136+ IP.parse (PR.longest (PR.all (<= value)) (PR.any (> value)))
137+
138+-------------------------------------------------------------------------------
139+-- Parsers in which -fspec-constr-recursive=16 is problematic
140+-------------------------------------------------------------------------------
141+
142+-- XXX -fspec-constr-recursive=16 makes GHC go beserk when compiling these.
143+-- We need to fix GHC so that we can have better control over that option or do
144+-- not have to rely on it.
145+--
146+{-# INLINE lookAhead #-}
147+lookAhead :: MonadCatch m => Int -> SerialT m Int -> m ()
148+lookAhead value =
149+ IP.parse (PR.lookAhead (PR.takeWhile (<= value) FL.drain) *> pure ())
150+
151+-- quadratic complexity
152+{-# INLINE sequenceA #-}
153+sequenceA :: MonadCatch m => Int -> SerialT m Int -> m Int
154+sequenceA value xs = do
155+ x <- IP.parse (TR.sequenceA (replicate value (PR.satisfy (> 0)))) xs
156+ return $ length x
157+
158+-- quadratic complexity
159+{-# INLINE sequence #-}
160+sequence :: MonadCatch m => Int -> SerialT m Int -> m Int
161+sequence value xs = do
162+ x <- IP.parse (TR.sequence (replicate value (PR.satisfy (> 0)))) xs
163+ return $ length x
164+
165+-- choice using the "Alternative" instance with direct style parser type has
166+-- quadratic performance complexity.
167+--
168+{-# INLINE choice #-}
169+choice :: MonadCatch m => Int -> SerialT m Int -> m Int
170+choice value =
171+ IP.parse (asum (replicate value (PR.satisfy (< 0)))
172+ AP.<|> PR.satisfy (> 0))
173+
174+-------------------------------------------------------------------------------
175+-- Benchmarks
176+-------------------------------------------------------------------------------
177+
178+o_1_space_serial_parse :: Int -> [Benchmark]
179+o_1_space_serial_parse value =
180+ [ benchIOSink value "any" $ any value
181+ , benchIOSink value "all" $ all value
182+ , benchIOSink value "take" $ take value
183+ , benchIOSink value "takeWhile" $ takeWhile value
184+ , benchIOSink value "split (all,any)" $ splitAllAny value
185+ , benchIOSink value "splitWith (all,any)" $ splitWithAllAny value
186+ , benchIOSink value "many" many
187+ , benchIOSink value "some" some
188+ , benchIOSink value "choice" $ choice value
189+ , benchIOSink value "tee (all,any)" $ teeAllAny value
190+ , benchIOSink value "teeFst (all,any)" $ teeFstAllAny value
191+ , benchIOSink value "shortest (all,any)" $ shortestAllAny value
192+ , benchIOSink value "longest (all,any)" $ longestAllAny value
193+ , benchIOSink value "sequenceA" $ sequenceA value
194+ , benchIOSink value "sequence" $ sequence value
195+ ]
196+
197+o_1_heap_serial_parse :: Int -> [Benchmark]
198+o_1_heap_serial_parse value =
199+ [ benchIOSink value "lookAhead" $ lookAhead value
200+ , benchIOSink value "manyAlt" manyAlt
201+ , benchIOSink value "someAlt" someAlt
202+ , benchIOSink value "manyTill" $ manyTill value
203+ ]
204+
205+-------------------------------------------------------------------------------
206+-- Driver
207+-------------------------------------------------------------------------------
208+
209+main :: IO ()
210+main = do
211+ (value, cfg, benches) <- parseCLIOpts defaultStreamSize
212+ value `seq` runMode (mode cfg) cfg benches (allBenchmarks value)
213+
214+ where
215+
216+ allBenchmarks value =
217+ [ bgroup "o-1-space"
218+ [ bgroup "parser" $ concat
219+ [
220+ o_1_space_serial_parse value
221+ ]
222+ ]
223+ , bgroup "o-n-heap"
224+ [ bgroup "parser" $ concat
225+ [
226+ o_1_heap_serial_parse value
227+ ]
228+ ]
229+ ]
benchmark/Streamly/Benchmark/Data/ParserD.hs+28−22
@@ -20,6 +20,7 @@ import System.Random (randomRIO)
20import Prelude hiding (any, all, take, sequence, sequenceA, takeWhile)
20import Prelude hiding (any, all, take, sequence, sequenceA, takeWhile)
21
21
22import qualified Data.Traversable as TR
22import qualified Data.Traversable as TR
23+import qualified Data.Foldable as F
23import qualified Control.Applicative as AP
24import qualified Control.Applicative as AP
24import qualified Streamly as S hiding (runStream)
25import qualified Streamly as S hiding (runStream)
25import qualified Streamly.Prelude as S
26import qualified Streamly.Prelude as S
@@ -37,9 +38,6 @@ import Streamly.Benchmark.Common
37
38
38-- XXX these can be moved to the common module
39-- XXX these can be moved to the common module
39
40
40−-- We need a monadic bind here to make sure that the function f does not get
41−-- completely optimized out by the compiler in some cases.
42−
43{-# INLINE sourceUnfoldrM #-}
41{-# INLINE sourceUnfoldrM #-}
44sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
42sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
45sourceUnfoldrM value n = S.unfoldrM step n
43sourceUnfoldrM value n = S.unfoldrM step n
@@ -63,74 +61,76 @@ benchIOSink value name f =
63
61
64{-# INLINE any #-}
62{-# INLINE any #-}
65any :: (MonadThrow m, Ord a) => a -> SerialT m a -> m Bool
63any :: (MonadThrow m, Ord a) => a -> SerialT m a -> m Bool
66−any value = IP.parse (PR.any (> value))
64+any value = IP.parseD (PR.any (> value))
67
65
68{-# INLINE all #-}
66{-# INLINE all #-}
69all :: (MonadThrow m, Ord a) => a -> SerialT m a -> m Bool
67all :: (MonadThrow m, Ord a) => a -> SerialT m a -> m Bool
70−all value = IP.parse (PR.all (<= value))
68+all value = IP.parseD (PR.all (<= value))
71
69
72{-# INLINE take #-}
70{-# INLINE take #-}
73take :: MonadThrow m => Int -> SerialT m a -> m ()
71take :: MonadThrow m => Int -> SerialT m a -> m ()
74−take value = IP.parse (PR.take value FL.drain)
72+take value = IP.parseD (PR.take value FL.drain)
75
73
76{-# INLINE takeWhile #-}
74{-# INLINE takeWhile #-}
77takeWhile :: MonadThrow m => Int -> SerialT m Int -> m ()
75takeWhile :: MonadThrow m => Int -> SerialT m Int -> m ()
78−takeWhile value = IP.parse (PR.takeWhile (<= value) FL.drain)
76+takeWhile value = IP.parseD (PR.takeWhile (<= value) FL.drain)
79
77
80{-# INLINE many #-}
78{-# INLINE many #-}
81many :: MonadCatch m => SerialT m Int -> m Int
79many :: MonadCatch m => SerialT m Int -> m Int
82−many = IP.parse (PR.many FL.length (PR.satisfy (> 0)))
80+many = IP.parseD (PR.many FL.length (PR.satisfy (> 0)))
83
81
84{-# INLINE manyAlt #-}
82{-# INLINE manyAlt #-}
85manyAlt :: MonadCatch m => SerialT m Int -> m Int
83manyAlt :: MonadCatch m => SerialT m Int -> m Int
86manyAlt xs = do
84manyAlt xs = do
87− x <- IP.parse (AP.many (PR.satisfy (> 0))) xs
85+ x <- IP.parseD (AP.many (PR.satisfy (> 0))) xs
88 return $ Prelude.length x
86 return $ Prelude.length x
89
87
90{-# INLINE some #-}
88{-# INLINE some #-}
91some :: MonadCatch m => SerialT m Int -> m Int
89some :: MonadCatch m => SerialT m Int -> m Int
92−some = IP.parse (PR.some FL.length (PR.satisfy (> 0)))
90+some = IP.parseD (PR.some FL.length (PR.satisfy (> 0)))
93
91
94{-# INLINE someAlt #-}
92{-# INLINE someAlt #-}
95someAlt :: MonadCatch m => SerialT m Int -> m Int
93someAlt :: MonadCatch m => SerialT m Int -> m Int
96someAlt xs = do
94someAlt xs = do
97− x <- IP.parse (AP.some (PR.satisfy (> 0))) xs
95+ x <- IP.parseD (AP.some (PR.satisfy (> 0))) xs
98 return $ Prelude.length x
96 return $ Prelude.length x
99
97
100{-# INLINE manyTill #-}
98{-# INLINE manyTill #-}
101manyTill :: MonadCatch m => Int -> SerialT m Int -> m Int
99manyTill :: MonadCatch m => Int -> SerialT m Int -> m Int
102manyTill value =
100manyTill value =
101+ let p = PR.satisfy (> 0)
102+ pcond = PR.satisfy (== value)
103− IP.parse (PR.manyTill FL.length (PR.satisfy (> 0)) (PR.satisfy (== value)))
103+ in IP.parseD (PR.manyTill FL.length p pcond)
104
104
105{-# INLINE splitAllAny #-}
105{-# INLINE splitAllAny #-}
106splitAllAny :: MonadThrow m
106splitAllAny :: MonadThrow m
107 => Int -> SerialT m Int -> m (Bool, Bool)
107 => Int -> SerialT m Int -> m (Bool, Bool)
108splitAllAny value =
108splitAllAny value =
109− IP.parse ((,) <$> PR.all (<= (value `div` 2)) <*> PR.any (> value))
109+ IP.parseD ((,) <$> PR.all (<= (value `div` 2)) <*> PR.any (> value))
110
110
111{-# INLINE teeAllAny #-}
111{-# INLINE teeAllAny #-}
112teeAllAny :: (MonadThrow m, Ord a)
112teeAllAny :: (MonadThrow m, Ord a)
113 => a -> SerialT m a -> m (Bool, Bool)
113 => a -> SerialT m a -> m (Bool, Bool)
114teeAllAny value =
114teeAllAny value =
115− IP.parse (PR.teeWith (,) (PR.all (<= value)) (PR.any (> value)))
115+ IP.parseD (PR.teeWith (,) (PR.all (<= value)) (PR.any (> value)))
116
116
117{-# INLINE teeFstAllAny #-}
117{-# INLINE teeFstAllAny #-}
118teeFstAllAny :: (MonadThrow m, Ord a)
118teeFstAllAny :: (MonadThrow m, Ord a)
119 => a -> SerialT m a -> m (Bool, Bool)
119 => a -> SerialT m a -> m (Bool, Bool)
120teeFstAllAny value =
120teeFstAllAny value =
121− IP.parse (PR.teeWithFst (,) (PR.all (<= value)) (PR.any (> value)))
121+ IP.parseD (PR.teeWithFst (,) (PR.all (<= value)) (PR.any (> value)))
122
122
123{-# INLINE shortestAllAny #-}
123{-# INLINE shortestAllAny #-}
124shortestAllAny :: (MonadThrow m, Ord a)
124shortestAllAny :: (MonadThrow m, Ord a)
125 => a -> SerialT m a -> m Bool
125 => a -> SerialT m a -> m Bool
126shortestAllAny value =
126shortestAllAny value =
127− IP.parse (PR.shortest (PR.all (<= value)) (PR.any (> value)))
127+ IP.parseD (PR.shortest (PR.all (<= value)) (PR.any (> value)))
128
128
129{-# INLINE longestAllAny #-}
129{-# INLINE longestAllAny #-}
130longestAllAny :: (MonadCatch m, Ord a)
130longestAllAny :: (MonadCatch m, Ord a)
131 => a -> SerialT m a -> m Bool
131 => a -> SerialT m a -> m Bool
132longestAllAny value =
132longestAllAny value =
133− IP.parse (PR.longest (PR.all (<= value)) (PR.any (> value)))
133+ IP.parseD (PR.longest (PR.all (<= value)) (PR.any (> value)))
134
134
135-------------------------------------------------------------------------------
135-------------------------------------------------------------------------------
136-- Parsers in which -fspec-constr-recursive=16 is problematic
136-- Parsers in which -fspec-constr-recursive=16 is problematic
@@ -143,20 +143,25 @@ longestAllAny value =
143{-# INLINE lookAhead #-}
143{-# INLINE lookAhead #-}
144lookAhead :: MonadThrow m => Int -> SerialT m Int -> m ()
144lookAhead :: MonadThrow m => Int -> SerialT m Int -> m ()
145lookAhead value =
145lookAhead value =
146− IP.parse (PR.lookAhead (PR.takeWhile (<= value) FL.drain) *> pure ())
146+ IP.parseD (PR.lookAhead (PR.takeWhile (<= value) FL.drain) *> pure ())
147+
148+{-# INLINE sequenceA_ #-}
149+sequenceA_ :: MonadThrow m => Int -> SerialT m Int -> m ()
150+sequenceA_ value =
151+ IP.parseD (F.sequenceA_ $ replicate value (PR.satisfy (> 0)))
147
152
148-- quadratic complexity
153-- quadratic complexity
149{-# INLINE sequenceA #-}
154{-# INLINE sequenceA #-}
150sequenceA :: MonadThrow m => Int -> SerialT m Int -> m Int
155sequenceA :: MonadThrow m => Int -> SerialT m Int -> m Int
151sequenceA value xs = do
156sequenceA value xs = do
152− x <- IP.parse (TR.sequenceA (replicate value (PR.satisfy (> 0)))) xs
157+ x <- IP.parseD (TR.sequenceA (replicate value (PR.satisfy (> 0)))) xs
153 return $ length x
158 return $ length x
154
159
155-- quadratic complexity
160-- quadratic complexity
156{-# INLINE sequence #-}
161{-# INLINE sequence #-}
157sequence :: MonadThrow m => Int -> SerialT m Int -> m Int
162sequence :: MonadThrow m => Int -> SerialT m Int -> m Int
158sequence value xs = do
163sequence value xs = do
159− x <- IP.parse (TR.sequence (replicate value (PR.satisfy (> 0)))) xs
164+ x <- IP.parseD (TR.sequence (replicate value (PR.satisfy (> 0)))) xs
160 return $ length x
165 return $ length x
161
166
162-- choice using the "Alternative" instance with direct style parser type has
167-- choice using the "Alternative" instance with direct style parser type has
@@ -164,8 +169,8 @@ sequence value xs = do
164--
169--
165{-# INLINE choice #-}
170{-# INLINE choice #-}
166choice :: MonadCatch m => Int -> SerialT m Int -> m Int
171choice :: MonadCatch m => Int -> SerialT m Int -> m Int
167−choice value = do
172+choice value =
168− IP.parse (asum (replicate value (PR.satisfy (< 0)))
173+ IP.parseD (asum (replicate value (PR.satisfy (< 0)))
169 AP.<|> PR.satisfy (> 0))
174 AP.<|> PR.satisfy (> 0))
170
175
171-------------------------------------------------------------------------------
176-------------------------------------------------------------------------------
@@ -187,6 +192,7 @@ o_1_space_serial_parse value =
187 , benchIOSink value "shortest (all,any)" $ shortestAllAny value
192 , benchIOSink value "shortest (all,any)" $ shortestAllAny value
188 , benchIOSink value "longest (all,any)" $ longestAllAny value
193 , benchIOSink value "longest (all,any)" $ longestAllAny value
189 , benchIOSink value "sequenceA/100" $ sequenceA (value `div` 100)
194 , benchIOSink value "sequenceA/100" $ sequenceA (value `div` 100)
195+ , benchIOSink value "sequenceA_/100" $ sequenceA_ (value `div` 100)
190 , benchIOSink value "sequence/100" $ sequence (value `div` 100)
196 , benchIOSink value "sequence/100" $ sequence (value `div` 100)
191 ]
197 ]
192
198
benchmark/Streamly/Benchmark/Data/ParserK.hs+2−5
@@ -18,8 +18,8 @@ import Data.Foldable (asum)
18import System.Random (randomRIO)
18import System.Random (randomRIO)
19import Prelude hiding (any, all, take, sequence, sequenceA, takeWhile)
19import Prelude hiding (any, all, take, sequence, sequenceA, takeWhile)
20
20
21−import qualified Data.Traversable as TR
22import qualified Control.Applicative as AP
21import qualified Control.Applicative as AP
22+import qualified Data.Traversable as TR
23import qualified Streamly as S hiding (runStream)
23import qualified Streamly as S hiding (runStream)
24import qualified Streamly.Prelude as S
24import qualified Streamly.Prelude as S
25import qualified Streamly.Internal.Data.Parser.ParserK.Types as PR
25import qualified Streamly.Internal.Data.Parser.ParserK.Types as PR
@@ -36,9 +36,6 @@ import Streamly.Benchmark.Common
36
36
37-- XXX these can be moved to the common module
37-- XXX these can be moved to the common module
38
38
39−-- We need a monadic bind here to make sure that the function f does not get
40−-- completely optimized out by the compiler in some cases.
41−
42{-# INLINE sourceUnfoldrM #-}
39{-# INLINE sourceUnfoldrM #-}
43sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
40sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
44sourceUnfoldrM value n = S.unfoldrM step n
41sourceUnfoldrM value n = S.unfoldrM step n
@@ -108,7 +105,7 @@ someAlt xs = do
108
105
109{-# INLINE choice #-}
106{-# INLINE choice #-}
110choice :: MonadCatch m => Int -> SerialT m Int -> m Int
107choice :: MonadCatch m => Int -> SerialT m Int -> m Int
111−choice value = do
108+choice value =
112 IP.parseK (asum (replicate value (satisfy (< 0)))
109 IP.parseK (asum (replicate value (satisfy (< 0)))
113 AP.<|> satisfy (> 0))
110 AP.<|> satisfy (> 0))
114
111
benchmark/streamly-benchmarks.cabal+12
@@ -271,6 +271,18 @@ benchmark parserK
271 buildable: True
271 buildable: True
272 build-depends: exceptions >= 0.8 && < 0.11
272 build-depends: exceptions >= 0.8 && < 0.11
273
273
274+benchmark parser
275+ import: bench-options
276+ type: exitcode-stdio-1.0
277+ ghc-options: -with-rtsopts "-T -K36K -M32M"
278+ hs-source-dirs: Streamly/Benchmark/Data
279+ main-is: Parser.hs
280+ if impl(ghcjs)
281+ buildable: False
282+ else
283+ buildable: True
284+ build-depends: exceptions >= 0.8 && < 0.11
285+
274-------------------------------------------------------------------------------
286-------------------------------------------------------------------------------
275-- Raw Streams
287-- Raw Streams
276-------------------------------------------------------------------------------
288-------------------------------------------------------------------------------
src/Streamly/Internal/Data/Parser.hsnew file+871
@@ -0,0 +1,871 @@
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE RankNTypes #-}
3+{-# LANGUAGE ScopedTypeVariables #-}
4+
5+#if __GLASGOW_HASKELL__ >= 800
6+{-# OPTIONS_GHC -Wno-orphans #-}
7+#endif
8+
9+-- |
10+-- Module : Streamly.Internal.Data.Parser
11+-- Copyright : (c) 2020 Composewell Technologies
12+-- License : BSD3
13+-- Maintainer : streamly@composewell.com
14+-- Stability : experimental
15+-- Portability : GHC
16+--
17+-- Fast backtracking parsers with stream fusion and native streaming
18+-- capability.
19+--
20+-- 'Applicative' and 'Control.Applicative.Alternative' type class based
21+-- combinators from the
22+-- <http://hackage.haskell.org/package/parser-combinators parser-combinators>
23+-- package can also be used with the 'Parser' type. However, there are two
24+-- important differences between @parser-combinators@ and the equivalent ones
25+-- provided in this module in terms of performance:
26+--
27+-- 1) @parser-combinators@ use plain Haskell lists to collect the results, in a
28+-- strict Monad like IO, the results are necessarily buffered before they can
29+-- be consumed. This may not perform optimally in streaming applications
30+-- processing large amounts of data. Equivalent combinators in this module can
31+-- consume the results of parsing using a 'Fold', thus providing a scalability
32+-- and a composable consumer.
33+--
34+-- 2) Several combinators in this module can be many times faster because of
35+-- stream fusion. For example, 'Streamly.Internal.Data.Parser.many' combinator
36+-- in this module is much faster than the 'Control.Applicative.many' combinator
37+-- of 'Control.Applicative.Alternative' type class.
38+--
39+-- = Errors
40+--
41+-- Failing parsers in this module throw the 'D.ParseError' exception.
42+--
43+-- = Naming
44+--
45+-- As far as possible, try that the names of the combinators in this module are
46+-- consistent with:
47+--
48+-- * <https://hackage.haskell.org/package/base/docs/Text-ParserCombinators-ReadP.html base/Text.ParserCombinators.ReadP>
49+-- * <http://hackage.haskell.org/package/parser-combinators parser-combinators>
50+-- * <http://hackage.haskell.org/package/megaparsec megaparsec>
51+-- * <http://hackage.haskell.org/package/attoparsec attoparsec>
52+-- * <http://hackage.haskell.org/package/parsec parsec>
53+
54+module Streamly.Internal.Data.Parser
55+ (
56+ K.Parser (..)
57+ , D.ParseError (..)
58+ , D.Step (..)
59+
60+ -- First order parsers
61+ -- * Accumulators
62+ , fromFold
63+ , any
64+ , all
65+ , yield
66+ , yieldM
67+ , die
68+ , dieM
69+
70+ -- * Element parsers
71+ , peek
72+ , eof
73+ , satisfy
74+
75+ -- * Sequence parsers
76+ --
77+ -- | Parsers chained in series, if one parser terminates the composition
78+ -- terminates.
79+ --
80+ -- TODO: Currently we are using folds to collect the output of the parsers
81+ -- but we can use Parsers instead of folds to make the composition more
82+ -- powerful. For example, we can do:
83+ --
84+ -- @
85+ -- sliceSepByMax cond n p = sliceBy cond (take n p)
86+ -- sliceSepByBetween cond m n p = sliceBy cond (takeBetween m n p)
87+ -- takeWhileBetween cond m n p = takeWhile cond (takeBetween m n p)
88+ -- @
89+ --
90+ -- TODO: Like toList fold we can have toNonEmpty Parser to fold to a
91+ -- nonempty list. If we cannot collect even one element the parser will
92+ -- fail. toNonEmpty can be used in takeWhile to implement takeWhile1.
93+
94+ -- | Grab a sequence of input elements without inspecting them
95+ , take
96+ -- $take
97+ -- | Unimplemented
98+ --
99+ -- @
100+ -- , takeBetween
101+ -- , takeLE -- take -- takeBetween 0 n
102+ -- , takeLE1 -- take1 -- takeBetween 1 n
103+ -- @
104+ , takeEQ -- takeBetween n n
105+ , takeGE -- takeBetween n maxBound
106+
107+ -- Grab a sequence of input elements by inspecting them
108+ , lookAhead
109+ , takeWhile
110+ -- $takeWhile
111+ , takeWhile1
112+ , sliceSepBy
113+ , sliceSepByMax
114+ -- | Unimplemented
115+ --
116+ -- @
117+ -- , sliceSepByBetween
118+ -- @
119+ , sliceEndWith
120+ , sliceBeginWith
121+ -- | Unimplemented
122+ --
123+ -- @
124+ -- , sliceSepWith
125+ --
126+ -- , frameSepBy -- parse frames escaped by an escape char/sequence
127+ -- , frameEndWith
128+ -- @
129+ , wordBy
130+ , groupBy
131+ , eqBy
132+ -- | Unimplemented
133+ --
134+ -- @
135+ -- , prefixOf -- match any prefix of a given string
136+ -- , suffixOf -- match any suffix of a given string
137+ -- , infixOf -- match any substring of a given string
138+ -- @
139+
140+ -- Second order parsers (parsers using parsers)
141+ -- * Binary Combinators
142+
143+ -- ** Sequential Applicative
144+ , splitWith
145+ , split_
146+
147+ -- ** Parallel Applicatives
148+ , teeWith
149+ , teeWithFst
150+ , teeWithMin
151+ -- , teeTill -- like manyTill but parallel
152+
153+ -- ** Sequential Interleaving
154+ -- Use two folds, run a primary parser, its rejected values go to the
155+ -- secondary parser.
156+ , deintercalate
157+
158+ -- ** Sequential Alternative
159+ , alt
160+
161+ -- ** Parallel Alternatives
162+ , shortest
163+ , longest
164+ -- , fastest
165+
166+ -- * N-ary Combinators
167+ -- ** Sequential Collection
168+ , sequence
169+ , concatMap
170+
171+ -- ** Sequential Repetition
172+ , count
173+ , countBetween
174+ -- , countBetweenTill
175+
176+ , many
177+ , some
178+ , manyTill
179+
180+ -- ** Special cases
181+ -- | TODO: traditional implmentations of these may be of limited use. For
182+ -- example, consider parsing lines separated by @\\r\\n@. The main parser
183+ -- will have to detect and exclude the sequence @\\r\\n@ anyway so that we
184+ -- can apply the "sep" parser.
185+ --
186+ -- We can instead implement these as special cases of deintercalate.
187+ --
188+ -- @
189+ -- , endBy
190+ -- , sepBy
191+ -- , sepEndBy
192+ -- , beginBy
193+ -- , sepBeginBy
194+ -- , sepAroundBy
195+ -- @
196+
197+ -- * Distribution
198+ --
199+ -- | A simple and stupid impl would be to just convert the stream to an
200+ -- array and give the array reference to all consumers. The array can be
201+ -- grown on demand by any consumer and truncated when nonbody needs it.
202+
203+ -- ** Distribute to collection
204+ -- ** Distribute to repetition
205+
206+ -- ** Interleaved collection
207+ -- |
208+ --
209+ -- 1. Round robin
210+ -- 2. Priority based
211+
212+ -- ** Interleaved repetition
213+ -- | repeat one parser and when it fails run an error recovery parser
214+ -- e.g. to find a key frame in the stream after an error
215+
216+ -- ** Collection of Alternatives
217+ -- | Unimplemented
218+ --
219+ -- @
220+ -- , shortestN
221+ -- , longestN
222+ -- , fastestN -- first N successful in time
223+ -- , choiceN -- first N successful in position
224+ -- @
225+ , choice -- first successful in position
226+
227+ -- ** Repeated Alternatives
228+ -- |
229+ --
230+ -- @
231+ -- , retryMax -- try N times
232+ -- , retryUntil -- try until successful
233+ -- , retryUntilN -- try until successful n times
234+ -- @
235+ )
236+where
237+
238+import Control.Monad.Catch (MonadCatch)
239+import Prelude
240+ hiding (any, all, take, takeWhile, sequence, concatMap)
241+
242+import Streamly.Internal.Data.Fold.Types (Fold(..))
243+import Streamly.Internal.Data.Parser.ParserK.Types (Parser)
244+
245+import qualified Streamly.Internal.Data.Parser.ParserD as D
246+import qualified Streamly.Internal.Data.Parser.ParserK.Types as K
247+
248+-------------------------------------------------------------------------------
249+-- Upgrade folds to parses
250+-------------------------------------------------------------------------------
251+--
252+-- | Make a 'Parser' from a 'Fold'.
253+--
254+-- /Internal/
255+--
256+{-# INLINE fromFold #-}
257+fromFold :: MonadCatch m => Fold m a b -> Parser m a b
258+fromFold = D.toParserK . D.fromFold
259+
260+-------------------------------------------------------------------------------
261+-- Terminating but not failing folds
262+-------------------------------------------------------------------------------
263+--
264+-- |
265+-- >>> S.parse (PR.any (== 0)) $ S.fromList [1,0,1]
266+-- > True
267+--
268+{-# INLINE any #-}
269+any :: MonadCatch m => (a -> Bool) -> Parser m a Bool
270+any = D.toParserK . D.any
271+
272+-- |
273+-- >>> S.parse (PR.all (== 0)) $ S.fromList [1,0,1]
274+-- > False
275+--
276+{-# INLINE all #-}
277+all :: MonadCatch m => (a -> Bool) -> Parser m a Bool
278+all = D.toParserK . D.all
279+
280+-- This is the dual of stream "yield".
281+--
282+-- | A parser that always yields a pure value without consuming any input.
283+--
284+-- /Internal/
285+--
286+{-# INLINE [3] yield #-}
287+yield :: MonadCatch m => b -> Parser m a b
288+yield = D.toParserK . D.yield
289+{-# RULES "yield fallback to CPS" [2]
290+ forall a. D.toParserK (D.yield a) = K.yield a #-}
291+
292+-- This is the dual of stream "yieldM".
293+--
294+-- | A parser that always yields the result of an effectful action without
295+-- consuming any input.
296+--
297+-- /Internal/
298+--
299+{-# INLINE yieldM #-}
300+yieldM :: MonadCatch m => m b -> Parser m a b
301+yieldM = D.toParserK . D.yieldM
302+
303+-- This is the dual of "nil".
304+--
305+-- | A parser that always fails with an error message without consuming
306+-- any input.
307+--
308+-- /Internal/
309+--
310+{-# INLINE [3] die #-}
311+die :: MonadCatch m => String -> Parser m a b
312+die = D.toParserK . D.die
313+{-# RULES "die fallback to CPS" [2]
314+ forall a. D.toParserK (D.die a) = K.die a #-}
315+
316+-- This is the dual of "nilM".
317+--
318+-- | A parser that always fails with an effectful error message and without
319+-- consuming any input.
320+--
321+-- /Internal/
322+--
323+{-# INLINE dieM #-}
324+dieM :: MonadCatch m => m String -> Parser m a b
325+dieM = D.toParserK . D.dieM
326+
327+-------------------------------------------------------------------------------
328+-- Failing Parsers
329+-------------------------------------------------------------------------------
330+
331+-- | Peek the head element of a stream, without consuming it. Fails if it
332+-- encounters end of input.
333+--
334+-- >>> S.parse ((,) <$> PR.peek <*> PR.satisfy (> 0)) $ S.fromList [1]
335+-- (1,1)
336+--
337+-- @
338+-- peek = lookAhead (satisfy True)
339+-- @
340+--
341+-- /Internal/
342+--
343+{-# INLINE peek #-}
344+peek :: MonadCatch m => Parser m a a
345+peek = D.toParserK D.peek
346+
347+-- | Succeeds if we are at the end of input, fails otherwise.
348+--
349+-- >>> S.parse ((,) <$> PR.satisfy (> 0) <*> PR.eof) $ S.fromList [1]
350+-- > (1,())
351+--
352+-- /Internal/
353+--
354+{-# INLINE eof #-}
355+eof :: MonadCatch m => Parser m a ()
356+eof = D.toParserK D.eof
357+
358+-- | Returns the next element if it passes the predicate, fails otherwise.
359+--
360+-- >>> S.parse (PR.satisfy (== 1)) $ S.fromList [1,0,1]
361+-- > 1
362+--
363+-- /Internal/
364+--
365+{-# INLINE satisfy #-}
366+satisfy :: MonadCatch m => (a -> Bool) -> Parser m a a
367+satisfy = D.toParserK . D.satisfy
368+
369+-------------------------------------------------------------------------------
370+-- Taking elements
371+-------------------------------------------------------------------------------
372+--
373+-- $take
374+-- Note: this is called takeP in some parser libraries.
375+--
376+-- TODO Once we have terminating folds, this Parse should get replaced by Fold.
377+-- Alternatively, we can name it "chunkOf" and the corresponding time domain
378+-- combinator as "intervalOf" or even "chunk" and "interval".
379+
380+-- | Take at most @n@ input elements and fold them using the supplied fold.
381+--
382+-- Stops after @n@ elements.
383+-- Never fails.
384+--
385+-- >>> S.parse (PR.take 1 FL.toList) $ S.fromList [1]
386+-- [1]
387+--
388+-- @
389+-- S.chunksOf n f = S.splitParse (FL.take n f)
390+-- @
391+--
392+-- /Internal/
393+--
394+{-# INLINE take #-}
395+take :: MonadCatch m => Int -> Fold m a b -> Parser m a b
396+take n = D.toParserK . D.take n
397+
398+-- | Stops after taking exactly @n@ input elements.
399+--
400+-- * Stops - after @n@ elements.
401+-- * Fails - if the stream ends before it can collect @n@ elements.
402+--
403+-- >>> S.parse (PR.takeEQ 4 FL.toList) $ S.fromList [1,0,1]
404+-- > "takeEQ: Expecting exactly 4 elements, got 3"
405+--
406+-- /Internal/
407+--
408+{-# INLINE takeEQ #-}
409+takeEQ :: MonadCatch m => Int -> Fold m a b -> Parser m a b
410+takeEQ n = D.toParserK . D.takeEQ n
411+
412+-- | Take at least @n@ input elements, but can collect more.
413+--
414+-- * Stops - never.
415+-- * Fails - if the stream end before producing @n@ elements.
416+--
417+-- >>> S.parse (PR.takeGE 4 FL.toList) $ S.fromList [1,0,1]
418+-- > "takeGE: Expecting at least 4 elements, got only 3"
419+--
420+-- >>> S.parse (PR.takeGE 4 FL.toList) $ S.fromList [1,0,1,0,1]
421+-- > [1,0,1,0,1]
422+--
423+-- /Internal/
424+--
425+{-# INLINE takeGE #-}
426+takeGE :: MonadCatch m => Int -> Fold m a b -> Parser m a b
427+takeGE n = D.toParserK . D.takeGE n
428+
429+-- $takeWhile
430+-- Note: This is called @takeWhileP@ and @munch@ in some parser libraries.
431+
432+-- | Collect stream elements until an element fails the predicate. The element
433+-- on which the predicate fails is returned back to the input stream.
434+--
435+-- * Stops - when the predicate fails.
436+-- * Fails - never.
437+--
438+-- >>> S.parse (PR.takeWhile (== 0) FL.toList) $ S.fromList [0,0,1,0,1]
439+-- > [0,0]
440+--
441+-- We can implement a @breakOn@ using 'takeWhile':
442+--
443+-- @
444+-- breakOn p = takeWhile (not p)
445+-- @
446+--
447+-- /Internal/
448+--
449+{-# INLINE takeWhile #-}
450+takeWhile :: MonadCatch m => (a -> Bool) -> Fold m a b -> Parser m a b
451+takeWhile cond = D.toParserK . D.takeWhile cond
452+
453+-- | Like 'takeWhile' but takes at least one element otherwise fails.
454+--
455+-- /Internal/
456+--
457+{-# INLINE takeWhile1 #-}
458+takeWhile1 :: MonadCatch m => (a -> Bool) -> Fold m a b -> Parser m a b
459+takeWhile1 cond = D.toParserK . D.takeWhile1 cond
460+
461+-- | Collect stream elements until an element succeeds the predicate. Drop the
462+-- element on which the predicate succeeded. The succeeding element is treated
463+-- as an infix separator which is dropped from the output.
464+--
465+-- * Stops - when the predicate succeeds.
466+-- * Fails - never.
467+--
468+-- >>> S.parse (PR.sliceSepBy (== 1) FL.toList) $ S.fromList [0,0,1,0,1]
469+-- > [0,0]
470+--
471+-- S.splitOn pred f = S.splitParse (PR.sliceSepBy pred f)
472+--
473+-- >>> S.toList $ S.splitParse (PR.sliceSepBy (== 1) FL.toList) $ S.fromList [0,0,1,0,1]
474+-- > [[0,0],[0],[]]
475+--
476+-- /Internal/
477+--
478+{-# INLINABLE sliceSepBy #-}
479+sliceSepBy :: MonadCatch m => (a -> Bool) -> Fold m a b -> Parser m a b
480+sliceSepBy cond = D.toParserK . D.sliceSepBy cond
481+
482+-- | Collect stream elements until an element succeeds the predicate. Also take
483+-- the element on which the predicate succeeded. The succeeding element is
484+-- treated as a suffix separator which is kept in the output segement.
485+--
486+-- * Stops - when the predicate succeeds.
487+-- * Fails - never.
488+--
489+-- S.splitWithSuffix pred f = S.splitParse (PR.sliceEndWith pred f)
490+--
491+-- /Unimplemented/
492+--
493+{-# INLINABLE sliceEndWith #-}
494+sliceEndWith ::
495+ -- Monad m =>
496+ (a -> Bool) -> Fold m a b -> Parser m a b
497+sliceEndWith = undefined
498+
499+-- | Collect stream elements until an elements passes the predicate, return the
500+-- last element on which the predicate succeeded back to the input stream. If
501+-- the predicate succeeds on the first element itself then it is kept in the
502+-- stream and we continue collecting. The succeeding element is treated as a
503+-- prefix separator which is kept in the output segement.
504+--
505+-- * Stops - when the predicate succeeds in non-leading position.
506+-- * Fails - never.
507+--
508+-- S.splitWithPrefix pred f = S.splitParse (PR.sliceBeginWith pred f)
509+--
510+-- /Unimplemented/
511+--
512+{-# INLINABLE sliceBeginWith #-}
513+sliceBeginWith ::
514+ -- Monad m =>
515+ (a -> Bool) -> Fold m a b -> Parser m a b
516+sliceBeginWith = undefined
517+
518+-- | Split using a condition or a count whichever occurs first. This is a
519+-- hybrid of 'splitOn' and 'take'. The element on which the condition succeeds
520+-- is dropped.
521+--
522+-- /Internal/
523+--
524+{-# INLINABLE sliceSepByMax #-}
525+sliceSepByMax :: MonadCatch m
526+ => (a -> Bool) -> Int -> Fold m a b -> Parser m a b
527+sliceSepByMax cond cnt = D.toParserK . D.sliceSepByMax cond cnt
528+
529+-- | Like 'splitOn' but strips leading, trailing, and repeated separators.
530+-- Therefore, @".a..b."@ having '.' as the separator would be parsed as
531+-- @["a","b"]@. In other words, its like parsing words from whitespace
532+-- separated text.
533+--
534+-- * Stops - when it finds a word separator after a non-word element
535+-- * Fails - never.
536+--
537+-- @
538+-- S.wordsBy pred f = S.splitParse (PR.wordBy pred f)
539+-- @
540+--
541+-- /Unimplemented/
542+--
543+{-# INLINABLE wordBy #-}
544+wordBy ::
545+ -- Monad m =>
546+ (a -> Bool) -> Fold m a b -> Parser m a b
547+wordBy = undefined
548+
549+-- | @groupBy cmp f $ S.fromList [a,b,c,...]@ assigns the element @a@ to the
550+-- first group, then if @a \`cmp` b@ is 'True' @b@ is also assigned to the same
551+-- group. If @a \`cmp` c@ is 'True' then @c@ is also assigned to the same
552+-- group and so on. When the comparison fails a new group is started. Each
553+-- group is folded using the 'Fold' @f@ and the result of the fold is emitted
554+-- in the output stream.
555+--
556+-- * Stops - when the comparison fails.
557+-- * Fails - never.
558+--
559+-- @
560+-- S.groupsBy cmp f = S.splitParse (PR.groupBy cmp f)
561+-- @
562+--
563+-- /Unimplemented/
564+--
565+{-# INLINABLE groupBy #-}
566+groupBy ::
567+ -- Monad m =>
568+ (a -> a -> Bool) -> Fold m a b -> Parser m a b
569+groupBy = undefined
570+
571+-- | Match the given sequence of elements using the given comparison function.
572+--
573+-- /Internal/
574+--
575+{-# INLINE eqBy #-}
576+eqBy :: MonadCatch m => (a -> a -> Bool) -> [a] -> Parser m a ()
577+eqBy cmp = D.toParserK . D.eqBy cmp
578+
579+-------------------------------------------------------------------------------
580+-- nested parsers
581+-------------------------------------------------------------------------------
582+
583+-- | Sequential parser application. Apply two parsers sequentially to an input
584+-- stream. The input is provided to the first parser, when it is done the
585+-- remaining input is provided to the second parser. If both the parsers
586+-- succeed their outputs are combined using the supplied function. The
587+-- operation fails if any of the parsers fail.
588+--
589+-- Note: This is a parsing dual of appending streams using
590+-- 'Streamly.Prelude.serial', it splits the streams using two parsers and zips
591+-- the results.
592+--
593+-- This implementation is strict in the second argument, therefore, the
594+-- following will fail:
595+--
596+-- >>> S.parse (PR.splitWith const (PR.satisfy (> 0)) undefined) $ S.fromList [1]
597+--
598+-- Compare with 'Applicative' instance method '<*>'. This implementation allows
599+-- stream fusion but has quadratic complexity. This can fuse with other
600+-- operations and can be faster than 'Applicative' instance for small number
601+-- (less than 8) of compositions.
602+--
603+-- /Internal/
604+--
605+{-# INLINE splitWith #-}
606+splitWith :: MonadCatch m
607+ => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
608+splitWith f p1 p2 =
609+ D.toParserK $ D.splitWith f (D.fromParserK p1) (D.fromParserK p2)
610+
611+-- | Sequential parser application ignoring the output of the first parser.
612+-- Apply two parsers sequentially to an input stream. The input is provided to
613+-- the first parser, when it is done the remaining input is provided to the
614+-- second parser. The output of the parser is the output of the second parser.
615+-- The operation fails if any of the parsers fail.
616+--
617+-- This implementation is strict in the second argument, therefore, the
618+-- following will fail:
619+--
620+-- >>> S.parse (split_ (PR.satisfy (> 0)) undefined) $ S.fromList [1]
621+--
622+-- Compare with 'Applicative' instance method '*>'. This implementation allows
623+-- stream fusion but has quadratic complexity. This can fuse with other
624+-- operations, and can be faster than 'Applicative' instance for small
625+-- number (less than 8) of compositions.
626+--
627+-- /Internal/
628+--
629+{-# INLINE split_ #-}
630+split_ :: MonadCatch m => Parser m x a -> Parser m x b -> Parser m x b
631+split_ p1 p2 = D.toParserK $ D.split_ (D.fromParserK p1) (D.fromParserK p2)
632+
633+-- | @teeWith f p1 p2@ distributes its input to both @p1@ and @p2@ until both
634+-- of them succeed or anyone of them fails and combines their output using @f@.
635+-- The parser succeeds if both the parsers succeed.
636+--
637+-- /Internal/
638+--
639+{-# INLINE teeWith #-}
640+teeWith :: MonadCatch m
641+ => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
642+teeWith f p1 p2 =
643+ D.toParserK $ D.teeWith f (D.fromParserK p1) (D.fromParserK p2)
644+
645+-- | Like 'teeWith' but ends parsing and zips the results, if available,
646+-- whenever the first parser ends.
647+--
648+-- /Internal/
649+--
650+{-# INLINE teeWithFst #-}
651+teeWithFst :: MonadCatch m
652+ => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
653+teeWithFst f p1 p2 =
654+ D.toParserK $ D.teeWithFst f (D.fromParserK p1) (D.fromParserK p2)
655+
656+-- | Like 'teeWith' but ends parsing and zips the results, if available,
657+-- whenever any of the parsers ends or fails.
658+--
659+-- /Unimplemented/
660+--
661+{-# INLINE teeWithMin #-}
662+teeWithMin :: MonadCatch m
663+ => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
664+teeWithMin f p1 p2 =
665+ D.toParserK $ D.teeWithMin f (D.fromParserK p1) (D.fromParserK p2)
666+
667+-- | Sequential alternative. Apply the input to the first parser and return the
668+-- result if the parser succeeds. If the first parser fails then backtrack and
669+-- apply the same input to the second parser and return the result.
670+--
671+-- Note: This implementation is not lazy in the second argument. The following
672+-- will fail:
673+--
674+-- >>> S.parse (PR.satisfy (> 0) `PR.alt` undefined) $ S.fromList [1..10]
675+--
676+-- Compare with 'Alternative' instance method '<|>'. This implementation allows
677+-- stream fusion but has quadratic complexity. This can fuse with other
678+-- operations and can be much faster than 'Alternative' instance for small
679+-- number (less than 8) of alternatives.
680+--
681+-- /Internal/
682+--
683+{-# INLINE alt #-}
684+alt :: MonadCatch m => Parser m x a -> Parser m x a -> Parser m x a
685+alt p1 p2 = D.toParserK $ D.alt (D.fromParserK p1) (D.fromParserK p2)
686+
687+-- | Shortest alternative. Apply both parsers in parallel but choose the result
688+-- from the one which consumed least input i.e. take the shortest succeeding
689+-- parse.
690+--
691+-- /Internal/
692+--
693+{-# INLINE shortest #-}
694+shortest :: MonadCatch m
695+ => Parser m x a -> Parser m x a -> Parser m x a
696+shortest p1 p2 = D.toParserK $ D.shortest (D.fromParserK p1) (D.fromParserK p2)
697+
698+-- | Longest alternative. Apply both parsers in parallel but choose the result
699+-- from the one which consumed more input i.e. take the longest succeeding
700+-- parse.
701+--
702+-- /Internal/
703+--
704+{-# INLINE longest #-}
705+longest :: MonadCatch m
706+ => Parser m x a -> Parser m x a -> Parser m x a
707+longest p1 p2 = D.toParserK $ D.longest (D.fromParserK p1) (D.fromParserK p2)
708+
709+-- | Run a parser without consuming the input.
710+--
711+-- /Internal/
712+--
713+{-# INLINE lookAhead #-}
714+lookAhead :: MonadCatch m => Parser m a b -> Parser m a b
715+lookAhead p = D.toParserK $ D.lookAhead $ D.fromParserK p
716+
717+-------------------------------------------------------------------------------
718+-- Interleaving
719+-------------------------------------------------------------------------------
720+--
721+-- To deinterleave we can chain two parsers one behind the other. The input is
722+-- given to the first parser and the input definitively rejected by the first
723+-- parser is given to the second parser.
724+--
725+-- We can either have the parsers themselves buffer the input or use the shared
726+-- global buffer to hold it until none of the parsers need it. When the first
727+-- parser returns Skip (i.e. rewind) we let the second parser consume the
728+-- rejected input and when it is done we move the cursor forward to the first
729+-- parser again. This will require a "move forward" command as well.
730+--
731+-- To implement grep we can use three parsers, one to find the pattern, one
732+-- to store the context behind the pattern and one to store the context in
733+-- front of the pattern. When a match occurs we need to emit the accumulator of
734+-- all the three parsers. One parser can count the line numbers to provide the
735+-- line number info.
736+--
737+-- | Apply two parsers alternately to an input stream. The input stream is
738+-- considered an interleaving of two patterns. The two parsers represent the
739+-- two patterns.
740+--
741+-- This undoes a "gintercalate" of two streams.
742+--
743+-- /Unimplemented/
744+--
745+{-# INLINE deintercalate #-}
746+deintercalate ::
747+ -- Monad m =>
748+ Fold m a y -> Parser m x a
749+ -> Fold m b z -> Parser m x b
750+ -> Parser m x (y, z)
751+deintercalate = undefined
752+
753+-------------------------------------------------------------------------------
754+-- Sequential Collection
755+-------------------------------------------------------------------------------
756+--
757+-- | @sequence f t@ collects sequential parses of parsers in the container @t@
758+-- using the fold @f@. Fails if the input ends or any of the parsers fail.
759+--
760+-- /Unimplemented/
761+--
762+{-# INLINE sequence #-}
763+sequence ::
764+ -- Foldable t =>
765+ Fold m b c -> t (Parser m a b) -> Parser m a c
766+sequence _f _p = undefined
767+
768+-- | Map a 'Parser' returning function on the result of a 'Parser'.
769+--
770+-- Compare with 'Monad' instance method '>>='. This implementation allows
771+-- stream fusion but has quadratic complexity. This can fuse with other
772+-- operations and can be much faster than 'Monad' instance for small number
773+-- (less than 8) of compositions.
774+--
775+-- /Internal/
776+--
777+{-# INLINE concatMap #-}
778+concatMap :: MonadCatch m
779+ => (b -> Parser m a c) -> Parser m a b -> Parser m a c
780+concatMap f p = D.toParserK $ D.concatMap (D.fromParserK . f) (D.fromParserK p)
781+
782+-------------------------------------------------------------------------------
783+-- Alternative Collection
784+-------------------------------------------------------------------------------
785+--
786+-- | @choice parsers@ applies the @parsers@ in order and returns the first
787+-- successful parse.
788+--
789+{-# INLINE choice #-}
790+choice ::
791+ -- Foldable t =>
792+ t (Parser m a b) -> Parser m a b
793+choice _ps = undefined
794+
795+-------------------------------------------------------------------------------
796+-- Sequential Repetition
797+-------------------------------------------------------------------------------
798+--
799+-- $many
800+-- TODO "many" is essentially a Fold because it cannot fail. So it can be
801+-- downgraded to a Fold. Or we can make the return type a Fold instead and
802+-- upgrade that to a parser when needed.
803+
804+-- | Collect zero or more parses. Apply the parser repeatedly on the input
805+-- stream, stop when the parser fails, accumulate zero or more parse results
806+-- using the supplied 'Fold'. This parser never fails, in case the first
807+-- application of parser fails it returns an empty result.
808+--
809+-- Compare with 'Control.Applicative.many'.
810+--
811+-- /Internal/
812+--
813+{-# INLINE many #-}
814+many :: MonadCatch m => Fold m b c -> Parser m a b -> Parser m a c
815+many f p = D.toParserK $ D.many f (D.fromParserK p)
816+-- many = countBetween 0 maxBound
817+
818+-- | Collect one or more parses. Apply the supplied parser repeatedly on the
819+-- input stream and accumulate the parse results as long as the parser
820+-- succeeds, stop when it fails. This parser fails if not even one result is
821+-- collected.
822+--
823+-- Compare with 'Control.Applicative.some'.
824+--
825+-- /Internal/
826+--
827+{-# INLINE some #-}
828+some :: MonadCatch m => Fold m b c -> Parser m a b -> Parser m a c
829+some f p = D.toParserK $ D.some f (D.fromParserK p)
830+-- some f p = many (takeGE 1 f) p
831+-- many = countBetween 1 maxBound
832+
833+-- | @countBetween m n f p@ collects between @m@ and @n@ sequential parses of
834+-- parser @p@ using the fold @f@. Stop after collecting @n@ results. Fails if
835+-- the input ends or the parser fails before @m@ results are collected.
836+--
837+-- /Unimplemented/
838+--
839+{-# INLINE countBetween #-}
840+countBetween ::
841+ -- MonadCatch m =>
842+ Int -> Int -> Fold m b c -> Parser m a b -> Parser m a c
843+countBetween _m _n _f = undefined
844+-- countBetween m n f p = many (takeBetween m n f) p
845+
846+-- | @count n f p@ collects exactly @n@ sequential parses of parser @p@ using
847+-- the fold @f@. Fails if the input ends or the parser fails before @n@
848+-- results are collected.
849+--
850+-- /Unimplemented/
851+--
852+{-# INLINE count #-}
853+count ::
854+ -- MonadCatch m =>
855+ Int -> Fold m b c -> Parser m a b -> Parser m a c
856+count n = countBetween n n
857+-- count n f p = many (takeEQ n f) p
858+
859+-- | @manyTill f collect test@ tries the parser @test@ on the input, if @test@
860+-- fails it backtracks and tries @collect@, after @collect@ succeeds @test@ is
861+-- tried again and so on. The parser stops when @test@ succeeds. The output of
862+-- @test@ is discarded and the output of @collect@ is accumulated by the
863+-- supplied fold. The parser fails if @collect@ fails.
864+--
865+-- /Internal/
866+--
867+{-# INLINE manyTill #-}
868+manyTill :: MonadCatch m
869+ => Fold m b c -> Parser m a b -> Parser m a x -> Parser m a c
870+manyTill f p1 p2 =
871+ D.toParserK $ D.manyTill f (D.fromParserK p1) (D.fromParserK p2)
src/Streamly/Internal/Data/Parser/ParserD.hs+73−219
@@ -2,6 +2,8 @@
2{-# LANGUAGE RankNTypes #-}
2{-# LANGUAGE RankNTypes #-}
3{-# LANGUAGE ScopedTypeVariables #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4
4
5+#include "inline.hs"
6+
5-- |
7-- |
6-- Module : Streamly.Internal.Data.Parser.ParserD
8-- Module : Streamly.Internal.Data.Parser.ParserD
7-- Copyright : (c) 2020 Composewell Technologies
9-- Copyright : (c) 2020 Composewell Technologies
@@ -10,40 +12,19 @@
10-- Stability : experimental
12-- Stability : experimental
11-- Portability : GHC
13-- Portability : GHC
12--
14--
13−-- Fast streaming parsers.
15+-- Direct style parser implementation with stream fusion.
14−--
15−-- 'Applicative' and 'Alternative' type class based combinators from the
16−-- <http://hackage.haskell.org/package/parser-combinators parser-combinators>
17−-- package can also be used with the 'Parser' type. However, there are two
18−-- important differences between @parser-combinators@ and the equivalent ones
19−-- provided in this module in terms of performance:
20−--
21−-- 1) @parser-combinators@ use plain Haskell lists to collect the results, in a
22−-- strict Monad like IO, the results are necessarily buffered before they can
23−-- be consumed. This may not perform optimally in streaming applications
24−-- processing large amounts of data. Equivalent combinators in this module can
25−-- consume the results of parsing using a 'Fold', thus providing a scalability
26−-- and a generic consumer.
27−--
28−-- 2) Several combinators in this module can be many times faster because of
29−-- stream fusion. For example, 'Streamly.Internal.Data.Parser.many' combinator
30−-- in this module is much faster than the 'Control.Applicative.many' combinator
31−-- of 'Alternative' type class.
32−--
33−-- Failing parsers in this module throw the 'ParseError' exception.
34−
35−-- XXX As far as possible, try that the combinators in this module and in
36−-- "Text.ParserCombinators.ReadP/parser-combinators/parsec/megaparsec/attoparsec"
37−-- have consistent names. takeP/takeWhileP/munch?
38
16
39module Streamly.Internal.Data.Parser.ParserD
17module Streamly.Internal.Data.Parser.ParserD
40 (
18 (
41 Parser (..)
19 Parser (..)
20+ , ParseError (..)
21+ , Step (..)
42
22
43 -- First order parsers
23 -- First order parsers
44 -- * Accumulators
24 -- * Accumulators
45 , fromFold
25 , fromFold
46 , toParserK
26 , toParserK
27+ , fromParserK
47 , any
28 , any
48 , all
29 , all
49 , yield
30 , yield
@@ -101,6 +82,7 @@ module Streamly.Internal.Data.Parser.ParserD
101
82
102 -- ** Sequential Applicative
83 -- ** Sequential Applicative
103 , splitWith
84 , splitWith
85+ , split_
104
86
105 -- ** Parallel Applicatives
87 -- ** Parallel Applicatives
106 , teeWith
88 , teeWith
@@ -113,6 +95,9 @@ module Streamly.Internal.Data.Parser.ParserD
113 -- secondary parser.
95 -- secondary parser.
114 , deintercalate
96 , deintercalate
115
97
98+ -- ** Sequential Alternative
99+ , alt
100+
116 -- ** Parallel Alternatives
101 -- ** Parallel Alternatives
117 , shortest
102 , shortest
118 , longest
103 , longest
@@ -121,6 +106,7 @@ module Streamly.Internal.Data.Parser.ParserD
121 -- * N-ary Combinators
106 -- * N-ary Combinators
122 -- ** Sequential Collection
107 -- ** Sequential Collection
123 , sequence
108 , sequence
109+ , concatMap
124
110
125 -- ** Sequential Repetition
111 -- ** Sequential Repetition
126 , count
112 , count
@@ -179,7 +165,7 @@ where
179import Control.Exception (assert)
165import Control.Exception (assert)
180import Control.Monad.Catch (MonadCatch, MonadThrow(..))
166import Control.Monad.Catch (MonadCatch, MonadThrow(..))
181import Prelude
167import Prelude
182− hiding (any, all, take, takeWhile, sequence)
168+ hiding (any, all, take, takeWhile, sequence, concatMap)
183
169
184import Streamly.Internal.Data.Fold.Types (Fold(..))
170import Streamly.Internal.Data.Fold.Types (Fold(..))
185
171
@@ -194,7 +180,9 @@ import Streamly.Internal.Data.Strict
194-- Upgrade folds to parses
180-- Upgrade folds to parses
195-------------------------------------------------------------------------------
181-------------------------------------------------------------------------------
196--
182--
197−-- | The resulting parse never terminates and never errors out.
183+-- | See 'Streamly.Internal.Data.Parser.fromFold'.
184+--
185+-- /Internal/
198--
186--
199{-# INLINE fromFold #-}
187{-# INLINE fromFold #-}
200fromFold :: Monad m => Fold m a b -> Parser m a b
188fromFold :: Monad m => Fold m a b -> Parser m a b
@@ -205,24 +193,45 @@ fromFold (Fold fstep finitial fextract) = Parser step finitial fextract
205 step s a = Yield 0 <$> fstep s a
193 step s a = Yield 0 <$> fstep s a
206
194
207-------------------------------------------------------------------------------
195-------------------------------------------------------------------------------
208−-- Convert to CPS style parser representation
196+-- Convert to and from CPS style parser representation
209-------------------------------------------------------------------------------
197-------------------------------------------------------------------------------
210
198
199+-- | Convert a direct style 'Parser' to a CPS style 'K.Parser'.
200+--
201+-- /Internal/
202+--
211−{-# INLINE toParserK #-}
203+{-# INLINE_LATE toParserK #-}
212toParserK :: MonadCatch m => Parser m a b -> K.Parser m a b
204toParserK :: MonadCatch m => Parser m a b -> K.Parser m a b
213toParserK (Parser step initial extract) =
205toParserK (Parser step initial extract) =
214 K.MkParser $ \inp yieldk ->
206 K.MkParser $ \inp yieldk ->
215 Z.parse step initial extract inp >>= yieldk
207 Z.parse step initial extract inp >>= yieldk
216
208
209+-- | Convert a CPS style 'K.Parser' to a direct style 'Parser'.
210+--
211+-- /Unimplemented/
212+--
213+{-# NOINLINE fromParserK #-}
214+fromParserK :: Monad m => K.Parser m a b -> Parser m a b
215+fromParserK _ = Parser step initial extract
216+
217+ where
218+
219+ initial = return ()
220+ step () _ = error "fromParserK: unimplemented"
221+ extract () = error "fromParserK: unimplemented"
222+
223+#ifndef DISABLE_FUSION
224+{-# RULES "fromParserK/toParserK fusion" [2]
225+ forall s. toParserK (fromParserK s) = s #-}
226+{-# RULES "toParserK/fromParserK fusion" [2]
227+ forall s. fromParserK (toParserK s) = s #-}
228+#endif
229+
217-------------------------------------------------------------------------------
230-------------------------------------------------------------------------------
218-- Terminating but not failing folds
231-- Terminating but not failing folds
219-------------------------------------------------------------------------------
232-------------------------------------------------------------------------------
220--
233--
221−-- |
234+{-# INLINE any #-}
222−-- >>> S.parse (PR.any (== 0)) $ S.fromList [1,0,1]
223−-- > Right True
224−--
225−{-# INLINABLE any #-}
226any :: Monad m => (a -> Bool) -> Parser m a Bool
235any :: Monad m => (a -> Bool) -> Parser m a Bool
227any predicate = Parser step initial return
236any predicate = Parser step initial return
228
237
@@ -238,10 +247,6 @@ any predicate = Parser step initial return
238 then Stop 0 True
247 then Stop 0 True
239 else Yield 0 False
248 else Yield 0 False
240
249
241−-- |
242−-- >>> S.parse (PR.all (== 0)) $ S.fromList [1,0,1]
243−-- > Right False
244−--
245{-# INLINABLE all #-}
250{-# INLINABLE all #-}
246all :: Monad m => (a -> Bool) -> Parser m a Bool
251all :: Monad m => (a -> Bool) -> Parser m a Bool
247all predicate = Parser step initial return
252all predicate = Parser step initial return
@@ -262,15 +267,7 @@ all predicate = Parser step initial return
262-- Failing Parsers
267-- Failing Parsers
263-------------------------------------------------------------------------------
268-------------------------------------------------------------------------------
264
269
265−-- | Peek the head element of a stream, without consuming it. Fails if it
270+-- | See 'Streamly.Internal.Data.Parser.peek'.
266−-- encounters end of input.
267−--
268−-- >>> S.parse ((,) <$> PR.peek <*> PR.satisfy (> 0)) $ S.fromList [1]
269−-- (1,1)
270−--
271−-- @
272−-- peek = lookAhead (satisfy True)
273−-- @
274--
271--
275-- /Internal/
272-- /Internal/
276--
273--
@@ -286,10 +283,7 @@ peek = Parser step initial extract
286
283
287 extract () = throwM $ ParseError "peek: end of input"
284 extract () = throwM $ ParseError "peek: end of input"
288
285
289−-- | Succeeds if we are at the end of input, fails otherwise.
286+-- | See 'Streamly.Internal.Data.Parser.eof'.
290−--
291−-- >>> S.parse ((,) <$> PR.satisfy (> 0) <*> PR.eof) $ S.fromList [1]
292−-- > (1,())
293--
287--
294-- /Internal/
288-- /Internal/
295--
289--
@@ -303,10 +297,7 @@ eof = Parser step initial return
303
297
304 step () _ = return $ Error "eof: not at end of input"
298 step () _ = return $ Error "eof: not at end of input"
305
299
306−-- | Returns the next element if it passes the predicate, fails otherwise.
300+-- | See 'Streamly.Internal.Data.Parser.satisfy'.
307−--
308−-- >>> S.parse (PR.satisfy (== 1)) $ S.fromList [1,0,1]
309−-- > 1
310--
301--
311-- /Internal/
302-- /Internal/
312--
303--
@@ -329,21 +320,7 @@ satisfy predicate = Parser step initial extract
329-- Taking elements
320-- Taking elements
330-------------------------------------------------------------------------------
321-------------------------------------------------------------------------------
331--
322--
332−-- XXX Once we have terminating folds, this Parse should get replaced by Fold.
323+-- | See 'Streamly.Internal.Data.Parser.take'.
333−-- Alternatively, we can name it "chunkOf" and the corresponding time domain
334−-- combinator as "intervalOf" or even "chunk" and "interval".
335−--
336−-- | Take at most @n@ input elements and fold them using the supplied fold.
337−--
338−-- Stops after @n@ elements.
339−-- Never fails.
340−--
341−-- >>> S.parse (PR.take 1 FL.toList) $ S.fromList [1]
342−-- [1]
343−--
344−-- @
345−-- S.chunksOf n f = S.splitParse (FL.take n f)
346−-- @
347--
324--
348-- /Internal/
325-- /Internal/
349--
326--
@@ -365,16 +342,7 @@ take n (Fold fstep finitial fextract) = Parser step initial extract
365
342
366 extract (Tuple' _ r) = fextract r
343 extract (Tuple' _ r) = fextract r
367
344
368−--
345+-- | See 'Streamly.Internal.Data.Parser.takeEQ'.
369−-- XXX can we use a "cmp" operation in a common implementation?
370−--
371−-- | Stops after taking exactly @n@ input elements.
372−--
373−-- * Stops - after @n@ elements.
374−-- * Fails - if the stream ends before it can collect @n@ elements.
375−--
376−-- >>> S.parse (PR.takeEQ 4 FL.toList) $ S.fromList [1,0,1]
377−-- > "takeEQ: Expecting exactly 4 elements, got 3"
378--
346--
379-- /Internal/
347-- /Internal/
380--
348--
@@ -403,16 +371,7 @@ takeEQ n (Fold fstep finitial fextract) = Parser step initial extract
403 "takeEQ: Expecting exactly " ++ show n
371 "takeEQ: Expecting exactly " ++ show n
404 ++ " elements, got " ++ show i
372 ++ " elements, got " ++ show i
405
373
406−-- | Take at least @n@ input elements, but can collect more.
374+-- | See 'Streamly.Internal.Data.Parser.takeGE'.
407−--
408−-- * Stops - never.
409−-- * Fails - if the stream ends before producing @n@ elements.
410−--
411−-- >>> S.parse (PR.takeGE 4 FL.toList) $ S.fromList [1,0,1]
412−-- > "takeGE: Expecting at least 4 elements, got only 3"
413−--
414−-- >>> S.parse (PR.takeGE 4 FL.toList) $ S.fromList [1,0,1,0,1]
415−-- > [1,0,1,0,1]
416--
375--
417-- /Internal/
376-- /Internal/
418--
377--
@@ -446,20 +405,7 @@ takeGE n (Fold fstep finitial fextract) = Parser step initial extract
446 then return x
405 then return x
447 else throwM $ ParseError err
406 else throwM $ ParseError err
448
407
449−-- | Collect stream elements until an element fails the predicate. The element
408+-- | See 'Streamly.Internal.Data.Parser.takeWhile'.
450−-- on which the predicate fails is returned back to the input stream.
451−--
452−-- * Stops - when the predicate fails.
453−-- * Fails - never.
454−--
455−-- >>> S.parse (PR.takeWhile (== 0) FL.toList) $ S.fromList [0,0,1,0,1]
456−-- > [0,0]
457−--
458−-- We can implement a @breakOn@ using 'takeWhile':
459−--
460−-- @
461−-- breakOn p = takeWhile (not p)
462−-- @
463--
409--
464-- /Internal/
410-- /Internal/
465--
411--
@@ -477,7 +423,7 @@ takeWhile predicate (Fold fstep finitial fextract) =
477 then Yield 0 <$> fstep s a
423 then Yield 0 <$> fstep s a
478 else Stop 1 <$> fextract s
424 else Stop 1 <$> fextract s
479
425
480−-- | Like 'takeWhile' but takes at least one element otherwise fails.
426+-- | See 'Streamly.Internal.Data.Parser.takeWhile1'.
481--
427--
482-- /Internal/
428-- /Internal/
483--
429--
@@ -509,20 +455,7 @@ takeWhile1 predicate (Fold fstep finitial fextract) =
509 extract Nothing = throwM $ ParseError "takeWhile1: end of input"
455 extract Nothing = throwM $ ParseError "takeWhile1: end of input"
510 extract (Just s) = fextract s
456 extract (Just s) = fextract s
511
457
512−-- | Collect stream elements until an element succeeds the predicate. Drop the
458+-- | See 'Streamly.Internal.Data.Parser.sliceSepBy'.
513−-- element on which the predicate succeeded. The succeeding element is treated
514−-- as an infix separator which is dropped from the output.
515−--
516−-- * Stops - when the predicate succeeds.
517−-- * Fails - never.
518−--
519−-- >>> S.parse (PR.sliceSepBy (== 1) FL.toList) $ S.fromList [0,0,1,0,1]
520−-- > [0,0]
521−--
522−-- S.splitOn pred f = S.splitParse (PR.sliceSepBy pred f)
523−--
524−-- >>> S.toList $ S.splitParse (PR.sliceSepBy (== 1) FL.toList) $ S.fromList [0,0,1,0,1]
525−-- > [[0,0],[0],[]]
526--
459--
527-- /Internal/
460-- /Internal/
528--
461--
@@ -539,14 +472,7 @@ sliceSepBy predicate (Fold fstep finitial fextract) =
539 then Yield 0 <$> fstep s a
472 then Yield 0 <$> fstep s a
540 else Stop 0 <$> fextract s
473 else Stop 0 <$> fextract s
541
474
542−-- | Collect stream elements until an element succeeds the predicate. Also take
475+-- | See 'Streamly.Internal.Data.Parser.sliceEndWith'.
543−-- the element on which the predicate succeeded. The succeeding element is
544−-- treated as a suffix separator which is kept in the output segement.
545−--
546−-- * Stops - when the predicate succeeds.
547−-- * Fails - never.
548−--
549−-- S.splitWithSuffix pred f = S.splitParse (PR.sliceEndWith pred f)
550--
476--
551-- /Unimplemented/
477-- /Unimplemented/
552--
478--
@@ -556,16 +482,7 @@ sliceEndWith ::
556 (a -> Bool) -> Fold m a b -> Parser m a b
482 (a -> Bool) -> Fold m a b -> Parser m a b
557sliceEndWith = undefined
483sliceEndWith = undefined
558
484
559−-- | Collect stream elements until an elements passes the predicate, return the
485+-- | See 'Streamly.Internal.Data.Parser.sliceBeginWith'.
560−-- last element on which the predicate succeeded back to the input stream. If
561−-- the predicate succeeds on the first element itself then it is kept in the
562−-- stream and we continue collecting. The succeeding element is treated as a
563−-- prefix separator which is kept in the output segement.
564−--
565−-- * Stops - when the predicate succeeds in non-leading position.
566−-- * Fails - never.
567−--
568−-- S.splitWithPrefix pred f = S.splitParse (PR.sliceBeginWith pred f)
569--
486--
570-- /Unimplemented/
487-- /Unimplemented/
571--
488--
@@ -575,9 +492,7 @@ sliceBeginWith ::
575 (a -> Bool) -> Fold m a b -> Parser m a b
492 (a -> Bool) -> Fold m a b -> Parser m a b
576sliceBeginWith = undefined
493sliceBeginWith = undefined
577
494
578−-- | Split using a condition or a count whichever occurs first. This is a
495+-- | See 'Streamly.Internal.Data.Parser.sliceSepByMax'.
579−-- hybrid of 'splitOn' and 'take'. The element on which the condition succeeds
580−-- is dropped.
581--
496--
582-- /Internal/
497-- /Internal/
583--
498--
@@ -601,17 +516,7 @@ sliceSepByMax predicate cnt (Fold fstep finitial fextract) =
601 return $ Stop 0 b
516 return $ Stop 0 b
602 extract (Tuple' _ r) = fextract r
517 extract (Tuple' _ r) = fextract r
603
518
604−-- | Like 'splitOn' but strips leading, trailing, and repeated separators.
519+-- | See 'Streamly.Internal.Data.Parser.wordBy'.
605−-- Therefore, @".a..b."@ having '.' as the separator would be parsed as
606−-- @["a","b"]@. In other words, its like parsing words from whitespace
607−-- separated text.
608−--
609−-- * Stops - when it finds a word separator after a non-word element
610−-- * Fails - never.
611−--
612−-- @
613−-- S.wordsBy pred f = S.splitParse (PR.wordBy pred f)
614−-- @
615--
520--
616-- /Unimplemented/
521-- /Unimplemented/
617--
522--
@@ -621,19 +526,7 @@ wordBy ::
621 (a -> Bool) -> Fold m a b -> Parser m a b
526 (a -> Bool) -> Fold m a b -> Parser m a b
622wordBy = undefined
527wordBy = undefined
623
528
624−-- | @groupBy cmp f $ S.fromList [a,b,c,...]@ assigns the element @a@ to the
529+-- | See 'Streamly.Internal.Data.Parser.groupBy'.
625−-- first group, then if @a \`cmp` b@ is 'True' @b@ is also assigned to the same
626−-- group. If @a \`cmp` c@ is 'True' then @c@ is also assigned to the same
627−-- group and so on. When the comparison fails a new group is started. Each
628−-- group is folded using the 'Fold' @f@ and the result of the fold is emitted
629−-- in the output stream.
630−--
631−-- * Stops - when the comparison fails.
632−-- * Fails - never.
633−--
634−-- @
635−-- S.groupsBy cmp f = S.splitParse (PR.groupBy cmp f)
636−-- @
637--
530--
638-- /Unimplemented/
531-- /Unimplemented/
639--
532--
@@ -646,7 +539,7 @@ groupBy = undefined
646-- XXX use an Unfold instead of a list?
539-- XXX use an Unfold instead of a list?
647-- XXX custom combinators for matching list, array and stream?
540-- XXX custom combinators for matching list, array and stream?
648--
541--
649−-- | Match the given sequence of elements using the given comparison function.
542+-- | See 'Streamly.Internal.Data.Parser.eqBy'.
650--
543--
651-- /Internal/
544-- /Internal/
652--
545--
@@ -662,8 +555,7 @@ eqBy cmp str = Parser step initial extract
662 step [x] a = return $
555 step [x] a = return $
663 if x `cmp` a
556 if x `cmp` a
664 then Stop 0 ()
557 then Stop 0 ()
665− else Error $
666− "eqBy: failed, at the last element"
558+ else Error "eqBy: failed, at the last element"
667 step (x:xs) a = return $
559 step (x:xs) a = return $
668 if x `cmp` a
560 if x `cmp` a
669 then Skip 0 xs
561 then Skip 0 xs
@@ -677,6 +569,10 @@ eqBy cmp str = Parser step initial extract
677-- nested parsers
569-- nested parsers
678-------------------------------------------------------------------------------
570-------------------------------------------------------------------------------
679
571
572+-- | See 'Streamly.Internal.Data.Parser.lookahead'.
573+--
574+-- /Internal/
575+--
680{-# INLINE lookAhead #-}
576{-# INLINE lookAhead #-}
681lookAhead :: MonadThrow m => Parser m a b -> Parser m a b
577lookAhead :: MonadThrow m => Parser m a b -> Parser m a b
682lookAhead (Parser step1 initial1 _) =
578lookAhead (Parser step1 initial1 _) =
@@ -705,27 +601,7 @@ lookAhead (Parser step1 initial1 _) =
705-- Interleaving
601-- Interleaving
706-------------------------------------------------------------------------------
602-------------------------------------------------------------------------------
707--
603--
708−-- To deinterleave we can chain two parsers one behind the other. The input is
604+-- | See 'Streamly.Internal.Data.Parser.deintercalate'.
709−-- given to the first parser and the input definitively rejected by the first
710−-- parser is given to the second parser.
711−--
712−-- We can either have the parsers themselves buffer the input or use the shared
713−-- global buffer to hold it until none of the parsers need it. When the first
714−-- parser returns Skip (i.e. rewind) we let the second parser consume the
715−-- rejected input and when it is done we move the cursor forward to the first
716−-- parser again. This will require a "move forward" command as well.
717−--
718−-- To implement grep we can use three parsers, one to find the pattern, one
719−-- to store the context behind the pattern and one to store the context in
720−-- front of the pattern. When a match occurs we need to emit the accumulator of
721−-- all the three parsers. One parser can count the line numbers to provide the
722−-- line number info.
723−--
724−-- | Apply two parsers alternately to an input stream. The input stream is
725−-- considered an interleaving of two patterns. The two parsers represent the
726−-- two patterns.
727−--
728−-- This undoes a "gintercalate" of two streams.
729--
605--
730-- /Unimplemented/
606-- /Unimplemented/
731--
607--
@@ -741,8 +617,7 @@ deintercalate = undefined
741-- Sequential Collection
617-- Sequential Collection
742-------------------------------------------------------------------------------
618-------------------------------------------------------------------------------
743--
619--
744−-- | @sequence f t@ collects sequential parses of parsers in the container @t@
620+-- | See 'Streamly.Internal.Data.Parser.sequence'.
745−-- using the fold @f@. Fails if the input ends or any of the parsers fail.
746--
621--
747-- /Unimplemented/
622-- /Unimplemented/
748--
623--
@@ -756,8 +631,9 @@ sequence _f _p = undefined
756-- Alternative Collection
631-- Alternative Collection
757-------------------------------------------------------------------------------
632-------------------------------------------------------------------------------
758--
633--
759−-- | @choice parsers@ applies the @parsers@ in order and returns the first
634+-- | See 'Streamly.Internal.Data.Parser.choice'.
760−-- successful parse.
635+--
636+-- /Unimplemented/
761--
637--
762{-# INLINE choice #-}
638{-# INLINE choice #-}
763choice ::
639choice ::
@@ -769,16 +645,7 @@ choice _ps = undefined
769-- Sequential Repetition
645-- Sequential Repetition
770-------------------------------------------------------------------------------
646-------------------------------------------------------------------------------
771--
647--
772−-- XXX "many" is essentially a Fold because it cannot fail. So it can be
648+-- | See 'Streamly.Internal.Data.Parser.many'.
773−-- downgraded to a Fold. Or we can make the return type a Fold instead and
774−-- upgrade that to a parser when needed.
775−--
776−-- | Collect zero or more parses. Apply the parser repeatedly on the input
777−-- stream, stop when the parser fails, accumulate zero or more parse results
778−-- using the supplied 'Fold'. This parser never fails, in case the first
779−-- application of parser fails it returns an empty result.
780−--
781−-- Compare with 'Control.Applicative.many'.
782--
649--
783-- /Internal/
650-- /Internal/
784--
651--
@@ -787,12 +654,7 @@ many :: MonadCatch m => Fold m b c -> Parser m a b -> Parser m a c
787many = splitMany
654many = splitMany
788-- many = countBetween 0 maxBound
655-- many = countBetween 0 maxBound
789
656
790−-- | Collect one or more parses. Apply the supplied parser repeatedly on the
657+-- | See 'Streamly.Internal.Data.Parser.some'.
791−-- input stream and accumulate the parse results as long as the parser
792−-- succeeds, stop when it fails. This parser fails if not even one result is
793−-- collected.
794−--
795−-- Compare with 'Control.Applicative.some'.
796--
658--
797-- /Internal/
659-- /Internal/
798--
660--
@@ -802,9 +664,7 @@ some = splitSome
802-- some f p = many (takeGE 1 f) p
664-- some f p = many (takeGE 1 f) p
803-- many = countBetween 1 maxBound
665-- many = countBetween 1 maxBound
804
666
805−-- | @countBetween m n f p@ collects between @m@ and @n@ sequential parses of
667+-- | See 'Streamly.Internal.Data.Parser.countBetween'.
806−-- parser @p@ using the fold @f@. Stop after collecting @n@ results. Fails if
807−-- the input ends or the parser fails before @m@ results are collected.
808--
668--
809-- /Unimplemented/
669-- /Unimplemented/
810--
670--
@@ -815,9 +675,7 @@ countBetween ::
815countBetween _m _n _f = undefined
675countBetween _m _n _f = undefined
816-- countBetween m n f p = many (takeBetween m n f) p
676-- countBetween m n f p = many (takeBetween m n f) p
817
677
818−-- | @count n f p@ collects exactly @n@ sequential parses of parser @p@ using
678+-- | See 'Streamly.Internal.Data.Parser.count'.
819−-- the fold @f@. Fails if the input ends or the parser fails before @n@
820−-- results are collected.
821--
679--
822-- /Unimplemented/
680-- /Unimplemented/
823--
681--
@@ -830,11 +688,7 @@ count n = countBetween n n
830
688
831data ManyTillState fs sr sl = ManyTillR Int fs sr | ManyTillL fs sl
689data ManyTillState fs sr sl = ManyTillR Int fs sr | ManyTillL fs sl
832
690
833−-- | @manyTill f collect test@ tries the parser @test@ on the input, if @test@
691+-- | See 'Streamly.Internal.Data.Parser.manyTill'.
834−-- fails it backtracks and tries @collect@, after @collect@ succeeds @test@ is
835−-- tried again and so on. The parser stops when @test@ succeeds. The output of
836−-- @test@ is discarded and the output of @collect@ is accumulated by the
837−-- supplied fold. The parser fails if @collect@ fails.
838--
692--
839-- /Internal/
693-- /Internal/
840--
694--
src/Streamly/Internal/Data/Parser/ParserD/Tee.hs+5−13
@@ -80,9 +80,7 @@ data Res = Yld Int | Stp Int | Skp | Err String
80-- line/column fold running in parallel with the main parser, whenever an error
80-- line/column fold running in parallel with the main parser, whenever an error
81-- occurs we can zip the error with the context fold.
81-- occurs we can zip the error with the context fold.
82--
82--
83−-- | @teeWith f p1 p2@ distributes its input to both @p1@ and @p2@ until both
83+-- | See 'Streamly.Internal.Data.Parser.teeWith'.
84−-- of them succeed or fail and combines their output using @f@. The parser
85−-- succeeds if both the parsers succeed.
86--
84--
87-- /Internal/
85-- /Internal/
88--
86--
@@ -200,8 +198,7 @@ teeWith zf (Parser stepL initialL extractL) (Parser stepR initialR extractR) =
200 TeePair (_, StepResult rL, _, _) (_, StepResult rR, _, _) ->
198 TeePair (_, StepResult rL, _, _) (_, StepResult rR, _, _) ->
201 return $ zf rL rR
199 return $ zf rL rR
202
200
203−-- | Like 'teeWith' but ends parsing and zips the results, if available,
201+-- | See 'Streamly.Internal.Data.Parser.teeWithFst'.
204−-- whenever the first parser ends.
205--
202--
206-- /Internal/
203-- /Internal/
207--
204--
@@ -310,8 +307,7 @@ teeWithFst zf (Parser stepL initialL extractL)
310 return $ zf rL rR
307 return $ zf rL rR
311 _ -> error "unreachable"
308 _ -> error "unreachable"
312
309
313−-- | Like 'teeWith' but ends parsing and zips the results, if available,
310+-- | See 'Streamly.Internal.Data.Parser.teeWithMin'.
314−-- whenever any of the parsers ends or fails.
315--
311--
316-- /Unimplemented/
312-- /Unimplemented/
317--
313--
@@ -325,9 +321,7 @@ teeWithMin = undefined
325-- Distribute input to two parsers and choose one result
321-- Distribute input to two parsers and choose one result
326-------------------------------------------------------------------------------
322-------------------------------------------------------------------------------
327
323
328−-- | Shortest alternative. Apply both parsers in parallel but choose the result
324+-- | See 'Streamly.Internal.Data.Parser.shortest'.
329−-- from the one which consumed least input i.e. take the shortest succeeding
330−-- parse.
331--
325--
332-- /Internal/
326-- /Internal/
333--
327--
@@ -403,9 +397,7 @@ shortest (Parser stepL initialL extractL) (Parser stepR initialR _) =
403 TeePair (_, StepState sL, _, _) _ -> extractL sL
397 TeePair (_, StepState sL, _, _) _ -> extractL sL
404 _ -> error "unreachable"
398 _ -> error "unreachable"
405
399
406−-- | Longest alternative. Apply both parsers in parallel but choose the result
400+-- | See 'Streamly.Internal.Data.Parser.longest'.
407−-- from the one which consumed more input i.e. take the longest succeeding
408−-- parse.
409--
401--
410-- /Internal/
402-- /Internal/
411--
403--
src/Streamly/Internal/Data/Parser/ParserD/Types.hs+100−112
@@ -1,6 +1,9 @@
1+{-# LANGUAGE CPP #-}
1−{-# LANGUAGE ExistentialQuantification #-}
2+{-# LANGUAGE ExistentialQuantification #-}
2{-# LANGUAGE ScopedTypeVariables #-}
3{-# LANGUAGE ScopedTypeVariables #-}
3
4
5+#include "inline.hs"
6+
4-- |
7-- |
5-- Module : Streamly.Internal.Data.Parser.ParserD.Types
8-- Module : Streamly.Internal.Data.Parser.ParserD.Types
6-- Copyright : (c) 2020 Composewell Technologies
9-- Copyright : (c) 2020 Composewell Technologies
@@ -116,12 +119,14 @@ module Streamly.Internal.Data.Parser.ParserD.Types
116 , yield
119 , yield
117 , yieldM
120 , yieldM
118 , splitWith
121 , splitWith
122+ , split_
119
123
120 , die
124 , die
121 , dieM
125 , dieM
122 , splitSome
126 , splitSome
123 , splitMany
127 , splitMany
124 , alt
128 , alt
129+ , concatMap
125 )
130 )
126where
131where
127
132
@@ -129,6 +134,7 @@ import Control.Applicative (Alternative(..))
129import Control.Exception (assert, Exception(..))
134import Control.Exception (assert, Exception(..))
130import Control.Monad (MonadPlus(..))
135import Control.Monad (MonadPlus(..))
131import Control.Monad.Catch (MonadCatch, try, throwM, MonadThrow)
136import Control.Monad.Catch (MonadCatch, try, throwM, MonadThrow)
137+import Prelude hiding (concatMap)
132
138
133import Fusion.Plugin.Types (Fuse(..))
139import Fusion.Plugin.Types (Fuse(..))
134import Streamly.Internal.Data.Fold (Fold(..), toList)
140import Streamly.Internal.Data.Fold (Fold(..), toList)
@@ -222,22 +228,17 @@ instance Functor m => Functor (Parser m a) where
222 step s b = fmap2 f (step1 s b)
228 step s b = fmap2 f (step1 s b)
223 fmap2 g = fmap (fmap g)
229 fmap2 g = fmap (fmap g)
224
230
225−-- This is the dual of stream "yield".
231+-- | See 'Streamly.Internal.Data.Parser.yield'.
226−--
227−-- | A parser that always yields a pure value without consuming any input.
228--
232--
229-- /Internal/
233-- /Internal/
230--
234--
231−{-# INLINE yield #-}
235+{-# INLINE_NORMAL yield #-}
232yield :: Monad m => b -> Parser m a b
236yield :: Monad m => b -> Parser m a b
233yield b = Parser (\_ _ -> pure $ Stop 1 b) -- step
237yield b = Parser (\_ _ -> pure $ Stop 1 b) -- step
234 (pure ()) -- initial
238 (pure ()) -- initial
235 (\_ -> pure b) -- extract
239 (\_ -> pure b) -- extract
236
240
237−-- This is the dual of stream "yieldM".
241+-- | See 'Streamly.Internal.Data.Parser.yieldM'.
238−--
239−-- | A parser that always yields the result of an effectful action without
240−-- consuming any input.
241--
242--
242-- /Internal/
243-- /Internal/
243--
244--
@@ -261,19 +262,7 @@ data SeqParseState sl f sr = SeqParseL sl | SeqParseR f sr
261-- compositions the performance starts dipping rapidly beyond a CPS style
262-- compositions the performance starts dipping rapidly beyond a CPS style
262-- unfused implementation.
263-- unfused implementation.
263--
264--
264−-- | Sequential application. Apply two parsers sequentially to an input stream.
265+-- | See 'Streamly.Internal.Data.Parser.splitWith'.
265−-- The input is provided to the first parser, when it is done the remaining
266−-- input is provided to the second parser. If both the parsers succeed their
267−-- outputs are combined using the supplied function. The operation fails if any
268−-- of the parsers fail.
269−--
270−-- This undoes an "append" of two streams, it splits the streams using two
271−-- parsers and zips the results.
272−--
273−-- This implementation is strict in the second argument, therefore, the
274−-- following will fail:
275−--
276−-- >>> S.parse (PR.satisfy (> 0) *> undefined) $ S.fromList [1]
277--
266--
278-- /Internal/
267-- /Internal/
279--
268--
@@ -315,6 +304,47 @@ splitWith func (Parser stepL initialL extractL)
315 rR <- extractR sR
304 rR <- extractR sR
316 return $ func rL rR
305 return $ func rL rR
317
306
307+{-# ANN type SeqAState Fuse #-}
308+data SeqAState sl sr = SeqAL sl | SeqAR sr
309+
310+-- This turns out to be slightly faster than splitWith
311+-- | See 'Streamly.Internal.Data.Parser.split_'.
312+--
313+-- /Internal/
314+--
315+{-# INLINE split_ #-}
316+split_ :: Monad m => Parser m x a -> Parser m x b -> Parser m x b
317+split_ (Parser stepL initialL extractL) (Parser stepR initialR extractR) =
318+ Parser step initial extract
319+
320+ where
321+
322+ initial = SeqAL <$> initialL
323+
324+ -- Note: For the composed parse to terminate, the left parser has to be
325+ -- a terminating parser returning a Stop at some point.
326+ step (SeqAL st) a = do
327+ (\r i -> case r of
328+ -- Note: this leads to buffering even if we are not in an
329+ -- Alternative composition.
330+ Yield _ s -> Skip 0 (SeqAL s)
331+ Skip n s -> Skip n (SeqAL s)
332+ Stop n _ -> Skip n (SeqAR i)
333+ -- XXX should we sequence initialR monadically?
334+ Error err -> Error err) <$> stepL st a <*> initialR
335+
336+ step (SeqAR st) a = do
337+ (\r -> case r of
338+ Yield n s -> Yield n (SeqAR s)
339+ Skip n s -> Skip n (SeqAR s)
340+ Stop n b -> Stop n b
341+ Error err -> Error err) <$> stepR st a
342+
343+ extract (SeqAR sR) = extractR sR
344+ extract (SeqAL sL) = do
345+ _ <- extractL sL
346+ initialR >>= extractR
347+
318-- | 'Applicative' form of 'splitWith'.
348-- | 'Applicative' form of 'splitWith'.
319instance Monad m => Applicative (Parser m a) where
349instance Monad m => Applicative (Parser m a) where
320 {-# INLINE pure #-}
350 {-# INLINE pure #-}
@@ -323,6 +353,9 @@ instance Monad m => Applicative (Parser m a) where
323 {-# INLINE (<*>) #-}
353 {-# INLINE (<*>) #-}
324 (<*>) = splitWith id
354 (<*>) = splitWith id
325
355
356+ {-# INLINE (*>) #-}
357+ (*>) = split_
358+
326-------------------------------------------------------------------------------
359-------------------------------------------------------------------------------
327-- Sequential Alternative
360-- Sequential Alternative
328-------------------------------------------------------------------------------
361-------------------------------------------------------------------------------
@@ -335,14 +368,7 @@ data AltParseState sl sr = AltParseL Int sl | AltParseR sr
335-- each subsequent alternative's input element has to go through, therefore, it
368-- each subsequent alternative's input element has to go through, therefore, it
336-- cannot scale to a large number of compositions
369-- cannot scale to a large number of compositions
337--
370--
338−-- | Sequential alternative. Apply the input to the first parser and return the
371+-- | See 'Streamly.Internal.Data.Parser.alt'.
339−-- result if the parser succeeds. If the first parser fails then backtrack and
340−-- apply the same input to the second parser and return the result.
341−--
342−-- Note: This implementation is not lazy in the second argument. The following
343−-- will fail:
344−--
345−-- >>> S.parse (PR.satisfy (> 0) `PR.alt` undefined) $ S.fromList [1..10]
346--
372--
347-- /Internal/
373-- /Internal/
348--
374--
@@ -480,24 +506,18 @@ splitSome (Fold fstep finitial fextract) (Parser step1 initial1 extract1) =
480 Left (_ :: ParseError) -> fextract fs
506 Left (_ :: ParseError) -> fextract fs
481 Right b -> fstep fs b >>= fextract
507 Right b -> fstep fs b >>= fextract
482
508
483−-- This is the dual of "nil".
509+-- | See 'Streamly.Internal.Data.Parser.die'.
484−--
485−-- | A parser that always fails with an error message without consuming
486−-- any input.
487--
510--
488-- /Internal/
511-- /Internal/
489--
512--
490−{-# INLINE die #-}
513+{-# INLINE_NORMAL die #-}
491die :: MonadThrow m => String -> Parser m a b
514die :: MonadThrow m => String -> Parser m a b
492die err =
515die err =
493 Parser (\_ _ -> pure $ Error err) -- step
516 Parser (\_ _ -> pure $ Error err) -- step
494 (pure ()) -- initial
517 (pure ()) -- initial
495 (\_ -> throwM $ ParseError err) -- extract
518 (\_ -> throwM $ ParseError err) -- extract
496
519
497−-- This is the dual of "nilM".
520+-- | See 'Streamly.Internal.Data.Parser.dieM'.
498−--
499−-- | A parser that always fails with an effectful error message and without
500−-- consuming any input.
501--
521--
502-- /Internal/
522-- /Internal/
503--
523--
@@ -539,92 +559,60 @@ instance MonadCatch m => Alternative (Parser m a) where
539{-# ANN type ConcatParseState Fuse #-}
559{-# ANN type ConcatParseState Fuse #-}
540data ConcatParseState sl p = ConcatParseL sl | ConcatParseR p
560data ConcatParseState sl p = ConcatParseL sl | ConcatParseR p
541
561
542−-- Note: The monad instance has quadratic performance complexity. It works fine
562+-- | See 'Streamly.Internal.Data.Parser.concatMap'.
543−-- for small number of compositions but for a scalable implementation we need a
544−-- CPS version.
545−
546−-- | Monad composition can be used for lookbehind parsers, we can make the
547−-- future parses depend on the previously parsed values.
548--
563--
549−-- If we have to parse "a9" or "9a" but not "99" or "aa" we can use the
564+-- /Internal/
550−-- following parser:
551−--
552−-- @
553−-- backtracking :: MonadCatch m => PR.Parser m Char String
554−-- backtracking =
555−-- sequence [PR.satisfy isDigit, PR.satisfy isAlpha]
556−-- '<|>'
557−-- sequence [PR.satisfy isAlpha, PR.satisfy isDigit]
558−-- @
559−--
560−-- We know that if the first parse resulted in a digit at the first place then
561−-- the second parse is going to fail. However, we waste that information and
562−-- parse the first character again in the second parse only to know that it is
563−-- not an alphabetic char. By using lookbehind in a 'Monad' composition we can
564−-- avoid redundant work:
565−--
566−-- @
567−-- data DigitOrAlpha = Digit Char | Alpha Char
568−--
569−-- lookbehind :: MonadCatch m => PR.Parser m Char String
570−-- lookbehind = do
571−-- x1 \<- Digit '<$>' PR.satisfy isDigit
572−-- '<|>' Alpha '<$>' PR.satisfy isAlpha
573−--
574−-- -- Note: the parse depends on what we parsed already
575−-- x2 <- case x1 of
576−-- Digit _ -> PR.satisfy isAlpha
577−-- Alpha _ -> PR.satisfy isDigit
578−--
579−-- return $ case x1 of
580−-- Digit x -> [x,x2]
581−-- Alpha x -> [x,x2]
582−-- @
583--
565--
584−instance Monad m => Monad (Parser m a) where
585− {-# INLINE return #-}
566+{-# INLINE concatMap #-}
586− return = pure
567+concatMap :: Monad m => (b -> Parser m a c) -> Parser m a b -> Parser m a c
568+concatMap func (Parser stepL initialL extractL) = Parser step initial extract
587
569
588− -- (>>=) :: Parser m a b -> (b -> Parser m a c) -> Parser m a c
570+ where
589− {-# INLINE (>>=) #-}
590− (Parser stepL initialL extractL) >>= func = Parser step initial extract
591
571
592− where
572+ initial = ConcatParseL <$> initialL
593
573
594− initial = ConcatParseL <$> initialL
574+ step (ConcatParseL st) a = do
575+ r <- stepL st a
576+ return $ case r of
577+ Yield _ s -> Skip 0 (ConcatParseL s)
578+ Skip n s -> Skip n (ConcatParseL s)
579+ Stop n b -> Skip n (ConcatParseR (func b))
580+ Error err -> Error err
595
581
596− step (ConcatParseL st) a = do
582+ step (ConcatParseR (Parser stepR initialR extractR)) a = do
583+ st <- initialR
597− r <- stepL st a
584+ r <- stepR st a
598− return $ case r of
585+ return $ case r of
599− Yield _ s -> Skip 0 (ConcatParseL s)
586+ Yield n s ->
587+ Yield n (ConcatParseR (Parser stepR (return s) extractR))
600− Skip n s -> Skip n (ConcatParseL s)
588+ Skip n s ->
589+ Skip n (ConcatParseR (Parser stepR (return s) extractR))
601− Stop n b -> Skip n (ConcatParseR (func b))
590+ Stop n b -> Stop n b
602− Error err -> Error err
591+ Error err -> Error err
603
592
604− step (ConcatParseR (Parser stepR initialR extractR)) a = do
593+ extract (ConcatParseR (Parser _ initialR extractR)) =
605− st <- initialR
594+ initialR >>= extractR
606− r <- stepR st a
607− return $ case r of
608− Yield n s ->
609− Yield n (ConcatParseR (Parser stepR (return s) extractR))
610− Skip n s ->
611− Skip n (ConcatParseR (Parser stepR (return s) extractR))
612− Stop n b -> Stop n b
613− Error err -> Error err
614
595
615− extract (ConcatParseR (Parser _ initialR extractR)) =
596+ extract (ConcatParseL sL) = extractL sL >>= f . func
616− initialR >>= extractR
617
597
618− extract (ConcatParseL sL) = extractL sL >>= f . func
598+ where
619
599
620− where
600+ f (Parser _ initialR extractR) = initialR >>= extractR
621
601
622− f (Parser _ initialR extractR) = initialR >>= extractR
602+-- Note: The monad instance has quadratic performance complexity. It works fine
603+-- for small number of compositions but for a scalable implementation we need a
604+-- CPS version.
623
605
624−-- | 'mzero' is same as 'empty', it aborts the parser. 'mplus' is same as
606+-- | See documentation of 'Streamly.Internal.Data.Parser.ParserK.Types.Parser'.
625−-- '<|>', it selects the first succeeding parser.
626--
607--
627−-- /Internal/
608+instance Monad m => Monad (Parser m a) where
609+ {-# INLINE return #-}
610+ return = pure
611+
612+ {-# INLINE (>>=) #-}
613+ (>>=) = flip concatMap
614+
615+-- | See documentation of 'Streamly.Internal.Data.Parser.ParserK.Types.Parser'.
628--
616--
629instance MonadCatch m => MonadPlus (Parser m a) where
617instance MonadCatch m => MonadPlus (Parser m a) where
630 {-# INLINE mzero #-}
618 {-# INLINE mzero #-}
src/Streamly/Internal/Data/Parser/ParserK/Types.hs+75−5
@@ -14,10 +14,20 @@
14-- Portability : GHC
14-- Portability : GHC
15--
15--
16-- CPS style implementation of parsers.
16-- CPS style implementation of parsers.
17+--
18+-- The CPS representation allows linear performance for Applicative, sequenceA,
19+-- Monad, sequence, and Alternative, choice operations compared to the
20+-- quadratic complexity of the corresponding direct style operations. However,
21+-- direct style operations allow fusion with ~10x better performance than CPS.
22+--
23+-- The direct style representation does not allow for recursive definitions of
24+-- "some" and "many" whereas CPS allows that.
17
25
18module Streamly.Internal.Data.Parser.ParserK.Types
26module Streamly.Internal.Data.Parser.ParserK.Types
19 (
27 (
20 Parser (..)
28 Parser (..)
29+ , yield
30+ , die
21 )
31 )
22where
32where
23
33
@@ -37,6 +47,10 @@ instance Functor m => Functor (Parser m a) where
37 fmap f parser =
47 fmap f parser =
38 MkParser $ \inp yieldk -> runParser parser inp (yieldk . fmap (fmap f))
48 MkParser $ \inp yieldk -> runParser parser inp (yieldk . fmap (fmap f))
39
49
50+-- | See 'Streamly.Internal.Data.Parser.yield'.
51+--
52+-- /Internal/
53+--
40{-# INLINE yield #-}
54{-# INLINE yield #-}
41yield :: b -> Parser m a b
55yield :: b -> Parser m a b
42yield b = MkParser (\_ yieldk -> yieldk (Z.nil, Right b))
56yield b = MkParser (\_ yieldk -> yieldk (Z.nil, Right b))
@@ -45,7 +59,10 @@ yield b = MkParser (\_ yieldk -> yieldk (Z.nil, Right b))
45-- Sequential applicative
59-- Sequential applicative
46-------------------------------------------------------------------------------
60-------------------------------------------------------------------------------
47--
61--
48−-- | 'Applicative' form of 'splitWith'.
62+-- | 'Applicative' form of 'Streamly.Internal.Data.Parser.splitWith'. Note that
63+-- this operation does not fuse, use 'Streamly.Internal.Data.Parser.splitWith'
64+-- when fusion is important.
65+--
49instance Monad m => Applicative (Parser m a) where
66instance Monad m => Applicative (Parser m a) where
50 {-# INLINE pure #-}
67 {-# INLINE pure #-}
51 pure = yield
68 pure = yield
@@ -53,10 +70,56 @@ instance Monad m => Applicative (Parser m a) where
53 {-# INLINE (<*>) #-}
70 {-# INLINE (<*>) #-}
54 (<*>) = ap
71 (<*>) = ap
55
72
73+-- | See 'Streamly.Internal.Data.Parser.die'.
74+--
75+-- /Internal/
76+--
56{-# INLINE die #-}
77{-# INLINE die #-}
57die :: String -> Parser m a b
78die :: String -> Parser m a b
58die err = MkParser (\z yieldk -> yieldk (z, Left err))
79die err = MkParser (\z yieldk -> yieldk (z, Left err))
59
80
81+-- | Monad composition can be used for lookbehind parsers, we can make the
82+-- future parses depend on the previously parsed values.
83+--
84+-- If we have to parse "a9" or "9a" but not "99" or "aa" we can use the
85+-- following parser:
86+--
87+-- @
88+-- backtracking :: MonadCatch m => PR.Parser m Char String
89+-- backtracking =
90+-- sequence [PR.satisfy isDigit, PR.satisfy isAlpha]
91+-- '<|>'
92+-- sequence [PR.satisfy isAlpha, PR.satisfy isDigit]
93+-- @
94+--
95+-- We know that if the first parse resulted in a digit at the first place then
96+-- the second parse is going to fail. However, we waste that information and
97+-- parse the first character again in the second parse only to know that it is
98+-- not an alphabetic char. By using lookbehind in a 'Monad' composition we can
99+-- avoid redundant work:
100+--
101+-- @
102+-- data DigitOrAlpha = Digit Char | Alpha Char
103+--
104+-- lookbehind :: MonadCatch m => PR.Parser m Char String
105+-- lookbehind = do
106+-- x1 \<- Digit '<$>' PR.satisfy isDigit
107+-- '<|>' Alpha '<$>' PR.satisfy isAlpha
108+--
109+-- -- Note: the parse depends on what we parsed already
110+-- x2 <- case x1 of
111+-- Digit _ -> PR.satisfy isAlpha
112+-- Alpha _ -> PR.satisfy isDigit
113+--
114+-- return $ case x1 of
115+-- Digit x -> [x,x2]
116+-- Alpha x -> [x,x2]
117+-- @
118+--
119+-- Seel also 'Streamly.Internal.Data.Parser.concatMap'. This monad instance
120+-- does not fuse, use 'Streamly.Internal.Data.Parser.concatMap' when you need
121+-- fusion.
122+--
60instance Monad m => Monad (Parser m a) where
123instance Monad m => Monad (Parser m a) where
61 {-# INLINE return #-}
124 {-# INLINE return #-}
62 return = pure
125 return = pure
@@ -68,11 +131,18 @@ instance Monad m => Monad (Parser m a) where
68 Left err -> runParser (die err) z yieldk
131 Left err -> runParser (die err) z yieldk
69 in runParser m inp yield1
132 in runParser m inp yield1
70
133
71−-- | 'Alternative' instance using 'alt'.
134+-- | 'Alternative' form of 'Streamly.Internal.Data.Parser.alt'. Backtrack and
135+-- run the second parser if the first one fails.
136+--
137+-- The "some" and "many" operations of alternative accumulate results in a pure
138+-- list which is not scalable and streaming. Instead use
139+-- 'Streamly.Internal.Data.Parser.some' and
140+-- 'Streamly.Internal.Data.Parser.many' for fusible operations with composable
141+-- accumulation of results.
72--
142--
73−-- The "some" and "many" operations of alternative collect results in a pure
143+-- See also 'Streamly.Internal.Data.Parser.alt'. This 'Alternative' instance
74−-- list which is not scalable and streaming. Instead use the "splitParse"
144+-- does not fuse, use 'Streamly.Internal.Data.Parser.alt' when you need
75−-- operation to apply a 'Parser' repeatedly on a stream in a scalable manner.
145+-- fusion.
76--
146--
77instance Monad m => Alternative (Parser m a) where
147instance Monad m => Alternative (Parser m a) where
78 {-# INLINE empty #-}
148 {-# INLINE empty #-}
src/Streamly/Internal/Data/Stream/Prelude.hs+1−1
@@ -74,7 +74,7 @@ import Prelude hiding (foldr, minimum, maximum)
74import qualified Prelude
74import qualified Prelude
75
75
76import Streamly.Internal.Data.Fold.Types (Fold (..))
76import Streamly.Internal.Data.Fold.Types (Fold (..))
77−import Streamly.Internal.Data.Parser.ParserD.Types (Step)
77+import Streamly.Internal.Data.Parser (Step)
78
78
79#ifdef USE_STREAMK_ONLY
79#ifdef USE_STREAMK_ONLY
80import qualified Streamly.Internal.Data.Stream.StreamK as S
80import qualified Streamly.Internal.Data.Stream.StreamK as S
src/Streamly/Internal/Data/Stream/StreamD.hs+5−4
@@ -362,7 +362,7 @@ import Streamly.Internal.Data.Time.Units
362import Streamly.Internal.Data.Atomics (atomicModifyIORefCAS_)
362import Streamly.Internal.Data.Atomics (atomicModifyIORefCAS_)
363import Streamly.Internal.Memory.Array.Types (Array(..))
363import Streamly.Internal.Memory.Array.Types (Array(..))
364import Streamly.Internal.Data.Fold.Types (Fold(..))
364import Streamly.Internal.Data.Fold.Types (Fold(..))
365−import Streamly.Internal.Data.Parser.ParserD.Types (Parser(..), ParseError(..))
365+import Streamly.Internal.Data.Parser (ParseError(..))
366import Streamly.Internal.Data.Pipe.Types (Pipe(..), PipeState(..))
366import Streamly.Internal.Data.Pipe.Types (Pipe(..), PipeState(..))
367import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime)
367import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime)
368import Streamly.Internal.Data.Time.Units
368import Streamly.Internal.Data.Time.Units
@@ -379,7 +379,8 @@ import qualified Streamly.Internal.Memory.Array.Types as A
379import qualified Streamly.Internal.Data.Fold as FL
379import qualified Streamly.Internal.Data.Fold as FL
380import qualified Streamly.Memory.Ring as RB
380import qualified Streamly.Memory.Ring as RB
381import qualified Streamly.Internal.Data.Stream.StreamK as K
381import qualified Streamly.Internal.Data.Stream.StreamK as K
382−import qualified Streamly.Internal.Data.Parser.ParserD.Types as PR
382+import qualified Streamly.Internal.Data.Parser as PR
383+import qualified Streamly.Internal.Data.Parser.ParserD as PRD
383
384
384------------------------------------------------------------------------------
385------------------------------------------------------------------------------
385-- Construction
386-- Construction
@@ -1039,10 +1040,10 @@ data ParseChunksState x inpBuf st pst =
1039{-# INLINE_NORMAL splitParse #-}
1040{-# INLINE_NORMAL splitParse #-}
1040splitParse
1041splitParse
1041 :: MonadThrow m
1042 :: MonadThrow m
1042− => Parser m a b
1043+ => PRD.Parser m a b
1043 -> Stream m a
1044 -> Stream m a
1044 -> Stream m b
1045 -> Stream m b
1045−splitParse (Parser pstep initial extract) (Stream step state) =
1046+splitParse (PRD.Parser pstep initial extract) (Stream step state) =
1046 Stream stepOuter (ParseChunksInit [] state)
1047 Stream stepOuter (ParseChunksInit [] state)
1047
1048
1048 where
1049 where
src/Streamly/Internal/Prelude.hs+19−7
@@ -94,6 +94,7 @@ module Streamly.Internal.Prelude
94 , fold
94 , fold
95 , parse
95 , parse
96 , parseK
96 , parseK
97+ , parseD
97
98
98 -- ** Concurrent Folds
99 -- ** Concurrent Folds
99 , foldAsync
100 , foldAsync
@@ -540,7 +541,7 @@ import qualified System.IO as IO
540
541
541import Streamly.Internal.Data.Stream.Enumeration (Enumerable(..), enumerate, enumerateTo)
542import Streamly.Internal.Data.Stream.Enumeration (Enumerable(..), enumerate, enumerateTo)
542import Streamly.Internal.Data.Fold.Types (Fold (..), Fold2 (..))
543import Streamly.Internal.Data.Fold.Types (Fold (..), Fold2 (..))
543−import Streamly.Internal.Data.Parser.ParserD.Types (Parser (..))
544+import Streamly.Internal.Data.Parser (Parser (..))
544import Streamly.Internal.Data.Unfold.Types (Unfold)
545import Streamly.Internal.Data.Unfold.Types (Unfold)
545import Streamly.Internal.Memory.Array.Types (Array, writeNUnsafe)
546import Streamly.Internal.Memory.Array.Types (Array, writeNUnsafe)
546-- import Streamly.Memory.Ring (Ring)
547-- import Streamly.Memory.Ring (Ring)
@@ -578,6 +579,7 @@ import qualified Streamly.Internal.Data.Stream.Serial as Serial
578import qualified Streamly.Internal.Data.Stream.Parallel as Par
579import qualified Streamly.Internal.Data.Stream.Parallel as Par
579import qualified Streamly.Internal.Data.Stream.Zip as Z
580import qualified Streamly.Internal.Data.Stream.Zip as Z
580import qualified Streamly.Internal.Data.Parser.ParserK.Types as PRK
581import qualified Streamly.Internal.Data.Parser.ParserK.Types as PRK
582+import qualified Streamly.Internal.Data.Parser.ParserD as PRD
581import qualified Streamly.Internal.Data.Zipper as ZR
583import qualified Streamly.Internal.Data.Zipper as ZR
582
584
583------------------------------------------------------------------------------
585------------------------------------------------------------------------------
@@ -1197,16 +1199,16 @@ runSink = fold . toFold
1197-}
1199-}
1198
1200
1199------------------------------------------------------------------------------
1201------------------------------------------------------------------------------
1200−-- Running a Parse
1202+-- Running a Parser
1201------------------------------------------------------------------------------
1203------------------------------------------------------------------------------
1202
1204
1203−-- | Parse a stream using the supplied 'Parse'.
1205+-- | Parse a stream using the supplied 'Parser'.
1204--
1206--
1205-- /Internal/
1207-- /Internal/
1206--
1208--
1207−{-# INLINE parse #-}
1209+{-# INLINE_NORMAL parseD #-}
1208−parse :: MonadThrow m => Parser m a b -> SerialT m a -> m b
1210+parseD :: MonadThrow m => PRD.Parser m a b -> SerialT m a -> m b
1209−parse (Parser step initial extract) = P.parselMx' step initial extract
1211+parseD (PRD.Parser step initial extract) = P.parselMx' step initial extract
1210
1212
1211{-# INLINE parseK #-}
1213{-# INLINE parseK #-}
1212parseK :: Monad m => PRK.Parser m a b -> SerialT m a -> m b
1214parseK :: Monad m => PRK.Parser m a b -> SerialT m a -> m b
@@ -1217,6 +1219,16 @@ parseK parser xs = do
1217 Left err -> error err
1219 Left err -> error err
1218 Right b -> return b
1220 Right b -> return b
1219
1221
1222+-- | Parse a stream using the supplied 'Parser'.
1223+--
1224+-- /Internal/
1225+--
1226+{-# INLINE [3] parse #-}
1227+parse :: MonadThrow m => Parser m a b -> SerialT m a -> m b
1228+parse = parseD . PRD.fromParserK
1229+{-# RULES "parse fallback to CPS" [2]
1230+ forall a. parseD (PRD.fromParserK a) = parseK a #-}
1231+
1220------------------------------------------------------------------------------
1232------------------------------------------------------------------------------
1221-- Specialized folds
1233-- Specialized folds
1222------------------------------------------------------------------------------
1234------------------------------------------------------------------------------
@@ -3141,7 +3153,7 @@ concatMapTreeYieldLeavesWith combine f = concatMapLoopWith combine f yield
3141{-# INLINE splitParse #-}
3153{-# INLINE splitParse #-}
3142splitParse
3154splitParse
3143 :: (IsStream t, MonadThrow m)
3155 :: (IsStream t, MonadThrow m)
3144− => Parser m a b
3156+ => PRD.Parser m a b
3145 -> t m a
3157 -> t m a
3146 -> t m b
3158 -> t m b
3147splitParse f m = D.fromStreamD $ D.splitParse f (D.toStreamD m)
3159splitParse f m = D.fromStreamD $ D.splitParse f (D.toStreamD m)
streamly.cabal+1
@@ -341,6 +341,7 @@ library
341 , Streamly.Internal.Data.Parser.ParserD.Types
341 , Streamly.Internal.Data.Parser.ParserD.Types
342 , Streamly.Internal.Data.Parser.ParserD.Tee
342 , Streamly.Internal.Data.Parser.ParserD.Tee
343 , Streamly.Internal.Data.Parser.ParserD
343 , Streamly.Internal.Data.Parser.ParserD
344+ , Streamly.Internal.Data.Parser
344
345
345 -- Base streams
346 -- Base streams
346 , Streamly.Internal.Data.Stream.StreamK.Type
347 , Streamly.Internal.Data.Stream.StreamK.Type