git.iko.soy/streamly
on 154a610 help sign in
streamly/test/Main.hs
189 lines 7.1 kB history raw
1module Main (main) where
3import Control.Concurrent (threadDelay)
4import Data.List (sort)
5import Prelude hiding (take, drop)
6import Test.Hspec
8import Asyncly
10main :: IO ()
11main = hspec $ do
12 describe "Runners" $ do
13 it "simple runAsyncly" $
14 runAsyncly (return (0 :: Int)) `shouldReturn` ()
15 it "simple runAsyncly with IO" $
16 runAsyncly (liftIO $ putStrLn "hello") `shouldReturn` ()
17 it "Captures a return value using toList" $
18 toList (return 0) `shouldReturn` ([0] :: [Int])
20 describe "Empty" $ do
21 it "Monoid - mempty" $
22 (toList mempty) `shouldReturn` ([] :: [Int])
23 it "Alternative - empty" $
24 (toList empty) `shouldReturn` ([] :: [Int])
25 it "MonadPlus - mzero" $
26 (toList mzero) `shouldReturn` ([] :: [Int])
28 describe "Bind" bind
30 describe "Serial Composition (<>)" $ compose (<>) id
31 describe "Serial interleaved (<=>)" $ interleaved (<=>) id
32 describe "Left biased parallel Composition (<|)" $ compose (<|) sort
33 describe "Fair parallel Composition (<|>)" $ compose (<|>) sort
34 describe "Left biased parallel time order check" $ parallelCheck (<|)
35 describe "Fair parallel time order check" $ parallelCheck (<|>)
36 describe "Parallel interleaved (<|>)" $ interleaved (<|>) reverse
38 describe "Serial loops (<>)" $ loops (<>) id reverse
39 describe "Left biased parallel loops (<|)" $ loops (<|) sort sort
40 describe "Fair parallel loops (<|>)" $ loops (<|>) sort sort
42 describe "Transformation" $ transformOps (<>)
43 describe "Miscellaneouse combined examples" mixedOps
45bind :: Spec
46bind = do
47 it "Simple runAsyncly and 'then' with IO" $
48 runAsyncly (liftIO (putStrLn "hello") >> liftIO (putStrLn "world"))
49 `shouldReturn` ()
50 it "Then and toList" $
51 toList (return (1 :: Int) >> return 2) `shouldReturn` ([2] :: [Int])
52 it "Bind and toList" $
53 toList (do x <- return 1; y <- return 2; return (x + y))
54 `shouldReturn` ([3] :: [Int])
56interleaved
57 :: (AsyncT IO Int -> AsyncT IO Int -> AsyncT IO Int)
58 -> ([Int] -> [Int])
59 -> Spec
60interleaved f srt =
61 it "Interleave four" $
62 toList ((return 0 <> return 1) `f` (return 100 <> return 101))
63 `shouldReturn` (srt [0, 100, 1, 101])
65parallelCheck :: (AsyncT IO Int -> AsyncT IO Int -> AsyncT IO Int) -> Spec
66parallelCheck f = do
67 it "Parallel ordering left associated" $
68 toList (((event 4 `f` event 3) `f` event 2) `f` event 1)
69 `shouldReturn` ([1..4])
71 it "Parallel ordering right associated" $
72 toList (event 4 `f` (event 3 `f` (event 2 `f` event 1)))
73 `shouldReturn` ([1..4])
75 where event n = (liftIO $ threadDelay (n * 100000)) >> (return n)
77compose
78 :: (AsyncT IO Int -> AsyncT IO Int -> AsyncT IO Int)
79 -> ([Int] -> [Int])
80 -> Spec
81compose f srt = do
82 it "Compose mempty, mempty" $
83 (toList (mempty `f` mempty)) `shouldReturn` []
84 it "Compose empty, empty" $
85 (toList (empty `f` empty)) `shouldReturn` []
86 it "Compose empty at the beginning" $
87 (toList $ (empty `f` return 1)) `shouldReturn` [1]
88 it "Compose empty at the end" $
89 (toList $ (return 1 `f` empty)) `shouldReturn` [1]
90 it "Compose two" $
91 (toList (return 0 `f` return 1) >>= return . srt)
92 `shouldReturn` [0, 1]
93 it "Compose three - empty in the middle" $
94 ((toList $ (return 0 `f` empty `f` return 1)) >>= return . srt)
95 `shouldReturn` [0, 1]
96 it "Compose left associated" $
97 ((toList $ (((return 0 `f` return 1) `f` return 2) `f` return 3))
98 >>= return . srt) `shouldReturn` [0, 1, 2, 3]
99 it "Compose right associated" $
100 ((toList $ (return 0 `f` (return 1 `f` (return 2 `f` return 3))))
101 >>= return . srt) `shouldReturn` [0, 1, 2, 3]
102 it "Compose many" $
103 ((toList $ forEachWith f [1..100] return) >>= return . srt)
104 `shouldReturn` [1..100]
105 it "Compose many (right fold) with bind" $
106 (toList (forEachWith f [1..10 :: Int] $ \x -> return x >>= return . id)
107 >>= return . srt) `shouldReturn` [1..10]
108 it "Compose many (left fold) with bind" $
109 let forL xs k = foldl f empty $ map k xs
110 in (toList (forL [1..10 :: Int] $ \x -> return x >>= return . id)
111 >>= return . srt) `shouldReturn` [1..10]
112 it "Compose hierarchical (multiple levels)" $
113 ((toList $ (((return 0 `f` return 1) `f` (return 2 `f` return 3))
114 `f` ((return 4 `f` return 5) `f` (return 6 `f` return 7)))
115 ) >>= return . srt) `shouldReturn` [0..7]
117loops
118 :: (AsyncT IO Int -> AsyncT IO Int -> AsyncT IO Int)
119 -> ([Int] -> [Int])
120 -> ([Int] -> [Int])
121 -> Spec
122loops f tsrt hsrt = do
123 it "Tail recursive loop" $ (toList (loopTail 0) >>= return . tsrt)
124 `shouldReturn` [0..3]
126 it "Head recursive loop" $ (toList (loopHead 0) >>= return . hsrt)
127 `shouldReturn` [0..3]
129 where
130 loopHead x = do
131 -- this print line is important for the test (causes a bind)
132 liftIO $ putStrLn "LoopHead..."
133 (if x < 3 then loopHead (x + 1) else empty) `f` return x
135 loopTail x = do
136 -- this print line is important for the test (causes a bind)
137 liftIO $ putStrLn "LoopTail..."
138 return x `f` (if x < 3 then loopTail (x + 1) else empty)
140transformOps :: (AsyncT IO Int -> AsyncT IO Int -> AsyncT IO Int) -> Spec
141transformOps f = do
142 it "take all" $
143 (toList $ take 10 $ foldMapWith f return [1..10])
144 `shouldReturn` [1..10]
145 it "take none" $
146 (toList $ take 0 $ foldMapWith f return [1..10])
147 `shouldReturn` []
148 it "take 5" $
149 (toList $ take 5 $ foldMapWith f return [1..10])
150 `shouldReturn` [1..5]
152 it "drop all" $
153 (toList $ drop 10 $ foldMapWith f return [1..10])
154 `shouldReturn` []
155 it "drop none" $
156 (toList $ drop 0 $ foldMapWith f return [1..10])
157 `shouldReturn` [1..10]
158 it "drop 5" $
159 (toList $ drop 5 $ foldMapWith f return [1..10])
160 `shouldReturn` [6..10]
162mixedOps :: Spec
163mixedOps = do
164 it "Compose many ops" $
165 (toList composeMixed >>= return . sort)
166 `shouldReturn` ([8,9,9,9,9,9,10,10,10,10,10,10,10,10,10,10,11,11
167 ,11,11,11,11,11,11,11,11,12,12,12,12,12,13
168 ] :: [Int])
170composeMixed :: AsyncT IO Int
171composeMixed = do
172 liftIO $ return ()
173 liftIO $ putStr ""
174 x <- return 1
175 y <- return 2
176 z <- do
177 x1 <- return 1 <|> return 2
178 liftIO $ return ()
179 liftIO $ putStr ""
180 y1 <- return 1 <| return 2
181 z1 <- do
182 x11 <- return 1 <> return 2
183 y11 <- return 1 <| return 2
184 z11 <- return 1 <=> return 2
185 liftIO $ return ()
186 liftIO $ putStr ""
187 return (x11 + y11 + z11)
188 return (x1 + y1 + z1)
189 return (x + y + z)