diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -53,8 +53,9 @@
 
 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
+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}
diff --git a/rank2classes.cabal b/rank2classes.cabal
--- a/rank2classes.cabal
+++ b/rank2classes.cabal
@@ -1,5 +1,5 @@
 name:                rank2classes
-version:             0.1
+version:             0.2
 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
diff --git a/src/Rank2.hs b/src/Rank2.hs
--- a/src/Rank2.hs
+++ b/src/Rank2.hs
@@ -5,15 +5,17 @@
 -- 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 #-}
+{-# LANGUAGE InstanceSigs, KindSignatures, Rank2Types, ScopedTypeVariables, PolyKinds, DefaultSignatures #-}
 module Rank2 (
 -- * Rank 2 classes
    Functor(..), Apply(..), Applicative(..),
-   Foldable(..), Traversable(..), Distributive(..),
+   Foldable(..), Traversable(..), Distributive(..), DistributiveTraversable(..), distributeJoin,
 -- * Rank 2 data types
    Compose(..), Empty(..), Only(..), Identity(..), Product(..), Arrow(..),
 -- * Method synonyms and helper functions
-   ap, fmap, liftA3)
+   ap, fmap, liftA3, liftA4, liftA5,
+   fmapTraverse, liftA2Traverse1, liftA2Traverse2, liftA2TraverseBoth,
+   cotraverse, cotraverseTraversable)
 where
 
 import qualified Control.Applicative as Rank1
@@ -31,7 +33,8 @@
 
 -- | Alphabetical synonym for '<$>'
 fmap :: Functor g => (forall a. p a -> q a) -> g p -> g q
-fmap = (<$>)
+fmap f g = f <$> g
+{-# INLINE fmap #-}
 
 -- | Equivalent of 'Foldable' for rank 2 data types
 class Foldable g where
@@ -57,46 +60,94 @@
    (<*>) :: 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
+   -- | Equivalent of 'Rank1.liftA3' for rank 2 data types
+   liftA3 :: (forall a. p a -> q a -> r a -> s a) -> g p -> g q -> g r -> g s
 
    (<*>) = liftA2 apply
    liftA2 f g h = (Arrow . f) <$> g <*> h
+   liftA3 f g h i = liftA2 (\p q-> Arrow (f p q)) g h <*> i
 
+liftA4 :: Apply g => (forall a. p a -> q a -> r a -> s a -> t a) -> g p -> g q -> g r -> g s -> g t
+liftA4 f g h i j = liftA3 (\p q r-> Arrow (f p q r)) g h i <*> j
+
+liftA5 :: Apply g => (forall a. p a -> q a -> r a -> s a -> t a -> u a) -> g p -> g q -> g r -> g s -> g t -> g u
+liftA5 f g1 g2 g3 g4 g5 = liftA4 (\p q r s-> Arrow (f p q r s)) g1 g2 g3 g4 <*> g5
+
 -- | 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
+  
+-- | Equivalent of 'Rank1.Distributive' for rank 2 data types
+class DistributiveTraversable 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 weaker 'Distributive' that requires 'Rank1.Traversable' to use, not just a 'Rank1.Functor'.
+class Functor g => DistributiveTraversable (g :: (k -> *) -> *) where
+   collectTraversable :: Rank1.Traversable f1 => (a -> g f2) -> f1 a -> g (Compose f1 f2)   
+   distributeTraversable :: Rank1.Traversable f1 => f1 (g f2) -> g (Compose f1 f2)
+   distributeWithTraversable :: Rank1.Traversable f1 => (forall x. f1 (f2 x) -> f x) -> f1 (g f2) -> g f
+
+   collectTraversable f = distributeTraversable . Rank1.fmap f
+   distributeTraversable = distributeWithTraversable Compose
+   
+   default distributeWithTraversable :: (Rank1.Traversable f1, Distributive g) => 
+                                        (forall x. f1 (f2 x) -> f x) -> f1 (g f2) -> g f
+   distributeWithTraversable = distributeWith
+
+-- | A variant of 'distribute' convenient with 'Rank1.Monad' instances
+distributeJoin :: (Distributive g, Rank1.Monad f) => f (g f) -> g f
+distributeJoin = distributeWith Rank1.join
+
+-- | Like 'fmap', but traverses over its argument
+fmapTraverse :: (DistributiveTraversable f, Rank1.Traversable g) => (forall a. g (t a) -> u a) -> g (f t) -> f u
+fmapTraverse f x = fmap (f . getCompose) (distributeTraversable x)
+
+-- | Like 'liftA2', but traverses over its first argument
+liftA2Traverse1 :: (Apply f, DistributiveTraversable f, Rank1.Traversable g) =>
+                   (forall a. g (t a) -> u a -> v a) -> g (f t) -> f u -> f v
+liftA2Traverse1 f x = liftA2 (f . getCompose) (distributeTraversable x)
+
+-- | Like 'liftA2', but traverses over its second argument
+liftA2Traverse2 :: (Apply f, DistributiveTraversable f, Rank1.Traversable g) => 
+                   (forall a. t a -> g (u a) -> v a) -> f t -> g (f u) -> f v
+liftA2Traverse2 f x y = liftA2 (\x' y' -> f x' (getCompose y')) x (distributeTraversable y)
+
+-- | Like 'liftA2', but traverses over both its arguments
+liftA2TraverseBoth :: (Apply f, DistributiveTraversable f, Rank1.Traversable g1, Rank1.Traversable g2) =>
+                      (forall a. g1 (t a) -> g2 (u a) -> v a) -> g1 (f t) -> g2 (f u) -> f v
+liftA2TraverseBoth f x y = liftA2 applyCompose (distributeTraversable x) (distributeTraversable y)
+   where applyCompose x' y' = f (getCompose x') (getCompose y')
+
+-- | Equivalent of 'Rank1.cotraverse' for rank 2 data types 
+cotraverse :: (Distributive g, Rank1.Functor f) => (forall i. f (a i) -> b i) -> f (g a) -> g b
+cotraverse f = (fmap (f . getCompose)) . distribute
+
+-- | Equivalent of 'Rank1.cotraverse' for rank 2 data types using traversable
+cotraverseTraversable :: (DistributiveTraversable g, Rank1.Traversable f) => 
+                         (forall i. f (a i) -> b i) -> f (g a) -> g b
+cotraverseTraversable f = (fmap (f . getCompose)) . distributeTraversable
+
 -- | A rank-2 equivalent of '()', a zero-element tuple
