@@ -0,0 +1,258 @@
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+--
10+module Main (main) where
11+
12+import qualified Streamly.Internal.Data.Unfold as UF
13+import qualified Streamly.Internal.Data.Stream.IsStream as S
14+import qualified Prelude as P
15+
16+import Control.Monad.Trans.State.Strict
17+import Data.Functor.Identity
18+import Prelude hiding (const, take, drop, concat)
19+import Streamly.Prelude (SerialT)
20+import Test.Hspec as H
21+import Test.Hspec.QuickCheck
22+import Test.QuickCheck
23+import Test.QuickCheck.Function
24+
25+fromStream :: Property
26+fromStream =
27+ property $ \n -> do
28+ let strm = S.fromList n :: SerialT IO Int
29+ n1 <- S.toList $ S.unfold UF.fromStream strm
30+ n1 `shouldBe` (n :: [Int])
31+
32+nilM :: Bool
33+nilM = evalState action undefined
34+ where
35+ action = do
36+ x <- S.toList $ S.unfold (UF.nilM put) (1 :: Int)
37+ y <- get
38+ return $ x == ([] :: [Int]) && y == 1
39+
40+consM :: Bool
41+consM = evalState action 0
42+ where
43+ action = do
44+ x <-
45+ S.toList $
46+ S.unfold
47+ (UF.consM (\a -> modify (+ a) >> get) $
48+ UF.consM (\a -> modify (+ a) >> get) $ UF.nilM put)
49+ 1
50+ y <- get
51+ return $ x == ([1, 2] :: [Int]) && y == 1
52+
53+effect :: Bool
54+effect = evalState action undefined
55+ where
56+ action = do
57+ x <- S.toList $ S.unfold (UF.effect (put (1 :: Int))) undefined
58+ y <- get
59+ return $ x == [()] && y == 1
60+
61+singletonM :: Bool
62+singletonM = evalState action undefined
63+ where
64+ action = do
65+ x <- S.toList $ S.unfold (UF.singletonM put) (1 :: Int)
66+ y <- get
67+ return $ x == [()] && y == 1
68+
69+const :: Bool
70+const = evalState action 0
71+ where
72+ action = do
73+ x <-
74+ S.toList $
75+ S.take 10 $ S.unfold (UF.const (modify (+ 1) >> get)) undefined
76+ y <- get
77+ let rList = [1..10] :: [Int]
78+ return $ x == rList && y == 10
79+
80+fromListM :: Property
81+fromListM = property $ \x -> evalState (action x) 0
82+ where
83+ action x = do
84+ let list = P.map (\a -> modify (+ a) >> return a) (x :: [Int])
85+ x1 <- S.toList $ S.unfold UF.fromListM list
86+ y <- get
87+ return $ x == x1 && y == foldr (+) 0 x
88+
89+replicateM :: Property
90+replicateM =
91+ property $ \x ->
92+ runIdentity $ do
93+ x1 <- S.toList $ S.unfold (UF.replicateM x) ()
94+ let x2 = P.replicate x ()
95+ return $ x1 == x2
96+
97+repeatM :: Property
98+repeatM =
99+ property $ \x ->
100+ runIdentity $ do
101+ x1 <- S.toList $ S.take x $ S.unfold UF.repeatM ()
102+ let x2 = P.take x $ P.repeat ()
103+ return $ x1 == x2
104+
105+take :: Property
106+take =
107+ property $ \x ->
108+ runIdentity $ do
109+ x1 <- S.toList $ S.unfold (UF.take x UF.repeatM) (return ())
110+ x2 <- S.toList $ S.take x $ S.unfold UF.repeatM (return ())
111+ return $ x1 == x2
112+
113+takeWhileM :: Property
114+takeWhileM = property $ \f x -> evalState (action f x) 0
115+ where
116+ action f x = do
117+ let f' z = if apply f z
118+ then modify (+ 1) >> return True
119+ else return False
120+ x1 <-
121+ S.toList $ S.unfold (UF.takeWhileM f' UF.fromListM) (P.map return x)
122+ let x2 = P.takeWhile (apply f) (x :: [Int])
123+ y1 <- get
124+ let y2 = P.length x2
125+ return $ x1 == x2 && y1 == y2
126+
127+filterM :: Property
128+filterM = property $ \f x -> evalState (action f x) 0
129+ where
130+ action f x = do
131+ let f' z = if apply f z
132+ then modify (+ 1) >> return True
133+ else return False
134+ x1 <-
135+ S.toList $ S.unfold (UF.filterM f' UF.fromListM) (P.map return x)
136+ let x2 = P.filter (apply f) (x :: [Int])
137+ y1 <- get
138+ let y2 = P.length x2
139+ return $ x1 == x2 && y1 == y2
140+
141+drop :: Property
142+drop =
143+ property $ \x y ->
144+ runIdentity $ do
145+ x1 <- S.toList $ S.unfold (UF.drop x (UF.replicateM (x + y))) ()
146+ x2 <- S.toList $ S.drop x $ S.unfold (UF.replicateM (x + y)) ()
147+ return $ x1 == x2
148+
149+dropWhileM :: Property
150+dropWhileM = property $ \f x -> evalState (action f x) 0
151+ where
152+ action f x = do
153+ let f' z = if apply f z
154+ then modify (+ 1) >> return True
155+ else return False
156+ x1 <-
157+ S.toList $ S.unfold (UF.dropWhileM f' UF.fromListM) (P.map return x)
158+ let x2 = P.dropWhile (apply f) (x :: [Int])
159+ y1 <- get
160+ let y2 = P.length x - P.length x2
161+ return $ x1 == x2 && y1 == y2
162+
163+enumerateFromStepIntegral :: Property
164+enumerateFromStepIntegral =
165+ property $ \x y ->
166+ runIdentity $ do
167+ x1 <-
168+ S.toList $
169+ S.unfold (UF.take y UF.enumerateFromStepIntegral) (0, x)
170+ let x2 = P.take y $ P.map (x *) [0 .. y]
171+ return $ x1 == x2
172+
173+enumerateFromToIntegral :: Property
174+enumerateFromToIntegral =
175+ property $ \x ->
176+ runIdentity $ do
177+ x1 <- S.toList $ S.unfold (UF.enumerateFromToIntegral x) 0
178+ let x2 = [0 .. x] :: [Int]
179+ return $ x1 == x2
180+
181+zipWithM :: Property
182+zipWithM = property $ \x -> evalState (action x) (0 :: Int)
183+ where
184+ action x = do
185+ let f a b = modify (+ 1) >> return (a + b)
186+ x1 <-
187+ S.toList $
188+ S.unfold
189+ (UF.zipWithM
190+ f
191+ (UF.enumerateFromToIntegral x)
192+ (UF.enumerateFromToIntegral x))
193+ (1, 1)
194+ let x2 = P.zipWith (+) ([1 .. x] :: [Int]) ([1 .. x] :: [Int])
195+ y <- get
196+ return $ x1 == x2 && y == max 0 x
197+
198+concat :: Property
199+concat =
200+ property $ \x y ->
201+ runIdentity $ do
202+ x1 <-
203+ S.toList $
204+ S.unfold
205+ (UF.concat
206+ (UF.enumerateFromToIntegral (x :: Int))
207+ (UF.enumerateFromToIntegral (y :: Int)))
208+ 0
209+ let x2 = P.concat $ P.map (\k -> [k..y]) [0 .. x]
210+ return $ x1 == x2
211+
212+outerProduct :: Property
213+outerProduct =
214+ property $ \x y ->
215+ runIdentity $ do
216+ x1 <-
217+ S.toList $
218+ S.unfold
219+ (UF.outerProduct
220+ (UF.enumerateFromToIntegral (x :: Int))
221+ (UF.enumerateFromToIntegral (y :: Int)))
222+ (0, 0)
223+ let x2 = [(a, b) | a <- [0 .. x], b <- [0 .. y]]
224+ return $ x1 == x2
225+
226+main :: IO ()
227+main = hspec $
228+ describe "Unfold tests" $ do
229+ prop "fromStream" fromStream
230+ prop "nilM" nilM
231+ prop "consM" consM
232+ prop "effect" effect
233+ prop "singletonM" singletonM
234+ prop "const" const
235+ prop "fromListM" fromListM
236+ prop "replicateM" replicateM
237+ prop "repeatM" repeatM
238+ prop "take" take
239+ prop "takeWhileM" takeWhileM
240+ prop "filterM" filterM
241+ prop "drop" drop
242+ prop "dropWhileM" dropWhileM
243+ prop "enumerateFromStepIntegral" enumerateFromStepIntegral
244+ prop "enumerateFromToIntegral" enumerateFromToIntegral
245+ prop "zipWithM" zipWithM
246+ prop "concat" concat
247+ prop "outerProduct" outerProduct
248+ -- prop "concatMapM" concatMapM
249+ -- prop "gbracket" gbracket
250+ -- prop "gbracketIO" gbracketIO
251+ -- prop "before" before
252+ -- prop "after" after
253+ -- prop "afterIO" afterIO
254+ -- prop "onException" onException
255+ -- prop "finally" finally
256+ -- prop "finallyIO" finallyIO
257+ -- prop "bracket" bracket
258+ -- prop "bracketIO" bracketIO