git.iko.soy/streamly
on 3feeec2 help sign in
streamly/test/Streamly/Test/Data/Unfold.hs
448 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.function id)
71 in testUnfoldMD unf 1 0 1 [1]
73supply :: Bool
74supply =
75 let unf = UF.supply 1 (UF.function id)
76 in testUnfold unf undefined ([1] :: [Int])
78supplyFirst :: Bool
79supplyFirst =
80 let unf = UF.supplyFirst 1 (UF.function id)
81 in testUnfold unf 2 ([(1, 2)] :: [(Int, Int)])
83supplySecond :: Bool
84supplySecond =
85 let unf = UF.supplySecond 1 (UF.function id)
86 in testUnfold unf 2 ([(2, 1)] :: [(Int, Int)])
88discardFirst :: Bool
89discardFirst =
90 let unf = UF.discardFirst (UF.function id)
91 in testUnfold unf ((1, 2) :: (Int, Int)) [2]
93discardSecond :: Bool
94discardSecond =
95 let unf = UF.discardSecond (UF.function id)
96 in testUnfold unf ((1, 2) :: (Int, Int)) [1]
98swap :: Bool
99swap =
100 let unf = UF.swap (UF.function 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]
137functionM :: Bool
138functionM =
139 let unf = UF.functionM (\a -> modify (+ a) >> get)
140 in testUnfoldMD unf 1 0 1 [1]
142const :: Bool
143const =
144 let unf = UF.fromEffect (modify (+ 1) >> get)
145 in testUnfoldMD unf (0 :: Int) 0 1 [1]
147unfoldrM :: Property
148unfoldrM =
149 property
150 $ \gen ->
151 let genA = apply gen :: Int -> Maybe (Int, Int)
152 genM x = modify (+ 1) >> return (genA x)
153 list = Prelude.take 100 $ List.unfoldr genA 1
154 unf = UF.take 100 $ UF.unfoldrM genM
155 ll = length list
156 fs = if ll < 100 then ll + 1 else 100
157 in testUnfoldMD unf 1 0 fs list
159fromListM :: Property
160fromListM =
161 property
162 $ \list ->
163 let listM = Prelude.map (\x -> modify (+ 1) >> return x) list
164 in testUnfoldMD UF.fromListM listM 0 (length list) list
166replicateM :: Property
167replicateM =
168 property
169 $ \i ->
170 let ns = max 0 i
171 seed = modify (+ 1) >> get
172 in testUnfoldMD (UF.replicateM i) seed 0 ns [1 .. i]
174repeatM :: Bool
175repeatM =
176 testUnfoldMD (UF.take 10 UF.repeatM) (modify (+ 1) >> get) 0 10 [1 .. 10]
178iterateM :: Property
179iterateM =
180 property
181 $ \next ->
182 let nextA = apply next :: Int -> Int
183 nextM x = modify (+ 1) >> return (nextA x)
184 list = Prelude.take 100 $ List.iterate nextA 1
185 unf = UF.take 100 $ UF.iterateM nextM
186 in testUnfoldMD unf (modify (+ 10) >> return 1) 0 110 list
188fromIndicesM :: Property
189fromIndicesM =
190 property
191 $ \indF ->
192 let indFA = apply indF :: Int -> Int
193 indFM x = modify (+ 1) >> return (indFA x)
194 list = Prelude.take 100 $ Prelude.map indFA [1 ..]
195 unf = UF.take 100 $ UF.fromIndicesM indFM
196 in testUnfoldMD unf 1 0 (length list) list
198enumerateFromStepNum :: Property
199enumerateFromStepNum =
200 property
201 $ \f s ->
202 let unf = UF.take 10 $ UF.enumerateFromStepNum s
203 lst = Prelude.take 10 $ List.unfoldr (\x -> Just (x, x + s)) f
204 in testUnfoldD unf f lst
206#if MIN_VERSION_base(4,12,0)
207enumerateFromToFractional :: Property
208enumerateFromToFractional =
209 property
210 $ \f t ->
211 let unf = UF.enumerateFromToFractional (t :: Double)
212 in testUnfold unf (f :: Double) [f..(t :: Double)]
213#endif
215enumerateFromStepIntegral :: Property
216enumerateFromStepIntegral =
217 property
218 $ \f s ->
219 let unf = UF.take 10 UF.enumerateFromStepIntegral
220 lst = Prelude.take 10 $ List.unfoldr (\x -> Just (x, x + s)) f
221 in testUnfoldD unf (f, s) lst
223enumerateFromToIntegral :: Property
224enumerateFromToIntegral =
225 property
226 $ \f t ->
227 let unf = UF.enumerateFromToIntegral t
228 in testUnfoldD unf f [f .. t]
230-------------------------------------------------------------------------------
231-- Stream transformation
232-------------------------------------------------------------------------------
234mapM :: Property
235mapM =
236 property
237 $ \f list ->
238 let fA = apply f :: Int -> Int
239 fM x = modify (+ 1) >> return (fA x)
240 unf = UF.mapM fM UF.fromList
241 mList = Prelude.map fA list
242 in testUnfoldMD unf list 0 (length list) mList
244mapMWithInput :: Property
245mapMWithInput =
246 property
247 $ \f list ->
248 let fA = applyFun2 f :: [Int] -> Int -> Int
249 fM x y = modify (+ 1) >> return (fA x y)
250 unf = UF.mapMWithInput fM UF.fromList
251 mList = Prelude.map (fA list) list
252 in testUnfoldMD unf list 0 (length list) mList
254take :: Property
255take =
256 property
257 $ \i ->
258 testUnfoldD
259 (UF.take i UF.repeatM)
260 (return 1)
261 (Prelude.take i (Prelude.repeat 1))
263takeWhileM :: Property
264takeWhileM =
265 property
266 $ \f list ->
267 let fM x =
268 if apply f x
269 then modify (+ 1) >> return True
270 else return False
271 unf = UF.takeWhileM fM UF.fromList
272 fL = Prelude.takeWhile (apply f) list
273 fS = Prelude.length fL
274 in testUnfoldMD unf list 0 fS fL
276filterM :: Property
277filterM =
278 property
279 $ \f list ->
280 let fM x =
281 if apply f x
282 then modify (+ 1) >> return True
283 else return False
284 unf = UF.filterM fM UF.fromList
285 fL = Prelude.filter (apply f) list
286 fS = Prelude.length fL
287 in testUnfoldMD unf list 0 fS fL
289drop :: Property
290drop =
291 property
292 $ \i list ->
293 let unf = UF.drop i UF.fromList
294 fL = Prelude.drop i list
295 in testUnfoldD unf list fL
297dropWhileM :: Property
298dropWhileM =
299 property
300 $ \f list ->
301 let fM x =
302 if apply f x
303 then modify (+ 1) >> return True
304 else return False
305 unf = UF.dropWhileM fM UF.fromList
306 fL = Prelude.dropWhile (apply f) list
307 fS = Prelude.length list - Prelude.length fL
308 in testUnfoldMD unf list 0 fS fL
310-------------------------------------------------------------------------------
311-- Stream combination
312-------------------------------------------------------------------------------
314zipWithM :: Property
315zipWithM =
316 property
317 $ \f ->
318 let unf1 = UF.enumerateFromToIntegral 10
319 unf2 = UF.enumerateFromToIntegral 20
320 fA = applyFun2 f :: Int -> Int -> Int
321 fM a b = modify (+ 1) >> return (fA a b)
322 unf = UF.zipWithM fM (UF.lmap fst unf1) (UF.lmap snd unf2)
323 lst = Prelude.zipWith fA [1 .. 10] [1 .. 20]
324 in testUnfoldMD unf (1, 1) 0 10 lst
326concat :: Bool
327concat =
328 let unfIn = UF.replicateM 10
329 unfOut = UF.map return $ UF.enumerateFromToIntegral 10
330 unf = UF.many unfOut unfIn
331 lst = Prelude.concat $ Prelude.map (Prelude.replicate 10) [1 .. 10]
332 in testUnfoldD unf 1 lst
334outerProduct :: Bool
335outerProduct =
336 let unf1 = UF.enumerateFromToIntegral 10
337 unf2 = UF.enumerateFromToIntegral 20
338 unf = crossProduct unf1 unf2
339 lst = [(a, b) :: (Int, Int) | a <- [0 .. 10], b <- [0 .. 20]]
340 in testUnfold unf ((0, 0) :: (Int, Int)) lst
342 where
344 crossProduct u1 u2 = UF.cross (UF.lmap fst u1) (UF.lmap snd u2)
346concatMapM :: Bool
347concatMapM =
348 let inner b =
349 let u = UF.lmap (\_ -> modify (+ 1) >> return b) (UF.replicateM 10)
350 in modify (+ 1) >> return u
351 unf = UF.concatMapM inner (UF.enumerateFromToIntegral 10)
352 list = List.concatMap (replicate 10) [1 .. 10]
353 in testUnfoldMD unf 1 0 110 list
355-------------------------------------------------------------------------------
356-- Test groups
357-------------------------------------------------------------------------------
359testInputOps :: Spec
360testInputOps =
361 describe "Input"
362 $ do
363 -- prop "lmap" lmap
364 prop "lmapM" lmapM
365 prop "supply" supply
366 prop "supplyFirst" supplyFirst
367 prop "supplySecond" supplySecond
368 prop "discardFirst" discardFirst
369 prop "discardSecond" discardSecond
370 prop "swap" swap
372testGeneration :: Spec
373testGeneration =
374 describe "Generation"
375 $ do
376 prop "fromStream" fromStream
377 prop "fromStreamK" fromStreamK
378 prop "fromStreamD" fromStreamD
379 prop "nilM" nilM
380 prop "consM" consM
381 prop "functionM" functionM
382 -- prop "function" function
383 -- prop "identity" identity
384 prop "const" const
385 prop "unfoldrM" unfoldrM
386 -- prop "fromList" fromList
387 prop "fromListM" fromListM
388 -- prop "fromSVar" fromSVar
389 -- prop "fromProducer" fromProducer
390 prop "replicateM" replicateM
391 prop "repeatM" repeatM
392 prop "iterateM" iterateM
393 prop "fromIndicesM" fromIndicesM
394 prop "enumerateFromStepIntegral" enumerateFromStepIntegral
395 prop "enumerateFromToIntegral" enumerateFromToIntegral
396 -- prop "enumerateFromIntegral" enumerateFromIntegral
397 prop "enumerateFromStepNum" enumerateFromStepNum
398 -- prop "numFrom" numFrom
399#if MIN_VERSION_base(4,12,0)
400 prop "enumerateFromToFractional" enumerateFromToFractional
401#endif
403testTransformation :: Spec
404testTransformation =
405 describe "Transformation"
406 $ do
407 -- prop "map" map
408 prop "mapM" mapM
409 prop "mapMWithInput" mapMWithInput
410 prop "takeWhileM" takeWhileM
411 -- prop "takeWhile" takeWhile
412 prop "take" take
413 -- prop "filter" filter
414 prop "filterM" filterM
415 prop "drop" drop
416 -- prop "dropWhile" dropWhile
417 prop "dropWhileM" dropWhileM
419testCombination :: Spec
420testCombination =
421 describe "Transformation"
422 $ do
423 prop "zipWithM" zipWithM
424 -- prop "zipWith" zipWith
425 -- prop "teeZipWith" teeZipWith
426 prop "concat" concat
427 prop "concatMapM" concatMapM
428 prop "outerProduct" outerProduct
429 -- prop "ap" ap
430 -- prop "apDiscardFst" apDiscardFst
431 -- prop "apDiscardSnd" apDiscardSnd
433-------------------------------------------------------------------------------
434-- Main
435-------------------------------------------------------------------------------
437moduleName :: String
438moduleName = "Data.Unfold"
440main :: IO ()
441main =
442 hspec
443 $ describe moduleName
444 $ do
445 testInputOps
446 testGeneration
447 testTransformation
448 testCombination