git.iko.soy/streamly
on b1ee90e help sign in
streamly/test/Main.hs
152 lines 6.9 kB history raw
1module Main (main) where
3import Asyncly
4import Control.Applicative ((<|>))
5import Control.Concurrent (myThreadId, threadDelay)
6import Data.Monoid ((<>))
7import Control.Monad.IO.Class (liftIO)
8import Data.List (nub, sort)
9import Test.Hspec
11default (Int)
13main :: IO ()
14main = hspec $ do
15 it "simple runAsyncly" $
16 runAsyncly (return 0) `shouldReturn` ()
17 it "simple runAsyncly with IO" $
18 runAsyncly (liftIO $ putStrLn "hello") `shouldReturn` ()
19 it "Captures a return value using toList" $
20 toList (return 0) `shouldReturn` ([0] :: [Int])
21 it "Monoid composition" $
22 toList (return 0 <> return 1) `shouldReturn` ([0, 1] :: [Int])
23 it "Monoid composition - each" $
24 ((toList $ each [1..100]) >>= return . sort) `shouldReturn` ([1..100] :: [Int])
25 it "simple runAsyncly and 'then' with IO" $
26 runAsyncly (liftIO (putStrLn "hello") >> liftIO (putStrLn "world")) `shouldReturn` ()
27 it "Then and toList" $
28 toList (return 1 >> return 2) `shouldReturn` ([2] :: [Int])
29 it "Bind and toList" $
30 toList (do x <- return 1; y <- return 2; return (x + y)) `shouldReturn` ([3] :: [Int])
31 it "Alternative composition" $
32 ((toList $ (return 0 <|> return 1)) >>= return . sort) `shouldReturn` ([0, 1] :: [Int])
33 it "Alternative composition with bind" $
34 (toList (for [1..10 :: Int] $ \x -> return x >>= return . id) >>= return . sort) `shouldReturn` ([1..10] :: [Int])
35 {-
36 it "Alternative composition of async and sync tasks" $
37 ((wait (threads 0 ((async (return 0) <|> return 1)))) >>= return . sort)
38 `shouldReturn` ([0,1] :: [Int])
39 it "Alternative composition of async tasks" $
40 (wait (async (return 0) <|> async (return 1)) >>= return . sort)
41 `shouldReturn` ([0,1] :: [Int])
42 it "Nested async tasks with Alternative" $
43 (wait (async (async $ return 0 <|> return 1) <|> return 1) >>= return . sort)
44 `shouldReturn` ([0,1,1] :: [Int])
45 it "General example" $
46 (wait generalExample >>= return . sort)
47 `shouldReturn` ([8,9,9,9,9,9,10,10,10,10,10,10,10,10,10,10,11,11,11,11,11,11,11,11,11,11,12,12,12,12,12,13] :: [Int])
48 it "General example synchronous" $
49 (wait (threads 0 generalExample) >>= return . sort)
50 `shouldReturn` ([8,9,9,9,9,9,10,10,10,10,10,10,10,10,10,10,11,11,11,11,11,11,11,11,11,11,12,12,12,12,12,13] :: [Int])
51 it "Alternative forks threads - 1" $
52 ((wait $ (liftIO myThreadId) <|> (liftIO myThreadId))
53 >>= (\x -> print x >> return x)
54 >>= return . \x -> (length x, length (nub x)))
55 `shouldReturn` ((2, 2) :: (Int, Int))
56 it "Alternative forks threads - 2" $
57 ((wait $
58 (liftIO myThreadId)
59 <|> (liftIO myThreadId)
60 <|> (liftIO myThreadId))
61 >>= (\x -> print x >> return x)
62 >>= return . \x -> (length x, length (nub x)))
63 `shouldReturn` ((3, 3) :: (Int, Int))
64 it "Alternative does not fork when using threads 0" $
65 ((wait $ threads 0 $ (liftIO myThreadId) <|> (liftIO myThreadId))
66 >>= (\x -> print x >> return x)
67 >>= return . \x -> (length x, length (nub x)))
68 `shouldReturn` ((2, 1) :: (Int, Int))
69 it "async primitive forces a fork at the end of Alternative\
70 \ (undesired but that's how the implementation behaves)" $
71 ((wait $ threads 0 $ (liftIO myThreadId) <|> async (liftIO myThreadId))
72 >>= (\x -> print x >> return x)
73 >>= return . \x -> (length x, length (nub x)))
74 `shouldReturn` ((2, 2) :: (Int, Int))
75 it "async primitive forces a fork at the beginning" $
76 ((wait $ threads 0 $ async (liftIO myThreadId) <|> (liftIO myThreadId))
77 >>= (\x -> print x >> return x)
78 >>= return . \x -> (length x, length (nub x)))
79 `shouldReturn` ((2, 2) :: (Int, Int))
80 it "async primitive forces a fork in the middle" $
81 ((wait $ threads 0 $
82 (liftIO myThreadId)
83 <|> async (liftIO (threadDelay 1000000) >> liftIO myThreadId)
84 <|> (liftIO myThreadId))
85 >>= (\x -> print x >> return x)
86 >>= return . \x -> (length x, length (nub x)))
87 `shouldReturn` ((3, 2) :: (Int, Int))
88 it "async primitive forces a fork - 3" $
89 ((wait $ threads 0 $
90 (liftIO myThreadId)
91 <|> async (liftIO (threadDelay 1000000) >> liftIO myThreadId)
92 <|> async (liftIO (threadDelay 1000000) >> liftIO myThreadId))
93 >>= (\x -> print x >> return x)
94 >>= return . \x -> (length x, length (nub x)))
95 `shouldReturn` ((3, 3) :: (Int, Int))
96 it "async primitive forces a fork - 4" $
97 ((wait $ threads 0 $
98 async (liftIO (threadDelay 1000000) >> liftIO myThreadId)
99 <|> async (liftIO (threadDelay 1000000) >> liftIO myThreadId)
100 <|> async (liftIO (threadDelay 1000000) >> liftIO myThreadId))
101 >>= (\x -> print x >> return x)
102 >>= return . \x -> (length x, length (nub x)))
103 `shouldReturn` ((3, 3) :: (Int, Int))
105 -- Both 0 and 1 must be printed on console
106 it "*>> works as expected" $
107 (wait $ (async (liftIO (putStrLn "0") >> return 0)
108 <|> (liftIO (putStrLn "1") >> return 1))
109 *>> (liftIO (putStrLn "2") >> return 2))
110 `shouldReturn` ([2] :: [Int])
112 -- Both 0 and 1 must be printed on console
113 it ">>* works as expected" $
114 (wait $ (return 2
115 >>* (async (liftIO (putStrLn "0") >> return 0)
116 <|> (liftIO (putStrLn "1") >> return 1))
117 )
118 >>* return 2
119 )
120 `shouldReturn` ([2] :: [Int])
122 -- 2 and 3 should be printed once and only once
123 it ">>| works as expected" $
124 ((wait $ ((async (liftIO (putStrLn "0") >> return 0)
125 <|> (liftIO (putStrLn "1") >> return 1))
126 >>| (async (liftIO (putStrLn "2") >> return 2)
127 <|> (liftIO (putStrLn "3") >> return 3))
128 )
129 ) >>= return . sort)
130 `shouldReturn` ([0, 1] :: [Int])
132generalExample :: AsyncT IO Int
133generalExample = do
134 liftIO $ return ()
135 liftIO $ putStr ""
136 x <- return 1
137 y <- return 2
138 z <- do
139 x1 <- async (return 1) <|> async (return 2)
140 liftIO $ return ()
141 liftIO $ putStr ""
142 y1 <- (return 1) <|> async (return 2)
143 z1 <- do
144 x11 <- async (return 1) <|> (return 2)
145 y11 <- async (return 1) <|> async (return 2)
146 z11 <- async (return 1) <|> (return 2)
147 liftIO $ return ()
148 liftIO $ putStr ""
149 return (x11 + y11 + z11)
150 return (x1 + y1 + z1)
151 return (x + y + z)
152 -}