diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,14 @@
 # Revision history for deep-transformations
 
+## 0.3 -- 2025-01-01
+
+* **BREAKING**: Changed the definitions of `Deep.Product` and `Deep.Sum`
+* Added `Shallow` class instances for all data types declared in the `Rank2` module
+* Added `Shallow` class instances for `Proxy`, `Const`, `Product`, and `Sum`
+* Bumped the upper bound of the template-haskell dependency to compile with GHC 9.12.1
+* Fixed the PolyKinds-related test errors
+* Added `Deep.Only` and `Deep.Flip` data types to mirror `Rank2.Only` and `Rank2.Flip`
+
 ## 0.2.3 -- 2024-05-18
 
 * Bumped the upper bound of the template-haskell dependency
diff --git a/deep-transformations.cabal b/deep-transformations.cabal
--- a/deep-transformations.cabal
+++ b/deep-transformations.cabal
@@ -2,7 +2,7 @@
 -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                deep-transformations
-version:             0.2.3
+version:             0.3
 synopsis:            Deep natural and unnatural tree transformations, including attribute grammars
 description:
 
@@ -22,7 +22,7 @@
 category:            Control, Generics
 build-type:          Custom
 cabal-version:       >=1.10
-tested-with:         GHC==9.2.2, GHC==9.0.1, GHC==8.10.4, GHC==8.8.4, GHC==8.6.5, GHC==8.4.4
+tested-with:         GHC==9.8.2, GHC==9.6.4, GHC==9.4.8, GHC==9.2.8, GHC==9.0.2, GHC==8.10.7
 extra-source-files:  README.md, CHANGELOG.md
 source-repository head
   type:              git
@@ -32,7 +32,7 @@
    base >= 4 && <5,
    Cabal < 4,
    cabal-doctest >= 1 && <1.1
- 
+
 library
   hs-source-dirs:       src
   exposed-modules:      Transformation,
@@ -45,7 +45,7 @@
   ghc-options:         -Wall
   build-depends:        base >= 4.11 && < 5, rank2classes >= 1.4.1 && < 1.6,
                         transformers >= 0.5 && < 0.7,
-                        template-haskell >= 2.11 && < 2.23, generic-lens >= 1.2 && < 2.3
+                        template-haskell >= 2.11 && < 2.24, generic-lens >= 1.2 && < 2.3
   default-language:     Haskell2010
 
 test-suite doctests
@@ -57,3 +57,4 @@
   ghc-options:         -threaded -pgmL markdown-unlit
   build-depends:       base, rank2classes, deep-transformations, doctest >= 0.8
   build-tool-depends:  markdown-unlit:markdown-unlit >= 0.5 && < 0.6
+  x-doctest-options:   --fast
diff --git a/src/Transformation.hs b/src/Transformation.hs
--- a/src/Transformation.hs
+++ b/src/Transformation.hs
@@ -20,27 +20,59 @@
 -- * while the actual mapping of values is performed by an arbitrary number of instances of the method '$', a bit like
 --   multiple equation clauses that make up a single function definition.
 --
--- The module is meant to be imported qualified.
+-- The module is meant to be imported qualified, and the importing module will require at least the
+-- @FlexibleInstances@, @MultiParamTypeClasses@, and @TypeFamilies@ language extensions to declare the appropriate
+-- instances.
 
 module Transformation where
 
-import Data.Coerce (coerce)
 import qualified Data.Functor.Compose as Functor
 import Data.Functor.Const (Const)
 import Data.Functor.Product (Product(Pair))
 import Data.Functor.Sum (Sum(InL, InR))
 import Data.Kind (Type)
-import GHC.TypeLits (ErrorMessage (Text, ShowType, (:<>:)), TypeError)
 import qualified Rank2
 
 import Prelude hiding (($))
 
