git.iko.soy/typeable/ether
on master help sign in
Refactor EtherTags and add instances
1526210Index Int
src/Control/Ether/Core.hs+31−40
compare with master
unifiedsplit
@@ -6,11 +6,15 @@
6{-# LANGUAGE UndecidableInstances #-}
6{-# LANGUAGE UndecidableInstances #-}
7module Control.Ether.Core
7module Control.Ether.Core
8 ( EtherTagless
8 ( EtherTagless
9− , MonadEther
10 , EtherTags
9 , EtherTags
11 ) where
10 ) where
12
11
12+import Data.Proxy (Proxy)
13−import Data.Functor.Identity
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)
14import GHC.Exts (Constraint)
18import GHC.Exts (Constraint)
15
19
16import qualified Control.Monad.Trans.Cont as Trans
20import qualified Control.Monad.Trans.Cont as Trans
@@ -36,41 +40,28 @@ type family ELEM (x :: k) (as :: [k]) :: Bool where
36type family EtherTagless (tag :: *) (m :: * -> *) :: Constraint where
40type family EtherTagless (tag :: *) (m :: * -> *) :: Constraint where
37 EtherTagless tag m = ELEM tag (EtherTags m) ~ 'False
41 EtherTagless tag m = ELEM tag (EtherTags m) ~ 'False
38
42
39−class Monad m => MonadEther m where
40− type family EtherTags m :: [*]
43+type family EtherTags (m :: * -> *) :: [*]
41−
44+
42−instance MonadEther IO where
45+type instance EtherTags IO = '[]
43− type EtherTags IO = '[]
46+type instance EtherTags Identity = '[]
44−
47+type instance EtherTags [] = '[]
45−instance MonadEther Identity where
46− type EtherTags Identity = '[]
48+type instance EtherTags Maybe = '[]
47−
49+type instance EtherTags Last = '[]
48−instance Monad m => MonadEther (Trans.ContT r m) where
50+type instance EtherTags First = '[]
49− type EtherTags (Trans.ContT r m) = EtherTags m
51+type instance EtherTags ((->) r) = '[]
50−
52+type instance EtherTags STM = '[]
51−instance Monad m => MonadEther (Trans.ExceptT e m) where
52− type EtherTags (Trans.ExceptT e m) = EtherTags m
53+type instance EtherTags (Either e) = '[]
53−
54+type instance EtherTags Proxy = '[]
54−instance Monad m => MonadEther (Trans.IdentityT m) where
55+type instance EtherTags (Strict.ST s) = '[]
55− type EtherTags (Trans.IdentityT m) = EtherTags m
56+type instance EtherTags (Lazy.ST s) = '[]
56−
57+
57−instance Monad m => MonadEther (Trans.ListT m) where
58− type EtherTags (Trans.ListT m) = EtherTags m
58+type instance EtherTags (Trans.ContT r m) = EtherTags m
59−
59+type instance EtherTags (Trans.ExceptT e m) = EtherTags m
60−instance Monad m => MonadEther (Trans.MaybeT m) where
61− type EtherTags (Trans.MaybeT m) = EtherTags m
60+type instance EtherTags (Trans.IdentityT m) = EtherTags m
62−
61+type instance EtherTags (Trans.ListT m) = EtherTags m
63−instance Monad m => MonadEther (Trans.ReaderT r m) where
64− type EtherTags (Trans.ReaderT r m) = EtherTags m
62+type instance EtherTags (Trans.MaybeT m) = EtherTags m
65−
63+type instance EtherTags (Trans.ReaderT r m) = EtherTags m
66−instance Monad m => MonadEther (Trans.Lazy.StateT s m) where
67− type EtherTags (Trans.Lazy.StateT s m) = EtherTags m
64+type instance 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
65+type instance 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
66+type instance 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
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
49import qualified Control.Monad.Trans.Writer.Lazy as Trans.Lazy (WriterT , mapWriterT)
49import qualified Control.Monad.Trans.Writer.Lazy as Trans.Lazy (WriterT , mapWriterT)
50import qualified Control.Monad.Trans.Writer.Strict as Trans.Strict (WriterT , mapWriterT)
50import qualified Control.Monad.Trans.Writer.Strict as Trans.Strict (WriterT , mapWriterT)
51
51
52−class MonadEther m => MonadEtherReader tag r m | m tag -> r where
52+class Monad m => MonadEtherReader tag r m | m tag -> r where
53
53
54 etherLocal :: proxy tag -> (r -> r) -> m a -> m a
54 etherLocal :: proxy tag -> (r -> r) -> m a -> m a
55
55
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)
45 deriving ( Functor, Applicative, Alternative, Monad, MonadPlus
45 deriving ( Functor, Applicative, Alternative, Monad, MonadPlus
46 , MonadFix, MonadTrans, MonadIO )
46 , MonadFix, MonadTrans, MonadIO )
47
47
48−type EtherReader tag r = EtherReaderT tag r Identity
48+type instance EtherTags (EtherReaderT tag r m) = tag ': EtherTags m
49
49
50−instance Monad m => MonadEther (EtherReaderT tag r m) where
50+type EtherReader tag r = EtherReaderT tag r Identity
51− type EtherTags (EtherReaderT tag r m) = tag ': EtherTags m
52
51
53etherReaderT :: proxy tag -> (r -> m a) -> EtherReaderT tag r m a
52etherReaderT :: proxy tag -> (r -> m a) -> EtherReaderT tag r m a
54etherReaderT _proxy = EtherReaderT . R.ReaderT
53etherReaderT _proxy = EtherReaderT . R.ReaderT