git.iko.soy/typeable/control-has
on master help sign in
adjust to base 4.18 (ghc-9.6.3)
2b0b246Dmitry Olshansky
src/Control/EnvT.hs+5−1
compare with master
unifiedsplit
@@ -1,3 +1,4 @@
1+{-# LANGUAGE CPP #-}
1{-# LANGUAGE TemplateHaskell #-}
2{-# LANGUAGE TemplateHaskell #-}
2
3
3module Control.EnvT
4module Control.EnvT
@@ -13,12 +14,15 @@ import Control.Lens
13import Control.Monad.Base
14import Control.Monad.Base
14import Control.Monad.Catch
15import Control.Monad.Catch
15import Control.Monad.Except
16import Control.Monad.Except
16−import Control.Monad.Fail
17import Control.Monad.Reader as X
17import Control.Monad.Reader as X
18import Control.Monad.Trans.Control
18import Control.Monad.Trans.Control
19import Control.Monad.Trans.Resource
19import Control.Monad.Trans.Resource
20import Control.Monad.Zip
20import Control.Monad.Zip
21
21
22+#if MIN_VERSION_base(4,18,0)
23+import Control.Monad
24+import Control.Monad.Fix
25+#endif
22
26
23-- | The only reason this exists is that there are a lot of instances for
27-- | The only reason this exists is that there are a lot of instances for
24-- 'EnvT, which simply pass the implementation to the inner 'm'
28-- 'EnvT, which simply pass the implementation to the inner 'm'
src/Control/Has.hs+11−11
@@ -20,11 +20,11 @@ class Has x r where
20instance {-# OVERLAPS #-} Has r r where
20instance {-# OVERLAPS #-} Has r r where
21 part = id
21 part = id
22
22
23−type family HasAll (xs :: [*]) r :: Constraint where
23+type family HasAll (xs :: [Type]) r :: Constraint where
24 HasAll '[] r = ()
24 HasAll '[] r = ()
25 HasAll (x ': xs) r = (Has x r, HasAll xs r)
25 HasAll (x ': xs) r = (Has x r, HasAll xs r)
26
26
27−data LensList (r :: *) (es :: [*]) where
27+data LensList (r :: Type) (es :: [Type]) where
28 LLNil :: LensList r '[]
28 LLNil :: LensList r '[]
29 LLCons :: Lens r r e e -> LensList r es -> LensList r (e ': es)
29 LLCons :: Lens r r e e -> LensList r es -> LensList r (e ': es)
30
30
@@ -32,7 +32,7 @@ mapLL :: Lens s s r r -> LensList r es -> LensList s es
32mapLL _ LLNil = LLNil
32mapLL _ LLNil = LLNil
33mapLL m (LLCons l ls) = LLCons (m . l) (mapLL m ls)
33mapLL m (LLCons l ls) = LLCons (m . l) (mapLL m ls)
34
34
35−type family (xs :: [*]) ++ (ys :: [*]) :: [*] where
35+type family (xs :: [Type]) ++ (ys :: [Type]) :: [Type] where
36 '[] ++ ys = ys
36 '[] ++ ys = ys
37 (x ': xs) ++ ys = x ': (xs ++ ys)
37 (x ': xs) ++ ys = x ': (xs ++ ys)
38
38
@@ -43,7 +43,7 @@ concatLL (LLCons l ls) ys = LLCons l (concatLL ls ys)
43-- borrowed from Data.HSet.Get
43-- borrowed from Data.HSet.Get
44data N = Z | S N
44data N = Z | S N
45
45
46−type family IndexOf (x :: *) (xs :: [*]) :: N where
46+type family IndexOf (x :: Type) (xs :: [Type]) :: N where
47 IndexOf x (x ': _) = 'Z
47 IndexOf x (x ': _) = 'Z
48 IndexOf x (_ ': xs) = 'S (IndexOf x xs)
48 IndexOf x (_ ': xs) = 'S (IndexOf x xs)
49
49
@@ -52,8 +52,8 @@ class (i ~ IndexOf e es) => GetLens e es i | i es -> e where
52
52
53type Elem e es = GetLens e es (IndexOf e es)
53type Elem e es = GetLens e es (IndexOf e es)
54
54
55−class Fieldy (r :: *) where
55+class Fieldy (r :: Type) where
56− type Fields r :: [*]
56+ type Fields r :: [Type]
57 type Fields r = GFields (Rep r)
57 type Fields r = GFields (Rep r)
58 lensList :: LensList r (Fields r)
58 lensList :: LensList r (Fields r)
59 default lensList
59 default lensList
@@ -73,16 +73,16 @@ instance (GetLens e' es n, 'S n ~ IndexOf e' (e ': es))
73 => GetLens e' (e ': es) ('S n) where
73 => GetLens e' (e ': es) ('S n) where
74 getLens (LLCons _ ls) = getLens ls
74 getLens (LLCons _ ls) = getLens ls
75
75
76−class GFieldy (r :: * -> *) where
76+class GFieldy (r :: Type -> Type) where
77− type GFields r :: [*]
77+ type GFields r :: [Type]
78 glensList :: LensList (r x) (GFields r)
78 glensList :: LensList (r x) (GFields r)
79
79
80instance GFieldyProduct r => GFieldy (D1 d (C1 c r)) where
80instance GFieldyProduct r => GFieldy (D1 d (C1 c r)) where
81 type GFields (D1 d (C1 c r)) = GFieldsProduct r
81 type GFields (D1 d (C1 c r)) = GFieldsProduct r
82 glensList = mapLL (iso unM1 M1 . iso unM1 M1) glensListProduct
82 glensList = mapLL (iso unM1 M1 . iso unM1 M1) glensListProduct
83
83
84−class GFieldyProduct (r :: * -> *) where
84+class GFieldyProduct (r :: Type -> Type) where
85− type GFieldsProduct r :: [*]
85+ type GFieldsProduct r :: [Type]
86 glensListProduct :: LensList (r x) (GFieldsProduct r)
86 glensListProduct :: LensList (r x) (GFieldsProduct r)
87
87
88instance (GFieldyProduct r, GFieldyProduct s) => GFieldyProduct (r :*: s) where
88instance (GFieldyProduct r, GFieldyProduct s) => GFieldyProduct (r :*: s) where
@@ -101,7 +101,7 @@ instance GFieldyProduct (S1 s (K1 k r)) where
101 type GFieldsProduct (S1 s (K1 k r)) = '[r]
101 type GFieldsProduct (S1 s (K1 k r)) = '[r]
102 glensListProduct = LLCons (iso unM1 M1 . iso unK1 K1) LLNil
102 glensListProduct = LLCons (iso unM1 M1 . iso unK1 K1) LLNil
103
103
104−type family AllElem (xs :: [*]) (es :: [*]) :: Constraint where
104+type family AllElem (xs :: [Type]) (es :: [Type]) :: Constraint where
105 AllElem '[] _ = ()
105 AllElem '[] _ = ()
106 AllElem (x ': xs) es = (Elem x es, AllElem xs es)
106 AllElem (x ': xs) es = (Elem x es, AllElem xs es)
107
107