diff --git a/generic-lens.cabal b/generic-lens.cabal
--- a/generic-lens.cabal
+++ b/generic-lens.cabal
@@ -1,5 +1,5 @@
 name:                 generic-lens
-version:              0.3.0.1
+version:              0.4.0.0
 synopsis:             Generic data-structure operations exposed as lenses.
 description:          This package uses the GHC 8 Generic representation to derive various operations on data structures with a lens interface, including structural subtype relationship between records and positional indexing into arbitrary product types.
 
@@ -24,17 +24,27 @@
                     , Data.Generics.Product.Positions
                     , Data.Generics.Product.Subtype
                     , Data.Generics.Product.Typed
+
                     , Data.Generics.Sum
                     , Data.Generics.Sum.Any
                     , Data.Generics.Sum.Constructors
                     , Data.Generics.Sum.Typed
-
+                    , Data.Generics.Sum.Subtype
                     , Data.Generics.Internal.Lens
 
   other-modules:      Data.Generics.Internal.Families
                     , Data.Generics.Internal.Families.Count
                     , Data.Generics.Internal.Families.Has
                     , Data.Generics.Internal.HList
+
+                    , Data.Generics.Sum.Internal.Constructors
+                    , Data.Generics.Sum.Internal.Typed
+                    , Data.Generics.Sum.Internal.Subtype
+
+                    , Data.Generics.Product.Internal.Fields
+                    , Data.Generics.Product.Internal.Positions
+                    , Data.Generics.Product.Internal.Subtype
+                    , Data.Generics.Product.Internal.Typed
 
   build-depends:      base        >= 4.9 && <= 5.0
                     , profunctors >= 5.0 && <= 6.0
diff --git a/src/Data/Generics/Internal/Families/Count.hs b/src/Data/Generics/Internal/Families/Count.hs
--- a/src/Data/Generics/Internal/Families/Count.hs
+++ b/src/Data/Generics/Internal/Families/Count.hs
@@ -20,10 +20,9 @@
   , Count (..)
   ) where
 
-import GHC.Generics
-
 import Data.Type.Bool     (If)
 import Data.Type.Equality (type (==))
+import GHC.Generics
 import GHC.TypeLits       (TypeError, ErrorMessage (..))
 
 import Data.Generics.Internal.HList
diff --git a/src/Data/Generics/Internal/Families/Has.hs b/src/Data/Generics/Internal/Families/Has.hs
--- a/src/Data/Generics/Internal/Families/Has.hs
+++ b/src/Data/Generics/Internal/Families/Has.hs
@@ -21,10 +21,9 @@
   , HasCtorP
   ) where
 
-import GHC.Generics
-
 import Data.Type.Bool     (type (||), type (&&))
 import Data.Type.Equality (type (==))
+import GHC.Generics
 import GHC.TypeLits       (Symbol, TypeError, ErrorMessage (..))
 
 import Data.Generics.Internal.HList
