diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,24 @@
+# Revision history for deep-transformations
+
+## 0.2 -- 2022-03-27
+
+* Changes necessary to compile with GHC 9.2.2
+* Excluded GHC 8.2.2 from `deep-transformations` and GitHub CI
+* Increased the `deep-transformations`' bottom bound of base dependency
+* Fixed `deep-transformations` compilation with GHC 9.0.1
+* Added an explicit implementation `mappend = (<>)`
+* Used haskell-ci to generate GitHub CI
+* Incremented upper dependency bounds
+* Added `AG.Generics.Keep`
+* Added `knitKeeping` and `applyDefaultWithAttributes` to `AG`
+* Dropped `fullMapDefault`
+* Switch the README's attribute grammar functor to map upwards
+* Removed unused code
+* Added `infixl 4` declarations for all `<$>` methods
+* Added the `AG.Monomorphic` module
+* Fixed `Transformation.Shallow.TH` for repeated type parameters
+* Added `Transformation.Deep.Sum`
+
+## 0.1 -- 2020-11-11
+
+First version
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -31,6 +31,7 @@
 import Data.Coerce (coerce)
 import Data.Functor.Const
 import Data.Functor.Identity
+import Data.Monoid
 import qualified Rank2
 import Transformation (Transformation, At)
 import qualified Transformation
@@ -279,11 +280,17 @@
    type Domain DeadCodeEliminator = Identity
    type Codomain DeadCodeEliminator = AG.Semantics DeadCodeEliminator
 
+instance DeadCodeEliminator `Transformation.At` Decl Sem Sem where
+  ($) = AG.applyDefault runIdentity
+
+instance DeadCodeEliminator `Transformation.At` Expr Sem Sem where
+  ($) = AG.applyDefault runIdentity
+
 instance Full.Functor DeadCodeEliminator Decl where
-  (<$>) = AG.fullMapDefault runIdentity
+  (<$>) = Full.mapUpDefault
 
 instance Full.Functor DeadCodeEliminator Expr where
-  (<$>) = AG.fullMapDefault runIdentity
+  (<$>) = Full.mapUpDefault
 ~~~
 
 We also need another bit of a boilerplate instance that can be automatically generated with Template Haskell functions
@@ -359,11 +366,11 @@
 because they don't have any children.
 
 ~~~ {.haskell}
-instance AG.Attribution DeadCodeEliminator Expr Identity Identity where
-  attribution DeadCodeEliminator (Identity e@(EVar v)) (AG.Inherited env, _) =
-    (AG.Synthesized (maybe e id $ env v), EVar v)
-  attribution DeadCodeEliminator (Identity e@(Con n)) (AG.Inherited env, _) =
-    (AG.Synthesized e, Con n)
+instance AG.Attribution DeadCodeEliminator Expr Sem Identity where
+  attribution DeadCodeEliminator (Identity (EVar v)) (AG.Inherited env, _) =
+    (AG.Synthesized (maybe (EVar v) id $ env v), EVar v)
+  attribution DeadCodeEliminator (Identity (Con n)) (AG.Inherited env, _) =
+    (AG.Synthesized (Con n), Con n)
 ~~~
 
 The `Add` and `Mul` nodes' rules need only to pass their inheritance down and to re-join the synthesized child
