git.iko.soy/typeable/ether
on master help sign in
Lifting instances for WrappedEther
commitb9b435aadaa3a7eee4ca2cf138ae14c784fcdad0 authorIndex Int <vlad.z.4096@gmail.com> dateSat 13 Jun 2015, 19:47 (11 years ago) parentcf3ef4e
2 files changed+35
compare with master
unifiedsplit
src/Control/Ether/Wrapped.hs+17 test/Regression.hs+18
src/Control/Ether/Wrapped.hs+17
@@ -29,18 +29,35 @@ instance MonadReader tag r m => Class.MonadReader r (WrappedEther tag m) where
2929 ask = WrapEther $ ask (Proxy :: Proxy tag)
3030 local f = WrapEther . local (Proxy :: Proxy tag) f . unwrapEther
3131
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+
3236instance MonadState tag s m => Class.MonadState s (WrappedEther tag m) where
3337 get = WrapEther $ get (Proxy :: Proxy tag)
3438 put = WrapEther . put (Proxy :: Proxy tag)
3539
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+
3644instance MonadExcept tag e m => Class.MonadError e (WrappedEther tag m) where
3745 throwError = WrapEther . throw (Proxy :: Proxy tag)
3846 catchError m h = WrapEther $ catch (Proxy :: Proxy tag) (unwrapEther m) (unwrapEther . h)
3947
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+
4052instance MonadWriter tag w m => Class.MonadWriter w (WrappedEther tag m) where
4153 tell = WrapEther . tell (Proxy :: Proxy tag)
4254 listen = WrapEther . listen (Proxy :: Proxy tag) . unwrapEther
4355 pass = WrapEther . pass (Proxy :: Proxy tag) . unwrapEther
4456
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+
4562ethered :: proxy tag -> WrappedEther tag m a -> m a
4663ethered _proxy = unwrapEther
test/Regression.hs+18
@@ -8,16 +8,20 @@
88module Main where
99
1010import Data.Functor.Identity
11+import Data.Monoid
12+import Data.Foldable
1113import Control.Ether.Tagged
1214import Control.Ether.TH
1315import Control.Ether.Wrapped
1416import Control.Monad.Ether.Reader
1517import Control.Monad.Ether.State
18+import Control.Monad.Ether.Writer
1619import Control.Monad.Ether.Implicit.Except.TH
1720import qualified Control.Monad.Ether.Implicit.Reader as I
1821import qualified Control.Monad.Ether.Implicit.State as I
1922import qualified Control.Monad.Ether.Implicit.Except as I
2023import qualified Control.Monad.Reader as T
24+import qualified Control.Monad.Writer as T
2125import qualified Control.Monad.State as T
2226
2327import Test.Tasty
@@ -27,6 +31,7 @@ import Test.QuickCheck.Function
2731ethereal "R1" "r1"
2832ethereal "R2" "r2"
2933ethereal "S1" "s1"
34+ethereal "Foo" "foo"
3035
3136main :: IO ()
3237main = defaultMain suite
@@ -182,3 +187,16 @@ exceptCore' a b = runIdentity $ do
182187 (show <$> exceptCore a b)
183188 (\NegativeLog -> "nl")
184189 (\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