@@ -0,0 +1,54 @@
1+{-# LANGUAGE AllowAmbiguousTypes #-}
2+{-# LANGUAGE DataKinds #-}
3+{-# LANGUAGE FlexibleContexts #-}
4+{-# LANGUAGE FlexibleInstances #-}
5+{-# LANGUAGE KindSignatures #-}
6+{-# LANGUAGE MultiParamTypeClasses #-}
7+{-# LANGUAGE ScopedTypeVariables #-}
8+{-# LANGUAGE TypeApplications #-}
9+{-# LANGUAGE TypeFamilies #-}
10+{-# LANGUAGE TypeOperators #-}
11+{-# LANGUAGE UndecidableInstances #-}
12+
13+-----------------------------------------------------------------------------
14+-- |
15+-- Module : Data.Generics.Product.Internal.Types
16+-- Copyright : (C) 2017 Csongor Kiss
17+-- License : BSD3
18+-- Maintainer : Csongor Kiss <kiss.csongor.kiss@gmail.com>
19+-- Stability : experimental
20+-- Portability : non-portable
21+--
22+-- Derive traversals of a given type in a product.
23+--
24+-----------------------------------------------------------------------------
25+
26+module Data.Generics.Product.Internal.Types
27+ ( GHasTypes (..)
28+ ) where
29+
30+--import Data.Generics.Internal.Families
31+import Data.Generics.Internal.Lens
32+
33+import Data.Kind (Type)
34+import GHC.Generics
35+
36+-- |As 'HasTypes' but over generic representations as defined by
37+-- "GHC.Generics".
38+class GHasTypes (f :: Type -> Type) a where
39+ gtypes :: Traversal' (f x) a
40+
41+instance (GHasTypes l a, GHasTypes r a) => GHasTypes (l :*: r) a where
42+ gtypes f (l :*: r) = (:*:) <$> gtypes f l <*> gtypes f r
43+
44+-- TODO:
45+-- instance (GHasTypes l a, GHasTypes r a) => GHasTypes (l :+: r) a where
46+
47+instance GHasTypes (K1 R a) a where
48+ gtypes f (K1 x) = fmap K1 (f x)
49+
50+instance {-# OVERLAPS #-} GHasTypes (K1 R a) b where
51+ gtypes _ k = pure k
52+
53+instance GHasTypes f a => GHasTypes (M1 m meta f) a where
54+ gtypes = mIso . gtypes