diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,13 @@
 # Revision history for deep-transformations
 
+## 0.4.1 -- 2026-11-08
+
+* Fixed issue #32, Template Haskell error for data types not using the deep functor
+* Added `Full.Inward`/`Outward` newtype `Transformation` modifiers
+* Added `foldMapInward`, `foldMapOutward`, `traverseInward`,  and `traverseOutward`
+* Added `AG.knitLeaf` and the overlappable `AG.Knit t \`Transformation.At\`` instance
+* Added `instance (t1, t2) \`AG.At\` Deep.Const2 a`
+
 ## 0.4.0.1 -- 2025-11-09
 
 * Presenting the `doctests` component as a testsuite to Cabal instead of a sublibrary because of issues with Haddock
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -314,7 +314,6 @@
 
 instance AG.Attribution DeadCodeEliminator where
    type Origin DeadCodeEliminator = Identity
-   unwrap DeadCodeEliminator = runIdentity
 ~~~
 
 We also need another bit of a boilerplate instance that can be automatically generated with Template Haskell functions
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.4.0.1
+version:             0.4.1
 synopsis:            Deep natural and unnatural tree transformations, including attribute grammars
 description:
 
@@ -40,7 +40,7 @@
   ghc-options:         -Wall
   build-depends:        base >= 4.11 && < 5, rank2classes >= 1.5.5 && < 1.6,
                         transformers >= 0.5 && < 0.7,
-                        template-haskell >= 2.11 && < 2.24, generic-lens >= 1.2 && < 2.4
+                        template-haskell >= 2.11 && < 2.25, generic-lens >= 1.2 && < 2.4
   default-language:     Haskell2010
 
 test-suite doctests
@@ -53,3 +53,11 @@
   ghc-options:         -threaded -pgmL markdown-unlit
   build-depends:       base, rank2classes, deep-transformations
   build-tool-depends:  markdown-unlit:markdown-unlit >= 0.5 && < 0.6
+
+test-suite TH
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      test
+  default-language:    Haskell2010
+  main-is:             Issue32.hs
+  build-depends:       base, rank2classes, deep-transformations,
+                       tasty < 2, tasty-hunit < 1
diff --git a/src/Transformation/AG.hs b/src/Transformation/AG.hs
--- a/src/Transformation/AG.hs
+++ b/src/Transformation/AG.hs
@@ -1,5 +1,6 @@
 {-# Language FlexibleContexts, FlexibleInstances, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes,
-             MultiParamTypeClasses, NamedFieldPuns, RankNTypes, ScopedTypeVariables, StandaloneDeriving,
+             MultiParamTypeClasses, NamedFieldPuns, QuantifiedConstraints,
+             RankNTypes, ScopedTypeVariables, StandaloneDeriving,
              TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-}
 
 -- | An attribute grammar is a particular kind of 'Transformation' that assigns attributes to nodes in a
@@ -8,12 +9,13 @@
 
 module Transformation.AG where
 
+import Data.Foldable1 as Foldable1
 import Data.Kind (Type)
 import Unsafe.Coerce (unsafeCoerce)
 
 import qualified Rank2
 import Transformation (Transformation, Codomain)
-import Transformation.Deep (Const2)
+import Transformation.Deep (Const2(Const2))
 import qualified Transformation
 import qualified Transformation.Deep as Deep
 import qualified Transformation.Full as Full
@@ -65,8 +67,6 @@
 -- attribute individually with a 'Transformation.AG.Generics.SynthesizedField' instance.
 class Attribution t where
    type Origin t :: Type -> Type
-   -- | Unwrap the value from the original attribution domain
-   unwrap :: t -> Origin t x -> x
 
 class Attribution t => At t g where
    -- | The attribution rule for a given transformation and node.
@@ -75,24 +75,55 @@
                -> (Inherited   t (g sem sem), g sem (Synthesized t))
                -> (Synthesized t (g sem sem), g sem (Inherited t))
 
+-- | Turns an `Attribution` into a `Transformation`
 newtype Knit t = Knit t
 
 instance Attribution t => Transformation (Knit t) where
    type Domain (Knit t) = Origin t
    type Codomain (Knit t) = Semantics t
 
