git.iko.soy/typeable/ether
on master help sign in
Lifting instances for WrappedEther
b9b435aIndex Int
src/Control/Ether/Wrapped.hs+17
compare with master
unifiedsplit
@@ -29,18 +29,35 @@ instance MonadReader tag r m => Class.MonadReader r (WrappedEther tag m) where
29 ask = WrapEther $ ask (Proxy :: Proxy tag)
29 ask = WrapEther $ ask (Proxy :: Proxy tag)
30 local f = WrapEther . local (Proxy :: Proxy tag) f . unwrapEther
30 local f = WrapEther . local (Proxy :: Proxy tag) f . unwrapEther
31
31
32+instance MonadReader tag r m => MonadReader tag r (WrappedEther tag' m) where
33+ ask t = WrapEther $ ask t
34+ local t f = WrapEther . local t f . unwrapEther
35+
32instance MonadState tag s m => Class.MonadState s (WrappedEther tag m) where
36instance MonadState tag s m => Class.MonadState s (WrappedEther tag m) where
33 get = WrapEther $ get (Proxy :: Proxy tag)
37 get = WrapEther $ get (Proxy :: Proxy tag)
34 put = WrapEther . put (Proxy :: Proxy tag)
38 put = WrapEther . put (Proxy :: Proxy tag)
35
39
40+instance MonadState tag s m => MonadState tag s (WrappedEther tag' m) where
41+ get t = WrapEther $ get t
42+ put t = WrapEther . put t
43+
36instance MonadExcept tag e m => Class.MonadError e (WrappedEther tag m) where
44instance MonadExcept tag e m => Class.MonadError e (WrappedEther tag m) where
37 throwError = WrapEther . throw (Proxy :: Proxy tag)
45 throwError = WrapEther . throw (Proxy :: Proxy tag)
38 catchError m h = WrapEther $ catch (Proxy :: Proxy tag) (unwrapEther m) (unwrapEther . h)
46 catchError m h = WrapEther $ catch (Proxy :: Proxy tag) (unwrapEther m) (unwrapEther . h)
39
47
48+instance MonadExcept tag e m => MonadExcept tag e (WrappedEther tag' m) where
49+ throw t = WrapEther . throw t
50+ catch t m h = WrapEther $ catch t (unwrapEther m) (unwrapEther . h)
51+
40instance MonadWriter tag w m => Class.MonadWriter w (WrappedEther tag m) where
52instance MonadWriter tag w m => Class.MonadWriter w (WrappedEther tag m) where
41 tell = WrapEther . tell (Proxy :: Proxy tag)
53 tell = WrapEther . tell (Proxy :: Proxy tag)
42 listen = WrapEther . listen (Proxy :: Proxy tag) . unwrapEther
54 listen = WrapEther . listen (Proxy :: Proxy tag) . unwrapEther
43 pass = WrapEther . pass (Proxy :: Proxy tag) . unwrapEther
55 pass = WrapEther . pass (Proxy :: Proxy tag) . unwrapEther
44
56
57+instance MonadWriter tag w m => MonadWriter tag w (WrappedEther tag' m) where
58+ tell t = WrapEther . tell t
59+ listen t = WrapEther . listen t . unwrapEther
60+ pass t = WrapEther . pass t . unwrapEther
61+
45ethered :: proxy tag -> WrappedEther tag m a -> m a
62ethered :: proxy tag -> WrappedEther tag m a -> m a
46ethered _proxy = unwrapEther
63ethered _proxy = unwrapEther
test/Regression.hs+18
@@ -8,16 +8,20 @@
8module Main where
8module Main where
9
9
10import Data.Functor.Identity
10import Data.Functor.Identity
11+import Data.Monoid
12+import Data.Foldable
11import Control.Ether.Tagged
13import Control.Ether.Tagged
12import Control.Ether.TH
14import Control.Ether.TH
13import Control.Ether.Wrapped
15import Control.Ether.Wrapped
14import Control.Monad.Ether.Reader
16import Control.Monad.Ether.Reader
15import Control.Monad.Ether.State
17import Control.Monad.Ether.State
18+import Control.Monad.Ether.Writer
16import Control.Monad.Ether.Implicit.Except.TH
19import Control.Monad.Ether.Implicit.Except.TH
17import qualified Control.Monad.Ether.Implicit.Reader as I
20import qualified Control.Monad.Ether.Implicit.Reader as I
18import qualified Control.Monad.Ether.Implicit.State as I
21import qualified Control.Monad.Ether.Implicit.State as I
19import qualified Control.Monad.Ether.Implicit.Except as I
22import qualified Control.Monad.Ether.Implicit.Except as I
20import qualified Control.Monad.Reader as T
23import qualified Control.Monad.Reader as T
24+import qualified Control.Monad.Writer as T
21import qualified Control.Monad.State as T
25import qualified Control.Monad.State as T
22
26
23import Test.Tasty
27import Test.Tasty
@@ -27,6 +31,7 @@ import Test.QuickCheck.Function
27ethereal "R1" "r1"
31ethereal "R1" "r1"
28ethereal "R2" "r2"
32ethereal "R2" "r2"
29ethereal "S1" "s1"
33ethereal "S1" "s1"
34+ethereal "Foo" "foo"
30
35
31main :: IO ()
36main :: IO ()
32main = defaultMain suite
37main = defaultMain suite
@@ -182,3 +187,16 @@ exceptCore' a b = runIdentity $ do
182 (show <$> exceptCore a b)
187 (show <$> exceptCore a b)
183 (\NegativeLog -> "nl")
188 (\NegativeLog -> "nl")
184 (\DivideByZero -> "dz")
189 (\DivideByZero -> "dz")
190+
191+summatorCore
192+ :: ( Num a
193+ , T.MonadWriter (Sum a) m
194+ , MonadWriter Foo (Sum a) m
195+ ) => [a] -> m ()
196+summatorCore xs = do
197+ for_ xs $ \x -> do
198+ T.tell (Sum x)
199+ tell foo (Sum 1)
200+
201+summatorCore' :: Num a => [a] -> (Sum a, Sum a)
202+summatorCore' = runWriter foo . T.execWriterT . summatorCore