+-- $setup
+-- >>> {-# Language FlexibleInstances, MultiParamTypeClasses, TypeFamilies, TypeOperators #-}
+-- >>> import Transformation (Transformation)
+-- >>> import qualified Transformation
+
 -- | A 'Transformation', natural or not, maps one functor to another.
+-- For example, here's the declaration for a transformation that maps `Maybe` to `[]`:
+--
+-- >>> :{
+-- data MaybeToList = MaybeToList
+-- instance Transformation MaybeToList where
+--    type Domain MaybeToList = Maybe
+--    type Codomain MaybeToList = []
+-- :}
 class Transformation t where
    type Domain t :: Type -> Type
    type Codomain t :: Type -> Type
 
--- | An unnatural 'Transformation' can behave differently at different points.
+-- | Before we can apply a 'Transformation', we also need to declare 'At' which base types it is applicable and how
+-- it works. If the transformation is natural, we'll need only one instance declaration.
+--
+-- >>> :{
+-- instance MaybeToList `Transformation.At` a where
+--    MaybeToList $ Just x = [x]
+--    MaybeToList $ Nothing = []
+-- :}
+--
+-- >>> MaybeToList Transformation.$ (Just True)
+-- [True]
+--
+-- An unnatural 'Transformation' can behave differently depending on the base type and even on its value.
+--
+-- >>> :{
+-- instance {-# OVERLAPS #-} MaybeToList `At` Char where
+--    MaybeToList $ Just '\0' = []
+--    MaybeToList $ Just c = [c]
+--    MaybeToList $ Nothing = []
+-- :}
 class Transformation t => At t x where
    -- | Apply the transformation @t@ at type @x@ to map 'Domain' to the 'Codomain' functor.
    ($) :: t -> Domain t x -> Codomain t x
diff --git a/src/Transformation/AG/Dimorphic.hs b/src/Transformation/AG/Dimorphic.hs
--- a/src/Transformation/AG/Dimorphic.hs
+++ b/src/Transformation/AG/Dimorphic.hs
@@ -1,4 +1,4 @@
-{-# Language DeriveDataTypeable, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, RankNTypes,
+{-# Language Haskell2010, DeriveDataTypeable, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, RankNTypes,
              ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
 
 -- | A special case of an attribute grammar where every node has only a single inherited and a single synthesized
@@ -140,9 +140,9 @@
 traverseDefaultWithAttributes t x rootInheritance = Full.traverse Feeder (t Full.<$> x) rootInheritance
 {-# INLINE traverseDefaultWithAttributes #-}
 
-data Feeder a b (f :: Type -> Type) = Feeder
+data Feeder (a :: Type) (b :: Type) (f :: Type -> Type) = Feeder
 
-type FeederDomain a b f = Compose ((->) a) (Compose ((,) (Atts a b)) f)
+type FeederDomain (a :: Type) (b :: Type) f = Compose ((->) a) (Compose ((,) (Atts a b)) f)
 
 instance Transformation (Feeder a b f) where
    type Domain (Feeder a b f) = FeederDomain a b f
diff --git a/src/Transformation/Deep.hs b/src/Transformation/Deep.hs
--- a/src/Transformation/Deep.hs
+++ b/src/Transformation/Deep.hs
@@ -1,4 +1,4 @@
-{-# Language DeriveDataTypeable, FlexibleInstances, KindSignatures, MultiParamTypeClasses, RankNTypes,
+{-# Language Haskell2010, DeriveDataTypeable, FlexibleInstances, KindSignatures, MultiParamTypeClasses, RankNTypes,
              StandaloneDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-}
 
 -- | Type classes 'Functor', 'Foldable', and 'Traversable' that correspond to the standard type classes of the same
@@ -8,12 +8,13 @@
 
 module Transformation.Deep where
 
-import Control.Applicative (Applicative, liftA2)
 import Data.Data (Data, Typeable)
 import Data.Functor.Compose (Compose)
 import Data.Functor.Const (Const)
+import qualified Control.Applicative as Rank1
+import qualified Data.Foldable as Rank1
 import qualified Data.Functor as Rank1
-import qualified Data.Functor
+import qualified Data.Traversable as Rank1
 import Data.Kind (Type)
 import qualified Rank2
 import           Transformation (Transformation, Domain, Codomain)
@@ -34,83 +35,167 @@
 class (Transformation t, Rank2.Traversable (g (Domain t))) => Traversable t g where
    traverse :: Codomain t ~ Compose m f => t -> g (Domain t) (Domain t) -> m (g f f)
 
+-- | A tuple of only one element
+newtype Only g (d :: Type -> Type) (s :: Type -> Type) =
+   Only {fromOnly :: s (g d d)}
+
+-- | Compose a regular type constructor with a data type with two type constructor parameters
+newtype Nest (f :: Type -> Type) g (d :: Type -> Type) (s :: Type -> Type) =
+   Nest {unNest :: f (g d s)}
+
 -- | Like 'Data.Functor.Product.Product' for data types with two type constructor parameters
 data Product g h (d :: Type -> Type) (s :: Type -> Type) =
-   Pair{fst :: s (g d d),
-        snd :: s (h d d)}
+   Pair{fst :: g d s,
+        snd :: h d s}
 
 -- | Like 'Data.Functor.Sum.Sum' for data types with two type constructor parameters
 data Sum g h (d :: Type -> Type) (s :: Type -> Type) =
-   InL (s (g d d))
-   | InR (s (h d d))
+   InL (g d s)
+   | InR (h d s)
 
-instance Rank2.Functor (Product g h p) where
-   f <$> ~(Pair left right) = Pair (f left) (f right)
+-- Instances
 
-instance Rank2.Apply (Product g h p) where
-   ~(Pair g1 h1) <*> ~(Pair g2 h2) = Pair (Rank2.apply g1 g2) (Rank2.apply h1 h2)
-   liftA2 f ~(Pair g1 h1) ~(Pair g2 h2) = Pair (f g1 g2) (f h1 h2)
+instance Rank2.Functor (Only g d) where
+   f <$> Only x = Only (f x)
 
-instance Rank2.Applicative (Product g h p) where
-   pure f = Pair f f
+instance Rank2.Foldable (Only g d) where
+   foldMap f (Only x) = f x
 
-instance Rank2.Foldable (Product g h p) where
-   foldMap f ~(Pair g h) = f g `mappend` f h
+instance Rank2.Traversable (Only g d) where
+   traverse f (Only x) = Only Rank1.<$> f x
 
-instance Rank2.Traversable (Product g h p) where
-   traverse f ~(Pair g h) = liftA2 Pair (f g) (f h)
+instance Rank2.Apply (Only g d) where
+   Only f <*> Only x = Only (Rank2.apply f x)
+   liftA2 f (Only x) (Only y) = Only (f x y)
 
-instance Rank2.DistributiveTraversable (Product g h p)
+instance Rank2.Applicative (Only g d) where
+   pure f = Only f
 
-instance Rank2.Distributive (Product g h p) where
-   cotraverse w f = Pair{fst= w (fst Data.Functor.<$> f),
-                         snd= w (snd Data.Functor.<$> f)}
+instance Rank2.DistributiveTraversable (Only g d)
 
-instance (Full.Functor t g, Full.Functor t h) => Functor t (Product g h) where
-   t <$> Pair left right = Pair (t Full.<$> left) (t Full.<$> right)
+instance Rank2.Distributive (Only g d) where
+   cotraverse w f = Only (w (Rank1.fmap fromOnly f))
 
-instance (Full.Traversable t g, Full.Traversable t h, Codomain t ~ Compose m f, Applicative m) =>
+instance Full.Functor t g => Functor t (Only g) where
+   t <$> Only x = Only (t Full.<$> x)
+
+instance Full.Foldable t g => Foldable t (Only g) where
+   foldMap t (Only x) = Full.foldMap t x
+
+instance (Full.Traversable t g, Codomain t ~ Compose m f, Rank1.Functor m) => Traversable t (Only g) where
+   traverse t (Only x) = Only Rank1.<$> Full.traverse t x
+
+deriving instance (Typeable s, Typeable d, Typeable g, Data (s (g d d))) => Data (Only g d s)
+deriving instance Eq (s (g d d)) => Eq (Only g d s)
+deriving instance Ord (s (g d d)) => Ord (Only g d s)
+deriving instance Show (s (g d d)) => Show (Only g d s)
+
+instance (Rank1.Functor f, Rank2.Functor (g d)) => Rank2.Functor (Nest f g d) where
+   f <$> Nest x = Nest ((f Rank2.<$>) Rank1.<$> x)
+
+instance (Rank1.Applicative f, Rank2.Apply (g d)) => Rank2.Apply (Nest f g d) where
+   Nest x <*> Nest y = Nest (Rank1.liftA2 (Rank2.<*>) x y)
+
+instance (Rank1.Applicative f, Rank2.Applicative (g d)) => Rank2.Applicative (Nest f g d) where
+   pure f = Nest (Rank1.pure (Rank2.pure f))
+
+instance (Rank1.Foldable f, Rank2.Foldable (g d)) => Rank2.Foldable (Nest f g d) where
+   foldMap f (Nest x) = Rank1.foldMap (Rank2.foldMap f) x
+
+instance (Rank1.Traversable f, Rank2.Traversable (g d)) => Rank2.Traversable (Nest f g d) where
+   traverse f (Nest x) = Nest Rank1.<$> Rank1.traverse (Rank2.traverse f) x
+
+instance (Rank1.Functor f, Functor t g) => Functor t (Nest f g) where
+   t <$> Nest x = Nest ((t <$>) Rank1.<$> x)
+
+instance (Rank1.Foldable f, Foldable t g) => Foldable t (Nest f g) where
+   foldMap t (Nest x) = Rank1.foldMap (foldMap t) x
+
+instance (Rank1.Traversable f, Traversable t g, Codomain t ~ Compose m f, Rank1.Applicative m) =>
+         Traversable t (Nest f g) where
+   traverse t (Nest x) = Nest Rank1.<$> Rank1.traverse (traverse t) x
+
+deriving instance (Typeable s, Typeable d, Typeable f, Typeable g,
+                   Data (f (g d s))) => Data (Nest f g d s)
+deriving instance Eq (f (g d s)) => Eq (Nest f g d s)
+deriving instance Ord (f (g d s)) => Ord (Nest f g d s)
+deriving instance Show (f (g d s)) => Show (Nest f g d s)
+
+instance (Rank2.Functor (g d), Rank2.Functor (h d)) => Rank2.Functor (Product g h d) where
+   f <$> (Pair left right) = Pair (f Rank2.<$> left) (f Rank2.<$> right)
+
+instance (Rank2.Apply (g d), Rank2.Apply (h d)) => Rank2.Apply (Product g h d) where
+   Pair g1 h1 <*> ~(Pair g2 h2) = Pair (g1 Rank2.<*> g2) (h1 Rank2.<*> h2)
+   liftA2 f (Pair g1 h1) ~(Pair g2 h2) = Pair (Rank2.liftA2 f g1 g2) (Rank2.liftA2 f h1 h2)
+   liftA3 f (Pair g1 h1) ~(Pair g2 h2) ~(Pair g3 h3) = Pair (Rank2.liftA3 f g1 g2 g3) (Rank2.liftA3 f h1 h2 h3)
+
+instance (Rank2.Applicative (g d), Rank2.Applicative (h d)) => Rank2.Applicative (Product g h d) where
+   pure f = Pair (Rank2.pure f) (Rank2.pure f)
+
+instance (Rank2.Foldable (g d), Rank2.Foldable (h d)) => Rank2.Foldable (Product g h d) where
+   foldMap f (Pair g h) = Rank2.foldMap f g `mappend` Rank2.foldMap f h
+
+instance (Rank2.Traversable (g d), Rank2.Traversable (h d)) => Rank2.Traversable (Product g h d) where
+   traverse f (Pair g h) = Rank1.liftA2 Pair (Rank2.traverse f g) (Rank2.traverse f h)
+
+instance (Rank2.Distributive (g d), Rank2.Distributive (h d)) => Rank2.DistributiveTraversable (Product g h d)
+
+instance (Rank2.Distributive (g d), Rank2.Distributive (h d)) => Rank2.Distributive (Product g h d) where
+   cotraverse w f = Pair{fst= Rank2.cotraverse w (fst Rank1.<$> f),
+                         snd= Rank2.cotraverse w (snd Rank1.<$> f)}
+
+instance (Functor t g, Functor t h) => Functor t (Product g h) where
+   t <$> Pair left right = Pair (t <$> left) (t <$> right)
+
+instance (Foldable t g, Foldable t h) => Foldable t (Product g h) where
+   foldMap t (Pair g h) = foldMap t g `mappend` foldMap t h
+
+instance (Traversable t g, Traversable t h, Codomain t ~ Compose m f, Rank1.Applicative m) =>
          Traversable t (Product g h) where
-   traverse t (Pair left right) = liftA2 Pair (Full.traverse t left) (Full.traverse t right)
+   traverse t (Pair left right) = Rank1.liftA2 Pair (traverse t left) (traverse t right)
 
-deriving instance (Typeable p, Typeable q, Typeable g1, Typeable g2,
-                   Data (q (g1 p p)), Data (q (g2 p p))) => Data (Product g1 g2 p q)
-deriving instance (Show (q (g1 p p)), Show (q (g2 p p))) => Show (Product g1 g2 p q)
+deriving instance (Typeable d, Typeable s, Typeable g1, Typeable g2,
+                   Data (g1 d s), Data (g2 d s)) => Data (Product g1 g2 d s)
+deriving instance (Show (g1 d s), Show (g2 d s)) => Show (Product g1 g2 d s)
+deriving instance (Eq (g d s), Eq (h d s)) => Eq (Product g h d s)
+deriving instance (Ord (g d s), Ord (h d s)) => Ord (Product g h d s)
 
-instance Rank2.Functor (Sum g h p) where
-   f <$> InL left = InL (f left)
-   f <$> InR right = InR (f right)
+instance (Rank2.Functor (g d), Rank2.Functor (h d)) => Rank2.Functor (Sum g h d) where
+   f <$> InL left = InL (f Rank2.<$> left)
+   f <$> InR right = InR (f Rank2.<$> right)
 
-instance Rank2.Foldable (Sum g h p) where
-   foldMap f (InL left) = f left
-   foldMap f (InR right) = f right
+instance (Rank2.Foldable (g d), Rank2.Foldable (h d)) => Rank2.Foldable (Sum g h d) where
+   foldMap f (InL left) = Rank2.foldMap f left
+   foldMap f (InR right) = Rank2.foldMap f right
 
-instance Rank2.Traversable (Sum g h p) where
-   traverse f (InL left) = InL Rank1.<$> f left
-   traverse f (InR right) = InR Rank1.<$> f right
+instance (Rank2.Traversable (g d), Rank2.Traversable (h d)) => Rank2.Traversable (Sum g h d) where
+   traverse f (InL left) = InL Rank1.<$> Rank2.traverse f left
+   traverse f (InR right) = InR Rank1.<$> Rank2.traverse f right
 
-instance (Full.Functor t g, Full.Functor t h) => Functor t (Sum g h) where
-   t <$> InL left = InL (t Full.<$> left)
-   t <$> InR right = InR (t Full.<$> right)
+instance (Functor t g, Functor t h) => Functor t (Sum g h) where
+   t <$> InL left = InL (t <$> left)
+   t <$> InR right = InR (t <$> right)
 
-instance (Full.Foldable t g, Full.Foldable t h, Codomain t ~ Const m) => Foldable t (Sum g h) where
-   foldMap t (InL left) = Full.foldMap t left
-   foldMap t (InR right) = Full.foldMap t right
+instance (Foldable t g, Foldable t h, Codomain t ~ Const m) => Foldable t (Sum g h) where
+   foldMap t (InL left) = foldMap t left
+   foldMap t (InR right) = foldMap t right
 
-instance (Full.Traversable t g, Full.Traversable t h, Codomain t ~ Compose m f, Applicative m) =>
+instance (Traversable t g, Traversable t h, Codomain t ~ Compose m f, Rank1.Applicative m) =>
          Traversable t (Sum g h) where
-   traverse t (InL left) = InL Rank1.<$> Full.traverse t left
-   traverse t (InR right) = InR Rank1.<$> Full.traverse t right
+   traverse t (InL left) = InL Rank1.<$> traverse t left
+   traverse t (InR right) = InR Rank1.<$> traverse t right
 
-deriving instance (Typeable p, Typeable q, Typeable g1, Typeable g2,
-                   Data (q (g1 p p)), Data (q (g2 p p))) => Data (Sum g1 g2 p q)
-deriving instance (Show (q (g1 p p)), Show (q (g2 p p))) => Show (Sum g1 g2 p q)
+deriving instance (Typeable d, Typeable s, Typeable g1, Typeable g2,
+                   Data (g1 d s), Data (g2 d s)) => Data (Sum g1 g2 d s)
+deriving instance (Show (g1 d s), Show (g2 d s)) => Show (Sum g1 g2 d s)
+deriving instance (Eq (g d s), Eq (h d s)) => Eq (Sum g h d s)
+deriving instance (Ord (g d s), Ord (h d s)) => Ord (Sum g h d s)
 
 -- | Alphabetical synonym for '<$>'
 fmap :: Functor t g => t -> g (Domain t) (Domain t) -> g (Codomain t) (Codomain t)
 fmap = (<$>)
 
 -- | Equivalent of 'Data.Either.either'
-eitherFromSum :: Sum g h d s -> Either (s (g d d)) (s (h d d))
+eitherFromSum :: Sum g h d s -> Either (g d s) (h d s)
 eitherFromSum (InL left) = Left left
 eitherFromSum (InR right) = Right right
diff --git a/src/Transformation/Deep/TH.hs b/src/Transformation/Deep/TH.hs
--- a/src/Transformation/Deep/TH.hs
+++ b/src/Transformation/Deep/TH.hs
@@ -9,7 +9,7 @@
 {-# Language CPP, TemplateHaskell #-}
 -- Adapted from https://wiki.haskell.org/A_practical_Template_Haskell_Tutorial
 
-module Transformation.Deep.TH (deriveAll, deriveFunctor, deriveTraversable)
+module Transformation.Deep.TH (deriveAll, deriveFunctor, deriveFoldable, deriveTraversable)
 where
 
 import Control.Applicative (liftA2)
diff --git a/src/Transformation/Rank2.hs b/src/Transformation/Rank2.hs
--- a/src/Transformation/Rank2.hs
+++ b/src/Transformation/Rank2.hs
@@ -7,6 +7,7 @@
 
 import Data.Functor.Compose (Compose(Compose))
 import Data.Functor.Const (Const(Const))
+import Data.Kind (Type)
 import qualified Rank2
 import           Transformation (Transformation, Domain, Codomain)
 import qualified Transformation
@@ -26,11 +27,11 @@
 traverse :: Deep.Traversable (Traversal p q m) g => (forall a. p a -> m (q a)) -> g p p -> m (g q q)
 traverse f = Deep.traverse (Traversal f)
 
-newtype Map p q = Map (forall x. p x -> q x)
+newtype Map (p :: Type -> Type) (q :: Type -> Type) = Map (forall x. p x -> q x)
 
-newtype Fold p m = Fold (forall x. p x -> m)
+newtype Fold (p :: Type -> Type) m = Fold (forall x. p x -> m)
 
-newtype Traversal p q m = Traversal (forall x. p x -> m (q x))
+newtype Traversal (p :: Type -> Type) (q :: Type -> Type) m = Traversal (forall x. p x -> m (q x))
 
 instance Transformation (Map p q) where
    type Domain (Map p q) = p
diff --git a/src/Transformation/Shallow.hs b/src/Transformation/Shallow.hs
--- a/src/Transformation/Shallow.hs
+++ b/src/Transformation/Shallow.hs
@@ -1,17 +1,25 @@
-{-# Language DeriveDataTypeable, FlexibleInstances, KindSignatures, MultiParamTypeClasses, RankNTypes,
+{-# Language DeriveDataTypeable, FlexibleContexts, FlexibleInstances, KindSignatures, MultiParamTypeClasses, RankNTypes,
              StandaloneDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-}
 
 -- | Type classes 'Functor', 'Foldable', and 'Traversable' that correspond to the standard type classes of the same
 -- name. The [rank2classes](https://hackage.haskell.org/package/rank2classes) package provides the equivalent set
 -- of classes for natural transformations. This module extends the functionality to unnatural transformations.
 
-module Transformation.Shallow where
+module Transformation.Shallow (Functor(..), Foldable(..), Traversable(..), fmap) where
 
-import Control.Applicative (Applicative, liftA2)
-import Data.Functor.Compose (Compose)
-import Data.Functor.Const (Const)
+import Control.Applicative (Applicative, liftA2, pure)
+import qualified Data.Functor as Rank1 (Functor, (<$>))
+import qualified Data.Foldable as Rank1 (Foldable, foldMap)
+import qualified Data.Traversable as Rank1 (Traversable, traverse)
+import Data.Functor.Compose (Compose(Compose, getCompose))
+import Data.Functor.Const (Const(Const, getConst))
+import Data.Functor.Product (Product(Pair))
+import Data.Functor.Sum (Sum(InL, InR))
+import Data.Kind (Type)
+import Data.Proxy (Proxy(Proxy))
 import qualified Rank2
-import           Transformation (Transformation, Domain, Codomain)
+import           Transformation (Transformation, Domain, Codomain, At)
+import qualified Transformation
 
 import Prelude hiding (Foldable(..), Traversable(..), Functor(..), Applicative(..), (<$>), fst, snd)
 
@@ -28,14 +36,117 @@
 class (Transformation t, Rank2.Traversable g) => Traversable t g where
    traverse :: Codomain t ~ Compose m f => t -> g (Domain t) -> m (g f)
 
-instance (Functor t g, Functor t h) => Functor t (Rank2.Product g h) where
-   t <$> Rank2.Pair left right = Rank2.Pair (t <$> left) (t <$> right)
+newtype FunctorCompose (p :: Type -> Type) t = FunctorCompose t
+newtype FoldableCompose (p :: Type -> Type) t = FoldableCompose t
+newtype TraversableCompose (p :: Type -> Type) t = TraversableCompose t
 
-instance (Foldable t g, Foldable t h, Codomain t ~ Const m, Monoid m) => Foldable t (Rank2.Product g h) where
-   foldMap t (Rank2.Pair left right) = foldMap t left `mappend` foldMap t right
+instance Transformation t => Transformation (FunctorCompose p t) where
+   type Domain (FunctorCompose p t) = Compose p (Domain t)
+   type Codomain (FunctorCompose p t) = Compose p (Codomain t)
+instance Transformation t => Transformation (FoldableCompose p t) where
+   type Domain (FoldableCompose p t) = Compose p (Domain t)
+   type Codomain (FoldableCompose p t) = Codomain t
+instance (Transformation t, Codomain t ~ Compose q r) => Transformation (TraversableCompose p t) where
+   type Domain (TraversableCompose p t) = Compose p (Domain t)
+   type Codomain (TraversableCompose p t) = Compose (Outer (Codomain t)) (Compose p (Inner (Codomain t)))
 
-instance (Traversable t g, Traversable t h, Codomain t ~ Compose m f, Applicative m) => Traversable t (Rank2.Product g h) where
-   traverse t (Rank2.Pair left right) = liftA2 Rank2.Pair (traverse t left) (traverse t right)
+type family Outer f where
+   Outer (Compose p q) = p
+type family Inner f where
+   Inner (Compose p q) = q
+
+instance (Rank1.Functor p, t `At` a) => FunctorCompose p t `At` a where
+   FunctorCompose t $ Compose x = Compose ((t Transformation.$) Rank1.<$> x)
+instance (Rank1.Foldable p, Codomain t ~ Const m, Monoid m, t `At` a) => FoldableCompose p t `At` a where
+   FoldableCompose t $ Compose x = Const $ Rank1.foldMap (getConst . (t Transformation.$)) x
+instance (Rank1.Traversable p, Applicative q, Codomain t ~ Compose q r, t `At` a) => TraversableCompose p t `At` a where
+   TraversableCompose t $ Compose x = Compose $ Compose Rank1.<$> Rank1.traverse (getCompose . (t Transformation.$)) x
+
+instance Transformation t => Functor t Rank2.Empty where
+   _ <$> Rank2.Empty = Rank2.Empty
+
+instance Transformation t => Functor t Proxy where
+   _ <$> _ = Proxy
+
+instance Transformation t => Functor t (Const a) where
+   _ <$> Const a = Const a
+
+instance (Transformation t, t `At` a) => Functor t (Rank2.Only a) where
+   t <$> Rank2.Only x = Rank2.Only (t Transformation.$ x)
+
+instance Functor t g => Functor t (Rank2.Identity g) where
+   f <$> Rank2.Identity g = Rank2.Identity (f <$> g)
+
+instance (Transformation t, Functor (FunctorCompose p t) g, Rank1.Functor p) => Functor t (Rank2.Compose g p) where
+   t <$> Rank2.Compose g = Rank2.Compose (FunctorCompose t <$> g)
+
+instance (Transformation t, t `At` a, Rank1.Functor g) => Functor t (Rank2.Flip g a) where
+   t <$> Rank2.Flip g = Rank2.Flip ((t Transformation.$) Rank1.<$> g)
+
+instance (Functor t g, Functor t h) => Functor t (Product g h) where
+   t <$> Pair left right = Pair (t <$> left) (t <$> right)
+
+instance (Functor t g, Functor t h) => Functor t (Sum g h) where
+   t <$> InL g = InL (t <$> g)
+   t <$> InR h = InR (t <$> h)
+
+instance Transformation t => Foldable t Rank2.Empty where
+   foldMap _ _ = mempty
+
+instance Transformation t => Foldable t Proxy where
+   foldMap _ _ = mempty
+
+instance Transformation t => Foldable t (Const x) where
+   foldMap _ _ = mempty
+
+instance (Transformation t, t `At` a, Codomain t ~ Const m) => Foldable t (Rank2.Only a) where
+   foldMap t (Rank2.Only x) = getConst (t Transformation.$ x)
+
+instance Foldable t g => Foldable t (Rank2.Identity g) where
+   foldMap t (Rank2.Identity g) = foldMap t g
+
+instance (Transformation t, Foldable (FoldableCompose p t) g, Rank1.Foldable p) => Foldable t (Rank2.Compose g p) where
+   foldMap t (Rank2.Compose g) = foldMap (FoldableCompose t) g
+
+instance (Transformation t, t `At` a, Codomain t ~ Const m, Rank1.Foldable g) => Foldable t (Rank2.Flip g a) where
+   foldMap t (Rank2.Flip g) = Rank1.foldMap (getConst . (t Transformation.$)) g
+
+instance (Foldable t g, Foldable t h, Codomain t ~ Const m, Monoid m) => Foldable t (Product g h) where
+   foldMap t (Pair left right) = foldMap t left `mappend` foldMap t right
+
+instance (Foldable t g, Foldable t h) => Foldable t (Sum g h) where
+   foldMap t (InL g) = foldMap t g
+   foldMap t (InR h) = foldMap t h
+
+instance (Transformation t, Codomain t ~ Compose m f, Applicative m) => Traversable t Rank2.Empty where
+   traverse _ _ = pure Rank2.Empty
+
+instance (Transformation t, Codomain t ~ Compose m f, Applicative m) => Traversable t Proxy where
+   traverse _ _ = pure Proxy
+
+instance (Transformation t, Codomain t ~ Compose m f, Applicative m) => Traversable t (Const x) where
+   traverse _ (Const x) = pure (Const x)
+
+instance (Transformation t, t `At` a, Codomain t ~ Compose m f, Rank1.Functor m) => Traversable t (Rank2.Only a) where
+   traverse t (Rank2.Only x) = Rank2.Only Rank1.<$> getCompose (t Transformation.$ x)
+
+instance (Traversable t g, Codomain t ~ Compose m f, Rank1.Functor m) => Traversable t (Rank2.Identity g) where
+   traverse t (Rank2.Identity g) = Rank2.Identity Rank1.<$> traverse t g
+
+instance (Transformation t, Traversable (TraversableCompose p t) g,
+          Rank1.Traversable p, Codomain t ~ Compose q r, Rank1.Functor q) => Traversable t (Rank2.Compose g p) where
+   traverse t (Rank2.Compose g) = Rank2.Compose Rank1.<$> traverse (TraversableCompose t) g
+
+instance (Transformation t, t `At` a,
+          Codomain t ~ Compose m f, Applicative m, Rank1.Traversable g) => Traversable t (Rank2.Flip g a) where
+   traverse t (Rank2.Flip g) = Rank2.Flip Rank1.<$> Rank1.traverse (getCompose . (t Transformation.$)) g
+
+instance (Traversable t g, Traversable t h, Codomain t ~ Compose m f, Applicative m) => Traversable t (Product g h) where
+   traverse t (Pair left right) = liftA2 Pair (traverse t left) (traverse t right)
+
+instance (Traversable t g, Traversable t h, Codomain t ~ Compose m f, Rank1.Functor m) => Traversable t (Sum g h) where
+   traverse t (InL g) = InL Rank1.<$> traverse t g
+   traverse t (InR h) = InR Rank1.<$> traverse t h
 
 -- | Alphabetical synonym for '<$>'
 fmap :: Functor t g => t -> g (Domain t) -> g (Codomain t)