git.iko.soy/typeable/ether
on master help sign in
Ensure Tag uniqueness on class level
commitd7cb7cde2a85e92d09f168a43915c3e3d6f12d7a authorIndex Int <vlad.z.4096@gmail.com> dateTue 9 Jun 2015, 11:48 (11 years ago) parent1526210
2 files changed+14−13
compare with master
unifiedsplit
src/Control/Ether/Core.hs+10−10 src/Control/Monad/Ether/Reader.hs+4−3
src/Control/Ether/Core.hs+10−10
@@ -5,7 +5,7 @@
55{-# LANGUAGE TypeOperators #-}
66{-# LANGUAGE UndecidableInstances #-}
77module Control.Ether.Core
8− ( EtherTagless
8+ ( EtherTagset
99 , EtherTags
1010 ) where
1111
@@ -28,17 +28,17 @@ import qualified Control.Monad.Trans.State.Strict as Trans.Strict
2828import qualified Control.Monad.Trans.Writer.Lazy as Trans.Lazy
2929import qualified Control.Monad.Trans.Writer.Strict as Trans.Strict
3030
31−type family OR (a :: Bool) (b :: Bool) :: Bool where
32− OR 'True a = 'True
33− OR 'False a = a
31+type family Elem (x :: k) (as :: [k]) :: Bool where
32+ Elem x (x ': as) = 'True
33+ Elem x (a ': as) = Elem x as
34+ Elem x '[] = 'False
3435
35−type family ELEM (x :: k) (as :: [k]) :: Bool where
36− ELEM x (x ': as) = 'True
37− ELEM x (a ': as) = ELEM x as
38− ELEM x '[] = 'False
36+type family Unique (as :: [k]) :: Constraint where
37+ Unique '[] = ()
38+ Unique (a ': as) = (Elem a as ~ 'False, Unique as)
3939
40−type family EtherTagless (tag :: *) (m :: * -> *) :: Constraint where
41− EtherTagless tag m = ELEM tag (EtherTags m) ~ 'False
40+type family EtherTagset (m :: * -> *) :: Constraint where
41+ EtherTagset m = Unique (EtherTags m)
4242
4343type family EtherTags (m :: * -> *) :: [*]
4444
src/Control/Monad/Ether/Reader.hs+4−3
@@ -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 Monad m => MonadEtherReader tag r m | m tag -> r where
52+class (Monad m, EtherTagset m) => MonadEtherReader tag r m | m tag -> r where
5353
5454 etherLocal :: proxy tag -> (r -> r) -> m a -> m a
5555
@@ -70,12 +70,13 @@ ask' = etherAsk (Proxy :: Proxy r)
7070reader' :: forall m r a . MonadReader' r m => (r -> a) -> m a
7171reader' = etherReader (Proxy :: Proxy r)
7272
73−instance {-# OVERLAPPING #-} (Monad m, EtherTagless tag m)
73+instance {-# OVERLAPPING #-} (Monad m, EtherTagset (EtherReaderT tag r m))
7474 => MonadEtherReader tag r (EtherReaderT tag r m) where
7575 etherAsk proxy = etherReaderT proxy return
7676 etherLocal proxy f m = etherReaderT proxy (runEtherReaderT proxy m . f)
7777
78−instance MonadEtherReader tag r m => MonadEtherReader tag r (EtherReaderT tag' r' m) where
78+instance (MonadEtherReader tag r m, EtherTagset (EtherReaderT tag' r' m))
79+ => MonadEtherReader tag r (EtherReaderT tag' r' m) where
7980 etherAsk proxy = lift (etherAsk proxy)
8081 etherLocal proxy = mapEtherReaderT Proxy . etherLocal proxy
8182