git.iko.soy/typeable/ether
on master help sign in
Ensure Tag uniqueness on class level
d7cb7cdIndex Int
src/Control/Ether/Core.hs+10−10
compare with master
unifiedsplit
@@ -5,7 +5,7 @@
5{-# LANGUAGE TypeOperators #-}
5{-# LANGUAGE TypeOperators #-}
6{-# LANGUAGE UndecidableInstances #-}
6{-# LANGUAGE UndecidableInstances #-}
7module Control.Ether.Core
7module Control.Ether.Core
8− ( EtherTagless
8+ ( EtherTagset
9 , EtherTags
9 , EtherTags
10 ) where
10 ) where
11
11
@@ -28,17 +28,17 @@ import qualified Control.Monad.Trans.State.Strict as Trans.Strict
28import qualified Control.Monad.Trans.Writer.Lazy as Trans.Lazy
28import qualified Control.Monad.Trans.Writer.Lazy as Trans.Lazy
29import qualified Control.Monad.Trans.Writer.Strict as Trans.Strict
29import qualified Control.Monad.Trans.Writer.Strict as Trans.Strict
30
30
31−type family OR (a :: Bool) (b :: Bool) :: Bool where
31+type family Elem (x :: k) (as :: [k]) :: Bool where
32− OR 'True a = 'True
32+ Elem x (x ': as) = 'True
33+ Elem x (a ': as) = Elem x as
33− OR 'False a = a
34+ Elem x '[] = 'False
34
35
35−type family ELEM (x :: k) (as :: [k]) :: Bool where
36+type family Unique (as :: [k]) :: Constraint where
36− ELEM x (x ': as) = 'True
37+ Unique '[] = ()
37− ELEM x (a ': as) = ELEM x as
38+ Unique (a ': as) = (Elem a as ~ 'False, Unique as)
38− ELEM x '[] = 'False
39
39
40−type family EtherTagless (tag :: *) (m :: * -> *) :: Constraint where
40+type family EtherTagset (m :: * -> *) :: Constraint where
41− EtherTagless tag m = ELEM tag (EtherTags m) ~ 'False
41+ EtherTagset m = Unique (EtherTags m)
42
42
43type family EtherTags (m :: * -> *) :: [*]
43type family EtherTags (m :: * -> *) :: [*]
44
44
src/Control/Monad/Ether/Reader.hs+4−3
@@ -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 Monad m => MonadEtherReader tag r m | m tag -> r where
52+class (Monad m, EtherTagset 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
@@ -70,12 +70,13 @@ ask' = etherAsk (Proxy :: Proxy r)
70reader' :: forall m r a . MonadReader' r m => (r -> a) -> m a
70reader' :: forall m r a . MonadReader' r m => (r -> a) -> m a
71reader' = etherReader (Proxy :: Proxy r)
71reader' = etherReader (Proxy :: Proxy r)
72
72
73−instance {-# OVERLAPPING #-} (Monad m, EtherTagless tag m)
73+instance {-# OVERLAPPING #-} (Monad m, EtherTagset (EtherReaderT tag r m))
74 => MonadEtherReader tag r (EtherReaderT tag r m) where
74 => MonadEtherReader tag r (EtherReaderT tag r m) where
75 etherAsk proxy = etherReaderT proxy return
75 etherAsk proxy = etherReaderT proxy return
76 etherLocal proxy f m = etherReaderT proxy (runEtherReaderT proxy m . f)
76 etherLocal proxy f m = etherReaderT proxy (runEtherReaderT proxy m . f)
77
77
78+instance (MonadEtherReader tag r m, EtherTagset (EtherReaderT tag' r' m))
78−instance MonadEtherReader tag r m => MonadEtherReader tag r (EtherReaderT tag' r' m) where
79+ => MonadEtherReader tag r (EtherReaderT tag' r' m) where
79 etherAsk proxy = lift (etherAsk proxy)
80 etherAsk proxy = lift (etherAsk proxy)
80 etherLocal proxy = mapEtherReaderT Proxy . etherLocal proxy
81 etherLocal proxy = mapEtherReaderT Proxy . etherLocal proxy
81
82