git.iko.soy/streamly
on 00a2f7b help sign in
streamly/test/Streamly/Test/Data/Unfold.hs
449 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.supply (UF.replicateM 10) (modify (+ 1) >> return b))
354 listInF b = replicate 10 b
355 unfOut = UF.enumerateFromToIntegral 10
356 unf = UF.concatMapM unfInF unfOut
357 list = List.concatMap listInF [1 .. 10]
358 in testUnfoldMD unf 1 0 110 list
360-------------------------------------------------------------------------------
361-- Test groups
362-------------------------------------------------------------------------------
364testInputOps :: Spec
365testInputOps =
366 describe "Input"
367 $ do
368 -- prop "lmap" lmap
369 prop "lmapM" lmapM
370 prop "supply" supply
371 prop "supplyFirst" supplyFirst
372 prop "supplySecond" supplySecond
373 prop "discardFirst" discardFirst
374 prop "discardSecond" discardSecond
375 prop "swap" swap
377testGeneration :: Spec
378testGeneration =
379 describe "Generation"
380 $ do
381 prop "fromStream" fromStream
382 prop "fromStreamK" fromStreamK
383 prop "fromStreamD" fromStreamD
384 prop "nilM" nilM
385 prop "consM" consM
386 prop "effect" effect
387 prop "singletonM" singletonM
388 -- prop "singleton" singleton
389 -- prop "identity" identity
390 prop "const" const
391 prop "unfoldrM" unfoldrM
392 -- prop "fromList" fromList
393 prop "fromListM" fromListM
394 -- prop "fromSVar" fromSVar
395 -- prop "fromProducer" fromProducer
396 prop "replicateM" replicateM
397 prop "repeatM" repeatM
398 prop "iterateM" iterateM
399 prop "fromIndicesM" fromIndicesM
400 prop "enumerateFromStepIntegral" enumerateFromStepIntegral
401 prop "enumerateFromToIntegral" enumerateFromToIntegral
402 -- prop "enumerateFromIntegral" enumerateFromIntegral
403 prop "enumerateFromStepNum" enumerateFromStepNum
404 -- prop "numFrom" numFrom
405 prop "enumerateFromToFractional" enumerateFromToFractional
407testTransformation :: Spec
408testTransformation =
409 describe "Transformation"
410 $ do
411 -- prop "map" map
412 prop "mapM" mapM
413 prop "mapMWithInput" mapMWithInput
414 prop "takeWhileM" takeWhileM
415 -- prop "takeWhile" takeWhile
416 prop "take" take
417 -- prop "filter" filter
418 prop "filterM" filterM
419 prop "drop" drop
420 -- prop "dropWhile" dropWhile
421 prop "dropWhileM" dropWhileM
423testCombination :: Spec
424testCombination =
425 describe "Transformation"
426 $ do
427 prop "zipWithM" zipWithM
428 -- prop "zipWith" zipWith
429 -- prop "teeZipWith" teeZipWith
430 prop "concat" concat
431 prop "concatMapM" concatMapM
432 prop "outerProduct" outerProduct
433 -- prop "ap" ap
434 -- prop "apDiscardFst" apDiscardFst
435 -- prop "apDiscardSnd" apDiscardSnd
437-------------------------------------------------------------------------------
438-- Main
439-------------------------------------------------------------------------------
441main :: IO ()
442main =
443 hspec
444 $ describe "Unfold tests"
445 $ do
446 testInputOps
447 testGeneration
448 testTransformation
449 testCombination