diff --git a/ChangeLog.md b/ChangeLog.md
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,3 +1,6 @@
+## 1.0.0.2
+- Fix compile-time performance regression
+
 ## 1.0.0.1
 - Remove dump-core dependency
 - Relax upper bound on criterion (#42)
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:              1.0.0.1
+version:              1.0.0.2
 synopsis:             Generically derive traversals, lenses and prisms.
 description:          This library uses GHC.Generics to derive efficient optics (traversals, lenses and prisms) for algebraic data types in a type-directed way, with a focus on good type inference and error messages when possible.
 
@@ -59,11 +59,11 @@
                     , Data.Generics.Sum.Internal.Subtype
 
                     , Data.Generics.Product.Internal.Positions
+                    , Data.Generics.Product.Internal.GLens
                     , Data.Generics.Product.Internal.Subtype
 
                     , Data.Generics.Product.Internal.Constraints
                     , Data.Generics.Product.Internal.List
-                    , Data.Generics.Product.Internal.Keyed
 
   build-depends:      base        >= 4.9 && <= 5.0
                     , profunctors >= 5.0 && <= 6.0
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
@@ -16,6 +16,9 @@
 -----------------------------------------------------------------------------
 module Data.Generics.Internal.Families.Has
   ( HasTotalFieldP
+  , HasTotalTypeP
+  , HasTotalPositionP
+  , Pos
   , HasPartialTypeP
   , HasCtorP
   , GTypes
@@ -24,10 +27,13 @@
 import Data.Type.Bool     (type (||), type (&&))
 import Data.Type.Equality (type (==))
 import GHC.Generics
-import GHC.TypeLits       (Symbol, TypeError, ErrorMessage (..))
+import GHC.TypeLits (Symbol, Nat)
+import Data.Kind (Type)
 
 import Data.Generics.Product.Internal.List
 
+-- Note: these could be factored out into a single traversal
+
 type family HasTotalFieldP (field :: Symbol) f :: Bool where
   HasTotalFieldP field (S1 ('MetaSel ('Just field) _ _ _) _)
     = 'True
@@ -41,18 +47,55 @@
     = HasTotalFieldP field f
   HasTotalFieldP field (D1 _ f)
     = HasTotalFieldP field f
-  HasTotalFieldP field (Rec0 _)
+  HasTotalFieldP field (K1 _ _)
     = 'False
   HasTotalFieldP field U1
     = 'False
   HasTotalFieldP field V1
     = 'False
-  HasTotalFieldP field f
-    = TypeError
-        (     'ShowType f
-        ':<>: 'Text " is not a valid GHC.Generics representation type"
-        )
 
+type family HasTotalTypeP (typ :: Type) f :: Bool where
+  HasTotalTypeP typ (S1 _ (K1 _ typ))
+    = 'True
+  HasTotalTypeP typ (l :*: r)
+    = HasTotalTypeP typ l || HasTotalTypeP typ r
+  HasTotalTypeP typ (l :+: r)
+    = HasTotalTypeP typ l && HasTotalTypeP typ r
+  HasTotalTypeP typ (S1 _ _)
+    = 'False
+  HasTotalTypeP typ (C1 _ f)
+    = HasTotalTypeP typ f
+  HasTotalTypeP typ (D1 _ f)
+    = HasTotalTypeP typ f
+  HasTotalTypeP typ (K1 _ _)
+    = 'False
+  HasTotalTypeP typ U1
+    = 'False
+  HasTotalTypeP typ V1
+    = 'False
+
+data Pos (p :: Nat)
+
+type family HasTotalPositionP (pos :: Nat) f :: Bool where
+  HasTotalPositionP pos (S1 _ (K1 (Pos pos) _))
+    = 'True
+  HasTotalPositionP pos (l :*: r)
+    = HasTotalPositionP pos l || HasTotalPositionP pos r
+  HasTotalPositionP pos (l :+: r)
+    = HasTotalPositionP pos l && HasTotalPositionP pos r
+  HasTotalPositionP pos (S1 _ _)
+    = 'False
+  HasTotalPositionP pos (C1 _ f)
+    = HasTotalPositionP pos f
+  HasTotalPositionP pos (D1 _ f)
+    = HasTotalPositionP pos f
+  HasTotalPositionP pos (K1 _ _)
+    = 'False
+  HasTotalPositionP pos U1
+    = 'False
+  HasTotalPositionP pos V1
+    = 'False
+
 type family HasPartialTypeP a f :: Bool where
   HasPartialTypeP t (l :+: r)
     = HasPartialTypeP t l || HasPartialTypeP t r
@@ -73,10 +116,10 @@
   HasCtorP ctor _
     = 'False
 
-type family GTypes (rep :: * -> *) :: [((), *)] where
+type family GTypes (rep :: Type -> Type) :: [((), Type)] where
   GTypes (l :*: r)
     = GTypes l ++ GTypes r
-  GTypes (Rec0 a)
+  GTypes (K1 _ a)
     = '[ '( '(), a)]
   GTypes (M1 _ m a)
     = GTypes a
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
@@ -40,7 +40,7 @@
 import Data.Generics.Internal.Families
 import Data.Generics.Internal.VL.Lens as VL
 import Data.Generics.Internal.Void
-import Data.Generics.Product.Internal.Keyed
+import Data.Generics.Product.Internal.GLens
 
 import Data.Kind    (Constraint, Type)
 import GHC.Generics
@@ -129,9 +129,9 @@
 instance
   ( Generic s
   , ErrorUnless field s (CollectField field (Rep s))
-  , GHasKey' field (Rep s) a
+  , GLens' (HasTotalFieldPSym field) (Rep s) a
   ) => HasField' field s a where
-  field' f s = VL.ravel (repLens . gkey @field) f s
+  field' f s = VL.ravel (repLens . glens @(HasTotalFieldPSym field)) f s
 
 instance  -- see Note [Changing type parameters]
   ( Generic s
@@ -146,14 +146,13 @@
 #endif
   , Generic s'
   , Generic t'
-  , GHasKey' field (Rep s) a
-  , GHasKey' field (Rep s') a'
-  , GHasKey' field (Rep t') b'
-  , GHasKey  field (Rep s) (Rep t) a b
+  , GLens' (HasTotalFieldPSym field) (Rep s') a'
+  , GLens' (HasTotalFieldPSym field) (Rep t') b'
+  , GLens  (HasTotalFieldPSym field) (Rep s) (Rep t) a b
   , t ~ Infer s a' b
   , s ~ Infer t b' a
   ) => HasField field s t a b where
