@@ -58,10 +58,35 @@ main = hspec $ do
5858 ---------------------------------------------------------------------------
5959
6060 -- 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]
61+ describe "<> and <>" $ composeAndComposeSimple (<>) (<>) (cycle [[1 .. 9]])
62+
63+ describe "<> and <=>" $ composeAndComposeSimple
64+ (<>)
65+ (<=>)
66+ ([ [1 .. 9]
67+ , [1 .. 9]
68+ , [1, 3, 2, 4, 6, 5, 7, 9, 8]
69+ , [1, 3, 2, 4, 6, 5, 7, 9, 8]
70+ ])
71+
72+ describe "<=> and <=>" $ composeAndComposeSimple
73+ (<=>)
74+ (<=>)
75+ ([ [1, 4, 2, 7, 3, 5, 8, 6, 9]
76+ , [1, 7, 4, 8, 2, 9, 5, 3, 6]
77+ , [1, 4, 3, 7, 2, 6, 9, 5, 8]
78+ , [1, 7, 4, 9, 3, 8, 6, 2, 5]
79+ ])
80+
81+ describe "<=> and <>" $ composeAndComposeSimple
82+ (<=>)
83+ (<>)
84+ ([ [1, 4, 2, 7, 3, 5, 8, 6, 9]
85+ , [1, 7, 4, 8, 2, 9, 5, 3, 6]
86+ , [1, 4, 2, 7, 3, 5, 8, 6, 9]
87+ , [1, 7, 4, 8, 2, 9, 5, 3, 6]
88+ ])
89+
6590
6691 ---------------------------------------------------------------------------
6792 -- Monoidal composition recursion loops
@@ -167,30 +192,29 @@ compose f srt = do
167192composeAndComposeSimple
168193 :: (AsyncT IO Int -> AsyncT IO Int -> AsyncT IO Int)
169194 -> (AsyncT IO Int -> AsyncT IO Int -> AsyncT IO Int)
170− -> [Int]
195+ -> [[Int]]
171196 -> Spec
172197composeAndComposeSimple f g answer = do
173198 it "Compose right associated outer expr, right folded inner" $
174199 let fold = foldMapWith g return
175200 in (toList (fold [1,2,3] `f` (fold [4,5,6] `f` fold [7,8,9])))
176− `shouldReturn` answer
201+ `shouldReturn` (answer !! 0)
177202
178− {-
179203 it "Compose left associated outer expr, right folded inner" $
180204 let fold = foldMapWith g return
181205 in (toList ((fold [1,2,3] `f` fold [4,5,6]) `f` fold [7,8,9]))
182− `shouldReturn` answer
206+ `shouldReturn` (answer !! 1)
183207
184208 it "Compose right associated outer expr, left folded inner" $
185209 let fold xs = foldl g empty $ map return xs
186210 in (toList (fold [1,2,3] `f` (fold [4,5,6] `f` fold [7,8,9])))
187− `shouldReturn` answer
211+ `shouldReturn` (answer !! 2)
188212
189213 it "Compose left associated outer expr, left folded inner" $
190214 let fold xs = foldl g empty $ map return xs
191215 in (toList ((fold [1,2,3] `f` fold [4,5,6]) `f` fold [7,8,9]))
192− `shouldReturn` answer
193− -}
216+ `shouldReturn` (answer !! 3)
217+
194218
195219loops
196220 :: (AsyncT IO Int -> AsyncT IO Int -> AsyncT IO Int)