-instance (t `At` g, Rank2.Apply (g sem), Rank2.Traversable (g sem), sem ~ Semantics t) =>
+instance {-# OVERLAPS #-}
+         (t `At` g, Rank2.Apply (g sem), Rank2.Traversable (g sem), sem ~ Semantics t, Foldable1 (Origin t)) =>
          Knit t `Transformation.At` g sem sem where
-   Knit t $ x = knit (attribution t x) (unwrap t x)
+   Knit t $ x = knit (attribution t x) (Foldable1.head x)
 
+-- | A leaf node, /i.e./ a node whose type is not of the @g deep shallow@ shape, carries no children and therefore
+-- needs no knot tying. Its attribution is given by the @t `At` Const2 a@ instance.
+instance {-# OVERLAPPABLE #-} (t `At` Const2 a, NodeConstructor a ~ Const2 a,
+                               Functor (Origin t), Foldable1 (Origin t)) =>
+         Knit t `Transformation.At` a where
+   Knit t $ x = knitLeaf t x
+
 instance (t `At` g, Rank2.Apply (g (Semantics t)), Rank2.Traversable (g (Semantics t)),
-          Functor (Origin t), Rank2.Functor (g (Origin t)), Deep.Functor (Knit t) g) =>
+          Foldable1 (Origin t), Functor (Origin t), Rank2.Functor (g (Origin t)), Deep.Functor (Knit t) g) =>
          Full.Functor (Knit t) g where
    (<$>) = Full.mapUpDefault
 
