git.iko.soy/generic-lens
on master help sign in
Improve inference for param
7260c24Csongor Kiss
src/Data/Generics/Internal/Families/Changing.hs+6
compare with master
unifiedsplit
@@ -14,6 +14,7 @@ module Data.Generics.Internal.Families.Changing
14 , PTag (..)
14 , PTag (..)
15 , P
15 , P
16 , LookupParam
16 , LookupParam
17+ , ArgAt
17 , ArgCount
18 , ArgCount
18 ) where
19 ) where
19
20
@@ -123,6 +124,11 @@ type family ArgCount (t :: k) :: Nat where
123 ArgCount (f a) = 1 + ArgCount f
124 ArgCount (f a) = 1 + ArgCount f
124 ArgCount a = 0
125 ArgCount a = 0
125
126
127+type family ArgAt (t :: k) (n :: Nat) :: j where
128+ ArgAt (t a) 0 = a
129+ ArgAt (t a) n = ArgAt t (n - 1)
130+
131+
126-- Note [CPP in instance constraints]
132-- Note [CPP in instance constraints]
127-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
133-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
128--
134--
src/Data/Generics/Product/Param.hs+4−2
@@ -1,3 +1,4 @@
1+{-# LANGUAGE PolyKinds #-}
1{-# LANGUAGE TypeFamilies #-}
2{-# LANGUAGE TypeFamilies #-}
2{-# LANGUAGE AllowAmbiguousTypes #-}
3{-# LANGUAGE AllowAmbiguousTypes #-}
3{-# LANGUAGE DataKinds #-}
4{-# LANGUAGE DataKinds #-}
@@ -33,14 +34,13 @@ import GHC.TypeLits
33import Data.Generics.Internal.Void
34import Data.Generics.Internal.Void
34import Data.Generics.Internal.Families.Changing
35import Data.Generics.Internal.Families.Changing
35import Data.Generics.Internal.VL.Traversal
36import Data.Generics.Internal.VL.Traversal
36−import Data.Generics.Internal.VL.Lens
37
37
38import GHC.Generics
38import GHC.Generics
39import Data.Kind
39import Data.Kind
40import Data.Generics.Internal.VL.Iso
40import Data.Generics.Internal.VL.Iso
41import Data.Generics.Internal.GenericN
41import Data.Generics.Internal.GenericN
42
42
43−class HasParam (p :: Nat) s t a b | p t a b -> s, p s a b -> t where
43+class HasParam (p :: Nat) s t a b | p t a b -> s, p s a b -> t, p s -> a, p t -> b where
44 param :: Applicative g => (a -> g b) -> s -> g t
44 param :: Applicative g => (a -> g b) -> s -> g t
45
45
46instance
46instance
@@ -50,6 +50,8 @@ instance
50 , s ~ Infer t (P n b 'PTag) a
50 , s ~ Infer t (P n b 'PTag) a
51 , t ~ Infer s (P n a 'PTag) b
51 , t ~ Infer s (P n a 'PTag) b
52 , Error ((ArgCount s) <=? n) n (ArgCount s) s
52 , Error ((ArgCount s) <=? n) n (ArgCount s) s
53+ , a ~ ArgAt s n
54+ , b ~ ArgAt t n
53 , GHasParam n (RepN s) (RepN t) a b
55 , GHasParam n (RepN s) (RepN t) a b
54 ) => HasParam n s t a b where
56 ) => HasParam n s t a b where
55
57