on master help sign in
Add more tests for monoidal compositions
b477693Harendra Kumar
test/Main.hs+47−5
@@ -37,7 +37,7 @@ main = hspec $ do
37 describe "Pure bind parallel BFS" $ pureBind (>|>)
37 describe "Pure bind parallel BFS" $ pureBind (>|>)
38
38
39 ---------------------------------------------------------------------------
39 ---------------------------------------------------------------------------
40− -- Compositions
40+ -- Monoidal Compositions
41 ---------------------------------------------------------------------------
41 ---------------------------------------------------------------------------
42
42
43 describe "Serial Composition (<>)" $ compose (<>) id
43 describe "Serial Composition (<>)" $ compose (<>) id
@@ -45,16 +45,26 @@ main = hspec $ do
45 describe "Fair parallel Composition (<|>)" $ compose (<|>) sort
45 describe "Fair parallel Composition (<|>)" $ compose (<|>) sort
46
46
47 ---------------------------------------------------------------------------
47 ---------------------------------------------------------------------------
48− -- Composition ordering checks
48+ -- Monoidal Composition ordering checks
49 ---------------------------------------------------------------------------
49 ---------------------------------------------------------------------------
50
50
51 describe "Serial interleaved (<=>)" $ interleaved (<=>) id
51 describe "Serial interleaved (<=>)" $ interleaved (<=>) id
52+ describe "Parallel interleaved (<|>)" $ interleaved (<|>) reverse
52 describe "Left biased parallel time order check" $ parallelCheck (<|)
53 describe "Left biased parallel time order check" $ parallelCheck (<|)
53 describe "Fair parallel time order check" $ parallelCheck (<|>)
54 describe "Fair parallel time order check" $ parallelCheck (<|>)
54− describe "Parallel interleaved (<|>)" $ interleaved (<|>) reverse
55
55
56 ---------------------------------------------------------------------------
56 ---------------------------------------------------------------------------
57+ -- TBD Monoidal composition combinations
58+ ---------------------------------------------------------------------------
59+
60+ -- TBD need more such combinations to be tested.
61+ describe "<> and <>" $ composeAndComposeSimple (<>) (<>) [1..9]
62+ describe "<> and <=>" $ composeAndComposeSimple (<>) (<=>) [1..9]
63+ describe "<=> and <=>" $ composeAndComposeSimple (<=>) (<=>) [1,4,7,2,5,8,3,6,9]
64+ describe "<=> and <>" $ composeAndComposeSimple (<=>) (<>) [1,4,7,2,5,8,3,6,9]
65+
66+ ---------------------------------------------------------------------------
57− -- Composition recursion loops
67+ -- Monoidal composition recursion loops
58 ---------------------------------------------------------------------------
68 ---------------------------------------------------------------------------
59
69
60 describe "Serial loops (<>)" $ loops (<>) id reverse
70 describe "Serial loops (<>)" $ loops (<>) id reverse
@@ -62,7 +72,7 @@ main = hspec $ do
62 describe "Fair parallel loops (<|>)" $ loops (<|>) sort sort
72 describe "Fair parallel loops (<|>)" $ loops (<|>) sort sort
63
73
64 ---------------------------------------------------------------------------
74 ---------------------------------------------------------------------------
65− -- Bind and Composition combinations
75+ -- Bind and monoidal composition combinations
66 ---------------------------------------------------------------------------
76 ---------------------------------------------------------------------------
67
77
68 forM_ [(>>=), (>->), (>>|), (>|>)] $ \f ->
78 forM_ [(>>=), (>->), (>>|), (>|>)] $ \f ->
@@ -77,6 +87,10 @@ main = hspec $ do
77 describe "Bind and compose" $
87 describe "Bind and compose" $
78 bindAndComposeHierarchy f (k g)
88 bindAndComposeHierarchy f (k g)
79
89
90+ ---------------------------------------------------------------------------
91+ -- TBD Bind and Bind combinations
92+ ---------------------------------------------------------------------------
93+
80 -- TBD combine all binds and all compose in one example
94 -- TBD combine all binds and all compose in one example
81 describe "Miscellaneous combined examples" mixedOps
95 describe "Miscellaneous combined examples" mixedOps
82
96
@@ -150,6 +164,34 @@ compose f srt = do
150 `f` ((return 4 `f` return 5) `f` (return 6 `f` return 7)))
164 `f` ((return 4 `f` return 5) `f` (return 6 `f` return 7)))
151 ) >>= return . srt) `shouldReturn` [0..7]
165 ) >>= return . srt) `shouldReturn` [0..7]
152
166
167+composeAndComposeSimple
168+ :: (AsyncT IO Int -> AsyncT IO Int -> AsyncT IO Int)
169+ -> (AsyncT IO Int -> AsyncT IO Int -> AsyncT IO Int)
170+ -> [Int]
171+ -> Spec
172+composeAndComposeSimple f g answer = do
173+ it "Compose right associated outer expr, right folded inner" $
174+ let fold = foldMapWith g return
175+ in (toList (fold [1,2,3] `f` (fold [4,5,6] `f` fold [7,8,9])))
176+ `shouldReturn` answer
177+
178+ {-
179+ it "Compose left associated outer expr, right folded inner" $
180+ let fold = foldMapWith g return
181+ in (toList ((fold [1,2,3] `f` fold [4,5,6]) `f` fold [7,8,9]))
182+ `shouldReturn` answer
183+
184+ it "Compose right associated outer expr, left folded inner" $
185+ let fold xs = foldl g empty $ map return xs
186+ in (toList (fold [1,2,3] `f` (fold [4,5,6] `f` fold [7,8,9])))
187+ `shouldReturn` answer
188+
189+ it "Compose left associated outer expr, left folded inner" $
190+ let fold xs = foldl g empty $ map return xs
191+ in (toList ((fold [1,2,3] `f` fold [4,5,6]) `f` fold [7,8,9]))
192+ `shouldReturn` answer
193+ -}
194+
153loops
195loops
154 :: (AsyncT IO Int -> AsyncT IO Int -> AsyncT IO Int)
196 :: (AsyncT IO Int -> AsyncT IO Int -> AsyncT IO Int)
155 -> ([Int] -> [Int])
197 -> ([Int] -> [Int])