-  field f s = VL.ravel (repLens . gkey @field) f s
+  field f s = VL.ravel (repLens . glens @(HasTotalFieldPSym field)) f s
 
 -- -- See Note [Uncluttering type signatures]
 instance {-# OVERLAPPING #-} HasField f (Void1 a) (Void1 b) a b where
@@ -180,3 +179,6 @@
 
   ErrorUnless _ _ ('TypeStat '[] '[] _)
     = ()
+
+data HasTotalFieldPSym :: Symbol -> (TyFun (Type -> Type) Bool)
+type instance Eval (HasTotalFieldPSym sym) tt = HasTotalFieldP sym tt
diff --git a/src/Data/Generics/Product/Internal/GLens.hs b/src/Data/Generics/Product/Internal/GLens.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Generics/Product/Internal/GLens.hs
@@ -0,0 +1,79 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeInType #-}
+{-# LANGUAGE AllowAmbiguousTypes    #-}
+{-# LANGUAGE ConstraintKinds        #-}
+{-# LANGUAGE DataKinds              #-}
+{-# LANGUAGE FlexibleInstances      #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE KindSignatures         #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE Rank2Types             #-}
+{-# LANGUAGE ScopedTypeVariables    #-}
+{-# LANGUAGE TypeApplications       #-}
+{-# LANGUAGE TypeFamilies           #-}
+{-# LANGUAGE TypeOperators          #-}
+{-# LANGUAGE UndecidableInstances   #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Generics.Product.Internal.GLens
+-- 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.GLens
+  ( GLens (..)
+  , GLens'
+  , TyFun
+  , Eval
+  ) where
+
+import Data.Generics.Internal.Profunctor.Lens (Lens, choosing, first, second)
+import Data.Generics.Internal.Profunctor.Iso (kIso, sumIso, mIso)
+
+import Data.Kind    (Type)
+import GHC.Generics
+
+type TyFun a b = a -> b -> Type
+type family Eval (f :: TyFun a b) (x :: a) :: b
+
+-- A generic lens that uses some predicate to determine which field to focus on
+class GLens (pred :: TyFun (Type -> Type) Bool) (s :: Type -> Type) (t :: Type -> Type) a b | s pred -> a, t pred -> b where
+  glens :: Lens (s x) (t x) a b
+
+type GLens' pred s a = GLens pred s s a a
+
+instance GProductLens (Eval pred l) pred l r l' r' a b
+      => GLens pred (l :*: r) (l' :*: r') a b where
+
+  glens = gproductField @(Eval pred l) @pred
+  {-# INLINE glens #-}
+
+instance (GLens pred l l' a b, GLens pred r r' a b) =>  GLens pred (l :+: r) (l' :+: r') a b where
+  glens = sumIso . choosing (glens @pred) (glens @pred)
+  {-# INLINE glens #-}
+
+instance GLens pred (K1 r a) (K1 r b) a b where
+  glens = kIso
+  {-# INLINE glens #-}
+
+instance (Functor g, GLens pred f g a b) => GLens pred (M1 m meta f) (M1 m meta g) a b where
+  glens = mIso . glens @pred
+  {-# INLINE glens #-}
+
+class GProductLens (left :: Bool) (pred :: TyFun (Type -> Type) Bool) l r l' r' a b | pred l r -> a, pred l' r' -> b where
+  gproductField :: Lens ((l :*: r) x) ((l' :*: r') x) a b
+
+instance GLens pred l l' a b => GProductLens 'True pred l r l' r a b where
+  gproductField = first . glens @pred
+  {-# INLINE gproductField #-}
+
+instance GLens pred r r' a b => GProductLens 'False pred l r l r' a b where
+  gproductField = second . glens @pred
+  {-# INLINE gproductField #-}
diff --git a/src/Data/Generics/Product/Internal/Keyed.hs b/src/Data/Generics/Product/Internal/Keyed.hs
deleted file mode 100644
--- a/src/Data/Generics/Product/Internal/Keyed.hs
+++ /dev/null
@@ -1,60 +0,0 @@
-{-# LANGUAGE AllowAmbiguousTypes    #-}
-{-# LANGUAGE CPP                    #-}
-{-# LANGUAGE ConstraintKinds        #-}
-{-# LANGUAGE FlexibleInstances      #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE GADTs                  #-}
-{-# LANGUAGE ScopedTypeVariables    #-}
-{-# LANGUAGE TypeApplications       #-}
-{-# LANGUAGE TypeFamilies           #-}
-{-# LANGUAGE TypeInType             #-}
-{-# LANGUAGE TypeOperators          #-}
-{-# LANGUAGE UndecidableInstances   #-}
-
-#if __GLASGOW_HASKELL__ == 802
-{-# OPTIONS_GHC -fno-solve-constant-dicts #-}
-#endif
-
---------------------------------------------------------------------------------
--- |
--- Module      : Data.Generics.Product.Internal.Keyed
--- Copyright   : (C) 2018 Csongor Kiss
--- Maintainer  : Csongor Kiss <kiss.csongor.kiss@gmail.com>
--- License     : BSD3
--- Stability   : experimental
--- Portability : non-portable
---
---------------------------------------------------------------------------------
-
-module Data.Generics.Product.Internal.Keyed
-  ( GHasKey (..)
-  , GHasKey'
-  ) where
-
-import Data.Generics.Product.Internal.List
-import Data.Kind
-import GHC.Generics
-import Data.Generics.Internal.Profunctor.Lens
-import Data.Generics.Internal.Profunctor.Iso
-
-class GHasKey (key :: k) (s :: Type -> Type) (t :: Type -> Type) a b | s key -> a, t key -> b where
-  gkey :: Lens (s x) (t x) a b
-
-type GHasKey' key s a = GHasKey key s s a a
-
-instance (GHasKey key l l' a b, GHasKey key r r' a b) =>  GHasKey key (l :+: r) (l' :+: r') a b where
-  gkey = sumIso . choosing (gkey @key) (gkey @key)
-  {-# INLINE gkey #-}
-
-instance (GHasKey key f g a b) => GHasKey key (M1 D meta f) (M1 D meta g) a b where
-  gkey = ravel (mLens . gkey @key)
-  {-# INLINE gkey #-}
-
-instance
-  ( Elem as key i a
-  , Elem bs key i b
-  , IndexList i as bs a b
-  , GIsList k f g as bs
-  ) => GHasKey (key :: k) (M1 C meta f) (M1 C meta g) a b where
-  gkey = mLens . glist @k . point @i
-  {-# INLINE gkey #-}
diff --git a/src/Data/Generics/Product/Internal/List.hs b/src/Data/Generics/Product/Internal/List.hs
--- a/src/Data/Generics/Product/Internal/List.hs
+++ b/src/Data/Generics/Product/Internal/List.hs
@@ -40,8 +40,10 @@
   , TupleToList
   ) where
 
-import GHC.TypeLits
+#if __GLASGOW_HASKELL__ < 804
 import Data.Semigroup
+#endif
+import GHC.TypeLits
 
 import Data.Kind    (Type)
 import GHC.Generics
diff --git a/src/Data/Generics/Product/Internal/Positions.hs b/src/Data/Generics/Product/Internal/Positions.hs
--- a/src/Data/Generics/Product/Internal/Positions.hs
+++ b/src/Data/Generics/Product/Internal/Positions.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE TypeInType #-}
 {-# LANGUAGE AllowAmbiguousTypes    #-}
 {-# LANGUAGE ConstraintKinds        #-}
 {-# LANGUAGE DataKinds              #-}
@@ -27,42 +28,62 @@
 -----------------------------------------------------------------------------
 
 module Data.Generics.Product.Internal.Positions
-  ( GHasPosition (..)
-  , GHasPosition'
-  , type (<?)
+  ( type (<?)
   , Size
+  , CRep
   ) where
 
-import Data.Generics.Product.Internal.List
+import Data.Generics.Internal.Families.Has (Pos)
 import Data.Kind      (Type)
 import Data.Type.Bool (If, Not)
 import GHC.Generics
-import GHC.TypeLits   (type (<=?), type (+), type (-), Nat)
-import Data.Generics.Internal.Profunctor.Lens
-import Data.Generics.Internal.Profunctor.Iso
+import GHC.TypeLits   (type (<=?), type (+), Nat)
 
--- |As 'HasPosition' but over generic representations as defined by
---  "GHC.Generics".
-class GHasPosition (i :: Nat) (s :: Type -> Type) (t :: Type -> Type) a b | s i -> a, t i -> b, s t i -> b where
-  gposition :: Lens (s x) (t x) a b
+-- | Alias for the kind of the generic rep
+type G k = k -> Type
 
-type GHasPosition' i s a = GHasPosition i s s a a
+--------------------------------------------------------------------------------
 
-instance (GHasPosition i l l' a b, GHasPosition i r r' a b) =>  GHasPosition i (l :+: r) (l' :+: r') a b where
-  gposition = \x -> sumIso (choosing (gposition @i) (gposition @i) x)
-  {-# INLINE gposition #-}
+-- | In-order labeling of the generic tree with the field positions
+--
+-- We replace the (K1 R a) nodes with (K1 (Pos n) a), where 'n' is the position
+-- of the field in question in the data type. This is convenient, because we
+-- can reuse all the existing functions as long as they are polymorphic in the
+-- first parameter of 'K1'.
+type family CRep (a :: Type) :: G k where
+  CRep rep = Fst (Traverse (Rep rep) 1)
 
-instance GHasPosition i s t a b => GHasPosition i (M1 D meta s) (M1 D meta t) a b where
-  gposition x = mLens (gposition @i x)
-  {-# INLINE gposition #-}
+-- | The actual traversal.
+--
+-- Might be cleaner if the sum and product parts were separated (as there's
+-- and invariant that 'n' should be zero when we're at a sum node, which holds
+-- for derived Generic instances (where the sums are strictly above the products))
+type family Traverse (a :: G k) (n :: Nat) :: (G k, Nat) where
+  Traverse (M1 mt m s) n
+    = Traverse1 (M1 mt m) (Traverse s n)
+  Traverse (l :+: r) n
+    = '(Fst (Traverse l n) :+: Fst (Traverse r n), n)
+  Traverse (l :*: r) n
+    = TraverseProd (:*:) (Traverse l n) r
+  Traverse (K1 _ p) n
+    = '(K1 (Pos n) p, n + 1)
+  Traverse U1 n
+    = '(U1, n)
 
-instance
-  ( IndexList (i - 1) as bs a b
-  , GIsList () f g as bs
-  ) => GHasPosition i (M1 C meta f) (M1 C meta g) a b where
-  gposition x = mIso (glist @() (point @(i - 1) x))
-  {-# INLINE gposition #-}
+type family Traverse1 (w :: G k -> G k) (z :: (G k, Nat)) :: (G k, Nat) where
+  Traverse1 w '(i, n) = '(w i, n)
 
+-- | For products, we first traverse the left-hand side, followed by the second
+-- using the counter returned by the left traversal.
+type family TraverseProd (c :: G k -> G k -> G k) (a :: (G k, Nat)) (r :: G k) :: (G k, Nat) where
+  TraverseProd w '(i, n) r = Traverse1 (w i) (Traverse r n)
+
+--------------------------------------------------------------------------------
+-- Utilities
+
+type family Fst (p :: (a, b)) :: a where
+  Fst '(a, b) = a
+
 type family Size f :: Nat where
   Size (l :*: r)
     = Size l + Size r
@@ -74,8 +95,6 @@
     = Size f
   Size f
     = 1
-
---------------------------------------------------------------------------------
 
 type x <? y = Not (y <=? x)
 infixl 4 <?
diff --git a/src/Data/Generics/Product/Internal/Subtype.hs b/src/Data/Generics/Product/Internal/Subtype.hs
--- a/src/Data/Generics/Product/Internal/Subtype.hs
+++ b/src/Data/Generics/Product/Internal/Subtype.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE TypeInType #-}
 {-# LANGUAGE AllowAmbiguousTypes       #-}
 {-# LANGUAGE DataKinds                 #-}
 {-# LANGUAGE FlexibleContexts          #-}
@@ -31,11 +32,12 @@
   ) where
 
 import Data.Generics.Internal.Families
-import Data.Generics.Product.Internal.Keyed
+import Data.Generics.Product.Internal.GLens
 
 import Data.Kind (Type)
 import GHC.Generics
-import Data.Generics.Internal.Profunctor.Lens
+import GHC.TypeLits (Symbol)
+import Data.Generics.Internal.Profunctor.Lens (view)
 
 --------------------------------------------------------------------------------
 -- * Generic upcasting
@@ -47,10 +49,10 @@
   gupcast rep = gupcast rep :*: gupcast rep
 
 instance
-  GHasKey field sub sub t t
+  GLens' (HasTotalFieldPSym field) sub t
   => GUpcast sub (S1 ('MetaSel ('Just field) p f b) (Rec0 t)) where
 
-  gupcast r = M1 (K1 (view (gkey @field) r))
+  gupcast r = M1 (K1 (view (glens @(HasTotalFieldPSym field)) r))
 
 instance GUpcast sub sup => GUpcast sub (C1 c sup) where
   gupcast = M1 . gupcast
@@ -84,9 +86,12 @@
   gsmashLeaf :: sup p -> sub p -> sub p
 
 instance
-  GHasKey field sup sup t t
+  GLens' (HasTotalFieldPSym field) sup t
   => GSmashLeaf (S1 ('MetaSel ('Just field) p f b) (Rec0 t)) sup 'True where
-  gsmashLeaf sup _ = M1 (K1 (view (gkey @field) sup))
+  gsmashLeaf sup _ = M1 (K1 (view (glens @(HasTotalFieldPSym field)) sup))
 
 instance GSmashLeaf (S1 ('MetaSel ('Just field) p f b) (Rec0 t)) sup 'False where
   gsmashLeaf _ = id
+
+data HasTotalFieldPSym :: Symbol -> (TyFun (Type -> Type) Bool)
+type instance Eval (HasTotalFieldPSym sym) tt = HasTotalFieldP sym tt
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
@@ -1,3 +1,5 @@
+{-# LANGUAGE TypeInType #-}
+{-# LANGUAGE PartialTypeSignatures #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE AllowAmbiguousTypes    #-}
 {-# LANGUAGE ConstraintKinds        #-}
@@ -42,12 +44,14 @@
 import Data.Generics.Internal.Void
 import Data.Generics.Internal.Families
 import Data.Generics.Product.Internal.Positions
+import Data.Generics.Product.Internal.GLens
 
 import Data.Kind      (Constraint, Type)
 import Data.Type.Bool (type (&&))
 import GHC.Generics
 import GHC.TypeLits   (type (<=?),  Nat, TypeError, ErrorMessage(..))
-import Data.Generics.Internal.Profunctor.Lens
+import Data.Generics.Internal.Profunctor.Lens as P
+import Data.Coerce
 
 -- $setup
 -- == /Running example:/
@@ -101,9 +105,11 @@
 instance
   ( Generic s
   , ErrorUnless i s (0 <? i && i <=? Size (Rep s))
-  , GHasPosition' i (Rep s) a
+  , cs ~ CRep s
+  , Coercible (Rep s) cs
+  , GLens' (HasTotalPositionPSym i) cs a
   ) => HasPosition' i s a where
-  position' f s = VL.ravel (repLens . gposition @i) f s
+  position' f s = VL.ravel (repLens . coerced @cs @cs . glens @(HasTotalPositionPSym i)) f s
   {-# INLINE position' #-}
 
 instance  -- see Note [Changing type parameters]
@@ -119,17 +125,28 @@
 #endif
   , Generic s'
   , Generic t'
-  , GHasPosition' i (Rep s) a
-  , GHasPosition' i (Rep s') a'
-  , GHasPosition i (Rep s) (Rep t) a b
+  , GLens (HasTotalPositionPSym i) cs ct a b
+  , cs ~ CRep s
+  , ct ~ CRep t
+  , GLens' (HasTotalPositionPSym i) (CRep s') a'
+  , GLens' (HasTotalPositionPSym i) (CRep t') b'
   , t ~ Infer s a' b
-  , GHasPosition' i (Rep t') b'
   , s ~ Infer t b' a
+  , Coercible cs (Rep s)
+  , Coercible ct (Rep t)
   ) => HasPosition i s t a b where
 
-  position = VL.ravel (repLens . gposition @i)
+  position = VL.ravel (repLens . coerced @cs @ct . glens @(HasTotalPositionPSym i))
   {-# INLINE position #-}
 
+-- We wouldn't need the universal 'x' here if we could express above that
+-- forall x. Coercible (cs x) (Rep s x), but this requires quantified
+-- constraints
+coerced :: forall s t s' t' x a b. (Coercible t t', Coercible s s')
+        => P.ALens a b (s x) (t x) -> P.ALens a b (s' x) (t' x)
+coerced = coerce
+{-# INLINE coerced #-}
+
 -- See Note [Uncluttering type signatures]
 instance {-# OVERLAPPING #-} HasPosition f (Void1 a) (Void1 b) a b where
   position = undefined
@@ -145,3 +162,6 @@
 
   ErrorUnless _ _ 'True
     = ()
+
+data HasTotalPositionPSym  :: Nat -> (TyFun (Type -> Type) Bool)
+type instance Eval (HasTotalPositionPSym t) tt = HasTotalPositionP t tt
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
@@ -7,6 +7,7 @@
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE TypeApplications      #-}
 {-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE TypeInType            #-}
 {-# LANGUAGE TypeOperators         #-}
 {-# LANGUAGE UndecidableInstances  #-}
 
@@ -33,7 +34,7 @@
 import Data.Generics.Internal.Families
 import Data.Generics.Internal.VL.Lens as VL
 import Data.Generics.Internal.Void
-import Data.Generics.Product.Internal.Keyed
+import Data.Generics.Product.Internal.GLens
 
 import Data.Kind    (Constraint, Type)
 import GHC.Generics (Generic (Rep))
@@ -110,10 +111,10 @@
 instance
   ( Generic s
   , ErrorUnlessOne a s (CollectTotalType a (Rep s))
-  , GHasKey a (Rep s) (Rep s) a a
+  , GLens (HasTotalTypePSym a) (Rep s) (Rep s) a a
   ) => HasType a s where
 
-  typed f s = VL.ravel (repLens . gkey @a) f s
+  typed f s = VL.ravel (repLens . glens @(HasTotalTypePSym a)) f s
 
 -- See Note [Uncluttering type signatures]
 instance {-# OVERLAPPING #-} HasType a Void where
@@ -150,3 +151,7 @@
 
   ErrorUnlessOne _ _ ('TypeStat '[] '[] _)
     = ()
+
+data HasTotalTypePSym :: Type -> (TyFun (Type -> Type) Bool)
+type instance Eval (HasTotalTypePSym t) tt = HasTotalTypeP t tt
+