on master help sign in
Add (:+:) case for typed Traversal
commit6f23a3a3b61ab7ffa633a1a9b8bcc9d703cc5b76 authorCsongor Kiss <kiss.csongor.kiss@gmail.com> dateThu 25 Jan 2018, 20:24 (9 years ago) parentde7627d
1 file changed+10−6
src/Data/Generics/Product/Internal/Types.hs+10−6
src/Data/Generics/Product/Internal/Types.hs+10−6
@@ -32,24 +32,28 @@ import GHC.Generics
3232-- |As 'HasTypes' but over generic representations as defined by
3333-- "GHC.Generics".
3434class 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)
3636
3737instance (GHasTypes l a, GHasTypes r a) => GHasTypes (l :*: r) a where
3838 gtypes f (l :*: r) = (:*:) <$> gtypes f l <*> gtypes f r
3939 {-# INLINE gtypes #-}
4040
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
4344
4445instance GHasTypes (K1 R a) a where
4546 gtypes f (K1 x) = fmap K1 (f x)
4647 {-# INLINE gtypes #-}
4748
48−
49−instance {-# OVERLAPS #-} GHasTypes (K1 R a) b where
49+instance {-# OVERLAPPING #-} GHasTypes (K1 R a) b where
5050 gtypes _ k = pure k
5151 {-# INLINE gtypes #-}
5252
5353instance 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
5559 {-# INLINE gtypes #-}