diff --git a/src/Data/Generics/Internal/HList.hs b/src/Data/Generics/Internal/HList.hs
--- a/src/Data/Generics/Internal/HList.hs
+++ b/src/Data/Generics/Internal/HList.hs
@@ -6,7 +6,6 @@
 {-# LANGUAGE MultiParamTypeClasses  #-}
 {-# LANGUAGE PolyKinds              #-}
 {-# LANGUAGE ScopedTypeVariables    #-}
-{-# LANGUAGE TypeApplications       #-}
 {-# LANGUAGE TypeFamilies           #-}
 {-# LANGUAGE TypeOperators          #-}
 {-# LANGUAGE UndecidableInstances   #-}
diff --git a/src/Data/Generics/Product/Fields.hs b/src/Data/Generics/Product/Fields.hs
--- a/src/Data/Generics/Product/Fields.hs
+++ b/src/Data/Generics/Product/Fields.hs
@@ -28,13 +28,11 @@
 
     --  $example
     HasField (..)
-
-    -- *Internals
-  , GHasField (..)
   ) where
 
 import Data.Generics.Internal.Families
 import Data.Generics.Internal.Lens
+import Data.Generics.Product.Internal.Fields
 
 import Data.Kind    (Constraint, Type)
 import GHC.Generics
@@ -106,36 +104,3 @@
 
   ErrorUnless _ _ 'True
     = ()
-
--- |As 'HasField' but over generic representations as defined by
---  "GHC.Generics".
-class GHasField (field :: Symbol) (f :: Type -> Type) a | field f -> a where
-  gfield :: Lens' (f x) a
-
-instance GProductHasField field l r a (HasTotalFieldP field l)
-      => GHasField field (l :*: r) a where
-
-  gfield = gproductField @field @_ @_ @_ @(HasTotalFieldP field l)
-
-instance (GHasField field l a, GHasField field r a)
-      =>  GHasField field (l :+: r) a where
-
-  gfield = combine (gfield @field @l) (gfield @field @r)
-
-instance GHasField field (S1 ('MetaSel ('Just field) upkd str infstr) (Rec0 a)) a where
-  gfield = mIso . kIso
-
-instance GHasField field f a => GHasField field (M1 D meta f) a where
-  gfield = mIso . gfield @field
-
-instance GHasField field f a => GHasField field (M1 C meta f) a where
-  gfield = mIso . gfield @field
-
-class GProductHasField (field :: Symbol) l r a (left :: Bool) | left field l r -> a where
-  gproductField :: Lens' ((l :*: r) x) a
-
-instance GHasField field l a => GProductHasField field l r a 'True where
-  gproductField = first . gfield @field
-
-instance GHasField field r a => GProductHasField field l r a 'False where
-  gproductField = second . gfield @field
diff --git a/src/Data/Generics/Product/Internal/Fields.hs b/src/Data/Generics/Product/Internal/Fields.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Generics/Product/Internal/Fields.hs
@@ -0,0 +1,68 @@
+{-# LANGUAGE AllowAmbiguousTypes    #-}
+{-# LANGUAGE DataKinds              #-}
+{-# LANGUAGE FlexibleInstances      #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE KindSignatures         #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE ScopedTypeVariables    #-}
+{-# LANGUAGE TypeApplications       #-}
+{-# LANGUAGE TypeFamilies           #-}
+{-# LANGUAGE TypeOperators          #-}
+{-# LANGUAGE UndecidableInstances   #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Generics.Product.Internal.Fields
+-- Copyright   :  (C) 2017 Csongor Kiss
+-- License     :  BSD3
+-- Maintainer  :  Csongor Kiss <kiss.csongor.kiss@gmail.com>
+-- Stability   :  experimental
+-- Portability :  non-portable
+--
+-- Derive record field getters and setters generically.
+--
+-----------------------------------------------------------------------------
+
+module Data.Generics.Product.Internal.Fields
+  ( GHasField (..)
+  ) where
+
+import Data.Generics.Internal.Families
+import Data.Generics.Internal.Lens
+
+import Data.Kind    (Type)
+import GHC.Generics
+import GHC.TypeLits (Symbol)
+
+-- |As 'HasField' but over generic representations as defined by
+--  "GHC.Generics".
+class GHasField (field :: Symbol) (f :: Type -> Type) a | field f -> a where
+  gfield :: Lens' (f x) a
+
+instance GProductHasField field l r a (HasTotalFieldP field l)
+      => GHasField field (l :*: r) a where
+
+  gfield = gproductField @field @_ @_ @_ @(HasTotalFieldP field l)
+
+instance (GHasField field l a, GHasField field r a)
+      =>  GHasField field (l :+: r) a where
+
+  gfield = combine (gfield @field @l) (gfield @field @r)
+
+instance GHasField field (S1 ('MetaSel ('Just field) upkd str infstr) (Rec0 a)) a where
+  gfield = mIso . kIso
+
+instance GHasField field f a => GHasField field (M1 D meta f) a where
+  gfield = mIso . gfield @field
+
+instance GHasField field f a => GHasField field (M1 C meta f) a where
+  gfield = mIso . gfield @field
+
+class GProductHasField (field :: Symbol) l r a (left :: Bool) | left field l r -> a where
+  gproductField :: Lens' ((l :*: r) x) a
+
+instance GHasField field l a => GProductHasField field l r a 'True where
+  gproductField = first . gfield @field
+
+instance GHasField field r a => GProductHasField field l r a 'False where
+  gproductField = second . gfield @field
diff --git a/src/Data/Generics/Product/Internal/Positions.hs b/src/Data/Generics/Product/Internal/Positions.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Generics/Product/Internal/Positions.hs
@@ -0,0 +1,89 @@
+{-# LANGUAGE AllowAmbiguousTypes    #-}
+{-# LANGUAGE DataKinds              #-}
+{-# LANGUAGE FlexibleInstances      #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE KindSignatures         #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE PolyKinds              #-}
+{-# LANGUAGE ScopedTypeVariables    #-}
+{-# LANGUAGE TypeApplications       #-}
+{-# LANGUAGE TypeFamilies           #-}
+{-# LANGUAGE TypeOperators          #-}
+{-# LANGUAGE UndecidableInstances   #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Generics.Product.Internal.Positions
+-- Copyright   :  (C) 2017 Csongor Kiss
+-- License     :  BSD3
+-- Maintainer  :  Csongor Kiss <kiss.csongor.kiss@gmail.com>
+-- Stability   :  experimental
+-- Portability :  non-portable
+--
+-- Derive positional product type getters and setters generically.
+--
+-----------------------------------------------------------------------------
+
+module Data.Generics.Product.Internal.Positions
+  ( GHasPosition (..)
+  , type (<?)
+  , Size
+  ) where
+
+import Data.Generics.Internal.Lens
+
+import Data.Kind      (Type)
+import Data.Type.Bool (If, Not)
+import GHC.Generics
+import GHC.TypeLits   (type (<=?), type (+), Nat)
+
+-- |As 'HasPosition' but over generic representations as defined by
+--  "GHC.Generics".
+class GHasPosition (offset :: Nat) (i :: Nat) (f :: Type -> Type) a | offset i f -> a where
+  gposition :: Lens' (f x) a
+
+instance GHasPosition i i (S1 meta (Rec0 a)) a where
+  gposition = mIso . kIso
+
+instance GHasPosition offset i f a => GHasPosition offset i (M1 D meta f) a where
+  gposition = mIso . gposition @offset @i
+
+instance GHasPosition offset i f a => GHasPosition offset i (M1 C meta f) a where
+  gposition = mIso . gposition @offset @i
+
+instance
+  ( goLeft  ~ (i <? (offset + Size l))
+  , offset' ~ (If goLeft offset (offset + Size l))
+  , GProductHasPosition offset' i l r a goLeft
+  ) => GHasPosition offset i (l :*: r) a where
+
+  gposition = gproductPosition @offset' @i @_ @_ @_ @goLeft
+
+
+class GProductHasPosition (offset :: Nat) (i :: Nat) l r a (left :: Bool) | offset i l r left -> a where
+  gproductPosition :: Lens' ((l :*: r) x) a
+
+instance GHasPosition offset i l a => GProductHasPosition offset i l r a 'True where
+  gproductPosition = first . gposition @offset @i
+
+instance GHasPosition offset i r a => GProductHasPosition offset i l r a 'False where
+  gproductPosition = second . gposition @offset @i
+
+type family Size f :: Nat where
+  Size (l :*: r)
+    = Size l + Size r
+  Size (l :+: r)
+    = Min (Size l) (Size r)
+  Size (D1 meta f)
+    = Size f
+  Size (C1 meta f)
+    = Size f
+  Size f
+    = 1
+
+--------------------------------------------------------------------------------
+
+type x <? y = Not (y <=? x)
+infixl 4 <?
+
+type Min a b = If (a <? b) a b
diff --git a/src/Data/Generics/Product/Internal/Subtype.hs b/src/Data/Generics/Product/Internal/Subtype.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Generics/Product/Internal/Subtype.hs
@@ -0,0 +1,92 @@
+{-# LANGUAGE AllowAmbiguousTypes       #-}
+{-# LANGUAGE DataKinds                 #-}
+{-# LANGUAGE FlexibleContexts          #-}
+{-# LANGUAGE FlexibleInstances         #-}
+{-# LANGUAGE MultiParamTypeClasses     #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+{-# LANGUAGE PolyKinds                 #-}
+{-# LANGUAGE Rank2Types                #-}
+{-# LANGUAGE ScopedTypeVariables       #-}
+{-# LANGUAGE TypeApplications          #-}
+{-# LANGUAGE TypeFamilies              #-}
+{-# LANGUAGE TypeOperators             #-}
+{-# LANGUAGE UndecidableInstances      #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Generics.Product.Internal.Subtype
+-- Copyright   :  (C) 2017 Csongor Kiss
+-- License     :  BSD3
+-- Maintainer  :  Csongor Kiss <kiss.csongor.kiss@gmail.com>
+-- Stability   :  experimental
+-- Portability :  non-portable
+--
+-- Structural subtype relationships between product types.
+--
+-----------------------------------------------------------------------------
+
+module Data.Generics.Product.Internal.Subtype
+  ( GUpcast (..)
+  , GSmash (..)
+  ) where
+
+import Data.Generics.Internal.Families
+import Data.Generics.Internal.Lens
+import Data.Generics.Product.Internal.Fields
+
+import Data.Kind (Type)
+import GHC.Generics
+
+--------------------------------------------------------------------------------
+-- * Generic upcasting
+
+class GUpcast (sub :: Type -> Type) (sup :: Type -> Type) where
+  gupcast :: sub p -> sup p
+
+instance (GUpcast sub a, GUpcast sub b) => GUpcast sub (a :*: b) where
+  gupcast rep = gupcast rep :*: gupcast rep
+
+instance
+  GHasField field sub t
+  => GUpcast sub (S1 ('MetaSel ('Just field) p f b) (Rec0 t)) where
+
+  gupcast r = M1 (K1 (r ^. gfield @field))
+
+instance GUpcast sub sup => GUpcast sub (C1 c sup) where
+  gupcast = M1 . gupcast
+
+instance GUpcast sub sup => GUpcast sub (D1 c sup) where
+  gupcast = M1 . gupcast
+
+--------------------------------------------------------------------------------
+-- * Generic smashing
+
+class GSmash sub sup where
+  gsmash :: sup p -> sub p -> sub p
+
+instance (GSmash a sup, GSmash b sup) => GSmash (a :*: b) sup where
+  gsmash rep (a :*: b) = gsmash rep a :*: gsmash rep b
+
+instance
+  ( leaf ~ (S1 ('MetaSel ('Just field) p f b) t)
+  , GSmashLeaf leaf sup (HasTotalFieldP field sup)
+  ) => GSmash (S1 ('MetaSel ('Just field) p f b) t) sup where
+
+  gsmash = gsmashLeaf @_ @_ @(HasTotalFieldP field sup)
+
+instance GSmash sub sup => GSmash (C1 c sub) sup where
+  gsmash sup (M1 sub) = M1 (gsmash sup sub)
+
+instance GSmash sub sup => GSmash (D1 c sub) sup where
+  gsmash sup (M1 sub) = M1 (gsmash sup sub)
+
+class GSmashLeaf sub sup (w :: Bool) where
+  gsmashLeaf :: sup p -> sub p -> sub p
+
+instance
+  GHasField field sup t
+  => GSmashLeaf (S1 ('MetaSel ('Just field) p f b) (Rec0 t)) sup 'True where
+  gsmashLeaf sup _ = M1 (K1 (sup ^. gfield @field))
+
+instance GSmashLeaf (S1 ('MetaSel ('Just field) p f b) (Rec0 t)) sup 'False where
+  gsmashLeaf _ = id
diff --git a/src/Data/Generics/Product/Internal/Typed.hs b/src/Data/Generics/Product/Internal/Typed.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Generics/Product/Internal/Typed.hs
@@ -0,0 +1,62 @@
+{-# LANGUAGE AllowAmbiguousTypes   #-}
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE KindSignatures        #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeApplications      #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE TypeOperators         #-}
+{-# LANGUAGE UndecidableInstances  #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Generics.Product.Internal.Typed
+-- Copyright   :  (C) 2017 Csongor Kiss
+-- License     :  BSD3
+-- Maintainer  :  Csongor Kiss <kiss.csongor.kiss@gmail.com>
+-- Stability   :  experimental
+-- Portability :  non-portable
+--
+-- Derive record field getters and setters generically.
+--
+-----------------------------------------------------------------------------
+
+module Data.Generics.Product.Internal.Typed
+  ( GHasType (..)
+  ) where
+
+import Data.Generics.Internal.Families
+import Data.Generics.Internal.Lens
+
+import Data.Kind    (Type)
+import GHC.Generics
+
+-- |As 'HasType' but over generic representations as defined by
+--  "GHC.Generics".
+class GHasType (f :: Type -> Type) a where
+  gtyped :: Lens' (f x) a
+
+instance GProductHasType l r a (HasTotalTypeP a l)
+      => GHasType (l :*: r) a where
+
+  gtyped = gproductTyped @_ @_ @_ @(HasTotalTypeP a l)
+
+instance (GHasType l a, GHasType r a) => GHasType (l :+: r) a where
+  gtyped = combine (gtyped @l) (gtyped @r)
+
+instance GHasType (K1 R a) a where
+  gtyped f (K1 x) = fmap K1 (f x)
+
+instance GHasType f a => GHasType (M1 m meta f) a where
+  gtyped = mIso . gtyped
+
+class GProductHasType l r a (contains :: Bool) where
+  gproductTyped :: Lens' ((l :*: r) x) a
+
+instance GHasType l a => GProductHasType l r a 'True where
+  gproductTyped = first . gtyped
+
+instance GHasType r a => GProductHasType l r a 'False where
+  gproductTyped = second . gtyped
diff --git a/src/Data/Generics/Product/Positions.hs b/src/Data/Generics/Product/Positions.hs
--- a/src/Data/Generics/Product/Positions.hs
+++ b/src/Data/Generics/Product/Positions.hs
@@ -29,17 +29,15 @@
 
     --  $example
     HasPosition (..)
-
-    -- *Internals
-  , GHasPosition (..)
   ) where
 
 import Data.Generics.Internal.Lens
+import Data.Generics.Product.Internal.Positions
 
 import Data.Kind      (Constraint, Type)
-import Data.Type.Bool (If, type (&&), Not)
+import Data.Type.Bool (type (&&))
 import GHC.Generics
-import GHC.TypeLits   (type (<=?), type (+), Nat, TypeError, ErrorMessage(..))
+import GHC.TypeLits   (type (<=?),  Nat, TypeError, ErrorMessage(..))
 
 --  $example
 --  @
@@ -108,54 +106,3 @@
 
   ErrorUnless _ _ 'True
     = ()
-
--- |As 'HasPosition' but over generic representations as defined by
---  "GHC.Generics".
-class GHasPosition (offset :: Nat) (i :: Nat) (f :: Type -> Type) a | offset i f -> a where
-  gposition :: Lens' (f x) a
-
-instance GHasPosition i i (S1 meta (Rec0 a)) a where
-  gposition = mIso . kIso
-
-instance GHasPosition offset i f a => GHasPosition offset i (M1 D meta f) a where
-  gposition = mIso . gposition @offset @i
-
-instance GHasPosition offset i f a => GHasPosition offset i (M1 C meta f) a where
-  gposition = mIso . gposition @offset @i
-
-instance
-  ( goLeft  ~ (i <? (offset + Size l))
-  , offset' ~ (If goLeft offset (offset + Size l))
-  , GProductHasPosition offset' i l r a goLeft
-  ) => GHasPosition offset i (l :*: r) a where
-
-  gposition = gproductPosition @offset' @i @_ @_ @_ @goLeft
-
-
-class GProductHasPosition (offset :: Nat) (i :: Nat) l r a (left :: Bool) | offset i l r left -> a where
-  gproductPosition :: Lens' ((l :*: r) x) a
-
-instance GHasPosition offset i l a => GProductHasPosition offset i l r a 'True where
-  gproductPosition = first . gposition @offset @i
-
-instance GHasPosition offset i r a => GProductHasPosition offset i l r a 'False where
-  gproductPosition = second . gposition @offset @i
-
-type family Size f :: Nat where
-  Size (l :*: r)
-    = Size l + Size r
-  Size (l :+: r)
-    = Min (Size l) (Size r)
-  Size (D1 meta f)
-    = Size f
-  Size (C1 meta f)
-    = Size f
-  Size f
-    = 1
-
---------------------------------------------------------------------------------
-
-type x <? y = Not (y <=? x)
-infixl 4 <?
-
-type Min a b = If (a <? b) a b
diff --git a/src/Data/Generics/Product/Subtype.hs b/src/Data/Generics/Product/Subtype.hs
--- a/src/Data/Generics/Product/Subtype.hs
+++ b/src/Data/Generics/Product/Subtype.hs
@@ -21,53 +21,52 @@
 -- Stability   :  experimental
 -- Portability :  non-portable
 --
--- Structural subtype relationship between record types.
---
--- The running example in this module is the following two types:
---
--- @
---
---   module Test where
---
---   import GHC.Generics
---   import Data.Generics.Record
---
---   data Human = Human
---     { name    :: String
---     , age     :: Int
---     , address :: String
---     } deriving (Generic, Show)
---
---   data Animal = Animal
---     { name    :: String
---     , age     :: Int
---     } deriving (Generic, Show)
---
---    human :: Human
---    human = Human \"Tunyasz\" 50 \"London\"
---
--- @
+-- Structural subtype relationships between product types.
 --
 -----------------------------------------------------------------------------
+
 module Data.Generics.Product.Subtype
-  ( Subtype (..)
+  ( -- *Lenses
+    --
+    --  $example
+    Subtype (..)
   ) where
 
-import Data.Generics.Internal.Families
 import Data.Generics.Internal.Lens
-import Data.Generics.Product.Fields
+import Data.Generics.Product.Internal.Subtype
 
-import Data.Kind (Type)
-import GHC.Generics
+import GHC.Generics (Generic (Rep, to, from) )
 
+--  $example
+--  @
+--     module Example where
+--
+--     import Data.Generics.Product
+--     import GHC.Generics
+--
+--     data Human = Human
+--       { name    :: String
+--       , age     :: Int
+--       , address :: String
+--       } deriving (Generic, Show)
+--
+--     data Animal = Animal
+--       { name    :: String
+--       , age     :: Int
+--       } deriving (Generic, Show)
+--
+--     human :: Human
+--     human = Human \"Tunyasz\" 50 \"London\"
+--  @
+
 -- |Structural subtype relationship
 --
 -- @sub@ is a (structural) `subtype' of @sup@, if its fields are a subset of
 -- those of @sup@.
 --
 class Subtype sup sub where
-  -- | Structural subtype lens. Given a subtype relationship @sub :< sup@,
-  --   we can focus on the @sub@ structure of @sup@.
+  -- |Structural subtype lens. Given a subtype relationship @sub :< sup@,
+  --  we can focus on the @sub@ structure of @sup@.
   --
   -- >>> human ^. super @Animal
   -- Animal {name = "Tunyasz", age = 50}
@@ -78,7 +77,7 @@
   super f sub
     = fmap (`smash` sub) (f (upcast sub))
 
-  -- | Cast the more specific subtype to the more general supertype
+  -- |Cast the more specific subtype to the more general supertype
   --
   -- >>> upcast human :: Animal
   -- Animal {name = "Tunyasz", age = 50}
@@ -86,7 +85,7 @@
   upcast :: sub -> sup
   upcast s = s ^. super @sup
 
-  -- | Plug a smaller structure into a larger one
+  -- |Plug a smaller structure into a larger one
   --
   -- >>> smash (Animal "dog" 10) human
   -- Human {name = "dog", age = 10, address = "London"}
@@ -95,7 +94,6 @@
 
   {-# MINIMAL super | smash, upcast #-}
 
--- | Instances are created by the compiler
 instance
   ( GSmash (Rep a) (Rep b)
   , GUpcast (Rep a) (Rep b)
@@ -104,58 +102,3 @@
   ) => Subtype b a where
     smash p b = to $ gsmash (from p) (from b)
     upcast    = to . gupcast . from
-
---------------------------------------------------------------------------------
--- * Generic upcasting
-
--- | Upcast 'sub to 'sup' (generic rep)
-class GUpcast (sub :: Type -> Type) (sup :: Type -> Type) where
-  gupcast :: sub p -> sup p
-
-instance (GUpcast sub a, GUpcast sub b) => GUpcast sub (a :*: b) where
-  gupcast rep = gupcast rep :*: gupcast rep
-
-instance
-  GHasField field sub t
-  => GUpcast sub (S1 ('MetaSel ('Just field) p f b) (Rec0 t)) where
-
-  gupcast r = M1 (K1 (r ^. gfield @field))
-
-instance GUpcast sub sup => GUpcast sub (C1 c sup) where
-  gupcast = M1 . gupcast
-
-instance GUpcast sub sup => GUpcast sub (D1 c sup) where
-  gupcast = M1 . gupcast
-
---------------------------------------------------------------------------------
--- * Generic smashing
-
-class GSmash sub sup where
-  gsmash :: sup p -> sub p -> sub p
-
-instance (GSmash a sup, GSmash b sup) => GSmash (a :*: b) sup where
-  gsmash rep (a :*: b) = gsmash rep a :*: gsmash rep b
-
-instance
-  ( leaf ~ (S1 ('MetaSel ('Just field) p f b) t)
-  , GSmashLeaf leaf sup (HasTotalFieldP field sup)
-  ) => GSmash (S1 ('MetaSel ('Just field) p f b) t) sup where
-
-  gsmash = gsmashLeaf @_ @_ @(HasTotalFieldP field sup)
-
-instance GSmash sub sup => GSmash (C1 c sub) sup where
-  gsmash sup (M1 sub) = M1 (gsmash sup sub)
-
-instance GSmash sub sup => GSmash (D1 c sub) sup where
-  gsmash sup (M1 sub) = M1 (gsmash sup sub)
-
-class GSmashLeaf sub sup (w :: Bool) where
-  gsmashLeaf :: sup p -> sub p -> sub p
-
-instance
-  GHasField field sup t
-  => GSmashLeaf (S1 ('MetaSel ('Just field) p f b) (Rec0 t)) sup 'True where
-  gsmashLeaf sup _ = M1 (K1 (sup ^. gfield @field))
-
-instance GSmashLeaf (S1 ('MetaSel ('Just field) p f b) (Rec0 t)) sup 'False where
-  gsmashLeaf _ = id
diff --git a/src/Data/Generics/Product/Typed.hs b/src/Data/Generics/Product/Typed.hs
--- a/src/Data/Generics/Product/Typed.hs
+++ b/src/Data/Generics/Product/Typed.hs
@@ -28,16 +28,14 @@
     --
     --  $example
     HasType (..)
-
-    -- *Internals
-  , GHasType (..)
   ) where
 
 import Data.Generics.Internal.Families
 import Data.Generics.Internal.Lens
+import Data.Generics.Product.Internal.Typed
 
 import Data.Kind    (Constraint, Type)
-import GHC.Generics
+import GHC.Generics (Generic (Rep))
 import GHC.TypeLits (TypeError, ErrorMessage (..))
 
 --  $example
@@ -58,7 +56,7 @@
 --    human = Human \"Tunyasz\" 50 \"London\"
 --  @
 
---  | Records that have a field with a unique type.
+-- |Records that have a field with a unique type.
 class HasType a s where
   -- |A lens that focuses on a field with a unique type in its parent type.
   --  Compatible with the lens package's 'Control.Lens.Lens' type.
@@ -69,11 +67,11 @@
   typed f t
     = fmap (flip (setTyped @a) t) (f (getTyped @a t))
 
-  -- |Get field at type
+  -- |Get field at type.
   getTyped :: s -> a
   getTyped s = s ^. typed @a
 
-  -- |Set field at type
+  -- |Set field at type.
   setTyped :: a -> s -> s
   setTyped = set (typed @a)
 
@@ -107,31 +105,3 @@
 
   ErrorUnlessOne _ _ 'One
     = ()
-
--- |As 'HasType' but over generic representations as defined by
---  "GHC.Generics".
-class GHasType (f :: Type -> Type) a where
-  gtyped :: Lens' (f x) a
-
-instance GProductHasType l r a (HasTotalTypeP a l)
-      => GHasType (l :*: r) a where
-
-  gtyped = gproductTyped @_ @_ @_ @(HasTotalTypeP a l)
-
-instance (GHasType l a, GHasType r a) => GHasType (l :+: r) a where
-  gtyped = combine (gtyped @l) (gtyped @r)
-
-instance GHasType (K1 R a) a where
-  gtyped f (K1 x) = fmap K1 (f x)
-
-instance GHasType f a => GHasType (M1 m meta f) a where
-  gtyped = mIso . gtyped
-
-class GProductHasType l r a (contains :: Bool) where
-  gproductTyped :: Lens' ((l :*: r) x) a
-
-instance GHasType l a => GProductHasType l r a 'True where
-  gproductTyped = first . gtyped
-
-instance GHasType r a => GProductHasType l r a 'False where
-  gproductTyped = second . gtyped
diff --git a/src/Data/Generics/Sum.hs b/src/Data/Generics/Sum.hs
--- a/src/Data/Generics/Sum.hs
+++ b/src/Data/Generics/Sum.hs
@@ -20,9 +20,11 @@
     AsAny (..)
 
   , AsConstructor (..)
+  , AsSubtype (..)
   , AsType (..)
   ) where
 
 import Data.Generics.Sum.Any
 import Data.Generics.Sum.Constructors
+import Data.Generics.Sum.Subtype
 import Data.Generics.Sum.Typed
diff --git a/src/Data/Generics/Sum/Any.hs b/src/Data/Generics/Sum/Any.hs
--- a/src/Data/Generics/Sum/Any.hs
+++ b/src/Data/Generics/Sum/Any.hs
@@ -41,7 +41,7 @@
 --
 --    data Animal
 --      = Dog Dog
---      | Cat (Name, Age)
+--      | Cat Name Age
 --      | Duck Age
 --      deriving (Generic, Show)
 --
@@ -57,7 +57,7 @@
 --    dog, cat, duck :: Animal
 --
 --    dog = Dog (MkDog "Shep" 3)
---    cat = Cat ("Mog", 5)
+--    cat = Cat "Mog" 5
 --    duck = Duck 2
 --  @
 
@@ -73,10 +73,12 @@
   --  Just (MkDog {name = "Shep", age = 3})
   --  >>> dog ^? _As @"Cat"
   --  Nothing
+  --  >>> cat ^? _As @(Name, Age)
+  --  Just ("Mog",5)
   --  >>> cat ^? _As @"Cat"
-  --  Just ("Mog", 5)
+  --  Just ("Mog",5)
   --  >>> _As @"Cat" # ("Garfield", 6) :: Animal
-  --  Cat ("Garfield", 6)
+  --  Cat ("Garfield",6)
   --  >>> duck ^? _As @Age
   --  Just 2
   _As :: Prism' s a
diff --git a/src/Data/Generics/Sum/Constructors.hs b/src/Data/Generics/Sum/Constructors.hs
--- a/src/Data/Generics/Sum/Constructors.hs
+++ b/src/Data/Generics/Sum/Constructors.hs
@@ -31,11 +31,11 @@
   ) where
 
 import Data.Generics.Internal.Families
-import Data.Generics.Internal.HList
 import Data.Generics.Internal.Lens
+import Data.Generics.Sum.Internal.Constructors
 
 import Data.Kind    (Constraint, Type)
-import GHC.Generics
+import GHC.Generics (Generic (Rep))
 import GHC.TypeLits (Symbol, TypeError, ErrorMessage (..))
 
 --  $example
@@ -47,7 +47,7 @@
 --
 --    data Animal
 --      = Dog Dog
---      | Cat (Name, Age)
+--      | Cat Name Age
 --      | Duck Age
 --      deriving (Generic, Show)
 --
@@ -63,7 +63,7 @@
 --    dog, cat, duck :: Animal
 --
 --    dog = Dog (MkDog "Shep" 3)
---    cat = Cat ("Mog", 5)
+--    cat = Cat "Mog" 5
 --    duck = Duck 2
 --  @
 
@@ -104,30 +104,3 @@
 
   ErrorUnless _ _ 'True
     = ()
-
--- |As 'AsConstructor' but over generic representations as defined by
---  "GHC.Generics".
-class GAsConstructor (ctor :: Symbol) (f :: Type -> Type) a | ctor f -> a where
-  _GCtor :: Prism' (f x) a
-
-instance
-  ( GCollectible f as
-  , ListTuple a as
-  ) => GAsConstructor ctor (M1 C ('MetaCons ctor fixity fields) f) a where
-
-  _GCtor = prism (M1 . gfromCollection . tupleToList) (Right . listToTuple @_ @as . gtoCollection . unM1)
-
-instance GSumAsConstructor ctor l r a (HasCtorP ctor l) => GAsConstructor ctor (l :+: r) a where
-  _GCtor = _GSumCtor @ctor @l @r @a @(HasCtorP ctor l)
-
-instance GAsConstructor ctor f a => GAsConstructor ctor (M1 D meta f) a where
-  _GCtor = mIso . _GCtor @ctor
-
-class GSumAsConstructor (ctor :: Symbol) l r a (contains :: Bool) | ctor l r contains -> a where
-  _GSumCtor :: Prism' ((l :+: r) x) a
-
-instance GAsConstructor ctor l a => GSumAsConstructor ctor l r a 'True where
-  _GSumCtor = left . _GCtor @ctor
-
-instance GAsConstructor ctor r a => GSumAsConstructor ctor l r a 'False where
-  _GSumCtor = right . _GCtor @ctor
diff --git a/src/Data/Generics/Sum/Internal/Constructors.hs b/src/Data/Generics/Sum/Internal/Constructors.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Generics/Sum/Internal/Constructors.hs
@@ -0,0 +1,63 @@
+{-# LANGUAGE AllowAmbiguousTypes    #-}
+{-# LANGUAGE DataKinds              #-}
+{-# LANGUAGE FlexibleInstances      #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE KindSignatures         #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE ScopedTypeVariables    #-}
+{-# LANGUAGE TypeApplications       #-}
+{-# LANGUAGE TypeFamilies           #-}
+{-# LANGUAGE TypeOperators          #-}
+{-# LANGUAGE UndecidableInstances   #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Generics.Sum.Internal.Constructors
+-- Copyright   :  (C) 2017 Csongor Kiss
+-- License     :  BSD3
+-- Maintainer  :  Csongor Kiss <kiss.csongor.kiss@gmail.com>
+-- Stability   :  experimental
+-- Portability :  non-portable
+--
+-- Derive constructor-name-based prisms generically.
+--
+-----------------------------------------------------------------------------
+
+module Data.Generics.Sum.Internal.Constructors
+  ( GAsConstructor (..)
+  ) where
+
+import Data.Generics.Internal.Families
+import Data.Generics.Internal.HList
+import Data.Generics.Internal.Lens
+
+import Data.Kind    (Type)
+import GHC.Generics
+import GHC.TypeLits (Symbol)
+
+-- |As 'AsConstructor' but over generic representations as defined by
+--  "GHC.Generics".
+class GAsConstructor (ctor :: Symbol) (f :: Type -> Type) a | ctor f -> a where
+  _GCtor :: Prism' (f x) a
+
+instance
+  ( GCollectible f as
+  , ListTuple a as
+  ) => GAsConstructor ctor (M1 C ('MetaCons ctor fixity fields) f) a where
+
+  _GCtor = prism (M1 . gfromCollection . tupleToList) (Right . listToTuple @_ @as . gtoCollection . unM1)
+
+instance GSumAsConstructor ctor l r a (HasCtorP ctor l) => GAsConstructor ctor (l :+: r) a where
+  _GCtor = _GSumCtor @ctor @l @r @a @(HasCtorP ctor l)
+
+instance GAsConstructor ctor f a => GAsConstructor ctor (M1 D meta f) a where
+  _GCtor = mIso . _GCtor @ctor
+
+class GSumAsConstructor (ctor :: Symbol) l r a (contains :: Bool) | ctor l r contains -> a where
+  _GSumCtor :: Prism' ((l :+: r) x) a
+
+instance GAsConstructor ctor l a => GSumAsConstructor ctor l r a 'True where
+  _GSumCtor = left . _GCtor @ctor
+
+instance GAsConstructor ctor r a => GSumAsConstructor ctor l r a 'False where
+  _GSumCtor = right . _GCtor @ctor
diff --git a/src/Data/Generics/Sum/Internal/Subtype.hs b/src/Data/Generics/Sum/Internal/Subtype.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Generics/Sum/Internal/Subtype.hs
@@ -0,0 +1,74 @@
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE KindSignatures        #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeApplications      #-}
+{-# LANGUAGE TypeOperators         #-}
+{-# LANGUAGE TypeSynonymInstances  #-}
+{-# LANGUAGE UndecidableInstances  #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Generics.Sum.Internal.Subtype
+-- Copyright   :  (C) 2017 Csongor Kiss
+-- License     :  BSD3
+-- Maintainer  :  Csongor Kiss <kiss.csongor.kiss@gmail.com>
+-- Stability   :  experimental
+-- Portability :  non-portable
+--
+-- Structural subtype relationships between sum types.
+--
+-----------------------------------------------------------------------------
+
+module Data.Generics.Sum.Internal.Subtype
+  ( GAsSubtype (..)
+  ) where
+
+import Data.Generics.Internal.HList
+import Data.Generics.Sum.Internal.Typed
+
+import Data.Kind
+import GHC.Generics
+
+-- |As 'AsSubtype' but over generic representations as defined by
+--  "GHC.Generics".
+class GAsSubtype (subf :: Type -> Type) (supf :: Type -> Type) where
+  ginjectSub  :: subf x -> supf x
+  gprojectSub :: supf x -> Either (supf x) (subf x)
+
+instance
+  ( GAsSubtype l supf
+  , GAsSubtype r supf
+  ) => GAsSubtype (l :+: r) supf where
+
+  ginjectSub x = case x of
+    L1 l -> ginjectSub l
+    R1 r -> ginjectSub r
+  gprojectSub x
+    = case gprojectSub x of
+        Left  _ -> fmap R1 (gprojectSub x)
+        Right y -> Right (L1 y)
+
+instance
+  ( GAsType supf a
+  , GCollectible subf as
+  , ListTuple a as
+  ) => GAsSubtype (C1 meta subf) supf where
+
+  ginjectSub
+    = ginjectTyped . listToTuple . gtoCollection . unM1
+  gprojectSub
+    = fmap (M1 . gfromCollection . tupleToList) . gprojectTyped
+
+instance GAsType supf a => GAsSubtype (S1 meta (Rec0 a)) supf where
+  ginjectSub
+    = ginjectTyped @supf . unK1 . unM1
+  gprojectSub
+    = fmap (M1 . K1) . gprojectTyped @supf
+
+instance GAsSubtype subf supf => GAsSubtype (D1 meta subf) supf where
+  ginjectSub
+    = ginjectSub . unM1
+  gprojectSub
+    = fmap M1 . gprojectSub
diff --git a/src/Data/Generics/Sum/Internal/Typed.hs b/src/Data/Generics/Sum/Internal/Typed.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Generics/Sum/Internal/Typed.hs
@@ -0,0 +1,88 @@
+{-# LANGUAGE AllowAmbiguousTypes    #-}
+{-# LANGUAGE DataKinds              #-}
+{-# LANGUAGE FlexibleContexts       #-}
+{-# LANGUAGE FlexibleInstances      #-}
+{-# LANGUAGE KindSignatures         #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE ScopedTypeVariables    #-}
+{-# LANGUAGE TypeApplications       #-}
+{-# LANGUAGE TypeFamilies           #-}
+{-# LANGUAGE TypeOperators          #-}
+{-# LANGUAGE UndecidableInstances   #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Generics.Sum.Internal.Typed
+-- Copyright   :  (C) 2017 Csongor Kiss
+-- License     :  BSD3
+-- Maintainer  :  Csongor Kiss <kiss.csongor.kiss@gmail.com>
+-- Stability   :  experimental
+-- Portability :  non-portable
+--
+-- Derive constructor-field-type-based prisms generically.
+--
+-----------------------------------------------------------------------------
+
+module Data.Generics.Sum.Internal.Typed
+  ( GAsType (..)
+  ) where
+
+import Data.Kind
+import GHC.Generics
+
+import Data.Generics.Internal.Families
+import Data.Generics.Internal.HList
+import Data.Generics.Internal.Lens
+
+-- |As 'AsType' but over generic representations as defined by "GHC.Generics".
+class GAsType (f :: Type -> Type) a where
+  _GTyped :: Prism' (f x) a
+  _GTyped = prism ginjectTyped gprojectTyped
+
+  ginjectTyped  :: a -> f x
+  gprojectTyped :: f x -> Either (f x) a
+
+instance
+  ( GCollectible f as
+  , ListTuple a as
+  ) => GAsType (M1 C meta f) a where
+
+  ginjectTyped
+    = M1 . gfromCollection . tupleToList
+  gprojectTyped
+    = Right . listToTuple . gtoCollection . unM1
+
+instance GSumAsType (HasPartialTypeTupleP a l) l r a => GAsType (l :+: r) a where
+  ginjectTyped
+    = ginjectSumTyped @(HasPartialTypeTupleP a l) @l @r @a
+  gprojectTyped
+    = gprojectSumTyped @(HasPartialTypeTupleP a l) @l @r @a
+
+instance GAsType f a => GAsType (M1 D meta f) a where
+  ginjectTyped
+    = M1 . ginjectTyped
+  gprojectTyped
+    = either (Left . M1) Right . gprojectTyped . unM1
+
+class GSumAsType (contains :: Bool) l r a where
+  _GSumTyped :: Prism' ((l :+: r) x) a
+  _GSumTyped = prism (ginjectSumTyped  @contains) (gprojectSumTyped @contains)
+
+  ginjectSumTyped  :: a -> (l :+: r) x
+  gprojectSumTyped :: (l :+: r) x -> Either ((l :+: r) x) a
+
+instance GAsType l a => GSumAsType 'True l r a where
+  ginjectSumTyped
+    = L1 . ginjectTyped
+  gprojectSumTyped x
+    = case x of
+        L1 l -> either (Left . L1) Right (gprojectTyped l)
+        R1 _ -> Left x
+
+instance GAsType r a => GSumAsType 'False l r a where
+  ginjectSumTyped
+    = R1 . ginjectTyped
+  gprojectSumTyped x
+    = case x of
+        R1 r -> either (Left . R1) Right (gprojectTyped r)
+        L1 _ -> Left x
diff --git a/src/Data/Generics/Sum/Subtype.hs b/src/Data/Generics/Sum/Subtype.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Generics/Sum/Subtype.hs
@@ -0,0 +1,108 @@
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeOperators         #-}
+{-# LANGUAGE TypeSynonymInstances  #-}
+{-# LANGUAGE UndecidableInstances  #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Generics.Sum.Subtype
+-- Copyright   :  (C) 2017 Csongor Kiss
+-- License     :  BSD3
+-- Maintainer  :  Csongor Kiss <kiss.csongor.kiss@gmail.com>
+-- Stability   :  experimental
+-- Portability :  non-portable
+--
+-- Structural subtype relationships between sum types.
+--
+-----------------------------------------------------------------------------
+
+module Data.Generics.Sum.Subtype
+  ( -- *Prisms
+    --
+    --  $example
+    AsSubtype (..)
+  ) where
+
+import Data.Generics.Internal.Lens
+import Data.Generics.Sum.Internal.Subtype
+
+import GHC.Generics (Generic (Rep, to, from))
+
+--  $example
+--  @
+--    module Example where
+--
+--    import Data.Generics.Sum
+--    import GHC.Generics
+--
+--    data Animal
+--      = Dog Dog
+--      | Cat Name Age
+--      | Duck Age
+--      deriving (Generic, Show)
+--
+--    data FourLeggedAnimal
+--      = Dog4 Dog
+--      | Cat4 Name Age
+--      deriving (Generic, Show)
+--
+--    data Dog = MkDog
+--      { name :: Name
+--      , age  :: Age
+--      }
+--      deriving (Generic, Show)
+--
+--    type Name = String
+--    type Age  = Int
+--
+--    dog, cat, duck :: Animal
+--
+--    dog = Dog (MkDog "Shep" 3)
+--    cat = Cat "Mog" 5
+--    duck = Duck 2
+--
+--    dog4, cat4 :: FourLeggedAnimal
+--
+--    dog4 = Dog4 (MkDog "Snowy" 4)
+--    cat4 = Cat4 "Garfield" 6
+--  @
+
+-- |Structural subtyping between sums. A sum 'Sub' is a subtype of another sum
+--  'Sup' if a value of 'Sub' can be given (modulo naming of constructors)
+--  whenever a value of 'Sup' is expected. In the running example for instance,
+--  'FourLeggedAnimal` is a subtype of 'Animal' since a value of the former can
+--  be given as a value of the latter (renaming 'Dog4' to 'Dog' and 'Cat4' to
+--  'Cat').
+class AsSubtype sub sup where
+  -- |A prism that captures structural subtyping. Allows a substructure to be
+  --  injected (upcast) into a superstructure or a superstructure to be downcast
+  --  into a substructure (which may fail).
+  --
+  --  >>> _Sub # dog4 :: Animal
+  --  Dog (MkDog {name = "Snowy", age = 4})
+  --  >>> cat ^? _Sub :: Maybe FourLeggedAnimal
+  --  Just (Cat4 "Mog" 5)
+  --  >>> duck ^? _Sub :: Maybe FourLeggedAnimal
+  --  Nothing
+  _Sub :: Prism' sup sub
+  _Sub = prism injectSub projectSub
+
+  -- |Injects a subtype into a supertype (upcast).
+  injectSub  :: sub -> sup
+
+  -- |Projects a subtype from a supertype (downcast).
+  projectSub :: sup -> Either sup sub
+
+  {-# MINIMAL injectSub, projectSub #-}
+
+instance
+  ( Generic sub
+  , Generic sup
+  , GAsSubtype (Rep sub) (Rep sup)
+  ) => AsSubtype sub sup where
+
+  injectSub  = to . ginjectSub . from
+  projectSub = either (Left . to) (Right . to) . gprojectSub . from
diff --git a/src/Data/Generics/Sum/Typed.hs b/src/Data/Generics/Sum/Typed.hs
--- a/src/Data/Generics/Sum/Typed.hs
+++ b/src/Data/Generics/Sum/Typed.hs
@@ -2,17 +2,13 @@
 {-# LANGUAGE DataKinds              #-}
 {-# LANGUAGE FlexibleContexts       #-}
 {-# LANGUAGE FlexibleInstances      #-}
-{-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE KindSignatures         #-}
 {-# LANGUAGE MultiParamTypeClasses  #-}
 {-# LANGUAGE ScopedTypeVariables    #-}
-{-# LANGUAGE TypeApplications       #-}
 {-# LANGUAGE TypeFamilies           #-}
 {-# LANGUAGE TypeOperators          #-}
 {-# LANGUAGE UndecidableInstances   #-}
 
-{-# LANGUAGE DeriveGeneric   #-}
-
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Generics.Sum.Typed
@@ -31,17 +27,14 @@
     --
     --  $example
     AsType (..)
-
-    -- *Internals
-  , GAsType (..)
   ) where
 
 import Data.Kind
 import GHC.Generics
 import GHC.TypeLits (TypeError, ErrorMessage (..))
+import Data.Generics.Sum.Internal.Typed
 
 import Data.Generics.Internal.Families
-import Data.Generics.Internal.HList
 import Data.Generics.Internal.Lens
 
 --  $example
@@ -69,7 +62,7 @@
 --    dog, cat, duck :: Animal
 --
 --    dog = Dog (MkDog "Shep" 3)
---    cat = Cat ("Mog", 5)
+--    cat = Cat "Mog" 5
 --    duck = Duck 2
 --  @
 
@@ -80,8 +73,10 @@
   --
   --  >>> dog ^? _Typed @Dog
   --  Just (MkDog {name = "Shep", age = 3})
-  --  >>> dog ^? _Typed @Cat
+  --  >>> dog ^? _Typed @Age
   --  Nothing
+  --  >>> cat ^? _Typed @(Name, Age)
+  --  Just ("Mog",5)
   --  >>> duck ^? _Typed @Age
   --  Just 2
   _Typed :: Prism' s a
@@ -114,56 +109,3 @@
 
   ErrorUnlessOne _ _ 'One
     = ()
-
--- |As 'AsType' but over generic representations as defined by "GHC.Generics".
-class GAsType (f :: Type -> Type) a where
-  _GTyped :: Prism' (f x) a
-  _GTyped = prism ginjectTyped gprojectTyped
-
-  ginjectTyped  :: a -> f x
-  gprojectTyped :: f x -> Either (f x) a
-
-instance
-  ( GCollectible f as
-  , ListTuple a as
-  ) => GAsType (M1 C meta f) a where
-
-  ginjectTyped
-    = M1 . gfromCollection . tupleToList
-  gprojectTyped
-    = Right . listToTuple @_ @as . gtoCollection . unM1
-
-instance GSumAsType (HasPartialTypeTupleP a l) l r a => GAsType (l :+: r) a where
-  ginjectTyped
-    = ginjectSumTyped @(HasPartialTypeTupleP a l) @l @r @a
-  gprojectTyped
-    = gprojectSumTyped @(HasPartialTypeTupleP a l) @l @r @a
-
-instance GAsType f a => GAsType (M1 D meta f) a where
-  ginjectTyped
-    = M1 . ginjectTyped
-  gprojectTyped
-    = either (Left . M1) Right . gprojectTyped . unM1
-
-class GSumAsType (contains :: Bool) l r a where
-  _GSumTyped :: Prism' ((l :+: r) x) a
-  _GSumTyped = prism (ginjectSumTyped  @contains) (gprojectSumTyped @contains)
-
-  ginjectSumTyped  :: a -> (l :+: r) x
-  gprojectSumTyped :: (l :+: r) x -> Either ((l :+: r) x) a
-
-instance GAsType l a => GSumAsType 'True l r a where
-  ginjectSumTyped
-    = L1 . ginjectTyped
-  gprojectSumTyped
-    = \x -> case x of
-        L1 l -> either (Left . L1) Right (gprojectTyped l)
-        R1 _ -> Left x
-
-instance GAsType r a => GSumAsType 'False l r a where
-  ginjectSumTyped
-    = R1 . ginjectTyped
-  gprojectSumTyped
-    = \x -> case x of
-        R1 r -> either (Left . R1) Right (gprojectTyped r)
-        L1 _ -> Left x