on master help sign in
Add (:+:) case for typed Traversal
6f23a3aCsongor Kiss
src/Data/Generics/Product/Internal/Types.hs+10−6
@@ -32,24 +32,28 @@ import GHC.Generics
32-- |As 'HasTypes' but over generic representations as defined by
32-- |As 'HasTypes' but over generic representations as defined by
33-- "GHC.Generics".
33-- "GHC.Generics".
34class GHasTypes (f :: Type -> Type) a where
34class GHasTypes (f :: Type -> Type) a where
35− gtypes :: forall g . Applicative g => (a -> g a) -> f a -> g (f a)
35+ gtypes :: forall g x. Applicative g => (a -> g a) -> f x -> g (f x)
36
36
37instance (GHasTypes l a, GHasTypes r a) => GHasTypes (l :*: r) a where
37instance (GHasTypes l a, GHasTypes r a) => GHasTypes (l :*: r) a where
38 gtypes f (l :*: r) = (:*:) <$> gtypes f l <*> gtypes f r
38 gtypes f (l :*: r) = (:*:) <$> gtypes f l <*> gtypes f r
39 {-# INLINE gtypes #-}
39 {-# INLINE gtypes #-}
40
40
41−-- TODO:
42−-- instance (GHasTypes l a, GHasTypes r a) => GHasTypes (l :+: r) a where
41+instance (GHasTypes l a, GHasTypes r a) => GHasTypes (l :+: r) a where
42+ gtypes f (L1 l) = L1 <$> gtypes f l
43+ gtypes f (R1 r) = R1 <$> gtypes f r
43
44
44instance GHasTypes (K1 R a) a where
45instance GHasTypes (K1 R a) a where
45 gtypes f (K1 x) = fmap K1 (f x)
46 gtypes f (K1 x) = fmap K1 (f x)
46 {-# INLINE gtypes #-}
47 {-# INLINE gtypes #-}
47
48
48−
49−instance {-# OVERLAPS #-} GHasTypes (K1 R a) b where
49+instance {-# OVERLAPPING #-} GHasTypes (K1 R a) b where
50 gtypes _ k = pure k
50 gtypes _ k = pure k
51 {-# INLINE gtypes #-}
51 {-# INLINE gtypes #-}
52
52
53instance GHasTypes f a => GHasTypes (M1 m meta f) a where
53instance GHasTypes f a => GHasTypes (M1 m meta f) a where
54− gtypes f (M1 x) = M1 <$> gtypes f x
54+ gtypes f (M1 x) = M1 <$> gtypes f x
55+ {-# INLINE gtypes #-}
56+
57+instance GHasTypes U1 a where
58+ gtypes _ U1 = pure U1
55 {-# INLINE gtypes #-}
59 {-# INLINE gtypes #-}