git.iko.soy/streamly
on master help sign in
Add pure stream (list) instances

Pure streams are streams with Identity as the base monad. Added Eq/Ord/Read/Show/IsString/IsList instances for pure streams.

commitc28043f48a174ba03033f9427903f39959e4d56c authorHarendra Kumar <harendra.kumar@gmail.com> dateFri 2 Nov 2018, 17:58 (8 years ago) parent7527247
14 files changed+640−186
compare with master
unifiedsplit
benchmark/BaseStreams.hs+8−2 benchmark/Chart.hs+1−1 benchmark/Linear.hs+140−108 benchmark/LinearOps.hs+62−1 benchmark/StreamDOps.hs+34−29 benchmark/StreamKOps.hs+3−3 src/Streamly/Prelude.hs+29−35 src/Streamly/Streams/Prelude.hs+97−1 src/Streamly/Streams/Serial.hs+72−1 src/Streamly/Streams/StreamD.hs+75 stack-7.10.yaml+1 stack-8.0.yaml+1 streamly.cabal+30−5 test/PureStreams.hs+87
benchmark/BaseStreams.hs+8−2
@@ -99,7 +99,11 @@ main =
9999 , benchIO "dropWhile-true" (D.dropWhileTrue 4) D.sourceUnfoldrM
100100 , benchIO "dropWhile-false" (D.dropWhileFalse 4) D.sourceUnfoldrM
101101 ]
102− , benchIO "zip" D.zip D.sourceUnfoldrM
102+ , bgroup "zipping"
103+ [ benchFold "eqBy" D.eqBy D.sourceUnfoldrM
104+ , benchFold "cmpBy" D.cmpBy D.sourceUnfoldrM
105+ , benchIO "zip" D.zip D.sourceUnfoldrM
106+ ]
103107 , bgroup "mixed"
104108 [ benchIO "scan-map" (D.scanMap 1) D.sourceUnfoldrM
105109 , benchIO "drop-map" (D.dropMap 1) D.sourceUnfoldrM
@@ -206,7 +210,9 @@ main =
206210 , benchIO "dropWhile-true" (K.dropWhileTrue 4) K.sourceUnfoldrM
207211 , benchIO "dropWhile-false" (K.dropWhileFalse 4) K.sourceUnfoldrM
208212 ]
209− , benchIO "zip" K.zip K.sourceUnfoldrM
213+ , bgroup "zipping"
214+ [ benchIO "zip" K.zip K.sourceUnfoldrM
215+ ]
210216 , bgroup "mixed"
211217 [ benchIO "scan-map" (K.scanMap 1) K.sourceUnfoldrM
212218 , benchIO "drop-map" (K.dropMap 1) K.sourceUnfoldrM
benchmark/Chart.hs+1−1
@@ -119,7 +119,7 @@ makeLinearGraphs cfg@Config{..} inputFile = do
119119 { title = (++) <$> title <*> Just " Transformation & Zip"
120120 , classifyBenchmark = \b ->
121121 if "serially/transformation/" `isPrefixOf` b
122− || "serially/zip" `isPrefixOf` b
122+ || "serially/zipping" `isPrefixOf` b
123123 then Just ("Streamly", last $ splitOn "/" b)
124124 else Nothing
125125 }
benchmark/Linear.hs+140−108
@@ -6,157 +6,189 @@
66-- Maintainer : harendra.kumar@gmail.com
77
88import Control.DeepSeq (NFData)
9−-- import Data.Functor.Identity (Identity, runIdentity)
9+import Data.Functor.Identity (Identity, runIdentity)
1010import System.Random (randomRIO)
11+
12+import qualified GHC.Exts as GHC
1113import qualified LinearOps as Ops
1214
1315import Streamly
16+import qualified Streamly.Prelude as S
1417import Gauge
1518
1619-- We need a monadic bind here to make sure that the function f does not get
1720-- completely optimized out by the compiler in some cases.
18−--
21+
1922-- | Takes a fold method, and uses it with a default source.
20−{-# INLINE benchIO #-}
21−benchIO :: (IsStream t, NFData b) => String -> (t IO Int -> IO b) -> Benchmark
22−benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f . Ops.source
23+{-# INLINE benchIOSink #-}
24+benchIOSink
25+ :: (IsStream t, NFData b)
26+ => String -> (t IO Int -> IO b) -> Benchmark
27+benchIOSink name f = bench name $ nfIO $ randomRIO (1,1) >>= f . Ops.source
2328
2429-- | Takes a source, and uses it with a default drain/fold method.
25−{-# INLINE benchSrcIO #-}
26−benchSrcIO
30+{-# INLINE benchIOSrc #-}
31+benchIOSrc
2732 :: (t IO Int -> SerialT IO Int)
2833 -> String
2934 -> (Int -> t IO Int)
3035 -> Benchmark
31−benchSrcIO t name f
32− = bench name $ nfIO $ randomRIO (1,1) >>= Ops.toNull t . f
36+benchIOSrc t name f =
37+ bench name $ nfIO $ randomRIO (1,1) >>= (Ops.toNull t) . f
38+
39+{-# INLINE benchPure #-}
40+benchPure :: NFData b => String -> (Int -> a) -> (a -> b) -> Benchmark
41+benchPure name src f = bench name $ nfIO $ randomRIO (1,1) >>= return . f . src
3342
34−{-
35−_benchId :: NFData b => String -> (Ops.Stream m Int -> Identity b) -> Benchmark
36−_benchId name f = bench name $ nf (runIdentity . f) (Ops.source 10)
37−-}
43+{-# INLINE benchPureSink #-}
44+benchPureSink :: NFData b => String -> (SerialT Identity Int -> b) -> Benchmark
45+benchPureSink name f = benchPure name Ops.sourceUnfoldr f
46+
47+{-# INLINE benchPureSrc #-}
48+benchPureSrc :: String -> (Int -> SerialT Identity a) -> Benchmark
49+benchPureSrc name src = benchPure name src (runIdentity . runStream)
3850
3951main :: IO ()
4052main =
4153 defaultMain
4254 [ bgroup "serially"
43− [ bgroup "generation"
55+ [ bgroup "pure"
56+ [ benchPureSink "eqBy" Ops.eqBy
57+ , benchPureSink "==" Ops.eqInstance
58+ , benchPureSink "/=" Ops.eqInstanceNotEq
59+ , benchPureSink "cmpBy" Ops.cmpBy
60+ , benchPureSink "<" Ops.ordInstance
61+ , benchPureSink "min" Ops.ordInstanceMin
62+ , benchPureSrc "IsList.fromList" Ops.sourceIsList
63+ , benchPureSink "IsList.toList" GHC.toList
64+ , benchPureSrc "IsString.fromString" Ops.sourceIsString
65+ , benchPure "readsPrec" (\n -> S.fromList [1..n :: Int])
66+ Ops.readInstance
67+ , benchPureSink "showsPrec" Ops.showInstance
68+ , benchPure "showsPrecList" (\n -> S.fromList [1..n :: Int])
69+ Ops.showInstanceList
70+ ]
71+ , bgroup "generation"
4472 [ -- Most basic, barely stream continuations running
45− benchSrcIO serially "unfoldr" Ops.sourceUnfoldr
46− , benchSrcIO serially "unfoldrM" Ops.sourceUnfoldrM
47− , benchSrcIO serially "fromList" Ops.sourceFromList
48− , benchSrcIO serially "fromListM" Ops.sourceFromListM
73+ benchIOSrc serially "unfoldr" Ops.sourceUnfoldr
74+ , benchIOSrc serially "unfoldrM" Ops.sourceUnfoldrM
75+ , benchIOSrc serially "fromList" Ops.sourceFromList
76+ , benchIOSrc serially "fromListM" Ops.sourceFromListM
4977 -- These are essentially cons and consM
50− , benchSrcIO serially "fromFoldable" Ops.sourceFromFoldable
51− , benchSrcIO serially "fromFoldableM" Ops.sourceFromFoldableM
78+ , benchIOSrc serially "fromFoldable" Ops.sourceFromFoldable
79+ , benchIOSrc serially "fromFoldableM" Ops.sourceFromFoldableM
5280 -- These are essentially appends
53− , benchSrcIO serially "foldMapWith" Ops.sourceFoldMapWith
54− , benchSrcIO serially "foldMapWithM" Ops.sourceFoldMapWithM
81+ , benchIOSrc serially "foldMapWith" Ops.sourceFoldMapWith
82+ , benchIOSrc serially "foldMapWithM" Ops.sourceFoldMapWithM
5583 ]
5684 , bgroup "elimination"
57− [ benchIO "toNull" $ Ops.toNull serially
58− , benchIO "uncons" Ops.uncons
59− , benchIO "init" Ops.init
60− , benchIO "tail" Ops.tail
61− , benchIO "nullHeadTail" Ops.nullHeadTail
62− , benchIO "mapM_" Ops.mapM_
63− , benchIO "toList" Ops.toList
64− , benchIO "foldr" Ops.foldr
65− , benchIO "foldr1" Ops.foldr1
66− , benchIO "foldrM" Ops.foldrM
67− , benchIO "foldl'" Ops.foldl'
68− , benchIO "foldl1'" Ops.foldl1'
85+ [ benchIOSink "toNull" $ Ops.toNull serially
86+ , benchIOSink "uncons" Ops.uncons
87+ , benchIOSink "init" Ops.init
88+ , benchIOSink "tail" Ops.tail
89+ , benchIOSink "nullHeadTail" Ops.nullHeadTail
90+ , benchIOSink "mapM_" Ops.mapM_
91+ , benchIOSink "toList" Ops.toList
92+ , benchIOSink "foldr" Ops.foldr
93+ , benchIOSink "foldr1" Ops.foldr1
94+ , benchIOSink "foldrM" Ops.foldrM
95+ , benchIOSink "foldl'" Ops.foldl'
96+ , benchIOSink "foldl1'" Ops.foldl1'
6997
70− , benchIO "last" Ops.last
71− , benchIO "length" Ops.length
72− , benchIO "elem" Ops.elem
73− , benchIO "notElem" Ops.notElem
74− , benchIO "all" Ops.all
75− , benchIO "any" Ops.any
76− , benchIO "and" Ops.and
77− , benchIO "or" Ops.or
78− , benchIO "find" Ops.find
79− , benchIO "findIndex" Ops.findIndex
80− , benchIO "elemIndex" Ops.elemIndex
81− , benchIO "maximum" Ops.maximum
82− , benchIO "minimum" Ops.minimum
83− , benchIO "sum" Ops.sum
84− , benchIO "product" Ops.product
98+ , benchIOSink "last" Ops.last
99+ , benchIOSink "length" Ops.length
100+ , benchIOSink "elem" Ops.elem
101+ , benchIOSink "notElem" Ops.notElem
102+ , benchIOSink "all" Ops.all
103+ , benchIOSink "any" Ops.any
104+ , benchIOSink "and" Ops.and
105+ , benchIOSink "or" Ops.or
106+ , benchIOSink "find" Ops.find
107+ , benchIOSink "findIndex" Ops.findIndex
108+ , benchIOSink "elemIndex" Ops.elemIndex
109+ , benchIOSink "maximum" Ops.maximum
110+ , benchIOSink "minimum" Ops.minimum
111+ , benchIOSink "sum" Ops.sum
112+ , benchIOSink "product" Ops.product
85113 ]
86114 , bgroup "transformation"
87− [ benchIO "scan" (Ops.scan 1)
88− , benchIO "map" (Ops.map 1)
89− , benchIO "fmap" (Ops.fmap 1)
90− , benchIO "mapM" (Ops.mapM serially 1)
91− , benchIO "mapMaybe" (Ops.mapMaybe 1)
92− , benchIO "mapMaybeM" (Ops.mapMaybeM 1)
115+ [ benchIOSink "scan" (Ops.scan 1)
116+ , benchIOSink "map" (Ops.map 1)
117+ , benchIOSink "fmap" (Ops.fmap 1)
118+ , benchIOSink "mapM" (Ops.mapM serially 1)
119+ , benchIOSink "mapMaybe" (Ops.mapMaybe 1)
120+ , benchIOSink "mapMaybeM" (Ops.mapMaybeM 1)
93121 , bench "sequence" $ nfIO $ randomRIO (1,1000) >>= \n ->
94122 Ops.sequence serially (Ops.sourceUnfoldrMAction n)
95− , benchIO "findIndices" (Ops.findIndices 1)
96− , benchIO "elemIndices" (Ops.elemIndices 1)
97− -- , benchIO "concat" Ops.concat
123+ , benchIOSink "findIndices" (Ops.findIndices 1)
124+ , benchIOSink "elemIndices" (Ops.elemIndices 1)
125+ -- , benchIOSink "concat" Ops.concat
98126 ]
99127 , bgroup "transformationX4"
100− [ benchIO "scan" (Ops.scan 4)
101− , benchIO "map" (Ops.map 4)
102− , benchIO "fmap" (Ops.fmap 4)
103− , benchIO "mapM" (Ops.mapM serially 4)
104− , benchIO "mapMaybe" (Ops.mapMaybe 4)
105− , benchIO "mapMaybeM" (Ops.mapMaybeM 4)
128+ [ benchIOSink "scan" (Ops.scan 4)
129+ , benchIOSink "map" (Ops.map 4)
130+ , benchIOSink "fmap" (Ops.fmap 4)
131+ , benchIOSink "mapM" (Ops.mapM serially 4)
132+ , benchIOSink "mapMaybe" (Ops.mapMaybe 4)
133+ , benchIOSink "mapMaybeM" (Ops.mapMaybeM 4)
106134 -- , bench "sequence" $ nfIO $ randomRIO (1,1000) >>= \n ->
107135 -- Ops.sequence serially (Ops.sourceUnfoldrMAction n)
108− , benchIO "findIndices" (Ops.findIndices 4)
109− , benchIO "elemIndices" (Ops.elemIndices 4)
110− -- , benchIO "concat" Ops.concat
136+ , benchIOSink "findIndices" (Ops.findIndices 4)
137+ , benchIOSink "elemIndices" (Ops.elemIndices 4)
138+ -- , benchIOSink "concat" Ops.concat
111139 ]
112140 , bgroup "filtering"
113− [ benchIO "filter-even" (Ops.filterEven 1)
114− , benchIO "filter-all-out" (Ops.filterAllOut 1)
115− , benchIO "filter-all-in" (Ops.filterAllIn 1)
116− , benchIO "take-all" (Ops.takeAll 1)
117− , benchIO "takeWhile-true" (Ops.takeWhileTrue 1)
118− --, benchIO "takeWhileM-true" (Ops.takeWhileMTrue 1)
119− , benchIO "drop-one" (Ops.dropOne 1)
120− , benchIO "drop-all" (Ops.dropAll 1)
121− , benchIO "dropWhile-true" (Ops.dropWhileTrue 1)
122− --, benchIO "dropWhileM-true" (Ops.dropWhileMTrue 1)
123− , benchIO "dropWhile-false" (Ops.dropWhileFalse 1)
141+ [ benchIOSink "filter-even" (Ops.filterEven 1)
142+ , benchIOSink "filter-all-out" (Ops.filterAllOut 1)
143+ , benchIOSink "filter-all-in" (Ops.filterAllIn 1)
144+ , benchIOSink "take-all" (Ops.takeAll 1)
145+ , benchIOSink "takeWhile-true" (Ops.takeWhileTrue 1)
146+ --, benchIOSink "takeWhileM-true" (Ops.takeWhileMTrue 1)
147+ , benchIOSink "drop-one" (Ops.dropOne 1)
148+ , benchIOSink "drop-all" (Ops.dropAll 1)
149+ , benchIOSink "dropWhile-true" (Ops.dropWhileTrue 1)
150+ --, benchIOSink "dropWhileM-true" (Ops.dropWhileMTrue 1)
151+ , benchIOSink "dropWhile-false" (Ops.dropWhileFalse 1)
124152 ]
125153 , bgroup "filteringX4"
126− [ benchIO "filter-even" (Ops.filterEven 4)
127− , benchIO "filter-all-out" (Ops.filterAllOut 4)
128− , benchIO "filter-all-in" (Ops.filterAllIn 4)
129− , benchIO "take-all" (Ops.takeAll 4)
130− , benchIO "takeWhile-true" (Ops.takeWhileTrue 4)
131− --, benchIO "takeWhileM-true" (Ops.takeWhileMTrue 4)
132− , benchIO "drop-one" (Ops.dropOne 4)
133− , benchIO "drop-all" (Ops.dropAll 4)
134− , benchIO "dropWhile-true" (Ops.dropWhileTrue 4)
135− --, benchIO "dropWhileM-true" (Ops.dropWhileMTrue 4)
136− , benchIO "dropWhile-false" (Ops.dropWhileFalse 4)
154+ [ benchIOSink "filter-even" (Ops.filterEven 4)
155+ , benchIOSink "filter-all-out" (Ops.filterAllOut 4)
156+ , benchIOSink "filter-all-in" (Ops.filterAllIn 4)
157+ , benchIOSink "take-all" (Ops.takeAll 4)
158+ , benchIOSink "takeWhile-true" (Ops.takeWhileTrue 4)
159+ --, benchIOSink "takeWhileM-true" (Ops.takeWhileMTrue 4)
160+ , benchIOSink "drop-one" (Ops.dropOne 4)
161+ , benchIOSink "drop-all" (Ops.dropAll 4)
162+ , benchIOSink "dropWhile-true" (Ops.dropWhileTrue 4)
163+ --, benchIOSink "dropWhileM-true" (Ops.dropWhileMTrue 4)
164+ , benchIOSink "dropWhile-false" (Ops.dropWhileFalse 4)
165+ ]
166+ , bgroup "zipping"
167+ [ benchIOSink "eqBy" Ops.eqBy
168+ , benchIOSink "cmpBy" Ops.cmpBy
169+ , benchIOSink "zip" Ops.zip
170+ , benchIOSink "zipM" Ops.zipM
137171 ]
138− , benchIO "zip" Ops.zip
139− , benchIO "zipM" Ops.zipM
140172 , bgroup "mixedX4"
141− [ benchIO "scan-map" (Ops.scanMap 4)
142− , benchIO "drop-map" (Ops.dropMap 4)
143− , benchIO "drop-scan" (Ops.dropScan 4)
144− , benchIO "take-drop" (Ops.takeDrop 4)
145− , benchIO "take-scan" (Ops.takeScan 4)
146− , benchIO "take-map" (Ops.takeMap 4)
147− , benchIO "filter-drop" (Ops.filterDrop 4)
148− , benchIO "filter-take" (Ops.filterTake 4)
149− , benchIO "filter-scan" (Ops.filterScan 4)
150− , benchIO "filter-map" (Ops.filterMap 4)
173+ [ benchIOSink "scan-map" (Ops.scanMap 4)
174+ , benchIOSink "drop-map" (Ops.dropMap 4)
175+ , benchIOSink "drop-scan" (Ops.dropScan 4)
176+ , benchIOSink "take-drop" (Ops.takeDrop 4)
177+ , benchIOSink "take-scan" (Ops.takeScan 4)
178+ , benchIOSink "take-map" (Ops.takeMap 4)
179+ , benchIOSink "filter-drop" (Ops.filterDrop 4)
180+ , benchIOSink "filter-take" (Ops.filterTake 4)
181+ , benchIOSink "filter-scan" (Ops.filterScan 4)
182+ , benchIOSink "filter-map" (Ops.filterMap 4)
151183 ]
152184 , bgroup "iterated"
153− [ benchSrcIO serially "mapM" Ops.iterateMapM
154− , benchSrcIO serially "scan(1/100)" Ops.iterateScan
155− , benchSrcIO serially "filterEven" Ops.iterateFilterEven
156− , benchSrcIO serially "takeAll" Ops.iterateTakeAll
157− , benchSrcIO serially "dropOne" Ops.iterateDropOne
158− , benchSrcIO serially "dropWhileFalse" Ops.iterateDropWhileFalse
159− , benchSrcIO serially "dropWhileTrue" Ops.iterateDropWhileTrue
185+ [ benchIOSrc serially "mapM" Ops.iterateMapM
186+ , benchIOSrc serially "scan(1/100)" Ops.iterateScan
187+ , benchIOSrc serially "filterEven" Ops.iterateFilterEven
188+ , benchIOSrc serially "takeAll" Ops.iterateTakeAll
189+ , benchIOSrc serially "dropOne" Ops.iterateDropOne
190+ , benchIOSrc serially "dropWhileFalse" Ops.iterateDropWhileFalse
191+ , benchIOSrc serially "dropWhileTrue" Ops.iterateDropWhileTrue
160192 ]
161193 ]
162194 ]
benchmark/LinearOps.hs+62−1
@@ -12,12 +12,14 @@
1212module LinearOps where
1313
1414import Control.Monad (when)
15+import Data.Functor.Identity (Identity)
1516import Data.Maybe (fromJust)
1617import Prelude
1718 (Monad, Int, (+), ($), (.), return, fmap, even, (>), (<=), (==), (<=),
1819 subtract, undefined, Maybe(..), odd, Bool, not, (>>=), mapM_, curry,
1920 maxBound, div)
2021import qualified Prelude as P
22+import qualified GHC.Exts as GHC
2123
2224import qualified Streamly as S
2325import qualified Streamly.Prelude as S
@@ -107,6 +109,18 @@ sourceUnfoldrMAction n = S.serially $ S.unfoldrM step n
107109 then return Nothing
108110 else return (Just (return cnt, cnt + 1))
109111
112+-------------------------------------------------------------------------------
113+-- Pure stream generation
114+-------------------------------------------------------------------------------
115+
116+{-# INLINE sourceIsList #-}
117+sourceIsList :: Int -> S.SerialT Identity Int
118+sourceIsList n = GHC.fromList [n..n+value]
119+
120+{-# INLINE sourceIsString #-}
121+sourceIsString :: Int -> S.SerialT Identity P.Char
122+sourceIsString n = GHC.fromString (P.replicate (n + value) 'a')
123+
110124-------------------------------------------------------------------------------
111125-- Elimination
112126-------------------------------------------------------------------------------
@@ -128,7 +142,8 @@ toList, foldr, foldrM :: Monad m => Stream m Int -> m [Int]
128142{-# INLINE elemIndex #-}
129143{-# INLINE foldl1' #-}
130144{-# INLINE foldr1 #-}
131−last, minimum, maximum, find, findIndex, elemIndex, foldl1', foldr1 :: Monad m => Stream m Int -> m (Maybe Int)
145+last, minimum, maximum, find, findIndex, elemIndex, foldl1', foldr1
146+ :: Monad m => Stream m Int -> m (Maybe Int)
132147
133148{-# INLINE foldl' #-}
134149{-# INLINE length #-}
@@ -360,8 +375,17 @@ zipAsyncM src = do
360375 r <- S.tail src
361376 let src1 = fromJust r
362377 transform (S.zipAsyncWithM (curry return) src src1)
378+
363379concat _n = return ()
364380
381+{-# INLINE eqBy #-}
382+eqBy :: (Monad m, P.Eq a) => Stream m a -> m P.Bool
383+eqBy src = S.eqBy (==) src src
384+
385+{-# INLINE cmpBy #-}
386+cmpBy :: (Monad m, P.Ord a) => Stream m a -> m P.Ordering
387+cmpBy src = S.cmpBy P.compare src src
388+
365389-------------------------------------------------------------------------------
366390-- Mixed Composition
367391-------------------------------------------------------------------------------
@@ -390,3 +414,40 @@ filterDrop n = composeN n $ S.drop 1 . S.filter (<= maxValue)
390414filterTake n = composeN n $ S.take maxValue . S.filter (<= maxValue)
391415filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
392416filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)
417+
418+-------------------------------------------------------------------------------
419+-- Pure stream operations
420+-------------------------------------------------------------------------------
421+
422+{-# INLINE eqInstance #-}
423+eqInstance :: Stream Identity Int -> Bool
424+eqInstance src = src == src
425+
426+{-# INLINE eqInstanceNotEq #-}
427+eqInstanceNotEq :: Stream Identity Int -> Bool
428+eqInstanceNotEq src = src P./= src
429+
430+{-# INLINE ordInstance #-}
431+ordInstance :: Stream Identity Int -> Bool
432+ordInstance src = src P.< src
433+
434+{-# INLINE ordInstanceMin #-}
435+ordInstanceMin :: Stream Identity Int -> Stream Identity Int
436+ordInstanceMin src = P.min src src
437+
438+{-# INLINE showInstance #-}
439+showInstance :: Stream Identity Int -> P.String
440+showInstance src = P.showsPrec 0 src ""
441+
442+{-# INLINE showInstanceList #-}
443+showInstanceList :: Stream Identity Int -> P.String
444+showInstanceList src = P.showsPrec 0 (GHC.toList src P.++ [2..value]) ""
445+
446+{-# INLINE readInstance #-}
447+readInstance :: Stream Identity Int -> Stream Identity Int
448+readInstance src =
449+ let r = P.readsPrec 0 ("fromList [1"
450+ P.++ P.concat (P.replicate value ",1") P.++ "]")
451+ in case r of
452+ [(x,"")] -> src S.<> x
453+ _ -> P.error "readInstance: no parse"
benchmark/StreamDOps.hs+34−29
@@ -15,7 +15,7 @@ import Data.Maybe (isJust)
1515import Prelude
1616 (Monad, Int, (+), ($), (.), return, (>), even, (<=), div,
1717 subtract, undefined, Maybe(..), not, mapM_, (>>=),
18− maxBound, fmap, odd)
18+ maxBound, fmap, odd, (==))
1919import qualified Prelude as P
2020
2121import qualified Streamly.Streams.StreamD as S
@@ -24,32 +24,6 @@ value, maxValue :: Int
2424value = 100000
2525maxValue = value + 1000
2626
27−-------------------------------------------------------------------------------
28−-- Benchmark ops
29−-------------------------------------------------------------------------------
30−
31−{-# INLINE uncons #-}
32−{-# INLINE nullTail #-}
33−{-# INLINE headTail #-}
34−{-# INLINE zip #-}
35−{-
36−{-# INLINE concat #-}
37−-}
38−uncons, nullTail, headTail, zip
39− -- concat,
40− :: Monad m
41− => Stream m Int -> m ()
42−
43−{-# INLINE toList #-}
44−toList :: Monad m => Stream m Int -> m [Int]
45−{-# INLINE foldl #-}
46−foldl :: Monad m => Stream m Int -> m Int
47−{-# INLINE last #-}
48−last :: Monad m => Stream m Int -> m (Maybe Int)
49−
50−{-# INLINE toNull #-}
51−toNull :: Monad m => Stream m Int -> m ()
52−
5327-------------------------------------------------------------------------------
5428-- Stream generation and elimination
5529-------------------------------------------------------------------------------
@@ -103,8 +77,17 @@ source = sourceUnfoldrM
10377runStream :: Monad m => Stream m a -> m ()
10478runStream = S.runStream
10579
80+{-# INLINE toNull #-}
81+toNull :: Monad m => Stream m Int -> m ()
10682toNull = runStream
10783
84+{-# INLINE uncons #-}
85+{-# INLINE nullTail #-}
86+{-# INLINE headTail #-}
87+uncons, nullTail, headTail
88+ :: Monad m
89+ => Stream m Int -> m ()
90+
10891uncons s = do
10992 r <- S.uncons s
11093 case r of
@@ -123,8 +106,16 @@ headTail s = do
123106 h <- S.head s
124107 when (isJust h) $ S.tail s >>= mapM_ headTail
125108
109+{-# INLINE toList #-}
110+toList :: Monad m => Stream m Int -> m [Int]
126111toList = S.toList
112+
113+{-# INLINE foldl #-}
114+foldl :: Monad m => Stream m Int -> m Int
127115foldl = S.foldl' (+) 0
116+
117+{-# INLINE last #-}
118+last :: Monad m => Stream m Int -> m (Maybe Int)
128119last = S.last
129120
130121-------------------------------------------------------------------------------
@@ -236,8 +227,22 @@ iterateDropWhileTrue = iterateSource (S.dropWhile (<= maxValue)) maxIters
236227-- Zipping and concat
237228-------------------------------------------------------------------------------
238229
239−zip src = transform $ S.zipWith (,) src src
240−-- concat _n = return ()
230+{-# INLINE eqBy #-}
231+eqBy :: (Monad m, P.Eq a) => S.Stream m a -> m P.Bool
232+eqBy src = S.eqBy (==) src src
233+
234+{-# INLINE cmpBy #-}
235+cmpBy :: (Monad m, P.Ord a) => S.Stream m a -> m P.Ordering
236+cmpBy src = S.cmpBy P.compare src src
237+
238+{-# INLINE zip #-}
239+zip :: Monad m => Stream m Int -> m ()
240+zip src = transform $ S.zipWith (,) src src
241+
242+{-
243+{-# INLINE concat #-}
244+concat _n = return ()
245+-}
241246
242247-------------------------------------------------------------------------------
243248-- Mixed Composition
benchmark/StreamKOps.hs+3−3
@@ -19,7 +19,7 @@ import Prelude
1919import qualified Prelude as P
2020
2121import qualified Streamly.Streams.StreamK as S
22−import qualified Streamly.Streams.Prelude as S
22+import qualified Streamly.Streams.Prelude as SP
2323import qualified Streamly.SVar as S
2424
2525value, maxValue :: Int
@@ -98,11 +98,11 @@ sourceFromFoldableM n = S.fromFoldableM (Prelude.fmap return [n..n+value])
9898
9999{-# INLINE sourceFoldMapWith #-}
100100sourceFoldMapWith :: Int -> Stream m Int
101−sourceFoldMapWith n = S.foldMapWith S.serial S.yield [n..n+value]
101+sourceFoldMapWith n = SP.foldMapWith S.serial S.yield [n..n+value]
102102
103103{-# INLINE sourceFoldMapWithM #-}
104104sourceFoldMapWithM :: Monad m => Int -> Stream m Int
105−sourceFoldMapWithM n = S.foldMapWith S.serial (S.yieldM . return) [n..n+value]
105+sourceFoldMapWithM n = SP.foldMapWith S.serial (S.yieldM . return) [n..n+value]
106106
107107{-# INLINE source #-}
108108source :: S.MonadAsync m => Int -> Stream m Int
src/Streamly/Prelude.hs+29−35
@@ -51,6 +51,7 @@ module Streamly.Prelude
5151 K.nil
5252 , K.cons
5353 , (K..:)
54+
5455 , consM
5556 , (|:)
5657 , yield
@@ -89,7 +90,7 @@ module Streamly.Prelude
8990 -- ** Generate From
9091 -- | Convert an input structure, container or source into a stream. All of
9192 -- these can be expressed in terms of primitives.
92− , fromList
93+ , P.fromList
9394 , fromListM
9495 , K.fromFoldable
9596 , fromFoldableM
@@ -136,6 +137,8 @@ module Streamly.Prelude
136137 , any
137138 , and
138139 , or
140+ , eqBy
141+ , cmpBy
139142
140143 -- Full folds - need to go through all elements
141144 , length
@@ -233,9 +236,12 @@ import qualified System.IO as IO
233236
234237import Streamly.SVar (MonadAsync, defState, rstState)
235238import Streamly.Streams.Combinators (maxYields)
239+import Streamly.Streams.Prelude (fromStreamS, toStreamS)
240+import Streamly.Streams.StreamD (fromStreamD, toStreamD)
236241import Streamly.Streams.StreamK (IsStream(..))
237242import Streamly.Streams.Serial (SerialT)
238243
244+import qualified Streamly.Streams.Prelude as P
239245import qualified Streamly.Streams.StreamK as K
240246import qualified Streamly.Streams.StreamD as D
241247import qualified Streamly.Streams.Zip as Z
@@ -249,27 +255,6 @@ import qualified Streamly.Streams.StreamD as S
249255
250256import qualified Streamly.Streams.Serial as Serial
251257
252−------------------------------------------------------------------------------
253−-- Conversion to and from direct style stream
254−------------------------------------------------------------------------------
255−
256−-- These definitions are dependent on what is imported as S
257−{-# INLINE fromStreamS #-}
258−fromStreamS :: (IsStream t, Monad m) => S.Stream m a -> t m a
259−fromStreamS = fromStream . S.toStreamK
260−
261−{-# INLINE toStreamS #-}
262−toStreamS :: (IsStream t, Monad m) => t m a -> S.Stream m a
263−toStreamS = S.fromStreamK . toStream
264−
265−{-# INLINE fromStreamD #-}
266−fromStreamD :: (IsStream t, Monad m) => D.Stream m a -> t m a
267−fromStreamD = fromStream . D.toStreamK
268−
269−{-# INLINE toStreamD #-}
270−toStreamD :: (IsStream t, Monad m) => t m a -> D.Stream m a
271−toStreamD = D.fromStreamK . toStream
272−
273258------------------------------------------------------------------------------
274259-- Deconstruction
275260------------------------------------------------------------------------------
@@ -460,17 +445,6 @@ iterateM step = go
460445-- Conversions
461446------------------------------------------------------------------------------
462447
463−-- | Construct a stream from a list containing pure values. More efficient list
464−-- specific implementation of 'K.fromFoldable' as it works well with fusion
465−-- optimization.
466−--
467−-- @since 0.4.0
468−{-# INLINE_EARLY fromList #-}
469−fromList :: (Monad m, IsStream t) => [a] -> t m a
470−fromList = fromStreamS . S.fromList
471−{-# RULES "fromList fallback to StreamK" [1]
472− forall a. S.toStreamK (S.fromList a) = K.fromFoldable a #-}
473−
474448-- | Construct a stream from a list containing monadic actions. More efficient
475449-- list specific implementation of 'fromFoldableM' especially for serial
476450-- streams as it works well with fusion optimization.
@@ -579,7 +553,7 @@ foldl = foldx
579553-- @since 0.2.0
580554{-# INLINE foldl' #-}
581555foldl' :: Monad m => (b -> a -> b) -> b -> SerialT m a -> m b
582−foldl' step begin m = S.foldl' step begin $ toStreamS m
556+foldl' = P.foldl'
583557
584558-- | Strict left fold, for non-empty streams, using first element as the
585559-- starting value. Returns 'Nothing' if the stream is empty.
@@ -798,7 +772,7 @@ mapM_ f m = S.mapM_ f $ toStreamS m
798772-- @since 0.1.0
799773{-# INLINE toList #-}
800774toList :: Monad m => SerialT m a -> m [a]
801−toList m = S.toList $ toStreamS m
775+toList = P.toList
802776
803777-- | Write a stream of Strings to an IO Handle.
804778--
@@ -1039,3 +1013,23 @@ zipWithM f m1 m2 = fromStreamS $ S.zipWithM f (toStreamS m1) (toStreamS m2)
10391013{-# INLINABLE zipWith #-}
10401014zipWith :: (IsStream t, Monad m) => (a -> b -> c) -> t m a -> t m b -> t m c
10411015zipWith f m1 m2 = fromStreamS $ S.zipWith f (toStreamS m1) (toStreamS m2)
1016+
1017+------------------------------------------------------------------------------
1018+-- Comparison
1019+------------------------------------------------------------------------------
1020+
1021+-- | Compare two streams for equality using a equality function.
1022+--
1023+-- @since 0.5.3
1024+{-# INLINABLE eqBy #-}
1025+eqBy :: Monad m => (a -> b -> Bool) -> SerialT m a -> SerialT m b -> m Bool
1026+eqBy = P.eqBy
1027+
1028+-- | Compare two streams using a comparison function.
1029+--
1030+-- @since 0.5.3
1031+{-# INLINABLE cmpBy #-}
1032+cmpBy
1033+ :: Monad m
1034+ => (a -> b -> Ordering) -> SerialT m a -> SerialT m b -> m Ordering
1035+cmpBy = P.cmpBy
src/Streamly/Streams/Prelude.hs+97−1
@@ -1,3 +1,11 @@
1+{-# LANGUAGE CPP #-}
2+
3+#if __GLASGOW_HASKELL__ >= 800
4+{-# OPTIONS_GHC -Wno-orphans #-}
5+#endif
6+
7+#include "inline.hs"
8+
19-- |
210-- Module : Streamly.Streams.Prelude
311-- Copyright : (c) 2017 Harendra Kumar
@@ -10,15 +18,103 @@
1018--
1119module Streamly.Streams.Prelude
1220 (
21+ -- * Stream Conversion
22+ fromStreamS
23+ , toStreamS
24+
25+ -- * Conversion operations
26+ , fromList
27+ , toList
28+
29+ -- * Fold operations
30+ , foldl'
31+
32+ -- * Zip style operations
33+ , eqBy
34+ , cmpBy
35+
1336 -- * Fold Utilities
14− foldWith
37+ , foldWith
1538 , foldMapWith
1639 , forEachWith
1740 )
1841where
1942
43+#ifdef USE_STREAMK_ONLY
44+import qualified Streamly.Streams.StreamK as S
45+#else
46+import qualified Streamly.Streams.StreamD as S
47+#endif
48+
2049import Streamly.Streams.StreamK (IsStream(..))
2150import qualified Streamly.Streams.StreamK as K
51+import qualified Streamly.Streams.StreamD as D
52+
53+------------------------------------------------------------------------------
54+-- Conversion to and from direct style stream
55+------------------------------------------------------------------------------
56+
57+-- These definitions are dependent on what is imported as S
58+{-# INLINE fromStreamS #-}
59+fromStreamS :: (IsStream t, Monad m) => S.Stream m a -> t m a
60+fromStreamS = fromStream . S.toStreamK
61+
62+{-# INLINE toStreamS #-}
63+toStreamS :: (IsStream t, Monad m) => t m a -> S.Stream m a
64+toStreamS = S.fromStreamK . toStream
65+
66+------------------------------------------------------------------------------
67+-- Conversions
68+------------------------------------------------------------------------------
69+
70+-- | Construct a stream from a list containing pure values. More efficient list
71+-- specific implementation of 'K.fromFoldable' as it works well with fusion
72+-- optimization.
73+--
74+-- @since 0.4.0
75+{-# INLINE_EARLY fromList #-}
76+fromList :: (Monad m, IsStream t) => [a] -> t m a
77+fromList = fromStreamS . S.fromList
78+{-# RULES "fromList fallback to StreamK" [1]
79+ forall a. S.toStreamK (S.fromList a) = K.fromFoldable a #-}
80+
81+-- | Convert a stream into a list in the underlying monad.
82+--
83+-- @since 0.1.0
84+{-# INLINE toList #-}
85+toList :: (Monad m, IsStream t) => t m a -> m [a]
86+toList m = S.toList $ toStreamS m
87+
88+------------------------------------------------------------------------------
89+-- Folds
90+------------------------------------------------------------------------------
91+
92+-- | Strict left associative fold.
93+--
94+-- @since 0.2.0
95+{-# INLINE foldl' #-}
96+foldl' :: (Monad m, IsStream t) => (b -> a -> b) -> b -> t m a -> m b
97+foldl' step begin m = S.foldl' step begin $ toStreamS m
98+
99+------------------------------------------------------------------------------
100+-- Comparison
101+------------------------------------------------------------------------------
102+
103+-- | Compare two streams for equality
104+--
105+-- @since 0.5.3
106+{-# INLINE eqBy #-}
107+eqBy :: (IsStream t, Monad m) => (a -> b -> Bool) -> t m a -> t m b -> m Bool
108+eqBy f m1 m2 = D.eqBy f (D.toStreamD m1) (D.toStreamD m2)
109+
110+-- | Compare two streams
111+--
112+-- @since 0.5.3
113+{-# INLINE cmpBy #-}
114+cmpBy
115+ :: (IsStream t, Monad m)
116+ => (a -> b -> Ordering) -> t m a -> t m b -> m Ordering
117+cmpBy f m1 m2 = D.cmpBy f (D.toStreamD m1) (D.toStreamD m2)
22118
23119------------------------------------------------------------------------------
24120-- Fold Utilities
src/Streamly/Streams/Serial.hs+72−1
@@ -6,6 +6,7 @@
66{-# LANGUAGE GeneralizedNewtypeDeriving#-}
77{-# LANGUAGE InstanceSigs #-}
88{-# LANGUAGE MultiParamTypeClasses #-}
9+{-# LANGUAGE TypeFamilies #-}
910{-# LANGUAGE UndecidableInstances #-} -- XXX
1011
1112-- |
@@ -42,6 +43,7 @@ module Streamly.Streams.Serial
4243 )
4344where
4445
46+import Control.DeepSeq (NFData(..), NFData1(..), rnf1)
4547import Control.Monad (ap)
4648import Control.Monad.Base (MonadBase(..), liftBaseDefault)
4749import Control.Monad.Catch (MonadThrow, throwM)
@@ -50,11 +52,16 @@ import Control.Monad.IO.Class (MonadIO(..))
5052import Control.Monad.Reader.Class (MonadReader(..))
5153import Control.Monad.State.Class (MonadState(..))
5254import Control.Monad.Trans.Class (MonadTrans(lift))
55+import Data.Functor.Identity (Identity, runIdentity)
5356import Data.Semigroup (Semigroup(..))
54−import Prelude hiding (map, mapM)
57+import GHC.Exts (IsList(..), IsString(..))
58+import Text.Read (Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec,
59+ readListPrecDefault)
60+import Prelude hiding (map, mapM, String)
5561
5662import Streamly.SVar (rstState)
5763import Streamly.Streams.StreamK (IsStream(..), adapt, Stream(..))
64+import qualified Streamly.Streams.Prelude as P
5865import qualified Streamly.Streams.StreamK as K
5966import qualified Streamly.Streams.StreamD as D
6067
@@ -343,3 +350,67 @@ instance Monad m => Monad (WSerialT m) where
343350
344351MONAD_APPLICATIVE_INSTANCE(WSerialT,)
345352MONAD_COMMON_INSTANCES(WSerialT,)
353+
354+------------------------------------------------------------------------------
355+-- Lists
356+------------------------------------------------------------------------------
357+
358+-- Serial streams can act like regular lists using the Identity monad
359+
360+-- XXX Show instance is 10x slower compared to read, we can do much better.
361+-- The list show instance itself is really slow.
362+
363+-- XXX The default definitions of "<" in the Ord instance etc. do not perform
364+-- well, because they do not get inlined. Need to add INLINE in Ord class in
365+-- base?
366+
367+#define LIST_INSTANCES(STREAM) \
368+instance IsList (STREAM Identity a) where { \
369+ type (Item (STREAM Identity a)) = a; \
370+ {-# INLINE fromList #-}; \
371+ fromList = P.fromList; \
372+ {-# INLINE toList #-}; \
373+ toList = runIdentity . P.toList }; \
374+ \
375+instance Eq a => Eq (STREAM Identity a) where { \
376+ {-# INLINE (==) #-}; \
377+ (==) xs ys = runIdentity $ P.eqBy (==) xs ys }; \
378+ \
379+instance Ord a => Ord (STREAM Identity a) where { \
380+ {-# INLINE compare #-}; \
381+ compare xs ys = runIdentity $ P.cmpBy compare xs ys; \
382+ {-# INLINE (<) #-}; \
383+ x < y = case compare x y of { LT -> True; _ -> False }; \
384+ {-# INLINE (<=) #-}; \
385+ x <= y = case compare x y of { GT -> False; _ -> True }; \
386+ {-# INLINE (>) #-}; \
387+ x > y = case compare x y of { GT -> True; _ -> False }; \
388+ {-# INLINE (>=) #-}; \
389+ x >= y = case compare x y of { LT -> False; _ -> True }; \
390+ {-# INLINE max #-}; \
391+ max x y = if x <= y then y else x; \
392+ {-# INLINE min #-}; \
393+ min x y = if x <= y then x else y; }; \
394+ \
395+instance Show a => Show (STREAM Identity a) where { \
396+ showsPrec p dl = showParen (p > 10) $ \
397+ showString "fromList " . shows (toList dl) }; \
398+ \
399+instance Read a => Read (STREAM Identity a) where { \
400+ readPrec = parens $ prec 10 $ do { \
401+ Ident "fromList" <- lexP; \
402+ dl <- readPrec; \
403+ return (fromList dl) }; \
404+ readListPrec = readListPrecDefault }; \
405+ \
406+instance (a ~ Char) => IsString (STREAM Identity a) where { \
407+ {-# INLINE fromString #-}; \
408+ fromString = P.fromList }; \
409+ \
410+instance NFData a => NFData (STREAM Identity a) where { rnf = rnf1 }; \
411+instance NFData1 (STREAM Identity) where { \
412+ {-# INLINE liftRnf #-}; \
413+ liftRnf r = runIdentity . P.foldl' (\_ x -> r x) () }
414+
415+LIST_INSTANCES(SerialT)
416+LIST_INSTANCES(WSerialT)
src/Streamly/Streams/StreamD.hs+75
@@ -61,6 +61,7 @@ module Streamly.Streams.StreamD
6161 , fromList
6262 , fromListM
6363 , fromStreamK
64+ , fromStreamD
6465
6566 -- * Elimination
6667 -- ** General Folds
@@ -89,6 +90,7 @@ module Streamly.Streams.StreamD
8990 -- | Transform a stream into another type.
9091 , toList
9192 , toStreamK
93+ , toStreamD
9294
9395 -- * Transformation
9496 -- ** By folding (scans)
@@ -116,6 +118,10 @@ module Streamly.Streams.StreamD
116118 -- * Zipping
117119 , zipWith
118120 , zipWithM
121+
122+ -- * Comparisions
123+ , eqBy
124+ , cmpBy
119125 )
120126where
121127
@@ -292,6 +298,10 @@ fromStreamK = Stream step
292298 yieldk a r = return $ Yield a r
293299 in K.unStream m1 gst stop single yieldk
294300
301+{-# INLINE toStreamD #-}
302+toStreamD :: (K.IsStream t, Monad m) => t m a -> Stream m a
303+toStreamD = fromStreamK . K.toStream
304+
295305------------------------------------------------------------------------------
296306-- Elimination by Folds
297307------------------------------------------------------------------------------
@@ -501,6 +511,10 @@ toStreamK (Stream step state) = go state
501511 forall s. fromStreamK (toStreamK s) = s #-}
502512#endif
503513
514+{-# INLINE fromStreamD #-}
515+fromStreamD :: (K.IsStream t, Monad m) => Stream m a -> t m a
516+fromStreamD = K.fromStream . toStreamK
517+
504518------------------------------------------------------------------------------
505519-- Transformation by Folding (Scans)
506520------------------------------------------------------------------------------
@@ -708,6 +722,67 @@ zipWithM f (Stream stepa ta) (Stream stepb tb) = Stream step (ta, tb, Nothing)
708722zipWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c
709723zipWith f = zipWithM (\a b -> return (f a b))
710724
725+------------------------------------------------------------------------------
726+-- Comparisions
727+------------------------------------------------------------------------------
728+
729+{-# INLINE_NORMAL eqBy #-}
730+eqBy :: Monad m => (a -> b -> Bool) -> Stream m a -> Stream m b -> m Bool
731+eqBy eq (Stream step1 t1) (Stream step2 t2) = eq_loop0 SPEC t1 t2
732+ where
733+ eq_loop0 !_ s1 s2 = do
734+ r <- step1 defState s1
735+ case r of
736+ Yield x s1' -> eq_loop1 SPEC x s1' s2
737+ Skip s1' -> eq_loop0 SPEC s1' s2
738+ Stop -> eq_null s2
739+
740+ eq_loop1 !_ x s1 s2 = do
741+ r <- step2 defState s2
742+ case r of
743+ Yield y s2'
744+ | eq x y -> eq_loop0 SPEC s1 s2'
745+ | otherwise -> return False
746+ Skip s2' -> eq_loop1 SPEC x s1 s2'
747+ Stop -> return False
748+
749+ eq_null s2 = do
750+ r <- step2 defState s2
751+ case r of
752+ Yield _ _ -> return False
753+ Skip s2' -> eq_null s2'
754+ Stop -> return True
755+
756+-- | Compare two streams lexicographically
757+{-# INLINE_NORMAL cmpBy #-}
758+cmpBy
759+ :: Monad m
760+ => (a -> b -> Ordering) -> Stream m a -> Stream m b -> m Ordering
761+cmpBy cmp (Stream step1 t1) (Stream step2 t2) = cmp_loop0 SPEC t1 t2
762+ where
763+ cmp_loop0 !_ s1 s2 = do
764+ r <- step1 defState s1
765+ case r of
766+ Yield x s1' -> cmp_loop1 SPEC x s1' s2
767+ Skip s1' -> cmp_loop0 SPEC s1' s2
768+ Stop -> cmp_null s2
769+
770+ cmp_loop1 !_ x s1 s2 = do
771+ r <- step2 defState s2
772+ case r of
773+ Yield y s2' -> case x `cmp` y of
774+ EQ -> cmp_loop0 SPEC s1 s2'
775+ c -> return c
776+ Skip s2' -> cmp_loop1 SPEC x s1 s2'
777+ Stop -> return GT
778+
779+ cmp_null s2 = do
780+ r <- step2 defState s2
781+ case r of
782+ Yield _ _ -> return LT
783+ Skip s2' -> cmp_null s2'
784+ Stop -> return EQ
785+
711786------------------------------------------------------------------------------
712787-- Instances
713788------------------------------------------------------------------------------
stack-7.10.yaml+1
@@ -12,6 +12,7 @@ extra-deps:
1212 - SDL-0.6.5.1
1313 - gauge-0.2.4
1414 - basement-0.0.7
15+ - deepseq-1.4.4.0
1516flags: {}
1617extra-package-dbs: []
1718# For mac ports installed SDL library on Mac OS X
stack-8.0.yaml+1
@@ -8,6 +8,7 @@ extra-deps:
88 - SDL-0.6.5.1
99 - gauge-0.2.4
1010 - basement-0.0.4
11+ - deepseq-1.4.4.0
1112flags: {}
1213extra-package-dbs: []
1314rebuild-ghc-options: true
streamly.cabal+30−5
@@ -172,6 +172,7 @@ library
172172
173173 build-depends: base >= 4.8 && < 5
174174 , ghc-prim >= 0.2 && < 0.6
175+ , deepseq >= 1.4.3 && < 1.5
175176 , containers >= 0.5 && < 0.7
176177 , heaps >= 0.3 && < 0.4
177178
@@ -225,6 +226,30 @@ test-suite test
225226 , exceptions >= 0.8 && < 0.11
226227 default-language: Haskell2010
227228
229+test-suite pure-streams
230+ type: exitcode-stdio-1.0
231+ main-is: PureStreams.hs
232+ hs-source-dirs: test
233+ ghc-options: -O0 -Wall -threaded -with-rtsopts=-N -fno-ignore-asserts
234+ if flag(dev)
235+ cpp-options: -DDEVBUILD
236+ ghc-options: -Wmissed-specialisations
237+ -Wall-missed-specialisations
238+ if impl(ghc >= 8.0)
239+ ghc-options: -Wcompat
240+ -Wunrecognised-warning-flags
241+ -Widentities
242+ -Wincomplete-record-updates
243+ -Wincomplete-uni-patterns
244+ -Wredundant-constraints
245+ -Wnoncanonical-monad-instances
246+ -Wnoncanonical-monadfail-instances
247+ build-depends:
248+ streamly
249+ , base >= 4.8 && < 5
250+ , hspec >= 2.0 && < 3
251+ default-language: Haskell2010
252+
228253test-suite properties
229254 type: exitcode-stdio-1.0
230255 main-is: Prop.hs
@@ -329,7 +354,7 @@ benchmark linear
329354 build-depends:
330355 streamly
331356 , base >= 4.8 && < 5
332− , deepseq >= 1.4.0 && < 1.5
357+ , deepseq >= 1.4.3 && < 1.5
333358 , random >= 1.0 && < 2.0
334359 , gauge >= 0.2.4 && < 0.3
335360
@@ -357,7 +382,7 @@ benchmark linear-async
357382 build-depends:
358383 streamly
359384 , base >= 4.8 && < 5
360− , deepseq >= 1.4.0 && < 1.5
385+ , deepseq >= 1.4.3 && < 1.5
361386 , random >= 1.0 && < 2.0
362387 , gauge >= 0.2.4 && < 0.3
363388
@@ -384,7 +409,7 @@ benchmark linear-rate
384409 build-depends:
385410 streamly
386411 , base >= 4.8 && < 5
387− , deepseq >= 1.4.0 && < 1.5
412+ , deepseq >= 1.4.3 && < 1.5
388413 , random >= 1.0 && < 2.0
389414 , gauge >= 0.2.4 && < 0.3
390415
@@ -411,7 +436,7 @@ benchmark nested
411436 build-depends:
412437 streamly
413438 , base >= 4.8 && < 5
414− , deepseq >= 1.4.0 && < 1.5
439+ , deepseq >= 1.4.3 && < 1.5
415440 , random >= 1.0 && < 2.0
416441 , gauge >= 0.2.4 && < 0.3
417442
@@ -454,7 +479,7 @@ benchmark base
454479 buildable: True
455480 build-depends:
456481 base >= 4.8 && < 5
457− , deepseq >= 1.4.0 && < 1.5
482+ , deepseq >= 1.4.3 && < 1.5
458483 , random >= 1.0 && < 2.0
459484 , gauge >= 0.2.4 && < 0.3
460485
test/PureStreams.hsnew file+87
@@ -0,0 +1,87 @@
1+{-# LANGUAGE FlexibleInstances #-}
2+{-# LANGUAGE TypeFamilies #-}
3+{-# LANGUAGE OverloadedStrings #-}
4+{-# LANGUAGE OverloadedLists #-}
5+{-# LANGUAGE PatternSynonyms #-}
6+{-# LANGUAGE ViewPatterns #-}
7+{-# LANGUAGE ScopedTypeVariables #-}
8+
9+module Main (main) where
10+
11+import Test.Hspec
12+import Data.Functor.Identity
13+import qualified GHC.Exts as GHC
14+import Prelude hiding (String)
15+
16+import Streamly
17+import qualified Streamly.Prelude as S
18+
19+type List = SerialT Identity
20+type String = List Char
21+
22+------------------------------------------------------------------------------
23+-- Patterns
24+------------------------------------------------------------------------------
25+
26+-- | A pattern that matches an empty pure stream.
27+pattern Nil :: SerialT Identity a
28+pattern Nil <- (runIdentity . S.null -> True) where
29+ Nil = S.nil
30+
31+-- | A pattern that deconstructs a pure stream into its head and tail.
32+pattern Cons :: a -> SerialT Identity a -> SerialT Identity a
33+pattern Cons x xs <- (runIdentity . S.uncons -> Just (x, xs)) where
34+ Cons x xs = S.cons x xs
35+
36+main :: IO ()
37+main = hspec $ do
38+ -- Need type annotation to resolve the monad ambiguity
39+ -- Use toList or runIdentity . S.toList to convert to Haskell lists
40+
41+ it "overloaded lists" $ do
42+ ([1..3] :: Main.List Int) `shouldBe` S.fromList [1..3]
43+ GHC.toList ([1..3] :: Main.List Int) `shouldBe` [1..3]
44+
45+ it "overloaded strings" $ do
46+ ("hello" :: Main.String) `shouldBe` S.fromList "hello"
47+
48+ it "pattern match constructs a list" $ do
49+ ('x' `Cons` Nil) `shouldBe` ('x' `S.cons` S.nil :: Main.String)
50+ (1 `Cons` [2] :: Main.List Int) `shouldBe` S.fromList [1,2]
51+
52+ it "pattern match on empty string" $
53+ case "" :: Main.String of
54+ Nil -> return ()
55+ _ -> expectationFailure "not reached"
56+
57+ it "pattern matches on singleton string" $
58+ case "a" :: Main.String of
59+ Cons x Nil -> x `shouldBe` 'a'
60+ _ -> expectationFailure "not reached"
61+
62+ it "pattern matches on non-empty string" $
63+ case "hello" <> "world" :: Main.String of
64+ Cons x1 (Cons x2 xs) -> do
65+ x1 `shouldBe` 'h'
66+ x2 `shouldBe` 'e'
67+ xs `shouldBe` "lloworld"
68+ _ -> expectationFailure "not reached"
69+
70+ it "pattern match on non-empty list" $
71+ case S.map (+1) [1..10] :: Main.List Int of
72+ Cons x xs -> do
73+ x `shouldBe` 2
74+ xs `shouldBe` [3..11]
75+ _ -> expectationFailure "not reached"
76+
77+ it "Shows as string" $ do
78+ show (S.fromList [1..3] :: Main.List Int) `shouldBe` "fromList [1,2,3]"
79+
80+ it "Reads from a string" $ do
81+ (read "fromList [1,2,3]" :: Main.List Int) `shouldBe` S.fromList [1..3]
82+
83+ it "Eq instance" $ do
84+ (S.fromList [1,2,3] :: Main.List Int) == S.fromList [1,2,3] `shouldBe` True
85+
86+ it "Ord instance" $ do
87+ (S.fromList [1,2,3] :: Main.List Int) > S.fromList [1,2,1] `shouldBe` True