--- | Transformation wrapper that keeps all the original tree nodes alongside their attributes
+instance (Attribution t1, Attribution t2, Origin t1 ~ Origin t2) => Attribution (t1, t2) where
+  type Origin (t1, t2) = Origin t1
+
+type instance Atts (Inherited (t1, t2)) g = (Atts (Inherited t1) g, Atts (Inherited t2) g)
+type instance Atts (Synthesized (t1, t2)) g = (Atts (Synthesized t1) g, Atts (Synthesized t2) g)
+
+instance {-# OVERLAPPABLE #-} (t1 `At` g, t2 `At` g, Origin t1 ~ Origin t2, forall sem. Rank2.Apply (g sem)) =>
+  (t1, t2) `At` g where
+  attribution (t1, t2) x (Inherited (i1, i2), s) = (Synthesized (s1, s2), Rank2.liftA2 pairInh i1' i2')
+    where (Synthesized s1, i1') = attribution t1 x (Inherited i1, Synthesized . fst . syn Rank2.<$> s)
+          (Synthesized s2, i2') = attribution t2 x (Inherited i2, Synthesized . snd . syn Rank2.<$> s)
+          pairInh (Inherited inh1) (Inherited inh2) = Inherited (inh1, inh2)
+
+-- | A 'Const2' leaf node has no children to bequeath the inherited attributes to, so the pair of attributions needs
+-- no 'Rank2.Apply' instance and in turn no @Semigroup a@ constraint.
+instance {-# OVERLAPS #-} (t1 `At` Const2 a, t2 `At` Const2 a, Origin t1 ~ Origin t2) =>
+  (t1, t2) `At` Const2 a where
+  attribution (t1, t2) x (Inherited (i1, i2), Const2 leaf) = (Synthesized (s1, s2), Const2 leaf)
+    where Synthesized s1 = fst (attribution t1 x (Inherited i1, Const2 leaf))
+          Synthesized s2 = fst (attribution t2 x (Inherited i2, Const2 leaf))
+
+-- | Attribution wrapper that keeps all the original tree nodes alongside their attributes in a `Kept` node
 newtype Keep t = Keep t deriving (Attribution)
 
+-- | The synthesized attributes of a `Keep`-wrapped attribution
 data Kept t a = Kept{inherited   :: Atts (Inherited t) (NodeConstructor a),
                      synthesized :: Atts (Synthesized t) (NodeConstructor a),
                      original    :: Origin t a}
@@ -127,3 +158,13 @@
    where knit' inherited = synthesized
             where (synthesized, chInh) = r (inherited, chSyn)
                   chSyn = chSem Rank2.<*> chInh
+
+-- | The counterpart of 'knit' for a /leaf node/, a node whose type @a@ is not of the @g deep shallow@ shape. Such a
+-- node is wrapped in 'Const2' to be given its attributes, and as it has no children there is no knot to tie.
+knitLeaf :: forall t a sem. (t `At` Const2 a, NodeConstructor a ~ Const2 a, sem ~ Semantics t,
+                             Functor (Origin t), Foldable1 (Origin t))
+         => t -> Origin t a -> sem a
+knitLeaf t x = Rank2.Arrow knitLeaf'
+   where knitLeaf' (Inherited inherited) = Synthesized (syn synthesized)
+            where synthesized :: Synthesized t (Const2 a sem sem)
+                  synthesized = fst $ attribution t (Const2 <$> x) (Inherited inherited, Const2 $ Foldable1.head 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
@@ -7,7 +7,8 @@
 
 module Transformation.AG.Dimorphic where
 
-import Data.Data (Data, Typeable)
+import Data.Data (Data)
+import Data.Foldable1 as Foldable1
 import Data.Functor.Const (Const(..))
 import Data.Kind (Type)
 import Data.Semigroup (Semigroup(..))
@@ -31,7 +32,7 @@
    inh :: a,
    -- | synthesized
    syn :: b}
-   deriving (Data, Typeable, Show)
+   deriving (Data, Show)
 
 instance (Semigroup a, Semigroup b) => Semigroup (Atts a b) where
    Atts i1 s1 <> Atts i2 s2 = Atts (i1 <> i2) (s1 <> s2)
@@ -52,8 +53,6 @@
    type Origin t :: Type -> Type
    type Inherited t :: Type
    type Synthesized t :: Type
-   -- | Unwrap the value from the original attribution domain
-   unwrap :: t -> Origin t x -> x
 
 -- | The core type class for defining the attribute grammar. The instances of this class typically have a form like
 --
@@ -72,13 +71,13 @@
 
 instance {-# overlappable #-} (Attribution t, p ~ Origin t, a ~ Inherited t, b ~ Synthesized t,
                                q ~ Semantics a b, Rank2.Foldable (g q), Rank2.Functor (g q),
-                               Monoid a, Monoid b, Foldable p, At t g) =>
+                               Monoid a, Monoid b, Foldable1 p, At t g) =>
                               T t `Transformation.At` g (Semantics a b) (Semantics a b) where
-   T t $ x = knit (attribution t x) (unwrap t x)
+   T t $ x = knit (attribution t x) (Foldable1.head x)
    {-# INLINE ($) #-}
 
 instance (Attribution t, At t g, p ~ Origin t, a ~ Inherited t, b ~ Synthesized t, q ~ Semantics a b,
-          Monoid a, Monoid b, Foldable p, Functor p,
+          Monoid a, Monoid b, Foldable1 p, Functor p,
           Rank2.Foldable (g q), Rank2.Functor (g p), Rank2.Functor (g q), Deep.Functor (T t) g) =>
          Full.Functor (T t) g where
    (<$>) = Full.mapUpDefault
@@ -97,7 +96,6 @@
 
 instance (Attribution t, Foldable (Origin t)) => AG.Attribution (Auto t) where
    type Origin (Auto t) = Origin t
-   unwrap _ = foldr1 const
 
 type instance AG.Atts (AG.Inherited (Auto t)) g = Inherited t
 type instance AG.Atts (AG.Synthesized (Auto t)) g = Synthesized t
@@ -109,4 +107,4 @@
       where result = attribution t x Atts{inh=AG.inh inherited, syn=Rank2.foldMap AG.syn chSyn}
             chInh = uniformInheritance Rank2.<$> foldr const (error "Missing node") x
             uniformInheritance :: forall p a. p a -> AG.Inherited (Auto t) a
-            uniformInheritance = const $ AG.Inherited (AG.inh inherited)
+            uniformInheritance = const $ AG.Inherited (inh result)
diff --git a/src/Transformation/AG/Generics.hs b/src/Transformation/AG/Generics.hs
--- a/src/Transformation/AG/Generics.hs
+++ b/src/Transformation/AG/Generics.hs
@@ -22,6 +22,7 @@
                                    foldedField, mappedField, passDown, bequestDefault)
 where
 
+import Data.Foldable1 as Foldable1
 import Data.Functor.Compose (Compose(..))
 import Data.Functor.Const (Const(..))
 import Data.Kind (Type)
@@ -45,7 +46,6 @@
 
 instance Attribution t => Attribution (Auto t) where
    type Origin (Auto t) = Origin t
-   unwrap (Auto t) = unwrap t
 
 instance {-# overlappable #-} (Attribution t, Bequether (Auto t) g, Synthesizer (Auto t) g) =>
                               Auto t `At` g where
@@ -79,7 +79,7 @@
                      -> g sem (Synthesized t)           -- ^ synthesized attributes
                      -> result
 
-instance {-# overlappable #-} (Attribution t, a ~ Atts (Inherited (Auto t)) g,
+instance {-# overlappable #-} (Attribution t, Foldable1 (Origin t), a ~ Atts (Inherited (Auto t)) g,
                                forall deep. Shallow.Functor (PassDown (Auto t) deep a) (g deep)) =>
                               Bequether (Auto t) g where
    bequest = bequestDefault
@@ -230,10 +230,10 @@
 -- | The default 'bequest' method definition relies on generics to automatically pass down all same-named inherited
 -- attributes.
 bequestDefault :: forall t g sem.
-                  (Attribution t, Shallow.Functor (PassDown t sem (Atts (Inherited t) g)) (g sem))
+                  (Attribution t, Foldable1 (Origin t), Shallow.Functor (PassDown t sem (Atts (Inherited t) g)) (g sem))
                => t -> Origin t (g sem sem) -> Atts (Inherited t) g -> g sem (Synthesized t)
                -> g sem (Inherited t)
-bequestDefault t local inheritance _synthesized = passDown @t inheritance (unwrap t local :: g sem sem)
+bequestDefault _t local inheritance _synthesized = passDown @t inheritance (Foldable1.head local :: g sem sem)
 
 -- | Pass down the given record of inherited fields to child nodes.
 passDown :: forall t g shallow deep atts. (Shallow.Functor (PassDown t shallow atts) (g deep)) =>
diff --git a/src/Transformation/Deep.hs b/src/Transformation/Deep.hs
--- a/src/Transformation/Deep.hs
+++ b/src/Transformation/Deep.hs
@@ -1,5 +1,6 @@
-{-# Language Haskell2010, DeriveDataTypeable, FlexibleInstances, KindSignatures, MultiParamTypeClasses, RankNTypes,
-             GeneralizedNewtypeDeriving, StandaloneDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-}
+{-# Language Haskell2010, DeriveDataTypeable, FlexibleContexts, FlexibleInstances,
+             GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, RankNTypes,
+             StandaloneDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-}
 
 -- | Type classes 'Functor', 'Foldable', and 'Traversable' that correspond to the standard type classes of the same
 -- name, but applying the given transformation to every descendant of the given tree node. The corresponding classes
@@ -9,7 +10,7 @@
 module Transformation.Deep where
 
 import Data.Data (Data, Typeable)
-import Data.Functor.Compose (Compose)
+import Data.Functor.Compose (Compose(getCompose))
 import Data.Functor.Const (Const)
 import qualified Control.Applicative as Rank1
 import qualified Data.Foldable as Rank1
@@ -18,8 +19,10 @@
 import Data.Kind (Type)
 import Data.String (IsString)
 import qualified Rank2
-import           Transformation (Transformation, Domain, Codomain)
+import           Transformation (Transformation, At, Domain, Codomain)
+import qualified Transformation
 import qualified Transformation.Full as Full
+import qualified Transformation.Shallow as Shallow
 
 import Prelude hiding (Foldable(..), Traversable(..), Functor(..), Applicative(..), (<$>), fst, snd)
 
@@ -62,6 +65,39 @@
 
 -- Instances
 
+instance Rank2.Functor (Const2 a d) where
+   _ <$> Const2 x = Const2 x
+
+instance Rank2.Foldable (Const2 a d) where
+   foldMap _ _ = mempty
+
+instance Rank2.Traversable (Const2 a d) where
+   traverse _ (Const2 x) = Rank1.pure (Const2 x)
+
+instance Semigroup a => Rank2.Apply (Const2 a d) where
+   Const2 x <*> Const2 y = Const2 (x <> y)
+
+instance Monoid a => Rank2.Applicative (Const2 a d) where
+   pure _ = Const2 mempty
+
+instance Transformation t => Shallow.Functor t (Const2 a d) where
+   _ <$> Const2 x = Const2 x
+
+instance Transformation t => Shallow.Foldable t (Const2 a d) where
+   foldMap _ _ = mempty
+
+instance (Transformation t, Codomain t ~ Compose m f, Rank1.Applicative m) => Shallow.Traversable t (Const2 a d) where
+   traverse _ (Const2 x) = Rank1.pure (Const2 x)
+
+instance Transformation t => Functor t (Const2 a) where
+   _ <$> Const2 x = Const2 x
+
+instance Transformation t => Foldable t (Const2 a) where
+   foldMap _ _ = mempty
+
+instance (Transformation t, Codomain t ~ Compose m f, Rank1.Applicative m) => Traversable t (Const2 a) where
+   traverse _ (Const2 x) = Rank1.pure (Const2 x)
+
 instance Rank2.Functor (Only g d) where
    f <$> Only x = Only (f x)
 
@@ -83,6 +119,16 @@
 instance Rank2.Distributive (Only g d) where
    cotraverse w f = Only (w (Rank1.fmap fromOnly f))
 
+instance (Transformation t, t `At` g d d) => Shallow.Functor t (Only g d) where
+   t <$> Only x = Only (t Transformation.$ x)
+
+instance (Transformation t, Codomain t ~ Rank1.Const m, t `At` g d d) => Shallow.Foldable t (Only g d) where
+   foldMap t (Only x) = Rank1.getConst $ t Transformation.$ x
+
+instance (Transformation t, Codomain t ~ Compose m f, Rank1.Functor m, t `At` g d d) =>
+   Shallow.Traversable t (Only g d) where
+   traverse t (Only x) = Only Rank1.<$> getCompose (t Transformation.$ x)
+
 instance Full.Functor t g => Functor t (Only g) where
    t <$> Only x = Only (t Full.<$> x)
 
@@ -178,6 +224,19 @@
 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 (Shallow.Functor t (g d), Shallow.Functor t (h d)) => Shallow.Functor t (Sum g h d) where
+   t <$> InL left = InL (t Shallow.<$> left)
+   t <$> InR right = InR (t Shallow.<$> right)
+
+instance (Shallow.Foldable t (g d), Shallow.Foldable t (h d)) => Shallow.Foldable t (Sum g h d) where
+   foldMap t (InL left) = Shallow.foldMap t left
+   foldMap t (InR right) = Shallow.foldMap t right
+
+instance (Shallow.Traversable t (g d), Shallow.Traversable t (h d),
+          Codomain t ~ Compose m f, Rank1.Functor m) => Shallow.Traversable t (Sum g h d) where
+   traverse t (InL left) = InL Rank1.<$> Shallow.traverse t left
+   traverse t (InR right) = InR Rank1.<$> Shallow.traverse t right
 
 instance (Functor t g, Functor t h) => Functor t (Sum g h) where
    t <$> InL left = InL (t <$> left)
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
@@ -109,12 +109,12 @@
    tyVars' <- traverse reifyTVKindSynonyms tyVars
 #if MIN_VERSION_template_haskell(2,17,0)
    let (KindedTV tyVar _ (AppT (AppT ArrowT StarT) StarT) :
-        KindedTV tyVar' _ (AppT (AppT ArrowT StarT) StarT) : _) = reverse tyVars'
+        KindedTV tyVar' _ _ : _) = reverse tyVars'
        apply t (PlainTV name _)    = appT t (varT name)
        apply t (KindedTV name _ _) = appT t (varT name)
 #else
    let (KindedTV tyVar  (AppT (AppT ArrowT StarT) StarT) :
-        KindedTV tyVar' (AppT (AppT ArrowT StarT) StarT) : _) = reverse tyVars'
+        KindedTV tyVar' _ : _) = reverse tyVars'
        apply t (PlainTV name)    = appT t (varT name)
        apply t (KindedTV name _) = appT t (varT name)
 #endif
diff --git a/src/Transformation/Full.hs b/src/Transformation/Full.hs
--- a/src/Transformation/Full.hs
+++ b/src/Transformation/Full.hs
@@ -1,5 +1,6 @@
 {-# Language FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}
 {-# Language QuantifiedConstraints, RankNTypes, TypeFamilies, TypeOperators #-}
+{-# Language UndecidableInstances #-}
 
 -- | Type classes 'Functor', 'Foldable', and 'Traversable' that correspond to the standard type classes of the same
 -- name, but applying the given transformation to the given tree node and all its descendants. The corresponding classes
@@ -37,6 +38,56 @@
 -- | Like "Transformation.Deep".'Deep.Traversable' except it traverses an additional wrapper around the entire tree
 class (Transformation t, Rank2.Traversable (g (Domain t))) => Traversable t g where
    traverse :: Codomain t ~ Compose m f => t -> Domain t (g (Domain t) (Domain t)) -> m (f (g f f))
+
+-- | Transformation modifier that applies the transformation first to the tree and then to the wrapper
+newtype Inward t = Inward t
+
+-- | Transformation modifier that applies the transformation first to the wrapper and then to the tree
+newtype Outward t = Outward t
+
+instance Transformation t => Transformation (Inward t) where
+  type Domain (Inward t) = Domain t
+  type Codomain (Inward t) = Codomain t
+
+instance Transformation t => Transformation (Outward t) where
+  type Domain (Outward t) = Domain t
+  type Codomain (Outward t) = Codomain t
+
+instance t `Transformation.At` a => Inward t `Transformation.At` a where
+  Inward t $ a = t Transformation.$ a
+
+instance t `Transformation.At` a => Outward t `Transformation.At` a where
+  Outward t $ a = t Transformation.$ a
+
+instance (Deep.Functor (Inward t) g, t `Transformation.At` g (Codomain t) (Codomain t),
+          Data.Functor.Functor (Domain t), Rank2.Functor (g (Domain t))) =>
+         Functor (Inward t) g where
+  (<$>) = mapUpDefault
+
+instance (Deep.Functor (Outward t) g, t `Transformation.At` g (Domain t) (Domain t),
+          Data.Functor.Functor (Codomain t), Rank2.Functor (g (Domain t))) =>
+         Functor (Outward t) g where
+  (<$>) = mapDownDefault
+
+instance (Deep.Foldable (Inward t) g, t `Transformation.At` g (Domain t) (Domain t),
+          Rank2.Foldable (g (Domain t)), Codomain t ~ Const m, Data.Foldable.Foldable (Domain t), Monoid m) =>
+         Foldable (Inward t) g where
+  foldMap = foldMapUpDefault
+
+instance (Deep.Foldable (Outward t) g, t `Transformation.At` g (Domain t) (Domain t),
+          Rank2.Foldable (g (Domain t)), Codomain t ~ Const m, Data.Foldable.Foldable (Domain t), Monoid m) =>
+         Foldable (Outward t) g where
+  foldMap = foldMapDownDefault
+
+instance (Deep.Traversable (Inward t) g, Codomain t ~ Compose m f, t `Transformation.At` g f f,
+          Rank2.Traversable (g (Domain t)), Data.Traversable.Traversable (Domain t), Monad m) =>
+         Traversable (Inward t) g where
+  traverse = traverseUpDefault
+
+instance (Deep.Traversable (Outward t) g, Codomain t ~ Compose m f, t `Transformation.At` g (Domain t) (Domain t),
+          Rank2.Traversable (g (Domain t)), Data.Traversable.Traversable f, Monad m) =>
+         Traversable (Outward t) g where
+  traverse = traverseDownDefault
 
 -- | Alphabetical synonym for '<$>'
 fmap :: Functor t g => t -> Domain t (g (Domain t) (Domain t)) -> Codomain t (g (Codomain t) (Codomain t))
diff --git a/src/Transformation/Rank2.hs b/src/Transformation/Rank2.hs
--- a/src/Transformation/Rank2.hs
+++ b/src/Transformation/Rank2.hs
@@ -11,6 +11,7 @@
 import           Transformation (Transformation, Domain, Codomain)
 import qualified Transformation
 import qualified Transformation.Deep as Deep
+import qualified Transformation.Full as Full
 
 -- | Transform (naturally) the containing functor of every node in the given tree.
 (<$>) :: Deep.Functor (Map p q) g => (forall a. p a -> q a) -> g p p -> g q q
@@ -21,9 +22,26 @@
 foldMap :: (Deep.Foldable (Fold p m) g, Monoid m) => (forall a. p a -> m) -> g p p -> m
 foldMap f = Deep.foldMap (Fold f)
 
+-- | Fold the containing functor of every node in the given tree inward from the leaves to the root.
+foldMapInward :: (Deep.Foldable (Full.Inward (Fold p m)) g, Monoid m) => (forall a. p a -> m) -> g p p -> m
+foldMapInward f = Deep.foldMap $ Full.Inward $ Fold f
+
+-- | Fold the containing functor of every node in the given tree outward from the root to the leaves.
+foldMapOutward :: (Deep.Foldable (Full.Outward (Fold p m)) g, Monoid m) => (forall a. p a -> m) -> g p p -> m
+foldMapOutward f = Deep.foldMap $ Full.Outward $ Fold f
+
 -- | Traverse the containing functors of all nodes in the given tree.
 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)
+
+-- | Traverse the containing functors of all nodes in the given tree inward from the leaves to the root.
+traverseInward :: Deep.Traversable (Full.Inward (Traversal p q m)) g => (forall a. p a -> m (q a)) -> g p p -> m (g q q)
+traverseInward f = Deep.traverse $ Full.Inward $ Traversal f
+
+-- | Traverse the containing functors of all nodes in the given tree outward from the root to the leaves.
+traverseOutward :: Deep.Traversable (Full.Outward (Traversal p q m)) g
+                => (forall a. p a -> m (q a)) -> g p p -> m (g q q)
+traverseOutward f = Deep.traverse $ Full.Outward $ Traversal f
 
 newtype Map (p :: Type -> Type) (q :: Type -> Type) = Map (forall x. p x -> q x)
 
diff --git a/test/Issue32.hs b/test/Issue32.hs
new file mode 100644
--- /dev/null
+++ b/test/Issue32.hs
@@ -0,0 +1,45 @@
+{-# LANGUAGE Haskell2010 #-}
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}
+{-# LANGUAGE KindSignatures, PolyKinds, StandaloneDeriving, TypeFamilies, TypeOperators #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+--module Issue32 where
+
+import Data.Functor.Compose
+import Data.Functor.Identity
+import Data.Kind (Type)
+import Data.Void
+import qualified Rank2.TH
+import qualified Transformation.Deep
+import qualified Transformation.Deep.TH
+import qualified Transformation.Rank2
+
+import Test.Tasty (TestTree, defaultMain)
+import Test.Tasty.HUnit (testCase, assertEqual)
+
+data Param d s = Param
+  { key :: s String,
+    val :: s String
+  }
+
+deriving instance Eq (s String) => Eq (Param d s)
+deriving instance Show (s String) => Show (Param d s)
+
+Rank2.TH.deriveFunctor ''Param
+Rank2.TH.deriveFoldable ''Param
+Rank2.TH.deriveTraversable ''Param
+Transformation.Deep.TH.deriveFunctor ''Param
+Transformation.Deep.TH.deriveFoldable ''Param
+Transformation.Deep.TH.deriveTraversable ''Param
+
+param :: Param x Identity
+param = Param {key = Identity "Hello", val = Identity "World"}
+
+test :: TestTree
+test = testCase "Issue #32" $ do
+  print param
+  assertEqual ""
+    (Just param)
+    (Transformation.Deep.traverse (Transformation.Rank2.Map (Compose . Just)) param)
+
+main = defaultMain test
diff --git a/test/README.lhs b/test/README.lhs
--- a/test/README.lhs
+++ b/test/README.lhs
@@ -314,7 +314,6 @@
 
 instance AG.Attribution DeadCodeEliminator where
    type Origin DeadCodeEliminator = Identity
-   unwrap DeadCodeEliminator = runIdentity
 ~~~
 
 We also need another bit of a boilerplate instance that can be automatically generated with Template Haskell functions
diff --git a/test/RepMin.hs b/test/RepMin.hs
--- a/test/RepMin.hs
+++ b/test/RepMin.hs
@@ -67,7 +67,6 @@
 
 instance Attribution RepMin where
    type Origin RepMin = Identity
-   unwrap RepMin = runIdentity
 
 -- | Inherited attributes' type
 data InhRepMin = InhRepMin{global :: Int}
@@ -86,9 +85,9 @@
 type instance AG.Atts (Inherited RepMin) (Deep.Const2 Int) = ()
 type instance AG.Atts (Synthesized RepMin) (Deep.Const2 Int) = Int
 
--- | The semantics of the primitive 'Int' type must be defined manually.
-instance Transformation.At (AG.Knit RepMin) Int where
-   _ $ Identity n = Rank2.Arrow (const $ Synthesized n)
+-- | The synthesized attributes of the leaf 'Int' are the number itself, and there are no inherited attributes.
+instance AG.At RepMin (Deep.Const2 Int) where
+   attribution RepMin self (inherited, Deep.Const2 n) = (Synthesized n, Deep.Const2 n)
 
 instance AG.At RepMin (Root Int) where
    attribution RepMin self (inherited, Root root) = (Synthesized SynRepMin{local= local (syn root),
diff --git a/test/RepMinAuto.hs b/test/RepMinAuto.hs
--- a/test/RepMinAuto.hs
+++ b/test/RepMinAuto.hs
@@ -46,7 +46,6 @@
 
 instance Attribution RepMin where
    type Origin RepMin = Identity
-   unwrap RepMin = runIdentity
    
 -- | Inherited attributes' type
 data InhRepMin = InhRepMin{global :: Int}
diff --git a/test/RepMinKeepAG.hs b/test/RepMinKeepAG.hs
--- a/test/RepMinKeepAG.hs
+++ b/test/RepMinKeepAG.hs
@@ -67,7 +67,6 @@
 
 instance AG.Attribution RepMin where
    type Origin RepMin = Identity
-   unwrap RepMin = runIdentity
 
 -- | Inherited attributes' type
 data InhRepMin = InhRepMin{global :: Int} deriving Show
@@ -83,9 +82,9 @@
 type instance AG.Atts (Inherited RepMin) (Deep.Const2 Int) = InhRepMin
 type instance AG.Atts (Synthesized RepMin) (Deep.Const2 Int) = Int
 
--- | The semantics of the primitive 'Int' type must be defined manually.
-instance Transformation.At (AG.Knit (AG.Keep RepMin)) Int where
-   _ $ Identity n = Rank2.Arrow (\(Inherited i)-> Synthesized $ AG.Kept i n (Identity $ Deep.Const2 n))
+-- | The synthesized attributes of the leaf 'Int' are the number itself, and there are no inherited attributes.
+instance RepMin `At` Deep.Const2 Int where
+   attribution RepMin self (inherited, Deep.Const2 n) = (Synthesized n, Deep.Const2 n)
 
 instance RepMin `At` Root Int where
    attribution RepMin self (inherited, Root root) = (Synthesized SynRepMin{local= local (syn root)},