@@ -37,7 +37,7 @@ main = hspec $ do
3737 describe "Pure bind parallel BFS" $ pureBind (>|>)
3838
3939 ---------------------------------------------------------------------------
40− -- Compositions
40+ -- Monoidal Compositions
4141 ---------------------------------------------------------------------------
4242
4343 describe "Serial Composition (<>)" $ compose (<>) id
@@ -45,16 +45,26 @@ main = hspec $ do
4545 describe "Fair parallel Composition (<|>)" $ compose (<|>) sort
4646
4747 ---------------------------------------------------------------------------
48− -- Composition ordering checks
48+ -- Monoidal Composition ordering checks
4949 ---------------------------------------------------------------------------
5050
5151 describe "Serial interleaved (<=>)" $ interleaved (<=>) id
52+ describe "Parallel interleaved (<|>)" $ interleaved (<|>) reverse
5253 describe "Left biased parallel time order check" $ parallelCheck (<|)
5354 describe "Fair parallel time order check" $ parallelCheck (<|>)
54− describe "Parallel interleaved (<|>)" $ interleaved (<|>) reverse
5555
5656 ---------------------------------------------------------------------------
57− -- Composition recursion loops
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+ ---------------------------------------------------------------------------
67+ -- Monoidal composition recursion loops
5868 ---------------------------------------------------------------------------
5969
6070 describe "Serial loops (<>)" $ loops (<>) id reverse
@@ -62,7 +72,7 @@ main = hspec $ do
6272 describe "Fair parallel loops (<|>)" $ loops (<|>) sort sort
6373
6474 ---------------------------------------------------------------------------
65− -- Bind and Composition combinations
75+ -- Bind and monoidal composition combinations
6676 ---------------------------------------------------------------------------
6777
6878 forM_ [(>>=), (>->), (>>|), (>|>)] $ \f ->
@@ -77,6 +87,10 @@ main = hspec $ do
7787 describe "Bind and compose" $
7888 bindAndComposeHierarchy f (k g)
7989
90+ ---------------------------------------------------------------------------
91+ -- TBD Bind and Bind combinations
92+ ---------------------------------------------------------------------------
93+
8094 -- TBD combine all binds and all compose in one example
8195 describe "Miscellaneous combined examples" mixedOps
8296
@@ -150,6 +164,34 @@ compose f srt = do
150164 `f` ((return 4 `f` return 5) `f` (return 6 `f` return 7)))
151165 ) >>= return . srt) `shouldReturn` [0..7]
152166
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+
153195loops
154196 :: (AsyncT IO Int -> AsyncT IO Int -> AsyncT IO Int)
155197 -> ([Int] -> [Int])