-data Empty (f :: * -> *) = Empty deriving (Eq, Ord, Show)
+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)
+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)
+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}
+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)
@@ -184,18 +235,23 @@
 instance (Applicative g, Applicative h) => Applicative (Product g h) where
    pure f = Pair (pure f) (pure f)
 
+instance DistributiveTraversable Empty
+instance DistributiveTraversable (Only x)
+instance DistributiveTraversable g => DistributiveTraversable (Identity g) where
+   distributeWithTraversable w f = Identity (distributeWithTraversable w $ Rank1.fmap runIdentity f)
+instance (DistributiveTraversable g, DistributiveTraversable h) => DistributiveTraversable (Product g h) where
+   distributeWithTraversable w f = Pair (distributeWithTraversable w $ Rank1.fmap fst f) 
+                                        (distributeWithTraversable w $ Rank1.fmap snd 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
--- a/src/Rank2/TH.hs
+++ b/src/Rank2/TH.hs
@@ -11,7 +11,7 @@
 -- Adapted from https://wiki.haskell.org/A_practical_Template_Haskell_Tutorial
 
 module Rank2.TH (deriveAll, deriveFunctor, deriveApply, deriveApplicative,
-                 deriveFoldable, deriveTraversable, deriveDistributive)
+                 deriveFoldable, deriveTraversable, deriveDistributive, deriveDistributiveTraversable)
 where
 
 import Control.Monad (replicateM)
@@ -25,7 +25,7 @@
 
 deriveAll :: Name -> Q [Dec]
 deriveAll ty = foldr f (pure []) [deriveFunctor, deriveApply, deriveApplicative,
-                                  deriveFoldable, deriveTraversable, deriveDistributive]
+                                  deriveFoldable, deriveTraversable, deriveDistributive, deriveDistributiveTraversable]
    where f derive rest = (<>) <$> derive ty <*> rest
 
 deriveFunctor :: Name -> Q [Dec]
@@ -36,7 +36,7 @@
 deriveApply :: Name -> Q [Dec]
 deriveApply ty = do
    (instanceType, cs) <- reifyConstructors ''Rank2.Apply ty
-   sequence [instanceD (return []) instanceType [genAp cs]]
+   sequence [instanceD (return []) instanceType [genAp cs, genLiftA2 cs, genLiftA3 cs]]
 
 deriveApplicative :: Name -> Q [Dec]
 deriveApplicative ty = do
@@ -56,8 +56,13 @@
 deriveDistributive :: Name -> Q [Dec]
 deriveDistributive ty = do
    (instanceType, cs) <- reifyConstructors ''Rank2.Distributive ty
-   sequence [instanceD (return []) instanceType [genDistributeWith cs, genDistributeM cs]]
+   sequence [instanceD (return []) instanceType [genDistributeWith cs]]
 
+deriveDistributiveTraversable :: Name -> Q [Dec]
+deriveDistributiveTraversable ty = do
+   (instanceType, cs) <- reifyConstructors ''Rank2.DistributiveTraversable ty
+   sequence [instanceD (return []) instanceType [genDistributeWithTraversable cs]]
+
 reifyConstructors :: Name -> Name -> Q (TypeQ, [Con])
 reifyConstructors cls ty = do
    (TyConI tyCon) <- reify ty
@@ -80,6 +85,12 @@
 genAp :: [Con] -> Q Dec
 genAp cs = funD '(Rank2.<*>) (map genApClause cs)
 
+genLiftA2 :: [Con] -> Q Dec
+genLiftA2 cs = funD 'Rank2.liftA2 (map genLiftA2Clause cs)
+
+genLiftA3 :: [Con] -> Q Dec
+genLiftA3 cs = funD 'Rank2.liftA3 (map genLiftA3Clause cs)
+
 genPure :: [Con] -> Q Dec
 genPure cs = funD 'Rank2.pure (map genPureClause cs)
 
