git.iko.soy/streamly
on e57424d help sign in
streamly/test/Streamly/Test/Data/Unfold.hs
453 lines 14 kB history raw
1-- |
2-- Module : Main
3-- Copyright : (c) 2020 Composewell Technologies
4--
5-- License : BSD-3-Clause
6-- Maintainer : streamly@composewell.com
7-- Stability : experimental
8-- Portability : GHC
9--
10module Main (main) where
12import Streamly.Internal.Data.Unfold (Unfold)
14import qualified Data.List as List
15import qualified Prelude
16import qualified Streamly.Internal.Data.Unfold as UF
17import qualified Streamly.Internal.Data.Stream.IsStream as S
18import qualified Streamly.Internal.Data.Stream.StreamD as D
19import qualified Streamly.Internal.Data.Stream.StreamK as K
21import Control.Monad.Trans.State.Strict
22import Data.Functor.Identity
23import Prelude hiding (const, take, drop, concat, mapM)
24import Streamly.Prelude (SerialT)
25import Test.Hspec as H
26import Test.Hspec.QuickCheck
27import Test.QuickCheck
28import Test.QuickCheck.Function
30-------------------------------------------------------------------------------
31-- Helper functions
32-------------------------------------------------------------------------------
34-- | @testUnfoldM unf seed initial final xs@, runs an unfold under state monad
35-- using @initial@ as the initial state. @final@ is the expected state after
36-- running it and @xs@ is the list of elements the stream must produce.
37testUnfoldM ::
38 (Eq s, Eq b) => Unfold (State s) a b -> a -> s -> s -> [b] -> Bool
39testUnfoldM unf seed si sf lst = evalState action si
41 where
43 action = do
44 x <- S.toList $ S.unfold unf seed
45 y <- get
46 return $ x == lst && y == sf
48testUnfoldMD :: Unfold (State Int) a Int -> a -> Int -> Int -> [Int] -> Bool
49testUnfoldMD = testUnfoldM
51-- | This is similar to 'testUnfoldM' but without the state monad.
52testUnfold :: Eq b => Unfold Identity a b -> a -> [b] -> Bool
53testUnfold unf seed lst = runIdentity action
55 where
57 action = do
58 x <- S.toList $ S.unfold unf seed
59 return $ x == lst
61testUnfoldD :: Unfold Identity a Int -> a -> [Int] -> Bool
62testUnfoldD = testUnfold
64-------------------------------------------------------------------------------
65-- Operations on input
66-------------------------------------------------------------------------------
68lmapM :: Bool
69lmapM =
70 let unf = UF.lmapM (\x -> modify (+ 1) >> return x) (UF.singleton id)
71 in testUnfoldMD unf 1 0 1 [1]
73supply :: Bool
74supply =
75 let unf = UF.supply (UF.singleton id) 1
76 in testUnfold unf undefined ([1] :: [Int])
78supplyFirst :: Bool
79supplyFirst =
80 let unf = UF.supplyFirst (UF.singleton id) 1
81 in testUnfold unf 2 ([(1, 2)] :: [(Int, Int)])
83supplySecond :: Bool
84supplySecond =
85 let unf = UF.supplySecond (UF.singleton id) 1
86 in testUnfold unf 2 ([(2, 1)] :: [(Int, Int)])
88discardFirst :: Bool
89discardFirst =
90 let unf = UF.discardFirst (UF.singleton id)
91 in testUnfold unf ((1, 2) :: (Int, Int)) [2]
93discardSecond :: Bool
94discardSecond =
95 let unf = UF.discardSecond (UF.singleton id)
96 in testUnfold unf ((1, 2) :: (Int, Int)) [1]
98swap :: Bool
99swap =
100 let unf = UF.swap (UF.singleton id)
101 in testUnfold unf ((1, 2) :: (Int, Int)) [(2, 1)]
103-------------------------------------------------------------------------------
104-- Stream generation
105-------------------------------------------------------------------------------
107fromStream :: Property
108fromStream =
109 property
110 $ \list ->
111 testUnfoldD
112 UF.fromStream
113 (S.fromList list :: SerialT Identity Int)
114 list
116fromStreamD :: Property
117fromStreamD =
118 property
119 $ \list -> testUnfoldD UF.fromStreamD (D.fromList list) (list :: [Int])
121fromStreamK :: Property
122fromStreamK =
123 property
124 $ \list -> testUnfoldD UF.fromStreamK (K.fromList list) (list :: [Int])
126nilM :: Bool
127nilM =
128 let unf = UF.nilM put
129 in testUnfoldMD unf 1 0 1 []
131consM :: Bool
132consM =
133 let cns = UF.consM (\a -> modify (+ a) >> get)
134 unf = cns $ cns $ UF.nilM $ \a -> modify (+ a)
135 in testUnfoldMD unf 1 0 3 [1, 2]
137effect :: Bool
138effect =
139 let unf = UF.effect (modify (+ 1) >> get)
140 in testUnfoldMD unf undefined 0 1 [1]
142singletonM :: Bool
143singletonM =
144 let unf = UF.singletonM (\a -> modify (+ a) >> get)
145 in testUnfoldMD unf 1 0 1 [1]
147const :: Bool
148const =
149 let unf = UF.take 10 $ UF.const (modify (+ 1) >> get)
150 in testUnfoldMD unf (0 :: Int) 0 10 [1 .. 10]
152unfoldrM :: Property
153unfoldrM =
154 property
155 $ \gen ->
156 let genA = apply gen :: Int -> Maybe (Int, Int)
157 genM x = modify (+ 1) >> return (genA x)
158 list = Prelude.take 100 $ List.unfoldr genA 1
159 unf = UF.take 100 $ UF.unfoldrM genM
160 ll = length list
161 fs = if ll < 100 then ll + 1 else 100
162 in testUnfoldMD unf 1 0 fs list
164fromListM :: Property
165fromListM =
166 property
167 $ \list ->
168 let listM = Prelude.map (\x -> modify (+ 1) >> return x) list
169 in testUnfoldMD UF.fromListM listM 0 (length list) list
171replicateM :: Property
172replicateM =
173 property
174 $ \i ->
175 let ns = max 0 i
176 seed = modify (+ 1) >> get
177 in testUnfoldMD (UF.replicateM i) seed 0 ns [1 .. i]
179repeatM :: Bool
180repeatM =
181 testUnfoldMD (UF.take 10 UF.repeatM) (modify (+ 1) >> get) 0 10 [1 .. 10]
183iterateM :: Property
184iterateM =
185 property
186 $ \next ->
187 let nextA = apply next :: Int -> Int
188 nextM x = modify (+ 1) >> return (nextA x)
189 list = Prelude.take 100 $ List.iterate nextA 1
190 unf = UF.take 100 $ UF.iterateM nextM
191 in testUnfoldMD unf (modify (+ 10) >> return 1) 0 110 list
193fromIndicesM :: Property
194fromIndicesM =
195 property
196 $ \indF ->
197 let indFA = apply indF :: Int -> Int
198 indFM x = modify (+ 1) >> return (indFA x)
199 list = Prelude.take 100 $ Prelude.map indFA [1 ..]
200 unf = UF.take 100 $ UF.fromIndicesM indFM
201 in testUnfoldMD unf 1 0 (length list) list
203enumerateFromStepNum :: Property
204enumerateFromStepNum =
205 property
206 $ \f s ->
207 let unf = UF.take 10 $ UF.enumerateFromStepNum s
208 lst = Prelude.take 10 $ List.unfoldr (\x -> Just (x, x + s)) f
209 in testUnfoldD unf f lst
211enumerateFromToFractional :: Property
212enumerateFromToFractional =
213 property
214 $ \f t ->
215 let unf = UF.enumerateFromToFractional (t :: Double)
216 list =
217 Prelude.takeWhile (<= t + 0.5)
218 $ List.unfoldr (\x -> Just (x, x + 1)) f
219 in testUnfold unf (f :: Double) list
221enumerateFromStepIntegral :: Property
222enumerateFromStepIntegral =
223 property
224 $ \f s ->
225 let unf = UF.take 10 UF.enumerateFromStepIntegral
226 lst = Prelude.take 10 $ List.unfoldr (\x -> Just (x, x + s)) f
227 in testUnfoldD unf (f, s) lst
229enumerateFromToIntegral :: Property
230enumerateFromToIntegral =
231 property
232 $ \f t ->
233 let unf = UF.enumerateFromToIntegral t
234 in testUnfoldD unf f [f .. t]
236-------------------------------------------------------------------------------
237-- Stream transformation
238-------------------------------------------------------------------------------
240mapM :: Property
241mapM =
242 property
243 $ \f list ->
244 let fA = apply f :: Int -> Int
245 fM x = modify (+ 1) >> return (fA x)
246 unf = UF.mapM fM UF.fromList
247 mList = Prelude.map fA list
248 in testUnfoldMD unf list 0 (length list) mList
250mapMWithInput :: Property
251mapMWithInput =
252 property
253 $ \f list ->
254 let fA = applyFun2 f :: [Int] -> Int -> Int
255 fM x y = modify (+ 1) >> return (fA x y)
256 unf = UF.mapMWithInput fM UF.fromList
257 mList = Prelude.map (fA list) list
258 in testUnfoldMD unf list 0 (length list) mList
260take :: Property
261take =
262 property
263 $ \i ->
264 testUnfoldD
265 (UF.take i UF.repeatM)
266 (return 1)
267 (Prelude.take i (Prelude.repeat 1))
269takeWhileM :: Property
270takeWhileM =
271 property
272 $ \f list ->
273 let fM x =
274 if apply f x
275 then modify (+ 1) >> return True
276 else return False
277 unf = UF.takeWhileM fM UF.fromList
278 fL = Prelude.takeWhile (apply f) list
279 fS = Prelude.length fL
280 in testUnfoldMD unf list 0 fS fL
282filterM :: Property
283filterM =
284 property
285 $ \f list ->
286 let fM x =
287 if apply f x
288 then modify (+ 1) >> return True
289 else return False
290 unf = UF.filterM fM UF.fromList
291 fL = Prelude.filter (apply f) list
292 fS = Prelude.length fL
293 in testUnfoldMD unf list 0 fS fL
295drop :: Property
296drop =
297 property
298 $ \i list ->
299 let unf = UF.drop i UF.fromList
300 fL = Prelude.drop i list
301 in testUnfoldD unf list fL
303dropWhileM :: Property
304dropWhileM =
305 property
306 $ \f list ->
307 let fM x =
308 if apply f x
309 then modify (+ 1) >> return True
310 else return False
311 unf = UF.dropWhileM fM UF.fromList
312 fL = Prelude.dropWhile (apply f) list
313 fS = Prelude.length list - Prelude.length fL
314 in testUnfoldMD unf list 0 fS fL
316-------------------------------------------------------------------------------
317-- Stream combination
318-------------------------------------------------------------------------------
320zipWithM :: Property
321zipWithM =
322 property
323 $ \f ->
324 let unf1 = UF.enumerateFromToIntegral 10
325 unf2 = UF.enumerateFromToIntegral 20
326 fA = applyFun2 f :: Int -> Int -> Int
327 fM a b = modify (+ 1) >> return (fA a b)
328 unf = UF.zipWithM fM unf1 unf2
329 lst = Prelude.zipWith fA [1 .. 10] [1 .. 20]
330 in testUnfoldMD unf (1, 1) 0 10 lst
332concat :: Bool
333concat =
334 let unfIn = UF.replicateM 10
335 unfOut = UF.map return $ UF.enumerateFromToIntegral 10
336 unf = UF.concat unfOut unfIn
337 lst = Prelude.concat $ Prelude.map (Prelude.replicate 10) [1 .. 10]
338 in testUnfoldD unf 1 lst
340outerProduct :: Bool
341outerProduct =
342 let unf1 = UF.enumerateFromToIntegral 10
343 unf2 = UF.enumerateFromToIntegral 20
344 unf = UF.outerProduct unf1 unf2
345 lst = [(a, b) :: (Int, Int) | a <- [0 .. 10], b <- [0 .. 20]]
346 in testUnfold unf ((0, 0) :: (Int, Int)) lst
348concatMapM :: Bool
349concatMapM =
350 let unfInF b =
351 modify (+ 1)
352 >> return
353 (UF.lmap
354 (\() -> undefined)
355 (UF.supply
356 (UF.replicateM 10)
357 (modify (+ 1) >> return b)))
358 listInF b = replicate 10 b
359 unfOut = UF.enumerateFromToIntegral 10
360 unf = UF.concatMapM unfInF unfOut
361 list = List.concatMap listInF [1 .. 10]
362 in testUnfoldMD unf 1 0 110 list
364-------------------------------------------------------------------------------
365-- Test groups
366-------------------------------------------------------------------------------
368testInputOps :: Spec
369testInputOps =
370 describe "Input"
371 $ do
372 -- prop "lmap" lmap
373 prop "lmapM" lmapM
374 prop "supply" supply
375 prop "supplyFirst" supplyFirst
376 prop "supplySecond" supplySecond
377 prop "discardFirst" discardFirst
378 prop "discardSecond" discardSecond
379 prop "swap" swap
381testGeneration :: Spec
382testGeneration =
383 describe "Generation"
384 $ do
385 prop "fromStream" fromStream
386 prop "fromStreamK" fromStreamK
387 prop "fromStreamD" fromStreamD
388 prop "nilM" nilM
389 prop "consM" consM
390 prop "effect" effect
391 prop "singletonM" singletonM
392 -- prop "singleton" singleton
393 -- prop "identity" identity
394 prop "const" const
395 prop "unfoldrM" unfoldrM
396 -- prop "fromList" fromList
397 prop "fromListM" fromListM
398 -- prop "fromSVar" fromSVar
399 -- prop "fromProducer" fromProducer
400 prop "replicateM" replicateM
401 prop "repeatM" repeatM
402 prop "iterateM" iterateM
403 prop "fromIndicesM" fromIndicesM
404 prop "enumerateFromStepIntegral" enumerateFromStepIntegral
405 prop "enumerateFromToIntegral" enumerateFromToIntegral
406 -- prop "enumerateFromIntegral" enumerateFromIntegral
407 prop "enumerateFromStepNum" enumerateFromStepNum
408 -- prop "numFrom" numFrom
409 prop "enumerateFromToFractional" enumerateFromToFractional
411testTransformation :: Spec
412testTransformation =
413 describe "Transformation"
414 $ do
415 -- prop "map" map
416 prop "mapM" mapM
417 prop "mapMWithInput" mapMWithInput
418 prop "takeWhileM" takeWhileM
419 -- prop "takeWhile" takeWhile
420 prop "take" take
421 -- prop "filter" filter
422 prop "filterM" filterM
423 prop "drop" drop
424 -- prop "dropWhile" dropWhile
425 prop "dropWhileM" dropWhileM
427testCombination :: Spec
428testCombination =
429 describe "Transformation"
430 $ do
431 prop "zipWithM" zipWithM
432 -- prop "zipWith" zipWith
433 -- prop "teeZipWith" teeZipWith
434 prop "concat" concat
435 prop "concatMapM" concatMapM
436 prop "outerProduct" outerProduct
437 -- prop "ap" ap
438 -- prop "apDiscardFst" apDiscardFst
439 -- prop "apDiscardSnd" apDiscardSnd
441-------------------------------------------------------------------------------
442-- Main
443-------------------------------------------------------------------------------
445main :: IO ()
446main =
447 hspec
448 $ describe "Unfold tests"
449 $ do
450 testInputOps
451 testGeneration
452 testTransformation
453 testCombination