@@ -0,0 +1,51 @@
1+module Regression.T9 (test9) where
2+
3+import Control.Ether.Abbr
4+import Control.Monad.Ether
5+
6+import Test.Tasty
7+import Test.Tasty.QuickCheck
8+
9+ethereal "Foo" "foo"
10+ethereal "Bar" "bar"
11+
12+
13+testEther1 :: Ether '[Foo <-> Int] m => m String
14+testEther1 = do
15+ modify foo negate
16+ gets foo show
17+
18+testEther2 :: Ether '[Bar <-> Int] m => m String
19+testEther2 = tagReplace foo bar testEther1
20+
21+testEther
22+ :: Ether '[Foo <-> Int, Bar <-> Int] m
23+ => m String
24+testEther = do
25+ a <- testEther1
26+ b <- testEther2
27+ return (a ++ b)
28+
29+model :: Int -> Int -> String
30+model a b = show (negate a) ++ show (negate b)
31+
32+runner1 a b
33+ = flip (evalState foo) a
34+ . flip (evalStateT bar) b
35+
36+runner2 a b
37+ = flip (evalState bar) b
38+ . flip (evalStateT foo) a
39+
40+test9 :: TestTree
41+test9 = testGroup "T9: Tag replacement"
42+ [ testProperty "runner₁ works"
43+ $ \a b -> property
44+ $ runner1 a b testEther == model a b
45+ , testProperty "runner₂ works"
46+ $ \a b -> property
47+ $ runner2 a b testEther == model a b
48+ , testProperty "runner₁ == runner₂"
49+ $ \a b -> property
50+ $ runner1 a b testEther == runner2 a b testEther
51+ ]