@@ -6,11 +6,14 @@ module Control.Has
66 , MonadHas
77 , Fieldy
88 , Generic
9− )
10−where
9+ ) where
1110
1211import Control.Lens
12+-- reexport all from Reader except Control.Monad etc
13+-- to correspond mtl-2.3+
1314import Control.Monad.Reader as X
15+ ( MonadReader(..), asks, Reader, runReader, mapReader, withReader
16+ , ReaderT(ReaderT), runReaderT, mapReaderT, withReaderT )
1417import Data.Kind
1518import GHC.Generics as G
1619
@@ -21,11 +24,11 @@ class Has x r where
2124instance {-# OVERLAPS #-} Has r r where
2225 part = id
2326
24−type family HasAll (xs :: [*]) r :: Constraint where
27+type family HasAll (xs :: [Type]) r :: Constraint where
2528 HasAll '[] r = ()
2629 HasAll (x ': xs) r = (Has x r, HasAll xs r)
2730
28−data LensList (r :: *) (es :: [*]) where
31+data LensList (r :: Type) (es :: [Type]) where
2932 LLNil :: LensList r '[]
3033 LLCons :: Lens r r e e -> LensList r es -> LensList r (e ': es)
3134
@@ -33,7 +36,7 @@ mapLL :: Lens s s r r -> LensList r es -> LensList s es
3336mapLL _ LLNil = LLNil
3437mapLL m (LLCons l ls) = LLCons (m . l) (mapLL m ls)
3538
36−type family (xs :: [*]) ++ (ys :: [*]) :: [*] where
39+type family (xs :: [Type]) ++ (ys :: [Type]) :: [Type] where
3740 '[] ++ ys = ys
3841 (x ': xs) ++ ys = x ': (xs ++ ys)
3942
@@ -44,7 +47,7 @@ concatLL (LLCons l ls) ys = LLCons l (concatLL ls ys)
4447-- borrowed from Data.HSet.Get
4548data N = Z | S N
4649
47−type family IndexOf (x :: *) (xs :: [*]) :: N where
50+type family IndexOf (x :: Type) (xs :: [Type]) :: N where
4851 IndexOf x (x ': _) = 'Z
4952 IndexOf x (_ ': xs) = 'S (IndexOf x xs)
5053
@@ -53,8 +56,8 @@ class (i ~ IndexOf e es) => GetLens e es i | i es -> e where
5356
5457type Elem e es = GetLens e es (IndexOf e es)
5558
56−class Fieldy (r :: *) where
57− type Fields r :: [*]
59+class Fieldy (r :: Type) where
60+ type Fields r :: [Type]
5861 type Fields r = GFields (Rep r)
5962 lensList :: LensList r (Fields r)
6063 default lensList
@@ -65,9 +68,7 @@ class Fieldy (r :: *) where
6568instance {-# OVERLAPPABLE #-} (Fieldy r, Elem e (Fields r)) => Has e r where
6669 part = getLens lensList
6770
68−class (MonadReader r m, HasAll es r)
69− => MonadHas (es :: [*]) (r :: *) (m :: * -> *) | m -> r
70−instance (MonadReader r m, HasAll es r) => MonadHas es r m
71+type MonadHas es r m = (MonadReader r m, HasAll es r)
7172
7273instance GetLens e (e ': es) 'Z where
7374 getLens (LLCons l _) = l
@@ -76,16 +77,16 @@ instance (GetLens e' es n, 'S n ~ IndexOf e' (e ': es))
7677 => GetLens e' (e ': es) ('S n) where
7778 getLens (LLCons _ ls) = getLens ls
7879
79−class GFieldy (r :: * -> *) where
80− type GFields r :: [*]
80+class GFieldy (r :: Type -> Type) where
81+ type GFields r :: [Type]
8182 glensList :: LensList (r x) (GFields r)
8283
8384instance GFieldyProduct r => GFieldy (D1 d (C1 c r)) where
8485 type GFields (D1 d (C1 c r)) = GFieldsProduct r
8586 glensList = mapLL (iso unM1 M1 . iso unM1 M1) glensListProduct
8687
87−class GFieldyProduct (r :: * -> *) where
88− type GFieldsProduct r :: [*]
88+class GFieldyProduct (r :: Type -> Type) where
89+ type GFieldsProduct r :: [Type]
8990 glensListProduct :: LensList (r x) (GFieldsProduct r)
9091
9192instance (GFieldyProduct r, GFieldyProduct s) => GFieldyProduct (r :*: s) where
@@ -104,7 +105,7 @@ instance GFieldyProduct (S1 s (K1 k r)) where
104105 type GFieldsProduct (S1 s (K1 k r)) = '[r]
105106 glensListProduct = LLCons (iso unM1 M1 . iso unK1 K1) LLNil
106107
107−type family AllElem (xs :: [*]) (es :: [*]) :: Constraint where
108+type family AllElem (xs :: [Type]) (es :: [Type]) :: Constraint where
108109 AllElem '[] _ = ()
109110 AllElem (x ': xs) es = (Elem x es, AllElem xs es)
110111