diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,26 @@
+Copyright (c) 2016, Mario Blažević
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the
+   distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,193 @@
+Rank 2 Classes
+==============
+
+### The standard constructor type classes in the parallel rank-2 universe ###
+
+The rank2 package exports module `Rank2`, meant to be imported qualified like this:
+
+~~~ {.haskell}
+{-# LANGUAGE RankNTypes, TemplateHaskell #-}
+module MyModule where
+import qualified Rank2
+import qualified Rank2.TH
+~~~
+
+Several more imports for the examples...
+
+~~~ {.haskell}
+import Data.Functor.Classes (Show1, showsPrec1)
+import Data.Functor.Identity (Identity(..))
+import Data.Functor.Const (Const(..))
+import Data.List (find)
+~~~
+
+The `Rank2` import will make available the following type classes:
+  * [Rank2.Functor](http://hackage.haskell.org/packages/rank2/doc/html/Rank2.html#t:Functor)
+  * [Rank2.Apply](http://hackage.haskell.org/packages/rank2/doc/html/Rank2.html#t:Apply)
+  * [Rank2.Applicative](http://hackage.haskell.org/packages/rank2/doc/html/Rank2.html#t:Applicative)
+  * [Rank2.Foldable](http://hackage.haskell.org/packages/archive/doc/html/Rank2.html#t:Foldable)
+  * [Rank2.Traversable](http://hackage.haskell.org/packages/archive/doc/html/Rank2.html#t:Traversable)
+  * [Rank2.Distributive](http://hackage.haskell.org/packages/archive/doc/html/Rank2.html#t:Distributive)
+
+The methods of these type classes all have rank-2 types. The class instances are data types of kind `(* -> *) -> *`, one
+example of which would be a database record with different field types but all wrapped by the same type constructor:
+
+~~~ {.haskell}
+data Person f = Person{
+   name           :: f String,
+   age            :: f Int,
+   mother, father :: f (Maybe PersonVerified)
+   }
+~~~
+
+By wrapping each field we have declared a generalized record type. It can made to play different roles by switching the
+value of the parameter `f`. Some examples would be
+
+~~~ {.haskell}
+type PersonVerified = Person Identity
+type PersonText = Person (Const String)
+type PersonWithErrors = Person (Either String)
+type PersonDatabase = [PersonVerified]
+type PersonDatabaseByColumns = Person []
+~~~
+
+If you wish to have the standard [Eq](http://hackage.haskell.org/package/base/docs/Data-Eq.html#t:Eq) and
+[Show](http://hackage.haskell.org/package/base/docs/Text-Show.html#t:Show) instances for a record type like `Person`,
+it's best if they refer to the [Eq1](http://hackage.haskell.org/package/base-4.9.1.0/docs/Data-Functor-Classes.html#t:Eq1)
+and [Show1](http://hackage.haskell.org/package/base-4.9.1.0/docs/Data-Functor-Classes.html#t:Show1) instances for its
+parameter `f`:
+
+~~~ {.haskell}
+instance Show1 f => Show (Person f) where
+   showsPrec prec person rest = "Person{" ++ separator ++ "name=" ++ showsPrec1 prec' (name person)
+                                     ("," ++ separator ++ "age=" ++ showsPrec1 prec' (age person)
+                                     ("," ++ separator ++ "mother=" ++ showsPrec1 prec' (mother person)
+                                     ("," ++ separator ++ "father=" ++ showsPrec1 prec' (father person)
+                                     ("}" ++ rest))))
+        where prec' = succ prec
+              separator = "\n" ++ replicate prec' ' '
+~~~
+
+You can create the rank-2 class instances for your data types manually, or you can generate the instances using the
+templates imported from the `Rank2.TH` module with a single line of code per data type:
+
+~~~ {.haskell}
+$(Rank2.TH.deriveAll ''Person)
+~~~
+
+Either way, once you have the rank-2 type class instances, you can use them to easily convert between records with
+different parameters `f`.
+
+### Record construction and modification examples ###
+
+In case of our `Person` record, a couple of helper functions will prove handy:
+
+~~~ {.haskell}
+findPerson :: PersonDatabase -> String -> Maybe PersonVerified
+findPerson db nameToFind = find ((nameToFind ==) . runIdentity . name) db
+   
+personByName :: PersonDatabase -> String -> Either String (Maybe PersonVerified)
+personByName db personName
+   | null personName = Right Nothing
+   | p@Just{} <- findPerson db personName = Right p
+   | otherwise = Left ("Nobody by name of " ++ personName)
+~~~
+
+Now we can start by constructing a `Person` record with rank-2 functions for fields. This record is not so much a person
+as a field-by-field person verifier:
+ 
+~~~ {.haskell}
+personChecker :: PersonDatabase -> Person (Rank2.Arrow (Const String) (Either String))
+personChecker db =
+   Person{name= Rank2.Arrow (Right . getConst),
+          age= Rank2.Arrow $ \(Const age)->
+               case reads age
+               of [(n, "")] -> Right n
+                  _ -> Left (age ++ " is not an integer"),
+          mother= Rank2.Arrow (personByName db . getConst),
+          father= Rank2.Arrow (personByName db . getConst)}
+~~~
+
+We can apply it using the [Rank2.<*>](http://hackage.haskell.org/packages/rank2/doc/html/Rank2.html#v:-60--42--62-)
+method of the [Rank2.Apply](http://hackage.haskell.org/packages/rank2/doc/html/Rank2.html#t:Apply) type class to a bunch
+of textual fields for `Person`, and get back either errors or proper field values:
+
+~~~ {.haskell}
+verify :: PersonDatabase -> PersonText -> PersonWithErrors
+verify db person = personChecker db Rank2.<*> person
+~~~
+
+If there are no errors, we can get a fully verified record by applying
+[Rank2.traverse](http://hackage.haskell.org/packages/rank2/doc/html/Rank2.html#v:traverse) to the result:
+
+~~~ {.haskell}
+completeVerified :: PersonWithErrors -> Either String PersonVerified
+completeVerified = Rank2.traverse (Identity <$>)
+~~~
+
+or we can go in the opposite direction with
+[Rank2.<$>](http://hackage.haskell.org/packages/rank2/doc/html/Rank2.html#v:-60--36--62-):
+
+~~~ {.haskell}
+uncompleteVerified :: PersonVerified -> PersonWithErrors
+uncompleteVerified = Rank2.fmap (Right . runIdentity)
+~~~
+
+If on the other hand there *are* errors, we can collect them using
+[Rank2.foldMap](http://hackage.haskell.org/packages/rank2/doc/html#v:foldMap):
+
+~~~ {.haskell}
+verificationErrors :: PersonWithErrors -> [String]
+verificationErrors = Rank2.foldMap (either (:[]) (const []))
+~~~
+
+Here is an example GHCi session:
+
+~~~ {.haskell}
+-- |
+-- >>> let Right alice = completeVerified $ verify [] Person{name= Const "Alice", age= Const "44", mother= Const "", father= Const ""}
+-- >>> let Right bob = completeVerified $ verify [] Person{name= Const "Bob", age= Const "45", mother= Const "", father= Const ""}
+-- >>> let Right charlie = completeVerified $ verify [alice, bob] Person{name= Const "Charlie", age= Const "19", mother= Const "Alice", father= Const "Bob"}
+-- >>> charlie
+-- Person{
+--  name=Identity "Charlie",
+--  age=Identity 19,
+--  mother=Identity (Just Person{
+--             name=(Identity "Alice"),
+--             age=(Identity 44),
+--             mother=(Identity Nothing),
+--             father=(Identity Nothing)}),
+--  father=Identity (Just Person{
+--             name=(Identity "Bob"),
+--             age=(Identity 45),
+--             mother=(Identity Nothing),
+--             father=(Identity Nothing)})}
+-- >>> let dave = verify [alice, bob, charlie] Person{name= Const "Eve", age= Const "young", mother= Const "Lise", father= Const "Mike"}
+-- >>> dave
+-- Person{
+--  name=Right "Eve",
+--  age=Left "young is not an integer",
+--  mother=Left "Nobody by name of Lise",
+--  father=Left "Nobody by name of Mike"}
+-- >>> completeVerified dave
+-- Left "young is not an integer"
+-- >>> verificationErrors  dave
+-- ["young is not an integer","Nobody by name of Lise","Nobody by name of Mike"]
+-- >>> Rank2.distribute [alice, bob, charlie]
+-- Person{
+--  name=Compose [Identity "Alice",Identity "Bob",Identity "Charlie"],
+--  age=Compose [Identity 44,Identity 45,Identity 19],
+--  mother=Compose [Identity Nothing,Identity Nothing,Identity (Just Person{
+--             name=(Identity "Alice"),
+--             age=(Identity 44),
+--             mother=(Identity Nothing),
+--             father=(Identity Nothing)})],
+--  father=Compose [Identity Nothing,Identity Nothing,Identity (Just Person{
+--             name=(Identity "Bob"),
+--             age=(Identity 45),
+--             mother=(Identity Nothing),
+--             father=(Identity Nothing)})]}
+~~~
+
+Grammars are another use case that is almost, but not quite, completely unlike database records. See
+[grammatical-parsers](https://github.com/blamario/grampa/tree/master/grammatical-parsers) about that.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/rank2classes.cabal b/rank2classes.cabal
new file mode 100644
--- /dev/null
+++ b/rank2classes.cabal
@@ -0,0 +1,43 @@
+name:                rank2classes
+version:             0.1
+synopsis:            a mirror image of some standard type classes, with methods of rank 2 types
+description:
+  A mirror image of the standard constructor type class hierarchy rooted in 'Functor', except with methods of rank 2
+  types and class instances of kind @(*->*)->*@. The classes enable generic handling of heterogenously typed data
+  structures and other neat tricks.
+
+homepage:            https://github.com/blamario/grampa/tree/master/rank2classes
+bug-reports:         https://github.com/blamario/grampa/issues
+license:             BSD3
+license-file:        LICENSE
+author:              Mario Blažević
+maintainer:          Mario Blažević <blamario@protonmail.com>
+copyright:           (c) 2017 Mario Blažević
+category:            Control, Data, Generics
+build-type:          Simple
+-- extra-source-files:  
+cabal-version:       >=1.10
+extra-source-files:  README.md
+source-repository head
+  type:              git
+  location:          https://github.com/blamario/grampa
+
+library
+  hs-source-dirs:      src
+  exposed-modules:     Rank2, Rank2.TH
+  default-language:    Haskell2010
+  -- other-modules:
+  ghc-options:         -Wall
+  build-depends:       base >=4.7 && <5,
+                       template-haskell >= 2.11 && < 2.12,
+                       transformers >= 0.5 && < 0.6
+  -- hs-source-dirs:      
+  default-language:    Haskell2010
+
+test-suite doctests
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      test
+  default-language:    Haskell2010
+  main-is:             Doctest.hs
+  ghc-options:         -threaded -pgmL markdown-unlit
+  build-depends:       base, rank2classes, doctest >= 0.8
diff --git a/src/Rank2.hs b/src/Rank2.hs
new file mode 100644
--- /dev/null
+++ b/src/Rank2.hs
@@ -0,0 +1,201 @@
+-- | Import this module qualified, like this:
+-- 
+-- > import qualified Rank2
+-- 
+-- This will bring into scope the standard classes 'Functor', 'Applicative', 'Foldable', and 'Traversable', but with a
+-- @Rank2.@ prefix and a twist that their methods operate on a heterogenous collection. The same property is shared by
+-- the two less standard classes 'Apply' and 'Distributive'.
+{-# LANGUAGE InstanceSigs, KindSignatures, Rank2Types, ScopedTypeVariables #-}
+module Rank2 (
+-- * Rank 2 classes
+   Functor(..), Apply(..), Applicative(..),
+   Foldable(..), Traversable(..), Distributive(..),
+-- * Rank 2 data types
+   Compose(..), Empty(..), Only(..), Identity(..), Product(..), Arrow(..),
+-- * Method synonyms and helper functions
+   ap, fmap, liftA3)
+where
+
+import qualified Control.Applicative as Rank1
+import qualified Control.Monad as Rank1
+import qualified Data.Foldable as Rank1
+import qualified Data.Traversable as Rank1
+import Data.Monoid (Monoid(..), (<>))
+import Data.Functor.Compose (Compose(..))
+
+import Prelude hiding (Foldable(..), Traversable(..), Functor(..), Applicative(..), (<$>), fst, snd)
+
+-- | Equivalent of 'Functor' for rank 2 data types
+class Functor g where
+   (<$>) :: (forall a. p a -> q a) -> g p -> g q
+
+-- | Alphabetical synonym for '<$>'
+fmap :: Functor g => (forall a. p a -> q a) -> g p -> g q
+fmap = (<$>)
+
+-- | Equivalent of 'Foldable' for rank 2 data types
+class Foldable g where
+   foldMap :: Monoid m => (forall a. p a -> m) -> g p -> m
+
+-- | Equivalent of 'Traversable' for rank 2 data types
+class (Functor g, Foldable g) => Traversable g where
+   {-# MINIMAL traverse | sequence #-}
+   traverse :: Rank1.Applicative m => (forall a. p a -> m (q a)) -> g p -> m (g q)
+   sequence :: Rank1.Applicative m => g (Compose m p) -> m (g p)
+   traverse f = sequence . fmap (Compose . f)
+   sequence = traverse getCompose
+
+-- | Wrapper for functions that map the argument constructor type
+newtype Arrow p q a = Arrow{apply :: p a -> q a}
+
+-- | Subclass of 'Functor' halfway to 'Applicative'
+--
+-- > (.) <$> u <*> v <*> w == u <*> (v <*> w)
+class Functor g => Apply g where
+   {-# MINIMAL liftA2 | (<*>) #-}
+   -- | Equivalent of 'Rank1.<*>' for rank 2 data types
+   (<*>) :: g (Arrow p q) -> g p -> g q
+   -- | Equivalent of 'Rank1.liftA2' for rank 2 data types
+   liftA2 :: (forall a. p a -> q a -> r a) -> g p -> g q -> g r
+
+   (<*>) = liftA2 apply
+   liftA2 f g h = (Arrow . f) <$> g <*> h
+
+-- | Alphabetical synonym for '<*>'
+ap :: Apply g => g (Arrow p q) -> g p -> g q
+ap = (<*>)
+
+-- | Equivalent of 'Rank1.liftA3' for rank 2 data types
+liftA3 :: Apply g => (forall a. p a -> q a -> r a -> s a) -> g p -> g q -> g r -> g s
+liftA3 f g h i = (\x-> Arrow (Arrow . f x)) <$> g <*> h <*> i
+
+-- | Equivalent of 'Rank1.Applicative' for rank 2 data types
+class Apply g => Applicative g where
+   pure :: (forall a. f a) -> g f
+
+-- | Equivalent of 'Distributive' for rank 2 data types
+class Functor g => Distributive g where
+   {-# MINIMAL distributeWith #-}
+   collect :: Rank1.Functor f1 => (a -> g f2) -> f1 a -> g (Compose f1 f2)
+   distribute :: Rank1.Functor f1 => f1 (g f2) -> g (Compose f1 f2)
+   distributeWith :: Rank1.Functor f1 => (forall x. f1 (f2 x) -> f x) -> f1 (g f2) -> g f
+   distributeM :: Rank1.Monad f => f (g f) -> g f
+
+   collect f = distribute . Rank1.fmap f
+   distribute = distributeWith Compose
+   distributeM = distributeWith Rank1.join
+
+-- | A rank-2 equivalent of '()', a zero-element tuple
+data Empty (f :: * -> *) = Empty deriving (Eq, Ord, Show)
+
+-- | A rank-2 tuple of only one element
+newtype Only a (f :: * -> *) = Only {fromOnly :: f a} deriving (Eq, Ord, Show)
+
+-- | Equivalent of 'Data.Functor.Identity' for rank 2 data types
+newtype Identity g (f :: * -> *) = Identity {runIdentity :: g f} deriving (Eq, Ord, Show)
+
+-- | Equivalent of 'Data.Functor.Product' for rank 2 data types
+data Product g h (f :: * -> *) = Pair {fst :: g f,
+                                       snd :: h f}
+                               deriving (Eq, Ord, Show)
+
+newtype Flip g a f = Flip (g (f a)) deriving (Eq, Ord, Show)
+
+instance Monoid (g (f a)) => Monoid (Flip g a f) where
+   mempty = Flip mempty
+   Flip x `mappend` Flip y = Flip (x `mappend` y)
+
+instance Rank1.Functor g => Rank2.Functor (Flip g a) where
+   f <$> Flip g = Flip (f Rank1.<$> g)
+
+instance Rank1.Applicative g => Rank2.Apply (Flip g a) where
+   Flip g <*> Flip h = Flip (apply Rank1.<$> g Rank1.<*> h)
+
+instance Rank1.Applicative g => Rank2.Applicative (Flip g a) where
+   pure f = Flip (Rank1.pure f)
+
+instance Rank1.Foldable g => Rank2.Foldable (Flip g a) where
+   foldMap f (Flip g) = Rank1.foldMap f g
+
+instance Rank1.Traversable g => Rank2.Traversable (Flip g a) where
+   traverse f (Flip g) = Flip Rank1.<$> Rank1.traverse f g
+
+instance Functor Empty where
+   _ <$> _ = Empty
+
+instance Functor (Only a) where
+   f <$> Only a = Only (f a)
+
+instance Functor g => Functor (Identity g) where
+   f <$> Identity g = Identity (f <$> g)
+
+instance (Functor g, Functor h) => Functor (Product g h) where
+   f <$> g = Pair (f <$> fst g) (f <$> snd g)
+
+instance Foldable Empty where
+   foldMap _ _ = mempty
+
+instance Foldable (Only x) where
+   foldMap f (Only x) = f x
+
+instance Foldable g => Foldable (Identity g) where
+   foldMap f (Identity g) = foldMap f g
+
+instance (Foldable g, Foldable h) => Foldable (Product g h) where
+   foldMap f ~(Pair g h) = foldMap f g <> foldMap f h
+
+instance Traversable Empty where
+   traverse _ _ = Rank1.pure Empty
+
+instance Traversable (Only x) where
+   traverse f (Only x) = Only Rank1.<$> f x
+
+instance Traversable g => Traversable (Identity g) where
+   traverse f (Identity g) = Identity Rank1.<$> traverse f g
+
+instance (Traversable g, Traversable h) => Traversable (Product g h) where
+   traverse f ~(Pair g h) = Rank1.liftA2 Pair (traverse f g) (traverse f h)
+
+instance Apply Empty where
+   _ <*> _ = Empty
+   liftA2 _ _ _ = Empty
+
+instance Apply (Only x) where
+   Only f <*> Only x = Only (apply f x)
+   liftA2 f (Only x) (Only y) = Only (f x y)
+
+instance Apply g => Apply (Identity g) where
+   Identity g <*> Identity h = Identity (g <*> h)
+   liftA2 f (Identity g) (Identity h) = Identity (liftA2 f g h)
+
+instance (Apply g, Apply h) => Apply (Product g h) where
+   gf <*> gx = Pair (fst gf <*> fst gx) (snd gf <*> snd gx)
+   liftA2 f ~(Pair g1 g2) ~(Pair h1 h2) = Pair (liftA2 f g1 h1) (liftA2 f g2 h2)
+
+instance Applicative Empty where
+   pure = const Empty
+
+instance Applicative (Only x) where
+   pure = Only
+
+instance Applicative g => Applicative (Identity g) where
+   pure f = Identity (pure f)
+
+instance (Applicative g, Applicative h) => Applicative (Product g h) where
+   pure f = Pair (pure f) (pure f)
+
+instance Distributive Empty where
+   distributeWith _ _ = Empty
+   distributeM _ = Empty
+
+instance Distributive (Only x) where
+   distributeWith w f = Only (w $ Rank1.fmap fromOnly f)
+   distributeM f = Only (f >>= fromOnly)
+
+instance Distributive g => Distributive (Identity g) where
+   distributeWith w f = Identity (distributeWith w $ Rank1.fmap runIdentity f)
+   distributeM f = Identity (distributeM $ Rank1.fmap runIdentity f)
+
+instance (Distributive g, Distributive h) => Distributive (Product g h) where
+   distributeWith w f = Pair (distributeWith w $ Rank1.fmap fst f) (distributeWith w $ Rank1.fmap snd f)
+   distributeM f = Pair (distributeM $ Rank1.fmap fst f) (distributeM $ Rank1.fmap snd f)
diff --git a/src/Rank2/TH.hs b/src/Rank2/TH.hs
new file mode 100644
--- /dev/null
+++ b/src/Rank2/TH.hs
@@ -0,0 +1,263 @@
+-- | This module exports the templates for automatic instance deriving of "Rank2" type classes. The most common way to
+-- use it would be
+--
+-- > import qualified Rank2.TH
+-- > data MyDataType = ...
+-- > $(Rank2.TH.deriveAll ''MyDataType)
+--
+-- or, if you're picky, you can invoke only 'deriveFunctor' and whichever other instances you need instead.
+
+{-# Language TemplateHaskell #-}
+-- Adapted from https://wiki.haskell.org/A_practical_Template_Haskell_Tutorial
+
+module Rank2.TH (deriveAll, deriveFunctor, deriveApply, deriveApplicative,
+                 deriveFoldable, deriveTraversable, deriveDistributive)
+where
+
+import Control.Monad (replicateM)
+import Data.Monoid ((<>))
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax (BangType, VarBangType, getQ, putQ)
+
+import qualified Rank2
+
+data Deriving = Deriving { derivingConstructor :: Name, derivingVariable :: Name }
+
+deriveAll :: Name -> Q [Dec]
+deriveAll ty = foldr f (pure []) [deriveFunctor, deriveApply, deriveApplicative,
+                                  deriveFoldable, deriveTraversable, deriveDistributive]
+   where f derive rest = (<>) <$> derive ty <*> rest
+
+deriveFunctor :: Name -> Q [Dec]
+deriveFunctor ty = do
+   (instanceType, cs) <- reifyConstructors ''Rank2.Functor ty
+   sequence [instanceD (return []) instanceType [genFmap cs]]
+
+deriveApply :: Name -> Q [Dec]
+deriveApply ty = do
+   (instanceType, cs) <- reifyConstructors ''Rank2.Apply ty
+   sequence [instanceD (return []) instanceType [genAp cs]]
+
+deriveApplicative :: Name -> Q [Dec]
+deriveApplicative ty = do
+   (instanceType, cs) <- reifyConstructors ''Rank2.Applicative ty
+   sequence [instanceD (return []) instanceType [genPure cs]]
+
+deriveFoldable :: Name -> Q [Dec]
+deriveFoldable ty = do
+   (instanceType, cs) <- reifyConstructors ''Rank2.Foldable ty
+   sequence [instanceD (return []) instanceType [genFoldMap cs]]
+
+deriveTraversable :: Name -> Q [Dec]
+deriveTraversable ty = do
+   (instanceType, cs) <- reifyConstructors ''Rank2.Traversable ty
+   sequence [instanceD (return []) instanceType [genTraverse cs]]
+
+deriveDistributive :: Name -> Q [Dec]
+deriveDistributive ty = do
+   (instanceType, cs) <- reifyConstructors ''Rank2.Distributive ty
+   sequence [instanceD (return []) instanceType [genDistributeWith cs, genDistributeM cs]]
+
+reifyConstructors :: Name -> Name -> Q (TypeQ, [Con])
+reifyConstructors cls ty = do
+   (TyConI tyCon) <- reify ty
+   (tyConName, tyVars, _kind, cs) <- case tyCon of
+      DataD _ nm tyVars kind cs _   -> return (nm, tyVars, kind, cs)
+      NewtypeD _ nm tyVars kind c _ -> return (nm, tyVars, kind, [c])
+      _ -> fail "deriveApply: tyCon may not be a type synonym."
+ 
+   let (KindedTV tyVar (AppT (AppT ArrowT StarT) StarT)) = last tyVars
+       instanceType           = conT cls `appT` foldl apply (conT tyConName) (init tyVars)
+       apply t (PlainTV name)    = appT t (varT name)
+       apply t (KindedTV name _) = appT t (varT name)
+ 
+   putQ (Deriving tyConName tyVar)
+   return (instanceType, cs)
+
+genFmap :: [Con] -> Q Dec
+genFmap cs = funD '(Rank2.<$>) (map genFmapClause cs)
+
+genAp :: [Con] -> Q Dec
+genAp cs = funD '(Rank2.<*>) (map genApClause cs)
+
+genPure :: [Con] -> Q Dec
+genPure cs = funD 'Rank2.pure (map genPureClause cs)
+
+genFoldMap :: [Con] -> Q Dec
+genFoldMap cs = funD 'Rank2.foldMap (map genFoldMapClause cs)
+
+genTraverse :: [Con] -> Q Dec
+genTraverse cs = funD 'Rank2.traverse (map genTraverseClause cs)
+
+genDistributeM :: [Con] -> Q Dec
+genDistributeM cs = funD 'Rank2.distributeM (map genDistributeMClause cs)
+
+genDistributeWith :: [Con] -> Q Dec
+genDistributeWith cs = funD 'Rank2.distributeWith (map genDistributeWithClause cs)
+
+genFmapClause :: Con -> Q Clause
+genFmapClause (NormalC name fieldTypes) = do
+   f          <- newName "f"
+   fieldNames <- replicateM (length fieldTypes) (newName "x")
+   let pats = [varP f, tildeP (conP name $ map varP fieldNames)]
+       body = normalB $ appsE $ conE name : zipWith newField fieldNames fieldTypes
+       newField :: Name -> BangType -> Q Exp
+       newField x (_, fieldType) = do
+          Just (Deriving _ typeVar) <- getQ
+          case fieldType of
+             AppT ty _ | ty == VarT typeVar -> [| $(varE f) $(varE x) |]
+             AppT _ ty | ty == VarT typeVar -> [| Rank2.fmap $(varE f) $(varE x) |]
+             _ -> [| $(varE x) |]
+   clause pats body []
+genFmapClause (RecC name fields) = do
+   f <- newName "f"
+   x <- newName "x"
+   let body = normalB $ recConE name $ map newNamedField fields
+       newNamedField :: VarBangType -> Q (Name, Exp)
+       newNamedField (fieldName, _, fieldType) = do
+          Just (Deriving _ typeVar) <- getQ
+          case fieldType of
+             AppT ty _
+                | ty == VarT typeVar -> fieldExp fieldName [| $(varE f) ($(varE fieldName) $(varE x)) |]
+             AppT _ ty
+                | ty == VarT typeVar -> fieldExp fieldName [| Rank2.fmap $(varE f) ($(varE fieldName) $(varE x)) |]
+             _ -> fieldExp fieldName [| $(varE x) |]
+   clause [varP f, varP x] body []
+ 
+genApClause :: Con -> Q Clause
+genApClause (NormalC name fieldTypes) = do
+   fieldNames1 <- replicateM (length fieldTypes) (newName "x")
+   fieldNames2 <- replicateM (length fieldTypes) (newName "y")
+   let pats = [tildeP (conP name $ map varP fieldNames1), tildeP (conP name $ map varP fieldNames2)]
+       body = normalB $ appsE $ conE name : zipWith newField (zip fieldNames1 fieldNames2) fieldTypes
+       newField :: (Name, Name) -> BangType -> Q Exp
+       newField (x, y) (_, fieldType) = do
+          Just (Deriving _ typeVar) <- getQ
+          case fieldType of
+             AppT ty _ | ty == VarT typeVar -> [| Rank2.apply $(varE x) $(varE y) |]
+             AppT _ ty | ty == VarT typeVar -> [| Rank2.ap $(varE x) $(varE y) |]
+   clause pats body []
+genApClause (RecC name fields) = do
+   x <- newName "x"
+   y <- newName "y"
+   let body = normalB $ recConE name $ map newNamedField fields
+       newNamedField :: VarBangType -> Q (Name, Exp)
+       newNamedField (fieldName, _, fieldType) = do
+          Just (Deriving _ typeVar) <- getQ
+          case fieldType of
+             AppT ty _ | ty == VarT typeVar -> fieldExp fieldName [| $(varE fieldName) $(varE x) `Rank2.apply`
+                                                                       $(varE fieldName) $(varE y) |]
+             AppT _ ty | ty == VarT typeVar -> fieldExp fieldName [| $(varE fieldName) $(varE x) `Rank2.ap`
+                                                                       $(varE fieldName) $(varE y) |]
+   clause [varP x, varP y] body []
+
+genPureClause :: Con -> Q Clause
+genPureClause (NormalC name fieldTypes) = do
+   argName <- newName "f"
+   let body = normalB $ appsE $ conE name : map newField fieldTypes
+       newField :: BangType -> Q Exp
+       newField (_, fieldType) = do
+          Just (Deriving _ typeVar) <- getQ
+          case fieldType of
+             AppT ty _ | ty == VarT typeVar -> varE argName
+             AppT _ ty | ty == VarT typeVar -> appE (varE 'Rank2.pure) (varE argName)
+   clause [varP argName] body []
+genPureClause (RecC name fields) = do
+   argName <- newName "f"
+   let body = normalB $ recConE name $ map newNamedField fields
+       newNamedField :: VarBangType -> Q (Name, Exp)
+       newNamedField (fieldName, _, fieldType) = do
+          Just (Deriving _ typeVar) <- getQ
+          case fieldType of
+             AppT ty _ | ty == VarT typeVar -> fieldExp fieldName (varE argName)
+             AppT _ ty | ty == VarT typeVar -> fieldExp fieldName (appE (varE 'Rank2.pure) $ varE argName)
+   clause [varP argName] body []
+
+genFoldMapClause :: Con -> Q Clause
+genFoldMapClause (NormalC name fieldTypes) = do
+   f          <- newName "f"
+   fieldNames <- replicateM (length fieldTypes) (newName "x")
+   let pats = [varP f, tildeP (conP name $ map varP fieldNames)]
+       body = normalB $ foldr1 append $ zipWith newField fieldNames fieldTypes
+       append a b = [| $(a) <> $(b) |]
+       newField :: Name -> BangType -> Q Exp
+       newField x (_, fieldType) = do
+          Just (Deriving _ typeVar) <- getQ
+          case fieldType of
+             AppT ty _ | ty == VarT typeVar -> [| $(varE f) $(varE x) |]
+             AppT _ ty | ty == VarT typeVar -> [| Rank2.foldMap $(varE f) $(varE x) |]
+             _ -> [| $(varE x) |]
+   clause pats body []
+genFoldMapClause (RecC _name fields) = do
+   f <- newName "f"
+   x <- newName "x"
+   let body = normalB $ foldr1 append $ map newField fields
+       append a b = [| $(a) <> $(b) |]
+       newField :: VarBangType -> Q Exp
+       newField (fieldName, _, fieldType) = do
+          Just (Deriving _ typeVar) <- getQ
+          case fieldType of
+             AppT ty _ | ty == VarT typeVar -> [| $(varE f) ($(varE fieldName) $(varE x)) |]
+             AppT _ ty | ty == VarT typeVar -> [| Rank2.foldMap $(varE f) ($(varE fieldName) $(varE x)) |]
+             _ -> [| $(varE x) |]
+   clause [varP f, varP x] body []
+
+genTraverseClause :: Con -> Q Clause
+genTraverseClause (NormalC name fieldTypes) = do
+   f          <- newName "f"
+   fieldNames <- replicateM (length fieldTypes) (newName "x")
+   let pats = [varP f, tildeP (conP name $ map varP fieldNames)]
+       body = normalB $ fst $ foldl apply (conE name, False) $ zipWith newField fieldNames fieldTypes
+       apply (a, False) b = ([| $(a) <$> $(b) |], True)
+       apply (a, True) b = ([| $(a) <*> $(b) |], True)
+       newField :: Name -> BangType -> Q Exp
+       newField x (_, fieldType) = do
+          Just (Deriving _ typeVar) <- getQ
+          case fieldType of
+             AppT ty _ | ty == VarT typeVar -> [| $(varE f) $(varE x) |]
+             AppT _ ty | ty == VarT typeVar -> [| Rank2.traverse $(varE f) $(varE x) |]
+             _ -> [| $(varE x) |]
+   clause pats body []
+genTraverseClause (RecC name fields) = do
+   f <- newName "f"
+   x <- newName "x"
+   let body = normalB $ fst $ foldl apply (conE name, False) $ map newField fields
+       apply (a, False) b = ([| $(a) <$> $(b) |], True)
+       apply (a, True) b = ([| $(a) <*> $(b) |], True)
+       newField :: VarBangType -> Q Exp
+       newField (fieldName, _, fieldType) = do
+          Just (Deriving _ typeVar) <- getQ
+          case fieldType of
+             AppT ty _ | ty == VarT typeVar -> [| $(varE f) ($(varE fieldName) $(varE x)) |]
+             AppT _ ty | ty == VarT typeVar -> [| Rank2.traverse $(varE f) ($(varE fieldName) $(varE x)) |]
+             _ -> [| $(varE x) |]
+   clause [varP f, varP x] body []
+
+genDistributeMClause :: Con -> Q Clause
+genDistributeMClause (RecC name fields) = do
+   argName <- newName "f"
+   let body = normalB $ recConE name $ map newNamedField fields
+       newNamedField :: VarBangType -> Q (Name, Exp)
+       newNamedField (fieldName, _, fieldType) = do
+          Just (Deriving _ typeVar) <- getQ
+          case fieldType of
+             AppT ty _ | ty == VarT typeVar -> fieldExp fieldName [| $(varE argName) >>= $(varE fieldName) |]
+             AppT _ ty | ty == VarT typeVar ->
+                         fieldExp fieldName [| Rank2.distributeM ($(varE fieldName) <$> $(varE argName)) |]
+   clause [varP argName] body []
+
+genDistributeWithClause :: Con -> Q Clause
+genDistributeWithClause (RecC name fields) = do
+   withName <- newName "w"
+   argName <- newName "f"
+   let body = normalB $ recConE name $ map newNamedField fields
+       newNamedField :: VarBangType -> Q (Name, Exp)
+       newNamedField (fieldName, _, fieldType) = do
+          Just (Deriving _ typeVar) <- getQ
+          case fieldType of
+             AppT ty _
+                | ty == VarT typeVar -> fieldExp fieldName [| $(varE withName) ($(varE fieldName) <$> $(varE argName)) |]
+             AppT _ ty
+                | ty == VarT typeVar ->
+                  fieldExp fieldName [| Rank2.distributeWith $(varE withName) ($(varE fieldName) <$> $(varE argName)) |]
+   clause [varP withName, varP argName] body []
diff --git a/test/Doctest.hs b/test/Doctest.hs
new file mode 100644
--- /dev/null
+++ b/test/Doctest.hs
@@ -0,0 +1,3 @@
+import Test.DocTest
+
+main = doctest ["-pgmL", "markdown-unlit", "-isrc", "test/README.lhs"]