@@ -89,12 +100,12 @@
 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)
 
+genDistributeWithTraversable :: [Con] -> Q Dec
+genDistributeWithTraversable cs = funD 'Rank2.distributeWith (map genDistributeWithTraversableClause cs)
+
 genFmapClause :: Con -> Q Clause
 genFmapClause (NormalC name fieldTypes) = do
    f          <- newName "f"
@@ -123,7 +134,74 @@
                 | ty == VarT typeVar -> fieldExp fieldName [| Rank2.fmap $(varE f) ($(varE fieldName) $(varE x)) |]
              _ -> fieldExp fieldName [| $(varE x) |]
    clause [varP f, varP x] body []
- 
+
+genLiftA2Clause :: Con -> Q Clause
+genLiftA2Clause (NormalC name fieldTypes) = do
+   f          <- newName "f"
+   fieldNames1 <- replicateM (length fieldTypes) (newName "x")
+   fieldNames2 <- replicateM (length fieldTypes) (newName "y")
+   let pats = [varP f, 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 -> [| $(varE f) $(varE x) $(varE y) |]
+             AppT _ ty | ty == VarT typeVar -> [| Rank2.liftA2 $(varE f) $(varE x) $(varE y) |]
+   clause pats body []
+genLiftA2Clause (RecC name fields) = do
+   f <- newName "f"
+   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 f) ($(varE fieldName) $(varE x)) 
+                                                                        ($(varE fieldName) $(varE y)) |]
+             AppT _ ty
+                | ty == VarT typeVar -> fieldExp fieldName [| Rank2.liftA2 $(varE f) ($(varE fieldName) $(varE x)) 
+                                                                                     ($(varE fieldName) $(varE y)) |]
+   clause [varP f, varP x, varP y] body []
+
+genLiftA3Clause :: Con -> Q Clause
+genLiftA3Clause (NormalC name fieldTypes) = do
+   f          <- newName "f"
+   fieldNames1 <- replicateM (length fieldTypes) (newName "x")
+   fieldNames2 <- replicateM (length fieldTypes) (newName "y")
+   fieldNames3 <- replicateM (length fieldTypes) (newName "z")
+   let pats = [varP f, tildeP (conP name $ map varP fieldNames1), tildeP (conP name $ map varP fieldNames2), 
+               tildeP (conP name $ map varP fieldNames3)]
+       body = normalB $ appsE $ conE name : zipWith newField (zip3 fieldNames1 fieldNames2 fieldNames3) fieldTypes
+       newField :: (Name, Name, Name) -> BangType -> Q Exp
+       newField (x, y, z) (_, fieldType) = do
+          Just (Deriving _ typeVar) <- getQ
+          case fieldType of
+             AppT ty _ | ty == VarT typeVar -> [| $(varE f) $(varE x) $(varE y) $(varE z) |]
+             AppT _ ty | ty == VarT typeVar -> [| Rank2.liftA3 $(varE f) $(varE x) $(varE y) $(varE z) |]
+   clause pats body []
+genLiftA3Clause (RecC name fields) = do
+   f <- newName "f"
+   x <- newName "x"
+   y <- newName "y"
+   z <- newName "z"
+   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))
+                                                                        ($(varE fieldName) $(varE y))
+                                                                        ($(varE fieldName) $(varE z)) |]
+             AppT _ ty
+                | ty == VarT typeVar -> fieldExp fieldName [| Rank2.liftA3 $(varE f) ($(varE fieldName) $(varE x))
+                                                                                     ($(varE fieldName) $(varE y))
+                                                                                     ($(varE fieldName) $(varE z)) |]
+   clause [varP f, varP x, varP y, varP z] body []
+
 genApClause :: Con -> Q Clause
 genApClause (NormalC name fieldTypes) = do
    fieldNames1 <- replicateM (length fieldTypes) (newName "x")
@@ -233,21 +311,24 @@
              _ -> [| $(varE x) |]
    clause [varP f, varP x] body []
 
-genDistributeMClause :: Con -> Q Clause
-genDistributeMClause (RecC name fields) = do
+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 argName) >>= $(varE fieldName) |]
-             AppT _ ty | ty == VarT typeVar ->
-                         fieldExp fieldName [| Rank2.distributeM ($(varE fieldName) <$> $(varE argName)) |]
-   clause [varP argName] body []
+             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 []
 
-genDistributeWithClause :: Con -> Q Clause
-genDistributeWithClause (RecC name fields) = do
+genDistributeWithTraversableClause :: Con -> Q Clause
+genDistributeWithTraversableClause (RecC name fields) = do
    withName <- newName "w"
    argName <- newName "f"
    let body = normalB $ recConE name $ map newNamedField fields
@@ -259,5 +340,5 @@
                 | 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)) |]
+                  fieldExp fieldName [| Rank2.distributeWithTraversable $(varE withName) ($(varE fieldName) <$> $(varE argName)) |]
    clause [varP withName, varP argName] body []