git.iko.soy/typeable/ether
on master help sign in
Refactor EtherTags and add instances
commit15262107c97a2908039959fd097d991d4d8f345f authorIndex Int <vlad.z.4096@gmail.com> dateMon 8 Jun 2015, 23:31 (11 years ago) parent650c7de
3 files changed+34−44
compare with master
unifiedsplit
src/Control/Ether/Core.hs+31−40 src/Control/Monad/Ether/Reader.hs+1−1 src/Control/Monad/Trans/Ether/Reader.hs+2−3
src/Control/Ether/Core.hs+31−40
@@ -6,11 +6,15 @@
66{-# LANGUAGE UndecidableInstances #-}
77module Control.Ether.Core
88 ( EtherTagless
9− , MonadEther
109 , EtherTags
1110 ) where
1211
13−import Data.Functor.Identity
12+import Data.Proxy (Proxy)
13+import Data.Functor.Identity (Identity)
14+import Data.Monoid (First, Last)
15+import qualified Control.Monad.ST.Strict as Strict (ST)
16+import qualified Control.Monad.ST.Lazy as Lazy (ST)
17+import GHC.Conc (STM)
1418import GHC.Exts (Constraint)
1519
1620import qualified Control.Monad.Trans.Cont as Trans
@@ -36,41 +40,28 @@ type family ELEM (x :: k) (as :: [k]) :: Bool where
3640type family EtherTagless (tag :: *) (m :: * -> *) :: Constraint where
3741 EtherTagless tag m = ELEM tag (EtherTags m) ~ 'False
3842
39−class Monad m => MonadEther m where
40− type family EtherTags m :: [*]
41−
42−instance MonadEther IO where
43− type EtherTags IO = '[]
44−
45−instance MonadEther Identity where
46− type EtherTags Identity = '[]
47−
48−instance Monad m => MonadEther (Trans.ContT r m) where
49− type EtherTags (Trans.ContT r m) = EtherTags m
50−
51−instance Monad m => MonadEther (Trans.ExceptT e m) where
52− type EtherTags (Trans.ExceptT e m) = EtherTags m
53−
54−instance Monad m => MonadEther (Trans.IdentityT m) where
55− type EtherTags (Trans.IdentityT m) = EtherTags m
56−
57−instance Monad m => MonadEther (Trans.ListT m) where
58− type EtherTags (Trans.ListT m) = EtherTags m
59−
60−instance Monad m => MonadEther (Trans.MaybeT m) where
61− type EtherTags (Trans.MaybeT m) = EtherTags m
62−
63−instance Monad m => MonadEther (Trans.ReaderT r m) where
64− type EtherTags (Trans.ReaderT r m) = EtherTags m
65−
66−instance Monad m => MonadEther (Trans.Lazy.StateT s m) where
67− type EtherTags (Trans.Lazy.StateT s m) = EtherTags m
68−
69−instance Monad m => MonadEther (Trans.Strict.StateT s m) where
70− type EtherTags (Trans.Strict.StateT s m) = EtherTags m
71−
72−instance (Monoid w, Monad m) => MonadEther (Trans.Lazy.WriterT w m) where
73− type EtherTags (Trans.Lazy.WriterT w m) = EtherTags m
74−
75−instance (Monoid w, Monad m) => MonadEther (Trans.Strict.WriterT w m) where
76− type EtherTags (Trans.Strict.WriterT w m) = EtherTags m
43+type family EtherTags (m :: * -> *) :: [*]
44+
45+type instance EtherTags IO = '[]
46+type instance EtherTags Identity = '[]
47+type instance EtherTags [] = '[]
48+type instance EtherTags Maybe = '[]
49+type instance EtherTags Last = '[]
50+type instance EtherTags First = '[]
51+type instance EtherTags ((->) r) = '[]
52+type instance EtherTags STM = '[]
53+type instance EtherTags (Either e) = '[]
54+type instance EtherTags Proxy = '[]
55+type instance EtherTags (Strict.ST s) = '[]
56+type instance EtherTags (Lazy.ST s) = '[]
57+
58+type instance EtherTags (Trans.ContT r m) = EtherTags m
59+type instance EtherTags (Trans.ExceptT e m) = EtherTags m
60+type instance EtherTags (Trans.IdentityT m) = EtherTags m
61+type instance EtherTags (Trans.ListT m) = EtherTags m
62+type instance EtherTags (Trans.MaybeT m) = EtherTags m
63+type instance EtherTags (Trans.ReaderT r m) = EtherTags m
64+type instance EtherTags (Trans.Lazy.StateT s m) = EtherTags m
65+type instance EtherTags (Trans.Strict.StateT s m) = EtherTags m
66+type instance EtherTags (Trans.Lazy.WriterT w m) = EtherTags m
67+type instance EtherTags (Trans.Strict.WriterT w m) = EtherTags m
src/Control/Monad/Ether/Reader.hs+1−1
@@ -49,7 +49,7 @@ import qualified Control.Monad.Trans.State.Strict as Trans.Strict (StateT , m
4949import qualified Control.Monad.Trans.Writer.Lazy as Trans.Lazy (WriterT , mapWriterT)
5050import qualified Control.Monad.Trans.Writer.Strict as Trans.Strict (WriterT , mapWriterT)
5151
52−class MonadEther m => MonadEtherReader tag r m | m tag -> r where
52+class Monad m => MonadEtherReader tag r m | m tag -> r where
5353
5454 etherLocal :: proxy tag -> (r -> r) -> m a -> m a
5555
src/Control/Monad/Trans/Ether/Reader.hs+2−3
@@ -45,10 +45,9 @@ newtype EtherReaderT tag r m a = EtherReaderT (R.ReaderT r m a)
4545 deriving ( Functor, Applicative, Alternative, Monad, MonadPlus
4646 , MonadFix, MonadTrans, MonadIO )
4747
48−type EtherReader tag r = EtherReaderT tag r Identity
48+type instance EtherTags (EtherReaderT tag r m) = tag ': EtherTags m
4949
50−instance Monad m => MonadEther (EtherReaderT tag r m) where
51− type EtherTags (EtherReaderT tag r m) = tag ': EtherTags m
50+type EtherReader tag r = EtherReaderT tag r Identity
5251
5352etherReaderT :: proxy tag -> (r -> m a) -> EtherReaderT tag r m a
5453etherReaderT _proxy = EtherReaderT . R.ReaderT