@@ -388,7 +395,7 @@
   attribution DeadCodeEliminator (Identity (Let _decl expr))
               (AG.Inherited env, (Let (AG.Synthesized ~(env', decl')) (AG.Synthesized expr'))) =
     (AG.Synthesized (maybe id (bin Let) decl' expr'),
-     Let (AG.Inherited (env, Full.foldMap GetVariables expr)) (AG.Inherited $ \v-> env' v <|> env v))
+     Let (AG.Inherited (env, Deep.foldMap GetVariables expr')) (AG.Inherited $ \v-> env' v <|> env v))
 ~~~
 
 ### Declaration rules
@@ -396,7 +403,7 @@
 The rules for `Decl` are a bit more involved.
 
 ~~~ {.haskell}
-instance AG.Attribution DeadCodeEliminator Decl Identity Identity where
+instance AG.Attribution DeadCodeEliminator Decl Sem Identity where
 ~~~
 
 A single variable binding can be in three distinct situations. If the variable is not referenced at all, we can just
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.1
+version:             0.2
 synopsis:            Deep natural and unnatural tree transformations, including attribute grammars
 description:
 
@@ -22,7 +22,8 @@
 category:            Control, Generics
 build-type:          Custom
 cabal-version:       >=1.10
-extra-source-files:  README.md
+tested-with:         GHC==9.0.1, GHC==8.10.4, GHC==8.8.4, GHC==8.6.5, GHC==8.4.4
+extra-source-files:  README.md, CHANGELOG.md
 source-repository head
   type:              git
   location:          https://github.com/blamario/grampa
@@ -38,10 +39,12 @@
                         Transformation.Shallow, Transformation.Shallow.TH,
                         Transformation.Deep, Transformation.Deep.TH,
                         Transformation.Full, Transformation.Full.TH,
-                        Transformation.Rank2, Transformation.AG, Transformation.AG.Generics
+                        Transformation.Rank2,
+                        Transformation.AG, Transformation.AG.Monomorphic, Transformation.AG.Generics
   ghc-options:         -Wall
-  build-depends:        base >= 4.7 && < 5, rank2classes >= 1.4.1 && < 1.5,
-                        template-haskell >= 2.11 && < 2.17, generic-lens == 2.0.*
+  build-depends:        base >= 4.11 && < 5, rank2classes >= 1.4.1 && < 1.5,
+                        transformers >= 0.5 && < 0.7,
+                        template-haskell >= 2.11 && < 2.19, generic-lens >= 1.2 && < 2.3
   default-language:     Haskell2010
 
 test-suite doctests
diff --git a/src/Transformation.hs b/src/Transformation.hs
--- a/src/Transformation.hs
+++ b/src/Transformation.hs
@@ -56,7 +56,7 @@
 instance (t `At` x, u `At` x, Domain t ~ Codomain u) => Compose t u `At` x where
    Compose t u $ x =  t $ (u $ x)
 
-instance Transformation (Rank2.Arrow p q x) where
+instance Transformation (Rank2.Arrow (p :: Type -> Type) q x) where
    type Domain (Rank2.Arrow p q x) = p
    type Codomain (Rank2.Arrow p q x) = q
 
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,5 @@
 {-# Language FlexibleContexts, FlexibleInstances,
-             MultiParamTypeClasses, RankNTypes, StandaloneDeriving,
+             MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, StandaloneDeriving,
              TypeFamilies, TypeOperators, UndecidableInstances #-}
 
 -- | An attribute grammar is a particular kind of 'Transformation' that assigns attributes to nodes in a
@@ -8,9 +8,10 @@
 
 module Transformation.AG where
 
+import Unsafe.Coerce (unsafeCoerce)
+
 import qualified Rank2
-import Transformation (Domain, Codomain)
-import qualified Transformation.Deep as Deep
+import qualified Transformation
 
 -- | Type family that maps a node type to the type of its attributes, indexed per type constructor.
 type family Atts (f :: * -> *) a
@@ -27,11 +28,19 @@
 -- attributes.
 type Semantics t = Inherited t Rank2.~> Synthesized t
 
+-- | A node's 'PreservingSemantics' is a natural tranformation from the node's inherited attributes to all its
+-- attributes paired with the preserved node.
+type PreservingSemantics t f = Rank2.Arrow (Inherited t) (Rank2.Product (AllAtts t) f)
+
+-- | All inherited and synthesized attributes
+data AllAtts t a = AllAtts{allInh :: Atts (Inherited t) a,
+                           allSyn :: Atts (Synthesized t) a}
+
 -- | An attribution rule maps a node's inherited attributes and its child nodes' synthesized attributes to the node's
 -- synthesized attributes and the children nodes' inherited attributes.
 type Rule t g =  forall sem . sem ~ Semantics t
-              => (Inherited   t (g sem sem), g sem (Synthesized t))
-              -> (Synthesized t (g sem sem), g sem (Inherited t))
+              => (Inherited   t (g sem (Semantics t)), g sem (Synthesized t))
+              -> (Synthesized t (g sem (Semantics t)), g sem (Inherited t))
 
 -- | The core function to tie the recursive knot, turning a 'Rule' for a node into its 'Semantics'.
 knit :: (Rank2.Apply (g sem), sem ~ Semantics t) => Rule t g -> g sem sem -> sem (g sem sem)
@@ -40,6 +49,28 @@
             where (synthesized, chInh) = r (inherited, chSyn)
                   chSyn = chSem Rank2.<*> chInh
 
+-- | Another way to tie the recursive knot, using a 'Rule' to add 'AllAtts' information to every node
+knitKeeping :: forall t f g sem. (sem ~ PreservingSemantics t f, Rank2.Apply (g sem),
+                              Atts (Inherited t) (g sem sem) ~ Atts (Inherited t) (g (Semantics t) (Semantics t)),
+                              Atts (Synthesized t) (g sem sem) ~ Atts (Synthesized t) (g (Semantics t) (Semantics t)),
+                              g sem (Synthesized t) ~ g (Semantics t) (Synthesized t),
+                              g sem (Inherited t) ~ g (Semantics t) (Inherited t))
+            => (forall a. f a -> a) -> Rule t g -> f (g (PreservingSemantics t f) (PreservingSemantics t f))
+            -> PreservingSemantics t f (g (PreservingSemantics t f) (PreservingSemantics t f))
+knitKeeping extract rule x = Rank2.Arrow knitted
+   where knitted :: Inherited t (g (PreservingSemantics t f) (PreservingSemantics t f))
+                 -> Rank2.Product (AllAtts t) f (g (PreservingSemantics t f) (PreservingSemantics t f))
+         chSem :: g (PreservingSemantics t f) (PreservingSemantics t f)
+         knitted inherited = Rank2.Pair AllAtts{allInh= inh inherited, allSyn= syn synthesized} x
+            where chInh :: g (PreservingSemantics t f) (Inherited t)
+                  chSyn :: g (PreservingSemantics t f) (Synthesized t)
+                  chKept :: g (PreservingSemantics t f) (Rank2.Product (AllAtts t) f)
+                  synthesized :: Synthesized t (g (PreservingSemantics t f) (PreservingSemantics t f))
+                  (synthesized, chInh) = unsafeCoerce (rule (unsafeCoerce inherited, unsafeCoerce chSyn))
+                  chSyn = Synthesized . allSyn . Rank2.fst Rank2.<$> chKept
+                  chKept = chSem Rank2.<*> chInh
+         chSem = extract x
+
 -- | The core type class for defining the attribute grammar. The instances of this class typically have a form like
 --
 -- > instance Attribution MyAttGrammar MyNode (Semantics MyAttGrammar) Identity where
@@ -63,9 +94,14 @@
 applyDefault extract t x = knit (attribution t x) (extract x)
 {-# INLINE applyDefault #-}
 
--- | Drop-in implementation of 'Transformation.Full.<$>'
-fullMapDefault :: (p ~ Domain t, q ~ Semantics t, q ~ Codomain t, x ~ g q q, Rank2.Apply (g q),
-                   Deep.Functor t g, Attribution t g p p)
-               => (forall a. p a -> a) -> t -> p (g p p) -> q (g q q)
-fullMapDefault extract t local = knit (attribution t local) (t Deep.<$> extract local)
-{-# INLINE fullMapDefault #-}
+-- | Drop-in implementation of 'Transformation.$' that preserves all attributes with every original node
+applyDefaultWithAttributes :: (p ~ Transformation.Domain t, q ~ PreservingSemantics t p, x ~ g q q, Rank2.Apply (g q),
+                               Atts (Inherited t) (g q q) ~ Atts (Inherited t) (g (Semantics t) (Semantics t)),
+                               Atts (Synthesized t) (g q q) ~ Atts (Synthesized t) (g (Semantics t) (Semantics t)),
+                               g q (Synthesized t) ~ g (Semantics t) (Synthesized t),
+                               g q (Inherited t) ~ g (Semantics t) (Inherited t),
+                               Attribution t g (PreservingSemantics t p) p)
+                           => (forall a. p a -> a) -> t -> p (g (PreservingSemantics t p) (PreservingSemantics t p))
+                           -> PreservingSemantics t p (g (PreservingSemantics t p) (PreservingSemantics t p))
+applyDefaultWithAttributes extract t x = knitKeeping extract (attribution t x) x
+{-# INLINE applyDefaultWithAttributes #-}
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
@@ -1,5 +1,5 @@
 {-# Language DataKinds, DefaultSignatures, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving,
-             MultiParamTypeClasses, PolyKinds, RankNTypes, ScopedTypeVariables, StandaloneDeriving,
+             InstanceSigs, MultiParamTypeClasses, PolyKinds, RankNTypes, ScopedTypeVariables, StandaloneDeriving,
              TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-}
 
 -- | This module can be used to scrap the boilerplate attribute declarations. In particular:
@@ -14,7 +14,7 @@
 -- * If the attribute additionally carries an applicative effect, the 'Mapped' wrapper can be replaced by 'Traversed'.
 
 module Transformation.AG.Generics (-- * Type wrappers for automatic attribute inference
-                                   Auto(..), Folded(..), Mapped(..), Traversed(..),
+                                   Auto(..), Keep(..), Folded(..), Mapped(..), Traversed(..),
                                    -- * Type classes replacing 'Attribution'
                                    Bequether(..), Synthesizer(..), SynthesizedField(..), Revelation(..),
                                    -- * The default behaviour on generic datatypes
@@ -27,24 +27,68 @@
 import Data.Kind (Type)
 import Data.Generics.Product.Subtype (Subtype(upcast))
 import Data.Proxy (Proxy(..))
+import Data.Semigroup (Semigroup(..))
 import GHC.Generics
 import GHC.Records
 import GHC.TypeLits (Symbol, ErrorMessage (Text), TypeError)
 import Unsafe.Coerce (unsafeCoerce)
-import Transformation (Transformation, Domain, Codomain)
+import qualified Rank2
+import Transformation (Transformation, Domain, Codomain, At)
 import Transformation.AG
 import qualified Transformation
 import qualified Transformation.Shallow as Shallow
+import qualified Transformation.Deep as Deep
+import qualified Transformation.Full as Full
 
 -- | Transformation wrapper that allows automatic inference of attribute rules.
 newtype Auto t = Auto t
 
+-- | Transformation wrapper that allows automatic inference of attribute rules and preservation of all attributes with
+-- the original nodes.
+newtype Keep t = Keep t
+
+type instance Atts (Inherited (Auto t)) x = Atts (Inherited t) x
+type instance Atts (Synthesized (Auto t)) x = Atts (Synthesized t) x
+
+type instance Atts (Inherited (Keep t)) x = Atts (Inherited t) x
+type instance Atts (Synthesized (Keep t)) x = Atts (Synthesized t) x
+
+instance {-# overlappable #-} (Revelation (Auto t), Domain (Auto t) ~ f, Codomain (Auto t) ~ Semantics (Auto t),
+                               Rank2.Apply (g (Semantics (Auto t))), Attribution (Auto t) g (Semantics (Auto t)) f) =>
+                              Auto t `At` g (Semantics (Auto t)) (Semantics (Auto t)) where
+   t $ x = applyDefault (reveal t) t x
+   {-# INLINE ($) #-}
+
+instance {-# overlappable #-}
+         (Revelation (Keep t), p ~ Transformation.Domain (Keep t), Rank2.Apply (g q),
+          q ~ Transformation.Codomain (Keep t), q ~ PreservingSemantics (Keep t) p, s ~ Semantics (Keep t),
+          Atts (Inherited (Keep t)) (g q q) ~ Atts (Inherited (Keep t)) (g s s),
+          Atts (Synthesized (Keep t)) (g q q) ~ Atts (Synthesized (Keep t)) (g s s),
+          g q (Synthesized (Keep t)) ~ g s (Synthesized (Keep t)),
+          g q (Inherited (Keep t)) ~ g s (Inherited (Keep t)), Attribution (Keep t) g q p) =>
+         Keep t `At` g (PreservingSemantics (Keep t) p) (PreservingSemantics (Keep t) p) where
+   ($) :: Keep t -> p (g (PreservingSemantics (Keep t) p) (PreservingSemantics (Keep t) p))
+       -> PreservingSemantics (Keep t) p (g (PreservingSemantics (Keep t) p) (PreservingSemantics (Keep t) p))
+   t $ x = applyDefaultWithAttributes (reveal t) t x
+   {-# INLINE ($) #-}
+
+instance (Transformation (Auto t), Domain (Auto t) ~ f, Functor f, Codomain (Auto t) ~ Semantics (Auto t),
+          Deep.Functor (Auto t) g, Auto t `At` g (Semantics (Auto t)) (Semantics (Auto t))) =>
+         Full.Functor (Auto t) g where
+   (<$>) = Full.mapUpDefault
+
+instance (Transformation (Keep t), Domain (Keep t) ~ f, Functor f, Codomain (Keep t) ~ PreservingSemantics (Keep t) f,
+          Functor f, Deep.Functor (Keep t) g,
+          Keep t `At` g (PreservingSemantics (Keep t) f) (PreservingSemantics (Keep t) f)) =>
+         Full.Functor (Keep t) g where
+   (<$>) = Full.mapUpDefault
+
 instance {-# overlappable #-} (Bequether (Auto t) g d s, Synthesizer (Auto t) g d s) => Attribution (Auto t) g d s where
    attribution t l (Inherited i, s) = (Synthesized $ synthesis t l i s, bequest t l i s)
 
-class (Transformation t, dom ~ Domain t) => Revelation t dom where
+class Transformation t => Revelation t where
    -- | Extract the value from the transformation domain
-   reveal :: t -> dom x -> x
+   reveal :: t -> Domain t x -> x
 
 -- | A half of the 'Attribution' class used to specify all inherited attributes.
 class Bequether t g deep shallow where
@@ -59,7 +103,7 @@
 class Synthesizer t g deep shallow where
    synthesis   :: forall sem. sem ~ Semantics t =>
                   t                                -- ^ transformation        
-               -> shallow (g deep deep)            -- ^ tre node
+               -> shallow (g deep deep)            -- ^ tree node
                -> Atts (Inherited t) (g sem sem)   -- ^ inherited attributes  
                -> g sem (Synthesized t)            -- ^ synthesized attributes
                -> Atts (Synthesized t) (g sem sem)
@@ -74,13 +118,7 @@
                      -> g sem (Synthesized t)           -- ^ synthesized attributes
                      -> result
 
-instance (Transformation t, Domain t ~ Identity) => Revelation t Identity where
-   reveal _ (Identity x) = x
-
-instance (Transformation t, Domain t ~ (,) a) => Revelation t ((,) a) where
-   reveal _ (_, x) = x
-
-instance {-# overlappable #-} (sem ~ Semantics t, Domain t ~ shallow, Revelation t shallow,
+instance {-# overlappable #-} (sem ~ Semantics t, Domain t ~ shallow, Revelation t,
                                Shallow.Functor (PassDown t sem (Atts (Inherited t) (g sem sem))) (g sem)) =>
                               Bequether t g (Semantics t) shallow where
    bequest = bequestDefault
@@ -231,7 +269,7 @@
 -- | The default 'bequest' method definition relies on generics to automatically pass down all same-named inherited
 -- attributes.
 bequestDefault :: forall t g shallow sem.
-                  (sem ~ Semantics t, Domain t ~ shallow, Revelation t shallow,
+                  (sem ~ Semantics t, Domain t ~ shallow, Revelation t,
                    Shallow.Functor (PassDown t sem (Atts (Inherited t) (g sem sem))) (g sem))
                => t -> shallow (g sem sem) -> Atts (Inherited t) (g sem sem) -> g sem (Synthesized t)
                -> g sem (Inherited t)
diff --git a/src/Transformation/AG/Monomorphic.hs b/src/Transformation/AG/Monomorphic.hs
new file mode 100644
--- /dev/null
+++ b/src/Transformation/AG/Monomorphic.hs
@@ -0,0 +1,153 @@
+{-# Language 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
+-- attribute of the same monoidal type. The synthesized attributes of child nodes are all 'mconcat`ted together.
+
+module Transformation.AG.Monomorphic where
+
+import Data.Data (Data, Typeable)
+import Data.Functor.Compose (Compose(..))
+import Data.Functor.Const (Const(..))
+import Data.Kind (Type)
+import Data.Semigroup (Semigroup(..))
+import qualified Rank2
+import Transformation (Transformation, Domain, Codomain, At)
+import qualified Transformation
+import qualified Transformation.Deep as Deep
+import qualified Transformation.Full as Full
+
+-- | Transformation wrapper that allows automatic inference of attribute rules.
+newtype Auto t = Auto t
+
+-- | Transformation wrapper that allows automatic inference of attribute rules and preservation of the attribute with
+-- the original nodes.
+newtype Keep t = Keep t
+
+data Atts a = Atts{
+   inh :: a,
+   syn :: a}
+   deriving (Data, Typeable, Show)
+
+instance Semigroup a => Semigroup (Atts a) where
+   Atts i1 s1 <> Atts i2 s2 = Atts (i1 <> i2) (s1 <> s2)
+
+instance Monoid a => Monoid (Atts a) where
+   mappend = (<>)
+   mempty = Atts mempty mempty
+
+-- | A node's 'Semantics' maps its inherited attribute to its synthesized attribute.
+type Semantics a = Const (a -> a)
+
+-- | A node's 'PreservingSemantics' maps its inherited attribute to its synthesized attribute.
+type PreservingSemantics f a = Compose ((->) a) (Compose ((,) (Atts a)) f)
+
+-- | An attribution rule maps a node's inherited attribute and its child nodes' synthesized attribute to the node's
+-- synthesized attribute and the children nodes' inherited attributes.
+type Rule a = Atts a -> Atts a
+
+instance {-# overlappable #-} Attribution t a g deep shallow where
+   attribution = const (const id)
+
+instance {-# overlappable #-} (Transformation (Auto t), p ~ Domain (Auto t), q ~ Codomain (Auto t), q ~ Semantics a,
+                               Rank2.Foldable (g q), Monoid a, Foldable p, Attribution (Auto t) a g q p) =>
+                              (Auto t) `At` g (Semantics a) (Semantics a) where
+   ($) = applyDefault (foldr const $ error "Missing node")
+   {-# INLINE ($) #-}
+
+instance {-# overlappable #-} (Transformation (Keep t), p ~ Domain (Keep t), q ~ Codomain (Keep t),
+                               q ~ PreservingSemantics p a, Rank2.Foldable (g q), Monoid a,
+                               Foldable p, Functor p, Attribution (Keep t) a g q p) =>
+                              (Keep t) `At` g (PreservingSemantics p a) (PreservingSemantics p a) where
+   ($) = applyDefaultWithAttributes
+   {-# INLINE ($) #-}
+
+instance (Transformation (Auto t), Domain (Auto t) ~ f, Functor f, Codomain (Auto t) ~ Semantics (Auto t),
+          Deep.Functor (Auto t) g, Auto t `At` g (Semantics (Auto t)) (Semantics (Auto t))) =>
+         Full.Functor (Auto t) g where
+   (<$>) = Full.mapUpDefault
+
+instance (Transformation (Keep t), Domain (Keep t) ~ f, Functor f, Codomain (Keep t) ~ PreservingSemantics f a,
+          Functor f, Deep.Functor (Keep t) g,
+          Keep t `At` g (PreservingSemantics f a) (PreservingSemantics f a)) =>
+         Full.Functor (Keep t) g where
+   (<$>) = Full.mapUpDefault
+
+instance (Transformation (Keep t), Domain (Keep t) ~ f, Traversable f, Rank2.Traversable (g f),
+          Codomain (Keep t) ~ PreservingSemantics f a, Deep.Traversable (Feeder a f) g, Full.Functor (Keep t) g,
+          Keep t `At` g (PreservingSemantics f a) (PreservingSemantics f a)) =>
+         Full.Traversable (Keep t) g where
+   traverse = traverseDefaultWithAttributes
+
+-- | The core function to tie the recursive knot, turning a 'Rule' for a node into its 'Semantics'.
+knit :: (Rank2.Foldable (g sem), sem ~ Semantics a, Monoid a)
+     => Rule a -> g sem sem -> sem (g sem sem)
+knit r chSem = Const knitted
+   where knitted inherited = synthesized
+            where Atts{syn= synthesized, inh= chInh} = r Atts{inh= inherited, syn= chSyn}
+                  chSyn = Rank2.foldMap (($ chInh) . getConst) chSem
+
+-- | Another way to tie the recursive knot, using a 'Rule' to add attributes to every node througha stateful calculation
+knitKeeping :: forall a f g sem. (Rank2.Foldable (g sem), sem ~ PreservingSemantics f a,
+                              Monoid a, Foldable f, Functor f)
+            => Rule a -> f (g sem sem) -> sem (g sem sem)
+knitKeeping r x = Compose knitted
+   where knitted :: a -> Compose ((,) (Atts a)) f (g sem sem)
+         knitted inherited = Compose (results, x)
+            where results@Atts{inh= chInh} = r Atts{inh= inherited, syn= chSyn}
+                  chSyn = foldMap (Rank2.foldMap (syn . fst . getCompose . ($ chInh) . getCompose)) x
+
+-- | The core type class for defining the attribute grammar. The instances of this class typically have a form like
+--
+-- > instance Attribution MyAttGrammar MyMonoid MyNode (Semantics MyAttGrammar) Identity where
+-- >   attribution MyAttGrammar{} (Identity MyNode{})
+-- >               Atts{inh= fromParent,
+-- >                    syn= fromChildren}
+-- >             = Atts{syn= toParent,
+-- >                    inh= toChildren}
+class Attribution t a g (deep :: Type -> Type) shallow where
+   -- | The attribution rule for a given transformation and node.
+   attribution :: t -> shallow (g deep deep) -> Rule a
+
+-- | Drop-in implementation of 'Transformation.$'
+applyDefault :: (p ~ Domain t, q ~ Semantics a, x ~ g q q, Rank2.Foldable (g q), Attribution t a g q p, Monoid a)
+             => (forall y. p y -> y) -> t -> p x -> q x
+applyDefault extract t x = knit (attribution t x) (extract x)
+{-# INLINE applyDefault #-}
+
+-- | Drop-in implementation of 'Full.<$>'
+fullMapDefault :: (p ~ Domain t, q ~ Semantics a, q ~ Codomain t, x ~ g q q, Rank2.Foldable (g q),
+                   Deep.Functor t g, Attribution t a g p p, Monoid a)
+               => (forall y. p y -> y) -> t -> p (g p p) -> q (g q q)
+fullMapDefault extract t local = knit (attribution t local) (t Deep.<$> extract local)
+{-# INLINE fullMapDefault #-}
+
+-- | Drop-in implementation of 'Transformation.$' that stores all attributes with every original node
+applyDefaultWithAttributes :: (p ~ Domain t, q ~ PreservingSemantics p a, x ~ g q q,
+                               Attribution t a g q p, Rank2.Foldable (g q), Monoid a, Foldable p, Functor p)
+                           => t -> p x -> q x
+applyDefaultWithAttributes t x = knitKeeping (attribution t x) x
+{-# INLINE applyDefaultWithAttributes #-}
+
+-- | Drop-in implementation of 'Full.traverse' that stores all attributes with every original node
+traverseDefaultWithAttributes :: forall t p q r a g.
+                                 (Transformation t, Domain t ~ p, Codomain t ~ Compose ((->) a) q,
+                                 q ~ Compose ((,) (Atts a)) p, r ~ Compose ((->) a) q,
+                                 Traversable p, Full.Functor t g, Deep.Traversable (Feeder a p) g,
+                                 Transformation.At t (g r r))
+                              => t -> p (g p p) -> a -> q (g q q)
+traverseDefaultWithAttributes t x rootInheritance = Full.traverse Feeder (t Full.<$> x) rootInheritance
+{-# INLINE traverseDefaultWithAttributes #-}
+
+data Feeder a (f :: Type -> Type) = Feeder
+
+instance Transformation (Feeder a f) where
+   type Domain (Feeder a f) = Compose ((->) a) (Compose ((,) (Atts a)) f)
+   type Codomain (Feeder a f) = Compose ((->) a) (Compose ((,) (Atts a)) f)
+
+instance Transformation.At (Feeder a f) g where
+   Feeder $ x = x
+
+instance (Traversable f, Deep.Traversable (Feeder a f) g) => Full.Traversable (Feeder a f) g where
+   traverse t x inheritance = Compose (atts{inh= inheritance}, traverse (Deep.traverse t) y (inh atts))
+      where Compose (atts, y) = getCompose x inheritance
diff --git a/src/Transformation/Deep.hs b/src/Transformation/Deep.hs
--- a/src/Transformation/Deep.hs
+++ b/src/Transformation/Deep.hs
@@ -12,6 +12,7 @@
 import Data.Data (Data, Typeable)
 import Data.Functor.Compose (Compose)
 import Data.Functor.Const (Const)
+import qualified Data.Functor as Rank1
 import qualified Rank2
 import qualified Data.Functor
 import           Transformation (Transformation, Domain, Codomain)
@@ -22,6 +23,7 @@
 -- | Like "Transformation.Shallow".'Transformation.Shallow.Functor' except it maps all descendants and not only immediate children
 class (Transformation t, Rank2.Functor (g (Domain t))) => Functor t g where
    (<$>) :: t -> g (Domain t) (Domain t) -> g (Codomain t) (Codomain t)
+   infixl 4 <$>
 
 -- | Like "Transformation.Shallow".'Transformation.Shallow.Foldable' except it folds all descendants and not only immediate children
 class (Transformation t, Rank2.Foldable (g (Domain t))) => Foldable t g where
@@ -32,10 +34,14 @@
    traverse :: Codomain t ~ Compose m f => t -> g (Domain t) (Domain t) -> m (g f f)
 
 -- | Like 'Data.Functor.Product.Product' for data types with two type constructor parameters
-data Product g1 g2 (p :: * -> *) (q :: * -> *) = Pair{fst :: q (g1 p p),
-                                                      snd :: q (g2 p p)}
+data Product g h (d :: * -> *) (s :: * -> *) = Pair{fst :: s (g d d),
+                                                    snd :: s (h d d)}
 
-instance Rank2.Functor (Product g1 g2 p) where
+-- | Like 'Data.Functor.Sum.Sum' for data types with two type constructor parameters
+data Sum g h (d :: * -> *) (s :: * -> *) = InL (s (g d d))
+                                         | InR (s (h d d))
+
+instance Rank2.Functor (Product g h p) where
    f <$> ~(Pair left right) = Pair (f left) (f right)
 
 instance Rank2.Apply (Product g h p) where
@@ -68,6 +74,40 @@
                    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)
 
+instance Rank2.Functor (Sum g h p) where
+   f <$> InL left = InL (f left)
+   f <$> InR right = InR (f right)
+
+instance Rank2.Foldable (Sum g h p) where
+   foldMap f (InL left) = f left
+   foldMap f (InR right) = 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 (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 (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 (Full.Traversable t g, Full.Traversable t h, Codomain t ~ Compose m f, 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
+
+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)
+
 -- | 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 (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
@@ -6,7 +6,7 @@
 -- > $(Transformation.Deep.TH.deriveFunctor ''MyDataType)
 --
 
-{-# Language TemplateHaskell #-}
+{-# Language CPP, TemplateHaskell #-}
 -- Adapted from https://wiki.haskell.org/A_practical_Template_Haskell_Tutorial
 
 module Transformation.Deep.TH (deriveAll, deriveFunctor, deriveTraversable)
@@ -95,11 +95,18 @@
       NewtypeD _ nm tyVars kind c _ -> return (nm, tyVars, kind, [c])
       _ -> fail "deriveApply: tyCon may not be a type synonym."
 
+#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
+       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
-       instanceType           = foldl apply (conT tyConName) (reverse $ drop 2 $ reverse tyVars)
        apply t (PlainTV name)    = appT t (varT name)
        apply t (KindedTV name _) = appT t (varT name)
+#endif
+       instanceType           = foldl apply (conT tyConName) (reverse $ drop 2 $ reverse tyVars)
 
    putQ (Deriving tyConName tyVar' tyVar)
    return (instanceType, cs)
diff --git a/src/Transformation/Full.hs b/src/Transformation/Full.hs
--- a/src/Transformation/Full.hs
+++ b/src/Transformation/Full.hs
@@ -22,6 +22,7 @@
 -- | Like "Transformation.Deep".'Deep.Functor' except it maps an additional wrapper around the entire tree
 class (Transformation t, Rank2.Functor (g (Domain t))) => Functor t g where
    (<$>) :: t -> Domain t (g (Domain t) (Domain t)) -> Codomain t (g (Codomain t) (Codomain t))
+   infixl 4 <$>
 
 -- | Like "Transformation.Deep".'Deep.Foldable' except the entire tree is also wrapped
 class (Transformation t, Rank2.Foldable (g (Domain t))) => Foldable t g where
@@ -49,9 +50,9 @@
                                          Codomain t ~ Const m, Data.Foldable.Foldable (Domain t), Monoid m)
                                      => t -> Domain t (g (Domain t) (Domain t)) -> m
 -- | Default implementation for 'foldMap' that folds the wrapper and then the tree
-foldMapDownDefault t x = getConst (t Transformation.$ x) <> Data.Foldable.foldMap (Deep.foldMap t) x
+foldMapDownDefault t x = getConst (t Transformation.$ x) `mappend` Data.Foldable.foldMap (Deep.foldMap t) x
 -- | Default implementation for 'foldMap' that folds the tree and then the wrapper
-foldMapUpDefault   t x = Data.Foldable.foldMap (Deep.foldMap t) x <> getConst (t Transformation.$ x)
+foldMapUpDefault   t x = Data.Foldable.foldMap (Deep.foldMap t) x `mappend` getConst (t Transformation.$ x)
 
 -- | Default implementation for 'traverse' that traverses the wrapper and then the tree
 traverseDownDefault :: (Deep.Traversable t g, t `Transformation.At` g (Domain t) (Domain t),
diff --git a/src/Transformation/Rank2.hs b/src/Transformation/Rank2.hs
--- a/src/Transformation/Rank2.hs
+++ b/src/Transformation/Rank2.hs
@@ -15,6 +15,7 @@
 -- | 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
 (<$>) f = (Deep.<$>) (Map f)
+infixl 4 <$>
 
 -- | Fold the containing functor of every node in the given tree.
 foldMap :: (Deep.Foldable (Fold p m) g, Monoid m) => (forall a. p a -> m) -> g p p -> m
diff --git a/src/Transformation/Shallow.hs b/src/Transformation/Shallow.hs
--- a/src/Transformation/Shallow.hs
+++ b/src/Transformation/Shallow.hs
@@ -18,6 +18,7 @@
 -- | Like Rank2.'Rank2.Functor' except it takes a 'Transformation' instead of a polymorphic function
 class (Transformation t, Rank2.Functor g) => Functor t g where
    (<$>) :: t -> g (Domain t) -> g (Codomain t)
+   infixl 4 <$>
 
 -- | Like Rank2.'Rank2.Foldable' except it takes a 'Transformation' instead of a polymorphic function
 class (Transformation t, Rank2.Foldable g) => Foldable t g where
@@ -31,7 +32,7 @@
    t <$> Rank2.Pair left right = Rank2.Pair (t <$> left) (t <$> right)
 
 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 <> foldMap t right
+   foldMap t (Rank2.Pair left right) = foldMap t left `mappend` foldMap t right
 
 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)
diff --git a/src/Transformation/Shallow/TH.hs b/src/Transformation/Shallow/TH.hs
--- a/src/Transformation/Shallow/TH.hs
+++ b/src/Transformation/Shallow/TH.hs
@@ -6,7 +6,7 @@
 -- > $(Transformation.Shallow.TH.deriveFunctor ''MyDataType)
 --
 
-{-# Language TemplateHaskell #-}
+{-# Language CPP, TemplateHaskell #-}
 -- Adapted from https://wiki.haskell.org/A_practical_Template_Haskell_Tutorial
 
 module Transformation.Shallow.TH (deriveAll, deriveFunctor, deriveFoldable, deriveTraversable)
@@ -91,10 +91,17 @@
       NewtypeD _ nm tyVars kind c _ -> return (nm, tyVars, kind, [c])
       _ -> fail "deriveApply: tyCon may not be a type synonym."
 
+#if MIN_VERSION_template_haskell(2,17,0)
+   let (KindedTV tyVar _ (AppT (AppT ArrowT StarT) StarT) : _) = reverse tyVars
+       instanceType           = foldl apply (conT tyConName) (reverse $ drop 1 $ 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) : _) = reverse tyVars
        instanceType           = foldl apply (conT tyConName) (reverse $ drop 1 $ reverse tyVars)
        apply t (PlainTV name)    = appT t (varT name)
        apply t (KindedTV name _) = appT t (varT name)
+#endif
 
    putQ (Deriving tyConName tyVar)
    return (instanceType, cs)
@@ -257,6 +264,8 @@
      AppT ty a | ty == VarT typeVar ->
         (,) <$> ((:[]) <$> baseConstraint (pure a))
             <*> (wrap (varE '(Transformation.$) `appE` trans) `appE` fieldAccess)
+     AppT t1 t2 | t2 == VarT typeVar -> (,) <$> traverse shallowConstraint [pure t1]
+                                            <*> appE (wrap [| ($trans Transformation.Shallow.<$>) |]) fieldAccess
      AppT t1 t2 | t1 /= VarT typeVar ->
         genShallowmapField trans t2 shallowConstraint baseConstraint fieldAccess (wrap . appE (varE '(<$>)))
      SigT ty _kind -> genShallowmapField trans ty shallowConstraint baseConstraint fieldAccess wrap
@@ -272,6 +281,8 @@
         (,) <$> ((:[]) <$> baseConstraint (pure a))
             <*> (wrap (varE '(.) `appE` varE 'getConst `appE` (varE '(Transformation.$) `appE` trans))
                  `appE` fieldAccess)
+     AppT t1 t2 | t2 == VarT typeVar -> (,) <$> traverse shallowConstraint [pure t1]
+                                            <*> appE (wrap [| (Transformation.Shallow.foldMap $trans) |]) fieldAccess
      AppT t1 t2 | t1 /= VarT typeVar ->
                   genFoldMapField trans t2 shallowConstraint baseConstraint fieldAccess (wrap . appE (varE 'foldMap))
      SigT ty _kind -> genFoldMapField trans ty shallowConstraint baseConstraint fieldAccess wrap
@@ -286,6 +297,8 @@
         (,) <$> ((:[]) <$> baseConstraint (pure a))
             <*> (wrap (varE '(.) `appE` varE 'getCompose `appE` (varE '(Transformation.$) `appE` trans))
                  `appE` fieldAccess)
+     AppT t1 t2 | t2 == VarT typeVar -> (,) <$> traverse shallowConstraint [pure t1]
+                                            <*> appE (wrap [| (Transformation.Shallow.traverse $trans) |]) fieldAccess
      AppT t1 t2 | t1 /= VarT typeVar ->
         genTraverseField trans t2 shallowConstraint baseConstraint fieldAccess (wrap . appE (varE 'traverse))
      SigT ty _kind -> genTraverseField trans ty shallowConstraint baseConstraint fieldAccess wrap
diff --git a/test/README.lhs b/test/README.lhs
--- a/test/README.lhs
+++ b/test/README.lhs
@@ -31,6 +31,7 @@
 import Data.Coerce (coerce)
 import Data.Functor.Const
 import Data.Functor.Identity
+import Data.Monoid
 import qualified Rank2
 import Transformation (Transformation, At)
 import qualified Transformation
@@ -279,11 +280,17 @@
    type Domain DeadCodeEliminator = Identity
    type Codomain DeadCodeEliminator = AG.Semantics DeadCodeEliminator
 
+instance DeadCodeEliminator `Transformation.At` Decl Sem Sem where
+  ($) = AG.applyDefault runIdentity
+
+instance DeadCodeEliminator `Transformation.At` Expr Sem Sem where
+  ($) = AG.applyDefault runIdentity
+
 instance Full.Functor DeadCodeEliminator Decl where
-  (<$>) = AG.fullMapDefault runIdentity
+  (<$>) = Full.mapUpDefault
 
 instance Full.Functor DeadCodeEliminator Expr where
-  (<$>) = AG.fullMapDefault runIdentity
+  (<$>) = Full.mapUpDefault
 ~~~
 
 We also need another bit of a boilerplate instance that can be automatically generated with Template Haskell functions
@@ -359,11 +366,11 @@
 because they don't have any children.
 
 ~~~ {.haskell}
-instance AG.Attribution DeadCodeEliminator Expr Identity Identity where
-  attribution DeadCodeEliminator (Identity e@(EVar v)) (AG.Inherited env, _) =
-    (AG.Synthesized (maybe e id $ env v), EVar v)
-  attribution DeadCodeEliminator (Identity e@(Con n)) (AG.Inherited env, _) =
-    (AG.Synthesized e, Con n)
+instance AG.Attribution DeadCodeEliminator Expr Sem Identity where
+  attribution DeadCodeEliminator (Identity (EVar v)) (AG.Inherited env, _) =
+    (AG.Synthesized (maybe (EVar v) id $ env v), EVar v)
+  attribution DeadCodeEliminator (Identity (Con n)) (AG.Inherited env, _) =
+    (AG.Synthesized (Con n), Con n)
 ~~~
 
 The `Add` and `Mul` nodes' rules need only to pass their inheritance down and to re-join the synthesized child
@@ -388,7 +395,7 @@
   attribution DeadCodeEliminator (Identity (Let _decl expr))
               (AG.Inherited env, (Let (AG.Synthesized ~(env', decl')) (AG.Synthesized expr'))) =
     (AG.Synthesized (maybe id (bin Let) decl' expr'),
-     Let (AG.Inherited (env, Full.foldMap GetVariables expr)) (AG.Inherited $ \v-> env' v <|> env v))
+     Let (AG.Inherited (env, Deep.foldMap GetVariables expr')) (AG.Inherited $ \v-> env' v <|> env v))
 ~~~
 
 ### Declaration rules
@@ -396,7 +403,7 @@
 The rules for `Decl` are a bit more involved.
 
 ~~~ {.haskell}
-instance AG.Attribution DeadCodeEliminator Decl Identity Identity where
+instance AG.Attribution DeadCodeEliminator Decl Sem Identity where
 ~~~
 
 A single variable binding can be in three distinct situations. If the variable is not referenced at all, we can just
diff --git a/test/RepMin.hs b/test/RepMin.hs
--- a/test/RepMin.hs
+++ b/test/RepMin.hs
@@ -1,4 +1,4 @@
-{-# Language FlexibleInstances, MultiParamTypeClasses, RankNTypes, StandaloneDeriving, 
+{-# Language FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, RankNTypes, StandaloneDeriving,
              TypeFamilies, UndecidableInstances #-}
 
 -- | The RepMin example - replicate a binary tree with all leaves replaced by the minimal leaf value.
@@ -35,7 +35,7 @@
    Leaf f <*> ~(Leaf x) = Leaf (Rank2.apply f x)
 
 instance Rank2.Applicative (Tree a f') where
-   pure = Leaf
+   pure x = Leaf x
 
 instance Rank2.Apply (Root a f') where
    Root f <*> ~(Root x) = Root (Rank2.apply f x)
@@ -50,9 +50,11 @@
 -- | The transformation type
 data RepMin = RepMin
 
+type Sem = AG.Semantics RepMin
+
 instance Transformation RepMin where
    type Domain RepMin = Identity
-   type Codomain RepMin = AG.Semantics RepMin
+   type Codomain RepMin = Sem
 
 -- | Inherited attributes' type
 data InhRepMin = InhRepMin{global :: Int}
@@ -68,24 +70,29 @@
 type instance AG.Atts (Inherited RepMin) (Root Int f' f) = ()
 type instance AG.Atts (Synthesized RepMin) (Root Int f' f) = SynRepMin
 
-type instance AG.Atts (Inherited a) Int = ()
-type instance AG.Atts (Synthesized a) Int = Int
+type instance AG.Atts (Inherited RepMin) Int = ()
+type instance AG.Atts (Synthesized RepMin) Int = Int
 
+instance Transformation.At RepMin (Tree Int Sem Sem) where
+  ($) = AG.applyDefault runIdentity
+instance Transformation.At RepMin (Root Int Sem Sem) where
+  ($) = AG.applyDefault runIdentity
+
 instance Full.Functor RepMin (Tree Int) where
-  (<$>) = AG.fullMapDefault runIdentity
+  (<$>) = Full.mapUpDefault
 instance Full.Functor RepMin (Root Int) where
-  (<$>) = AG.fullMapDefault runIdentity
+  (<$>) = Full.mapUpDefault
 
 -- | The semantics of the primitive 'Int' type must be defined manually.
 instance Transformation.At RepMin Int where
    RepMin $ Identity n = Rank2.Arrow (const $ Synthesized n)
 
-instance AG.Attribution RepMin (Root Int) Identity Identity where
+instance AG.Attribution RepMin (Root Int) Sem Identity where
    attribution RepMin self (inherited, Root root) = (Synthesized SynRepMin{local= local (syn root),
                                                                            tree= tree (syn root)},
                                                      Root{root= Inherited InhRepMin{global= local (syn root)}})
 
-instance AG.Attribution RepMin (Tree Int) Identity Identity where
+instance AG.Attribution RepMin (Tree Int) Sem Identity where
    attribution _ _ (inherited, Fork left right) = (Synthesized SynRepMin{local= local (syn left)
                                                                                 `min` local (syn right),
                                                                          tree= tree (syn left) `fork` tree (syn right)},
diff --git a/test/RepMinAuto.hs b/test/RepMinAuto.hs
--- a/test/RepMinAuto.hs
+++ b/test/RepMinAuto.hs
@@ -1,4 +1,4 @@
-{-# Language DataKinds, DeriveGeneric, DuplicateRecordFields, FlexibleInstances, MultiParamTypeClasses, RankNTypes,
+{-# Language DataKinds, DeriveGeneric, DuplicateRecordFields, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, RankNTypes,
              StandaloneDeriving, TemplateHaskell, TypeFamilies, UndecidableInstances #-}
 
 -- | The RepMin example with automatic derivation of attributes.
@@ -36,10 +36,6 @@
         [Rank2.TH.deriveFunctor, Rank2.TH.deriveFoldable, Rank2.TH.deriveTraversable, Rank2.TH.unsafeDeriveApply,
          Transformation.Shallow.TH.deriveAll, Transformation.Deep.TH.deriveAll]))
 
-instance (Transformation t, Transformation.At t a, Transformation.At t (Tree a (Codomain t) (Codomain t)),
-          Functor (Domain t)) => Full.Functor t (Tree a) where
-   (<$>) = Full.mapUpDefault
-
 -- | The transformation type. It will always appear wrapped in 'Auto' to enable automatic attribute derivation.
 data RepMin = RepMin
 
@@ -50,6 +46,9 @@
    type Domain (Auto RepMin) = Identity
    type Codomain (Auto RepMin) = Sem
 
+instance AG.Revelation (Auto RepMin) where
+   reveal (Auto RepMin) = runIdentity
+   
 -- | Inherited attributes' type
 data InhRepMin = InhRepMin{global :: Int}
                deriving (Generic, Show)
@@ -66,18 +65,13 @@
                              tree :: AG.Mapped Identity Int}
                   deriving (Generic, Show)
 
-type instance AG.Atts (Inherited (Auto RepMin)) (Tree Int f' f) = InhRepMin
-type instance AG.Atts (Synthesized (Auto RepMin)) (Tree Int f' f) = SynRepMin Tree
-type instance AG.Atts (Inherited (Auto RepMin)) (Root Int f' f) = ()
-type instance AG.Atts (Synthesized (Auto RepMin)) (Root Int f' f) = SynRepMin Root
-
-type instance AG.Atts (Inherited a) Int = InhRepMin
-type instance AG.Atts (Synthesized a) Int = SynRepLeaf
+type instance AG.Atts (Inherited RepMin) (Tree Int f' f) = InhRepMin
+type instance AG.Atts (Synthesized RepMin) (Tree Int f' f) = SynRepMin Tree
+type instance AG.Atts (Inherited RepMin) (Root Int f' f) = ()
+type instance AG.Atts (Synthesized RepMin) (Root Int f' f) = SynRepMin Root
 
-instance Transformation.At (Auto RepMin) (Tree Int Sem Sem) where
-   ($) = AG.applyDefault runIdentity
-instance Transformation.At (Auto RepMin) (Root Int Sem Sem) where
-   ($) = AG.applyDefault runIdentity
+type instance AG.Atts (Inherited RepMin) Int = InhRepMin
+type instance AG.Atts (Synthesized RepMin) Int = SynRepLeaf
 
 -- | The semantics of the primitive 'Int' type must be defined manually.
 instance Transformation.At (Auto RepMin) Int where