diff --git a/0.2/Control/Applicative/Backwards.hs b/0.2/Control/Applicative/Backwards.hs
--- a/0.2/Control/Applicative/Backwards.hs
+++ b/0.2/Control/Applicative/Backwards.hs
@@ -1,3 +1,13 @@
+{-# LANGUAGE CPP #-}
+
+#ifndef HASKELL98
+# if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Safe #-}
+# endif
+# if __GLASGOW_HASKELL__ >= 704
+{-# LANGUAGE PolyKinds #-}
+# endif
+#endif
 -- |
 -- Module      :  Control.Applicative.Backwards
 -- Copyright   :  (c) Russell O'Connor 2009
@@ -14,16 +24,36 @@
 -- @transformers@ versions before 3.0.
 module Control.Applicative.Backwards where
 
+import Data.Functor.Classes
+
 import Prelude hiding (foldr, foldr1, foldl, foldl1)
 import Control.Applicative
 import Data.Foldable
-import Data.Functor.Classes
 import Data.Traversable
 
 -- | The same functor, but with an 'Applicative' instance that performs
 -- actions in the reverse order.
 newtype Backwards f a = Backwards { forwards :: f a }
 
+instance (Eq1 f) => Eq1 (Backwards f) where
+    liftEq eq (Backwards x) (Backwards y) = liftEq eq x y
+
+instance (Ord1 f) => Ord1 (Backwards f) where
+    liftCompare comp (Backwards x) (Backwards y) = liftCompare comp x y
+
+instance (Read1 f) => Read1 (Backwards f) where
+    liftReadsPrec rp rl = readsData $
+        readsUnaryWith (liftReadsPrec rp rl) "Backwards" Backwards
+
+instance (Show1 f) => Show1 (Backwards f) where
+    liftShowsPrec sp sl d (Backwards x) =
+        showsUnaryWith (liftShowsPrec sp sl) "Backwards" d x
+
+instance (Eq1 f, Eq a) => Eq (Backwards f a) where (==) = eq1
+instance (Ord1 f, Ord a) => Ord (Backwards f a) where compare = compare1
+instance (Read1 f, Read a) => Read (Backwards f a) where readsPrec = readsPrec1
+instance (Show1 f, Show a) => Show (Backwards f a) where showsPrec = showsPrec1
+
 -- | Derived instance.
 instance (Functor f) => Functor (Backwards f) where
     fmap f (Backwards a) = Backwards (fmap f a)
@@ -43,29 +73,10 @@
     foldMap f (Backwards t) = foldMap f t
     foldr f z (Backwards t) = foldr f z t
     foldl f z (Backwards t) = foldl f z t
-    foldr1 f (Backwards t) = foldl1 f t
-    foldl1 f (Backwards t) = foldr1 f t
+    foldr1 f (Backwards t) = foldr1 f t
+    foldl1 f (Backwards t) = foldl1 f t
 
 -- | Derived instance.
 instance (Traversable f) => Traversable (Backwards f) where
     traverse f (Backwards t) = fmap Backwards (traverse f t)
     sequenceA (Backwards t) = fmap Backwards (sequenceA t)
-
-
-instance (Eq1 f, Eq a) => Eq (Backwards f a) where
-    Backwards x == Backwards y = eq1 x y
-
-instance (Ord1 f, Ord a) => Ord (Backwards f a) where
-    compare (Backwards x) (Backwards y) = compare1 x y
-
-instance (Read1 f, Read a) => Read (Backwards f a) where
-    readsPrec = readsData $ readsUnary1 "Backwards" Backwards
-
-instance (Show1 f, Show a) => Show (Backwards f a) where
-    showsPrec d (Backwards x) = showsUnary1 "Backwards" d x
-
-instance Eq1 f => Eq1 (Backwards f) where eq1 = (==)
-instance Ord1 f => Ord1 (Backwards f) where compare1 = compare
-instance Read1 f => Read1 (Backwards f) where readsPrec1 = readsPrec
-instance Show1 f => Show1 (Backwards f) where showsPrec1 = showsPrec
-
diff --git a/0.2/Control/Applicative/Lift.hs b/0.2/Control/Applicative/Lift.hs
--- a/0.2/Control/Applicative/Lift.hs
+++ b/0.2/Control/Applicative/Lift.hs
@@ -1,3 +1,12 @@
+{-# LANGUAGE CPP #-}
+
+#ifndef HASKELL98
+# if __GLASGOW_HASKELL__ >= 704
+{-# LANGUAGE Safe #-}
+# elif __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Trustworthy #-}
+# endif
+#endif
 -- |
 -- Module      :  Control.Applicative.Lift
 -- Copyright   :  (c) Ross Paterson 2010
@@ -13,45 +22,54 @@
 -- @transformers@ versions before 3.0.
 
 module Control.Applicative.Lift (
-    Lift(..), unLift,
+    -- * Lifting an applicative
+    Lift(..),
+    unLift,
+    mapLift,
     -- * Collecting errors
-    Errors, failure
+    Errors,
+    runErrors,
+    failure
   ) where
 
+import Data.Functor.Classes
+
 import Control.Applicative
 import Data.Foldable (Foldable(foldMap))
 import Data.Functor.Constant
-import Data.Functor.Classes
-import Data.Monoid
+import Data.Monoid (Monoid(..))
 import Data.Traversable (Traversable(traverse))
 
 -- | Applicative functor formed by adding pure computations to a given
 -- applicative functor.
 data Lift f a = Pure a | Other (f a)
 
-instance (Eq1 f, Eq a) => Eq (Lift f a) where
-    Pure x1 == Pure x2 = x1 == x2
-    Other y1 == Other y2 = eq1 y1 y2
-    _ == _ = False
+instance (Eq1 f) => Eq1 (Lift f) where
+    liftEq eq (Pure x1) (Pure x2) = eq x1 x2
+    liftEq _ (Pure _) (Other _) = False
+    liftEq _ (Other _) (Pure _) = False
+    liftEq eq (Other y1) (Other y2) = liftEq eq y1 y2
 
-instance (Ord1 f, Ord a) => Ord (Lift f a) where
-    compare (Pure x1) (Pure x2) = compare x1 x2
-    compare (Pure _) (Other _) = LT
-    compare (Other _) (Pure _) = GT
-    compare (Other y1) (Other y2) = compare1 y1 y2
+instance (Ord1 f) => Ord1 (Lift f) where
+    liftCompare comp (Pure x1) (Pure x2) = comp x1 x2
+    liftCompare _ (Pure _) (Other _) = LT
+    liftCompare _ (Other _) (Pure _) = GT
+    liftCompare comp (Other y1) (Other y2) = liftCompare comp y1 y2
 
-instance (Read1 f, Read a) => Read (Lift f a) where
-    readsPrec = readsData $
-        readsUnary "Pure" Pure `mappend` readsUnary1 "Other" Other
+instance (Read1 f) => Read1 (Lift f) where
+    liftReadsPrec rp rl = readsData $
+        readsUnaryWith rp "Pure" Pure `mappend`
+        readsUnaryWith (liftReadsPrec rp rl) "Other" Other
 
-instance (Show1 f, Show a) => Show (Lift f a) where
-    showsPrec d (Pure x) = showsUnary "Pure" d x
-    showsPrec d (Other y) = showsUnary1 "Other" d y
+instance (Show1 f) => Show1 (Lift f) where
+    liftShowsPrec sp _ d (Pure x) = showsUnaryWith sp "Pure" d x
+    liftShowsPrec sp sl d (Other y) =
+        showsUnaryWith (liftShowsPrec sp sl) "Other" d y
 
-instance (Eq1 f) => Eq1 (Lift f) where eq1 = (==)
-instance (Ord1 f) => Ord1 (Lift f) where compare1 = compare
-instance (Read1 f) => Read1 (Lift f) where readsPrec1 = readsPrec
-instance (Show1 f) => Show1 (Lift f) where showsPrec1 = showsPrec
+instance (Eq1 f, Eq a) => Eq (Lift f a) where (==) = eq1
+instance (Ord1 f, Ord a) => Ord (Lift f a) where compare = compare1
+instance (Read1 f, Read a) => Read (Lift f a) where readsPrec = readsPrec1
+instance (Show1 f, Show a) => Show (Lift f a) where showsPrec = showsPrec1
 
 instance (Functor f) => Functor (Lift f) where
     fmap f (Pure x) = Pure (f x)
@@ -74,23 +92,47 @@
     Other f <*> Other y = Other (f <*> y)
 
 -- | A combination is 'Pure' only either part is.
-instance Alternative f => Alternative (Lift f) where
+instance (Alternative f) => Alternative (Lift f) where
     empty = Other empty
     Pure x <|> _ = Pure x
     Other _ <|> Pure y = Pure y
     Other x <|> Other y = Other (x <|> y)
 
 -- | Projection to the other functor.
-unLift :: Applicative f => Lift f a -> f a
+unLift :: (Applicative f) => Lift f a -> f a
 unLift (Pure x) = pure x
 unLift (Other e) = e
 
+-- | Apply a transformation to the other computation.
+mapLift :: (f a -> g a) -> Lift f a -> Lift g a
+mapLift _ (Pure x) = Pure x
+mapLift f (Other e) = Other (f e)
+
 -- | An applicative functor that collects a monoid (e.g. lists) of errors.
 -- A sequence of computations fails if any of its components do, but
--- unlike monads made with 'ErrorT' from "Control.Monad.Trans.Error",
+-- unlike monads made with 'ExceptT' from "Control.Monad.Trans.Except",
 -- these computations continue after an error, collecting all the errors.
+--
+-- * @'pure' f '<*>' 'pure' x = 'pure' (f x)@
+--
+-- * @'pure' f '<*>' 'failure' e = 'failure' e@
+--
+-- * @'failure' e '<*>' 'pure' x = 'failure' e@
+--
+-- * @'failure' e1 '<*>' 'failure' e2 = 'failure' (e1 '<>' e2)@
+--
 type Errors e = Lift (Constant e)
 
+-- | Extractor for computations with accumulating errors.
+--
+-- * @'runErrors' ('pure' x) = 'Right' x@
+--
+-- * @'runErrors' ('failure' e) = 'Left' e@
+--
+runErrors :: Errors e a -> Either e a
+runErrors (Other (Constant e)) = Left e
+runErrors (Pure x) = Right x
+
 -- | Report an error.
-failure :: Monoid e => e -> Errors e a
+failure :: e -> Errors e a
 failure e = Other (Constant e)
diff --git a/0.2/Data/Functor/Reverse.hs b/0.2/Data/Functor/Reverse.hs
--- a/0.2/Data/Functor/Reverse.hs
+++ b/0.2/Data/Functor/Reverse.hs
@@ -1,3 +1,13 @@
+{-# LANGUAGE CPP #-}
+
+#ifndef HASKELL98
+# if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Safe #-}
+# endif
+# if __GLASGOW_HASKELL__ >= 704
+{-# LANGUAGE PolyKinds #-}
+# endif
+#endif
 -- |
 -- Module      :  Data.Functor.Reverse
 -- Copyright   :  (c) Russell O'Connor 2009
@@ -16,11 +26,11 @@
 module Data.Functor.Reverse where
 
 import Control.Applicative.Backwards
+import Data.Functor.Classes
 
 import Prelude hiding (foldr, foldr1, foldl, foldl1)
 import Control.Applicative
 import Data.Foldable
-import Data.Functor.Classes
 import Data.Traversable
 import Data.Monoid
 
@@ -28,6 +38,25 @@
 -- that process the elements in the reverse order.
 newtype Reverse f a = Reverse { getReverse :: f a }
 
+instance (Eq1 f) => Eq1 (Reverse f) where
+    liftEq eq (Reverse x) (Reverse y) = liftEq eq x y
+
+instance (Ord1 f) => Ord1 (Reverse f) where
+    liftCompare comp (Reverse x) (Reverse y) = liftCompare comp x y
+
+instance (Read1 f) => Read1 (Reverse f) where
+    liftReadsPrec rp rl = readsData $
+        readsUnaryWith (liftReadsPrec rp rl) "Reverse" Reverse
+
+instance (Show1 f) => Show1 (Reverse f) where
+    liftShowsPrec sp sl d (Reverse x) =
+        showsUnaryWith (liftShowsPrec sp sl) "Reverse" d x
+
+instance (Eq1 f, Eq a) => Eq (Reverse f a) where (==) = eq1
+instance (Ord1 f, Ord a) => Ord (Reverse f a) where compare = compare1
+instance (Read1 f, Read a) => Read (Reverse f a) where readsPrec = readsPrec1
+instance (Show1 f, Show a) => Show (Reverse f a) where showsPrec = showsPrec1
+
 -- | Derived instance.
 instance (Functor f) => Functor (Reverse f) where
     fmap f (Reverse a) = Reverse (fmap f a)
@@ -56,21 +85,3 @@
         fmap Reverse . forwards $ traverse (Backwards . f) t
     sequenceA (Reverse t) =
         fmap Reverse . forwards $ sequenceA (fmap Backwards t)
-
-instance (Eq1 f, Eq a) => Eq (Reverse f a) where
-    Reverse x == Reverse y = eq1 x y
-
-instance (Ord1 f, Ord a) => Ord (Reverse f a) where
-    compare (Reverse x) (Reverse y) = compare1 x y
-
-instance (Read1 f, Read a) => Read (Reverse f a) where
-    readsPrec = readsData $ readsUnary1 "Reverse" Reverse
-
-instance (Show1 f, Show a) => Show (Reverse f a) where
-    showsPrec d (Reverse x) = showsUnary1 "Reverse" d x
-
-instance Eq1 f => Eq1 (Reverse f) where eq1 = (==)
-instance Ord1 f => Ord1 (Reverse f) where compare1 = compare
-instance Read1 f => Read1 (Reverse f) where readsPrec1 = readsPrec
-instance Show1 f => Show1 (Reverse f) where showsPrec1 = showsPrec
-
diff --git a/0.3/Control/Monad/Signatures.hs b/0.3/Control/Monad/Signatures.hs
--- a/0.3/Control/Monad/Signatures.hs
+++ b/0.3/Control/Monad/Signatures.hs
@@ -1,3 +1,13 @@
+{-# LANGUAGE CPP #-}
+
+#ifndef HASKELL98
+# if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Safe #-}
+# endif
+# if __GLASGOW_HASKELL__ >= 704
+{-# LANGUAGE PolyKinds #-}
+# endif
+#endif
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Control.Monad.Signatures
@@ -9,6 +19,7 @@
 -- Portability :  portable
 --
 -- Signatures for monad operations that require specialized lifting.
+-- Each signature has a uniformity property that the lifting should satisfy.
 -----------------------------------------------------------------------------
 
 module Control.Monad.Signatures (
@@ -17,16 +28,32 @@
 
 -- | Signature of the @callCC@ operation,
 -- introduced in "Control.Monad.Trans.Cont".
+-- Any lifting function @liftCallCC@ should satisfy
+--
+-- * @'lift' (f k) = f' ('lift' . k) => 'lift' (cf f) = liftCallCC cf f'@
+--
 type CallCC m a b = ((a -> m b) -> m a) -> m a
 
 -- | Signature of the @catchE@ operation,
 -- introduced in "Control.Monad.Trans.Except".
+-- Any lifting function @liftCatch@ should satisfy
+--
+-- * @'lift' (cf m f) = liftCatch ('lift' . cf) ('lift' f)@
+--
 type Catch e m a = m a -> (e -> m a) -> m a
 
 -- | Signature of the @listen@ operation,
 -- introduced in "Control.Monad.Trans.Writer".
+-- Any lifting function @liftListen@ should satisfy
+--
+-- * @'lift' . liftListen = liftListen . 'lift'@
+--
 type Listen w m a = m a -> m (a, w)
 
 -- | Signature of the @pass@ operation,
 -- introduced in "Control.Monad.Trans.Writer".
+-- Any lifting function @liftPass@ should satisfy
+--
+-- * @'lift' . liftPass = liftPass . 'lift'@
+--
 type Pass w m a =  m (a, w -> w) -> m a
diff --git a/0.3/Control/Monad/Trans/Except.hs b/0.3/Control/Monad/Trans/Except.hs
--- a/0.3/Control/Monad/Trans/Except.hs
+++ b/0.3/Control/Monad/Trans/Except.hs
@@ -1,5 +1,9 @@
 {-# LANGUAGE CPP #-}
 
+#ifndef MIN_VERSION_base
+#define MIN_VERSION_base(x,y,z) 1
+#endif
+
 #ifndef MIN_VERSION_mtl
 #define MIN_VERSION_mtl(x,y,z) 1
 #endif
@@ -8,6 +12,11 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE UndecidableInstances #-}
+# if __GLASGOW_HASKELL__ >= 704
+{-# LANGUAGE Safe #-}
+# elif __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Trustworthy #-}
+# endif
 #endif
 -----------------------------------------------------------------------------
 -- |
@@ -57,6 +66,9 @@
 import Control.Monad.IO.Class
 import Control.Monad.Signatures
 import Control.Monad.Trans.Class
+#if MIN_VERSION_base(4,4,0)
+import Control.Monad.Zip (MonadZip(mzipWith))
+#endif
 
 #ifndef HASKELL98
 import Control.Monad.Writer.Class
@@ -117,22 +129,33 @@
 -- first exception.
 newtype ExceptT e m a = ExceptT { runExceptT :: m (Either e a) }
 
-instance (Eq e, Eq1 m, Eq a) => Eq (ExceptT e m a) where
-    ExceptT x == ExceptT y = eq1 x y
+instance (Eq e, Eq1 m) => Eq1 (ExceptT e m) where
+    liftEq eq (ExceptT x) (ExceptT y) = liftEq (liftEq eq) x y
 
-instance (Ord e, Ord1 m, Ord a) => Ord (ExceptT e m a) where
-    compare (ExceptT x) (ExceptT y) = compare1 x y
+instance (Ord e, Ord1 m) => Ord1 (ExceptT e m) where
+    liftCompare comp (ExceptT x) (ExceptT y) =
+        liftCompare (liftCompare comp) x y
 
-instance (Read e, Read1 m, Read a) => Read (ExceptT e m a) where
-    readsPrec = readsData $ readsUnary1 "ExceptT" ExceptT
+instance (Read e, Read1 m) => Read1 (ExceptT e m) where
+    liftReadsPrec rp rl = readsData $
+        readsUnaryWith (liftReadsPrec rp' rl') "ExceptT" ExceptT
+      where
+        rp' = liftReadsPrec rp rl
+        rl' = liftReadList rp rl
 
-instance (Show e, Show1 m, Show a) => Show (ExceptT e m a) where
-    showsPrec d (ExceptT m) = showsUnary1 "ExceptT" d m
+instance (Show e, Show1 m) => Show1 (ExceptT e m) where
+    liftShowsPrec sp sl d (ExceptT m) =
+        showsUnaryWith (liftShowsPrec sp' sl') "ExceptT" d m
+      where
+        sp' = liftShowsPrec sp sl
+        sl' = liftShowList sp sl
 
-instance (Eq e, Eq1 m) => Eq1 (ExceptT e m) where eq1 = (==)
-instance (Ord e, Ord1 m) => Ord1 (ExceptT e m) where compare1 = compare
-instance (Read e, Read1 m) => Read1 (ExceptT e m) where readsPrec1 = readsPrec
-instance (Show e, Show1 m) => Show1 (ExceptT e m) where showsPrec1 = showsPrec
+instance (Eq e, Eq1 m, Eq a) => Eq (ExceptT e m a) where (==) = eq1
+instance (Ord e, Ord1 m, Ord a) => Ord (ExceptT e m a) where compare = compare1
+instance (Read e, Read1 m, Read a) => Read (ExceptT e m a) where
+    readsPrec = readsPrec1
+instance (Show e, Show1 m, Show a) => Show (ExceptT e m a) where
+    showsPrec = showsPrec1
 
 -- | Map the unwrapped computation using the given function.
 --
@@ -170,8 +193,12 @@
                     Right x -> return (Right (k x))
 
 instance (Functor m, Monad m, Monoid e) => Alternative (ExceptT e m) where
-    empty = mzero
-    (<|>) = mplus
+    empty = ExceptT $ return (Left mempty)
+    ExceptT mx <|> ExceptT my = ExceptT $ do
+        ex <- mx
+        case ex of
+            Left e -> liftM (either (Left . mappend e) Right) my
+            Right x -> return (Right x)
 
 instance (Monad m) => Monad (ExceptT e m) where
     return a = ExceptT $ return (Right a)
@@ -191,15 +218,19 @@
             Right x -> return (Right x)
 
 instance (MonadFix m) => MonadFix (ExceptT e m) where
-    mfix f = ExceptT $ mfix $ \ a -> runExceptT $ f $ case a of
-        Right x -> x
-        Left _ -> error "mfix ExceptT: Left"
+    mfix f = ExceptT (mfix (runExceptT . f . either (const bomb) id))
+      where bomb = error "mfix (ExceptT): inner computation returned Left value"
 
 instance MonadTrans (ExceptT e) where
     lift = ExceptT . liftM Right
 
 instance (MonadIO m) => MonadIO (ExceptT e m) where
     liftIO = lift . liftIO
+
+#if MIN_VERSION_base(4,4,0)
+instance (MonadZip m) => MonadZip (ExceptT e m) where
+    mzipWith f (ExceptT a) (ExceptT b) = ExceptT $ mzipWith (liftA2 f) a b
+#endif
 
 -- | Signal an exception value @e@.
 --
diff --git a/0.3/Data/Functor/Classes.hs b/0.3/Data/Functor/Classes.hs
--- a/0.3/Data/Functor/Classes.hs
+++ b/0.3/Data/Functor/Classes.hs
@@ -1,26 +1,72 @@
 {-# LANGUAGE CPP #-}
+
 #ifndef MIN_VERSION_transformers
 #define MIN_VERSION_transformers(a,b,c) 1
 #endif
+
+#ifndef HASKELL98
+# if __GLASGOW_HASKELL__ >= 704
+{-# LANGUAGE Safe #-}
+# elif __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Trustworthy #-}
+# endif
+# if __GLASGOW_HASKELL__ >= 708
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE StandaloneDeriving #-}
+# endif
+#endif
+-----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Functor.Classes
 -- Copyright   :  (c) Ross Paterson 2013, Edward Kmett 2014
 -- License     :  BSD-style (see the file LICENSE)
 --
--- Maintainer  :  ross@soi.city.ac.uk
+-- Maintainer  :  R.Paterson@city.ac.uk
 -- Stability   :  experimental
 -- Portability :  portable
 --
--- Prelude classes, lifted to unary type constructors.
+-- Liftings of the Prelude classes 'Eq', 'Ord', 'Read' and 'Show' to
+-- unary and binary type constructors.
+--
+-- These classes are needed to express the constraints on arguments of
+-- transformers in portable Haskell.  Thus for a new transformer @T@,
+-- one might write instances like
+--
+-- > instance (Eq1 f) => Eq1 (T f) where ...
+-- > instance (Ord1 f) => Ord1 (T f) where ...
+-- > instance (Read1 f) => Read1 (T f) where ...
+-- > instance (Show1 f) => Show1 (T f) where ...
+--
+-- If these instances can be defined, defining instances of the base
+-- classes is mechanical:
+--
+-- > instance (Eq1 f, Eq a) => Eq (T f a) where (==) = eq1
+-- > instance (Ord1 f, Ord a) => Ord (T f a) where compare = compare1
+-- > instance (Read1 f, Read a) => Read (T f a) where readsPrec = readsPrec1
+-- > instance (Show1 f, Show a) => Show (T f a) where showsPrec = showsPrec1
+--
+-----------------------------------------------------------------------------
 
 module Data.Functor.Classes (
     -- * Liftings of Prelude classes
-    Eq1(..),
-    Ord1(..),
-    Read1(..),
-    Show1(..),
+    -- ** For unary constructors
+    Eq1(..), eq1,
+    Ord1(..), compare1,
+    Read1(..), readsPrec1,
+    Show1(..), showsPrec1,
+    -- ** For binary constructors
+    Eq2(..), eq2,
+    Ord2(..), compare2,
+    Read2(..), readsPrec2,
+    Show2(..), showsPrec2,
     -- * Helper functions
+    -- $example
     readsData,
+    readsUnaryWith,
+    readsBinaryWith,
+    showsUnaryWith,
+    showsBinaryWith,
+    -- ** Obsolete helpers
     readsUnary,
     readsUnary1,
     readsBinary1,
@@ -29,6 +75,11 @@
     showsBinary1,
   ) where
 
+import Control.Applicative (Const(Const))
+import Data.Functor.Identity (Identity(Identity))
+import Data.Monoid (mappend)
+import Text.Show (showListWith)
+
 import Control.Monad.Trans.Error
 import Control.Monad.Trans.Identity
 import Control.Monad.Trans.List
@@ -37,73 +88,309 @@
 import Control.Monad.Trans.Writer.Strict as Strict
 import Data.Functor.Compose
 import Data.Functor.Constant
-import Data.Functor.Identity
 import Data.Functor.Product
-import Data.Monoid (Monoid(mappend))
+
 #if MIN_VERSION_transformers(0,3,0)
 import Control.Applicative.Lift
 import Control.Applicative.Backwards
 import Data.Functor.Reverse
 #endif
 
-instance Show a => Show (Identity a) where
-  showsPrec d (Identity a) = showParen (d > 10) $
-    showString "Identity " . showsPrec 11 a
-instance Read a => Read (Identity a) where
-  readsPrec d = readParen (d > 10) (\r -> [(Identity m,t) | ("Identity",s) <- lex r, (m,t) <- readsPrec 11 s])
-instance Eq a   => Eq (Identity a) where
-  Identity a == Identity b = a == b
-instance Ord a  => Ord (Identity a) where
-  compare (Identity a) (Identity b) = compare a b
-
-instance Show a => Show (Constant a b) where
-  showsPrec d (Constant a) = showParen (d > 10) $
-    showString "Constant " . showsPrec 11 a
-instance Read a => Read (Constant a b) where
-  readsPrec d = readParen (d > 10) (\r -> [(Constant m,t) | ("Constant",s) <- lex r, (m,t) <- readsPrec 11 s])
-instance Eq a   => Eq (Constant a b) where
-  Constant a == Constant b = a == b
-instance Ord a  => Ord (Constant a b) where
-  compare (Constant a) (Constant b) = compare a b
+#ifndef HASKELL98
+# if __GLASGOW_HASKELL__ >= 708
+import Data.Typeable
+# endif
+#endif
 
 -- | Lifting of the 'Eq' class to unary type constructors.
 class Eq1 f where
-    eq1 :: (Eq a) => f a -> f a -> Bool
+    -- | Lift an equality test through the type constructor.
+    --
+    -- The function will usually be applied to an equality function,
+    -- but the more general type ensures that the implementation uses
+    -- it to compare elements of the first container with elements of
+    -- the second.
+    liftEq :: (a -> b -> Bool) -> f a -> f b -> Bool
 
+-- | Lift the standard @('==')@ function through the type constructor.
+eq1 :: (Eq1 f, Eq a) => f a -> f a -> Bool
+eq1 = liftEq (==)
+
 -- | Lifting of the 'Ord' class to unary type constructors.
 class (Eq1 f) => Ord1 f where
-    compare1 :: (Ord a) => f a -> f a -> Ordering
+    -- | Lift a 'compare' function through the type constructor.
+    --
+    -- The function will usually be applied to a comparison function,
+    -- but the more general type ensures that the implementation uses
+    -- it to compare elements of the first container with elements of
+    -- the second.
+    liftCompare :: (a -> b -> Ordering) -> f a -> f b -> Ordering
 
+-- | Lift the standard 'compare' function through the type constructor.
+compare1 :: (Ord1 f, Ord a) => f a -> f a -> Ordering
+compare1 = liftCompare compare
+
 -- | Lifting of the 'Read' class to unary type constructors.
 class Read1 f where
-    readsPrec1 :: (Read a) => Int -> ReadS (f a)
+    -- | 'readsPrec' function for an application of the type constructor
+    -- based on 'readsPrec' and 'readList' functions for the argument type.
+    liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
 
+    -- | 'readList' function for an application of the type constructor
+    -- based on 'readsPrec' and 'readList' functions for the argument type.
+    -- The default implementation using standard list syntax is correct
+    -- for most types.
+    liftReadList :: (Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
+    liftReadList rp rl = readListWith (liftReadsPrec rp rl 0)
+
+-- | Read a list (using square brackets and commas), given a function
+-- for reading elements.
+readListWith :: ReadS a -> ReadS [a]
+readListWith rp =
+    readParen False (\r -> [pr | ("[",s) <- lex r, pr <- readl s])
+  where
+    readl s = [([],t) | ("]",t) <- lex s] ++
+        [(x:xs,u) | (x,t) <- rp s, (xs,u) <- readl' t]
+    readl' s = [([],t) | ("]",t) <- lex s] ++
+        [(x:xs,v) | (",",t) <- lex s, (x,u) <- rp t, (xs,v) <- readl' u]
+
+-- | Lift the standard 'readsPrec' and 'readList' functions through the
+-- type constructor.
+readsPrec1 :: (Read1 f, Read a) => Int -> ReadS (f a)
+readsPrec1 = liftReadsPrec readsPrec readList
+
 -- | Lifting of the 'Show' class to unary type constructors.
 class Show1 f where
-    showsPrec1 :: (Show a) => Int -> f a -> ShowS
+    -- | 'showsPrec' function for an application of the type constructor
+    -- based on 'showsPrec' and 'showList' functions for the argument type.
+    liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) ->
+        Int -> f a -> ShowS
 
+    -- | 'showList' function for an application of the type constructor
+    -- based on 'showsPrec' and 'showList' functions for the argument type.
+    -- The default implementation using standard list syntax is correct
+    -- for most types.
+    liftShowList :: (Int -> a -> ShowS) -> ([a] -> ShowS) ->
+        [f a] -> ShowS
+    liftShowList sp sl = showListWith (liftShowsPrec sp sl 0)
+
+-- | Lift the standard 'showsPrec' and 'showList' functions through the
+-- type constructor.
+showsPrec1 :: (Show1 f, Show a) => Int -> f a -> ShowS
+showsPrec1 = liftShowsPrec showsPrec showList
+
+-- | Lifting of the 'Eq' class to binary type constructors.
+class Eq2 f where
+    -- | Lift equality tests through the type constructor.
+    --
+    -- The function will usually be applied to equality functions,
+    -- but the more general type ensures that the implementation uses
+    -- them to compare elements of the first container with elements of
+    -- the second.
+    liftEq2 :: (a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
+
+-- | Lift the standard @('==')@ function through the type constructor.
+eq2 :: (Eq2 f, Eq a, Eq b) => f a b -> f a b -> Bool
+eq2 = liftEq2 (==) (==)
+
+-- | Lifting of the 'Ord' class to binary type constructors.
+class (Eq2 f) => Ord2 f where
+    -- | Lift 'compare' functions through the type constructor.
+    --
+    -- The function will usually be applied to comparison functions,
+    -- but the more general type ensures that the implementation uses
+    -- them to compare elements of the first container with elements of
+    -- the second.
+    liftCompare2 :: (a -> b -> Ordering) -> (c -> d -> Ordering) ->
+        f a c -> f b d -> Ordering
+
+-- | Lift the standard 'compare' function through the type constructor.
+compare2 :: (Ord2 f, Ord a, Ord b) => f a b -> f a b -> Ordering
+compare2 = liftCompare2 compare compare
+
+-- | Lifting of the 'Read' class to binary type constructors.
+class Read2 f where
+    -- | 'readsPrec' function for an application of the type constructor
+    -- based on 'readsPrec' and 'readList' functions for the argument types.
+    liftReadsPrec2 :: (Int -> ReadS a) -> ReadS [a] ->
+        (Int -> ReadS b) -> ReadS [b] -> Int -> ReadS (f a b)
+
+    -- | 'readList' function for an application of the type constructor
+    -- based on 'readsPrec' and 'readList' functions for the argument types.
+    -- The default implementation using standard list syntax is correct
+    -- for most types.
+    liftReadList2 :: (Int -> ReadS a) -> ReadS [a] ->
+        (Int -> ReadS b) -> ReadS [b] -> ReadS [f a b]
+    liftReadList2 rp1 rl1 rp2 rl2 =
+        readListWith (liftReadsPrec2 rp1 rl1 rp2 rl2 0)
+
+-- | Lift the standard 'readsPrec' function through the type constructor.
+readsPrec2 :: (Read2 f, Read a, Read b) => Int -> ReadS (f a b)
+readsPrec2 = liftReadsPrec2 readsPrec readList readsPrec readList
+
+-- | Lifting of the 'Show' class to binary type constructors.
+class Show2 f where
+    -- | 'showsPrec' function for an application of the type constructor
+    -- based on 'showsPrec' and 'showList' functions for the argument types.
+    liftShowsPrec2 :: (Int -> a -> ShowS) -> ([a] -> ShowS) ->
+        (Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> f a b -> ShowS
+
+    -- | 'showList' function for an application of the type constructor
+    -- based on 'showsPrec' and 'showList' functions for the argument types.
+    -- The default implementation using standard list syntax is correct
+    -- for most types.
+    liftShowList2 :: (Int -> a -> ShowS) -> ([a] -> ShowS) ->
+        (Int -> b -> ShowS) -> ([b] -> ShowS) -> [f a b] -> ShowS
+    liftShowList2 sp1 sl1 sp2 sl2 =
+        showListWith (liftShowsPrec2 sp1 sl1 sp2 sl2 0)
+
+-- | Lift the standard 'showsPrec' function through the type constructor.
+showsPrec2 :: (Show2 f, Show a, Show b) => Int -> f a b -> ShowS
+showsPrec2 = liftShowsPrec2 showsPrec showList showsPrec showList
+
 -- Instances for Prelude type constructors
 
-instance Eq1 Maybe where eq1 = (==)
-instance Ord1 Maybe where compare1 = compare
-instance Read1 Maybe where readsPrec1 = readsPrec
-instance Show1 Maybe where showsPrec1 = showsPrec
+instance Eq1 Maybe where
+    liftEq _ Nothing Nothing = True
+    liftEq _ Nothing (Just _) = False
+    liftEq _ (Just _) Nothing = False
+    liftEq eq (Just x) (Just y) = eq x y
 
-instance Eq1 [] where eq1 = (==)
-instance Ord1 [] where compare1 = compare
-instance Read1 [] where readsPrec1 = readsPrec
-instance Show1 [] where showsPrec1 = showsPrec
+instance Ord1 Maybe where
+    liftCompare _ Nothing Nothing = EQ
+    liftCompare _ Nothing (Just _) = LT
+    liftCompare _ (Just _) Nothing = GT
+    liftCompare comp (Just x) (Just y) = comp x y
 
-instance (Eq a) => Eq1 ((,) a) where eq1 = (==)
-instance (Ord a) => Ord1 ((,) a) where compare1 = compare
-instance (Read a) => Read1 ((,) a) where readsPrec1 = readsPrec
-instance (Show a) => Show1 ((,) a) where showsPrec1 = showsPrec
+instance Read1 Maybe where
+    liftReadsPrec rp _ d =
+         readParen False (\ r -> [(Nothing,s) | ("Nothing",s) <- lex r])
+         `mappend`
+         readsData (readsUnaryWith rp "Just" Just) d
 
-instance (Eq a) => Eq1 (Either a) where eq1 = (==)
-instance (Ord a) => Ord1 (Either a) where compare1 = compare
-instance (Read a) => Read1 (Either a) where readsPrec1 = readsPrec
-instance (Show a) => Show1 (Either a) where showsPrec1 = showsPrec
+instance Show1 Maybe where
+    liftShowsPrec _ _ _ Nothing = showString "Nothing"
+    liftShowsPrec sp _ d (Just x) = showsUnaryWith sp "Just" d x
 
+instance Eq1 [] where
+    liftEq _ [] [] = True
+    liftEq _ [] (_:_) = False
+    liftEq _ (_:_) [] = False
+    liftEq eq (x:xs) (y:ys) = eq x y && liftEq eq xs ys
+
+instance Ord1 [] where
+    liftCompare _ [] [] = EQ
+    liftCompare _ [] (_:_) = LT
+    liftCompare _ (_:_) [] = GT
+    liftCompare comp (x:xs) (y:ys) = comp x y `mappend` liftCompare comp xs ys
+
+instance Read1 [] where
+    liftReadsPrec _ rl _ = rl
+
+instance Show1 [] where
+    liftShowsPrec _ sl _ = sl
+
+instance Eq2 (,) where
+    liftEq2 e1 e2 (x1, y1) (x2, y2) = e1 x1 x2 && e2 y1 y2
+
+instance Ord2 (,) where
+    liftCompare2 comp1 comp2 (x1, y1) (x2, y2) =
+        comp1 x1 x2 `mappend` comp2 y1 y2
+
+instance Read2 (,) where
+    liftReadsPrec2 rp1 _ rp2 _ _ = readParen False $ \ r ->
+        [((x,y), w) | ("(",s) <- lex r,
+                      (x,t)   <- rp1 0 s,
+                      (",",u) <- lex t,
+                      (y,v)   <- rp2 0 u,
+                      (")",w) <- lex v]
+
+instance Show2 (,) where
+    liftShowsPrec2 sp1 _ sp2 _ _ (x, y) =
+        showChar '(' . sp1 0 x . showChar ',' . sp2 0 y . showChar ')'
+
+instance (Eq a) => Eq1 ((,) a) where
+    liftEq = liftEq2 (==)
+
+instance (Ord a) => Ord1 ((,) a) where
+    liftCompare = liftCompare2 compare
+
+instance (Read a) => Read1 ((,) a) where
+    liftReadsPrec = liftReadsPrec2 readsPrec readList
+
+instance (Show a) => Show1 ((,) a) where
+    liftShowsPrec = liftShowsPrec2 showsPrec showList
+
+instance Eq2 Either where
+    liftEq2 e1 _ (Left x) (Left y) = e1 x y
+    liftEq2 _ _ (Left _) (Right _) = False
+    liftEq2 _ _ (Right _) (Left _) = False
+    liftEq2 _ e2 (Right x) (Right y) = e2 x y
+
+instance Ord2 Either where
+    liftCompare2 comp1 _ (Left x) (Left y) = comp1 x y
+    liftCompare2 _ _ (Left _) (Right _) = LT
+    liftCompare2 _ _ (Right _) (Left _) = GT
+    liftCompare2 _ comp2 (Right x) (Right y) = comp2 x y
+
+instance Read2 Either where
+    liftReadsPrec2 rp1 _ rp2 _ = readsData $
+         readsUnaryWith rp1 "Left" Left `mappend`
+         readsUnaryWith rp2 "Right" Right
+
+instance Show2 Either where
+    liftShowsPrec2 sp1 _ _ _ d (Left x) = showsUnaryWith sp1 "Left" d x
+    liftShowsPrec2 _ _ sp2 _ d (Right x) = showsUnaryWith sp2 "Right" d x
+
+instance (Eq a) => Eq1 (Either a) where
+    liftEq = liftEq2 (==)
+
+instance (Ord a) => Ord1 (Either a) where
+    liftCompare = liftCompare2 compare
+
+instance (Read a) => Read1 (Either a) where
+    liftReadsPrec = liftReadsPrec2 readsPrec readList
+
+instance (Show a) => Show1 (Either a) where
+    liftShowsPrec = liftShowsPrec2 showsPrec showList
+
+-- Instances for other functors defined in the base package
+
+instance Eq1 Identity where
+    liftEq eq (Identity x) (Identity y) = eq x y
+
+instance Ord1 Identity where
+    liftCompare comp (Identity x) (Identity y) = comp x y
+
+instance Read1 Identity where
+    liftReadsPrec rp _ = readsData $
+         readsUnaryWith rp "Identity" Identity
+
+instance Show1 Identity where
+    liftShowsPrec sp _ d (Identity x) = showsUnaryWith sp "Identity" d x
+
+instance Eq2 Const where
+    liftEq2 eq _ (Const x) (Const y) = eq x y
+
+instance Ord2 Const where
+    liftCompare2 comp _ (Const x) (Const y) = comp x y
+
+instance Read2 Const where
+    liftReadsPrec2 rp _ _ _ = readsData $
+         readsUnaryWith rp "Const" Const
+
+instance Show2 Const where
+    liftShowsPrec2 sp _ _ _ d (Const x) = showsUnaryWith sp "Const" d x
+
+instance (Eq a) => Eq1 (Const a) where
+    liftEq = liftEq2 (==)
+instance (Ord a) => Ord1 (Const a) where
+    liftCompare = liftCompare2 compare
+instance (Read a) => Read1 (Const a) where
+    liftReadsPrec = liftReadsPrec2 readsPrec readList
+instance (Show a) => Show1 (Const a) where
+    liftShowsPrec = liftShowsPrec2 showsPrec showList
+
 -- Building blocks
 
 -- | @'readsData' p d@ is a parser for datatypes where each alternative
@@ -115,20 +402,54 @@
 readsData reader d =
     readParen (d > 10) $ \ r -> [res | (kw,s) <- lex r, res <- reader kw s]
 
+-- | @'readsUnaryWith' rp n c n'@ matches the name of a unary data constructor
+-- and then parses its argument using @rp@.
+readsUnaryWith :: (Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
+readsUnaryWith rp name cons kw s =
+    [(cons x,t) | kw == name, (x,t) <- rp 11 s]
+
+-- | @'readsBinaryWith' rp1 rp2 n c n'@ matches the name of a binary
+-- data constructor and then parses its arguments using @rp1@ and @rp2@
+-- respectively.
+readsBinaryWith :: (Int -> ReadS a) -> (Int -> ReadS b) ->
+    String -> (a -> b -> t) -> String -> ReadS t
+readsBinaryWith rp1 rp2 name cons kw s =
+    [(cons x y,u) | kw == name, (x,t) <- rp1 11 s, (y,u) <- rp2 11 t]
+
+-- | @'showsUnaryWith' sp n d x@ produces the string representation of a
+-- unary data constructor with name @n@ and argument @x@, in precedence
+-- context @d@.
+showsUnaryWith :: (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
+showsUnaryWith sp name d x = showParen (d > 10) $
+    showString name . showChar ' ' . sp 11 x
+
+-- | @'showsBinaryWith' sp1 sp2 n d x y@ produces the string
+-- representation of a binary data constructor with name @n@ and arguments
+-- @x@ and @y@, in precedence context @d@.
+showsBinaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) ->
+    String -> Int -> a -> b -> ShowS
+showsBinaryWith sp1 sp2 name d x y = showParen (d > 10) $
+    showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y
+
+-- Obsolete building blocks
+
 -- | @'readsUnary' n c n'@ matches the name of a unary data constructor
 -- and then parses its argument using 'readsPrec'.
+{-# DEPRECATED readsUnary "Use readsUnaryWith to define liftReadsPrec" #-}
 readsUnary :: (Read a) => String -> (a -> t) -> String -> ReadS t
 readsUnary name cons kw s =
     [(cons x,t) | kw == name, (x,t) <- readsPrec 11 s]
 
 -- | @'readsUnary1' n c n'@ matches the name of a unary data constructor
 -- and then parses its argument using 'readsPrec1'.
+{-# DEPRECATED readsUnary1 "Use readsUnaryWith to define liftReadsPrec" #-}
 readsUnary1 :: (Read1 f, Read a) => String -> (f a -> t) -> String -> ReadS t
 readsUnary1 name cons kw s =
     [(cons x,t) | kw == name, (x,t) <- readsPrec1 11 s]
 
 -- | @'readsBinary1' n c n'@ matches the name of a binary data constructor
 -- and then parses its arguments using 'readsPrec1'.
+{-# DEPRECATED readsBinary1 "Use readsBinaryWith to define liftReadsPrec" #-}
 readsBinary1 :: (Read1 f, Read1 g, Read a) =>
     String -> (f a -> g a -> t) -> String -> ReadS t
 readsBinary1 name cons kw s =
@@ -137,19 +458,22 @@
 
 -- | @'showsUnary' n d x@ produces the string representation of a unary data
 -- constructor with name @n@ and argument @x@, in precedence context @d@.
+{-# DEPRECATED showsUnary "Use showsUnaryWith to define liftShowsPrec" #-}
 showsUnary :: (Show a) => String -> Int -> a -> ShowS
 showsUnary name d x = showParen (d > 10) $
     showString name . showChar ' ' . showsPrec 11 x
 
 -- | @'showsUnary1' n d x@ produces the string representation of a unary data
 -- constructor with name @n@ and argument @x@, in precedence context @d@.
+{-# DEPRECATED showsUnary1 "Use showsUnaryWith to define liftShowsPrec" #-}
 showsUnary1 :: (Show1 f, Show a) => String -> Int -> f a -> ShowS
 showsUnary1 name d x = showParen (d > 10) $
     showString name . showChar ' ' . showsPrec1 11 x
 
--- | @'showsBinary1' n d x@ produces the string representation of a binary
+-- | @'showsBinary1' n d x y@ produces the string representation of a binary
 -- data constructor with name @n@ and arguments @x@ and @y@, in precedence
 -- context @d@.
+{-# DEPRECATED showsBinary1 "Use showsBinaryWith to define liftShowsPrec" #-}
 showsBinary1 :: (Show1 f, Show1 g, Show a) =>
     String -> Int -> f a -> g a -> ShowS
 showsBinary1 name d x y = showParen (d > 10) $
@@ -157,232 +481,359 @@
         showChar ' ' . showsPrec1 11 y
 
 
-instance (Eq e, Eq1 m, Eq a) => Eq (ErrorT e m a) where
-    ErrorT x == ErrorT y = eq1 x y
+instance (Eq e, Eq1 m) => Eq1 (ErrorT e m) where
+    liftEq eq (ErrorT x) (ErrorT y) = liftEq (liftEq eq) x y
 
-instance (Ord e, Ord1 m, Ord a) => Ord (ErrorT e m a) where
-    compare (ErrorT x) (ErrorT y) = compare1 x y
+instance (Ord e, Ord1 m) => Ord1 (ErrorT e m) where
+    liftCompare comp (ErrorT x) (ErrorT y) = liftCompare (liftCompare comp) x y
 
-instance (Read e, Read1 m, Read a) => Read (ErrorT e m a) where
-    readsPrec = readsData $ readsUnary1 "ErrorT" ErrorT
+instance (Read e, Read1 m) => Read1 (ErrorT e m) where
+    liftReadsPrec rp rl = readsData $
+        readsUnaryWith (liftReadsPrec rp' rl') "ErrorT" ErrorT
+      where
+        rp' = liftReadsPrec rp rl
+        rl' = liftReadList rp rl
 
+instance (Show e, Show1 m) => Show1 (ErrorT e m) where
+    liftShowsPrec sp sl d (ErrorT m) =
+        showsUnaryWith (liftShowsPrec sp' sl') "ErrorT" d m
+      where
+        sp' = liftShowsPrec sp sl
+        sl' = liftShowList sp sl
+
+instance (Eq e, Eq1 m, Eq a) => Eq (ErrorT e m a) where (==) = eq1
+instance (Ord e, Ord1 m, Ord a) => Ord (ErrorT e m a) where compare = compare1
+instance (Read e, Read1 m, Read a) => Read (ErrorT e m a) where
+    readsPrec = readsPrec1
 instance (Show e, Show1 m, Show a) => Show (ErrorT e m a) where
-    showsPrec d (ErrorT m) = showsUnary1 "ErrorT" d m
+    showsPrec = showsPrec1
 
-instance (Eq e, Eq1 m) => Eq1 (ErrorT e m) where eq1 = (==)
-instance (Ord e, Ord1 m) => Ord1 (ErrorT e m) where compare1 = compare
-instance (Read e, Read1 m) => Read1 (ErrorT e m) where readsPrec1 = readsPrec
-instance (Show e, Show1 m) => Show1 (ErrorT e m) where showsPrec1 = showsPrec
+instance (Eq1 f) => Eq1 (IdentityT f) where
+    liftEq eq (IdentityT x) (IdentityT y) = liftEq eq x y
 
-instance (Eq1 f, Eq a) => Eq (IdentityT f a) where
-    IdentityT x == IdentityT y = eq1 x y
+instance (Ord1 f) => Ord1 (IdentityT f) where
+    liftCompare comp (IdentityT x) (IdentityT y) = liftCompare comp x y
 
-instance (Ord1 f, Ord a) => Ord (IdentityT f a) where
-    compare (IdentityT x) (IdentityT y) = compare1 x y
+instance (Read1 f) => Read1 (IdentityT f) where
+    liftReadsPrec rp rl = readsData $
+        readsUnaryWith (liftReadsPrec rp rl) "IdentityT" IdentityT
 
-instance (Read1 f, Read a) => Read (IdentityT f a) where
-    readsPrec = readsData $ readsUnary1 "IdentityT" IdentityT
+instance (Show1 f) => Show1 (IdentityT f) where
+    liftShowsPrec sp sl d (IdentityT m) =
+        showsUnaryWith (liftShowsPrec sp sl) "IdentityT" d m
 
-instance (Show1 f, Show a) => Show (IdentityT f a) where
-    showsPrec d (IdentityT m) = showsUnary1 "IdentityT" d m
+instance (Eq1 f, Eq a) => Eq (IdentityT f a) where (==) = eq1
+instance (Ord1 f, Ord a) => Ord (IdentityT f a) where compare = compare1
+instance (Read1 f, Read a) => Read (IdentityT f a) where readsPrec = readsPrec1
+instance (Show1 f, Show a) => Show (IdentityT f a) where showsPrec = showsPrec1
 
-instance Eq1 f => Eq1 (IdentityT f) where eq1 = (==)
-instance Ord1 f => Ord1 (IdentityT f) where compare1 = compare
-instance Read1 f => Read1 (IdentityT f) where readsPrec1 = readsPrec
-instance Show1 f => Show1 (IdentityT f) where showsPrec1 = showsPrec
+instance (Eq1 m) => Eq1 (ListT m) where
+    liftEq eq (ListT x) (ListT y) = liftEq (liftEq eq) x y
 
-instance (Eq1 m, Eq a) => Eq (ListT m a) where
-    ListT x == ListT y = eq1 x y
+instance (Ord1 m) => Ord1 (ListT m) where
+    liftCompare comp (ListT x) (ListT y) = liftCompare (liftCompare comp) x y
 
-instance (Ord1 m, Ord a) => Ord (ListT m a) where
-    compare (ListT x) (ListT y) = compare1 x y
+instance (Read1 m) => Read1 (ListT m) where
+    liftReadsPrec rp rl = readsData $
+        readsUnaryWith (liftReadsPrec rp' rl') "ListT" ListT
+      where
+        rp' = liftReadsPrec rp rl
+        rl' = liftReadList rp rl
 
-instance (Read1 m, Read a) => Read (ListT m a) where
-    readsPrec = readsData $ readsUnary1 "ListT" ListT
+instance (Show1 m) => Show1 (ListT m) where
+    liftShowsPrec sp sl d (ListT m) =
+        showsUnaryWith (liftShowsPrec sp' sl') "ListT" d m
+      where
+        sp' = liftShowsPrec sp sl
+        sl' = liftShowList sp sl
 
-instance (Show1 m, Show a) => Show (ListT m a) where
-    showsPrec d (ListT m) = showsUnary1 "ListT" d m
+instance (Eq1 m, Eq a) => Eq (ListT m a) where (==) = eq1
+instance (Ord1 m, Ord a) => Ord (ListT m a) where compare = compare1
+instance (Read1 m, Read a) => Read (ListT m a) where readsPrec = readsPrec1
+instance (Show1 m, Show a) => Show (ListT m a) where showsPrec = showsPrec1
 
-instance Eq1 m => Eq1 (ListT m) where eq1 = (==)
-instance Ord1 m => Ord1 (ListT m) where compare1 = compare
-instance Read1 m => Read1 (ListT m) where readsPrec1 = readsPrec
-instance Show1 m => Show1 (ListT m) where showsPrec1 = showsPrec
+instance (Eq1 m) => Eq1 (MaybeT m) where
+    liftEq eq (MaybeT x) (MaybeT y) = liftEq (liftEq eq) x y
 
-instance (Eq1 m, Eq a) => Eq (MaybeT m a) where
-    MaybeT x == MaybeT y = eq1 x y
+instance (Ord1 m) => Ord1 (MaybeT m) where
+    liftCompare comp (MaybeT x) (MaybeT y) = liftCompare (liftCompare comp) x y
 
-instance (Ord1 m, Ord a) => Ord (MaybeT m a) where
-    compare (MaybeT x) (MaybeT y) = compare1 x y
+instance (Read1 m) => Read1 (MaybeT m) where
+    liftReadsPrec rp rl = readsData $
+        readsUnaryWith (liftReadsPrec rp' rl') "MaybeT" MaybeT
+      where
+        rp' = liftReadsPrec rp rl
+        rl' = liftReadList rp rl
 
-instance (Read1 m, Read a) => Read (MaybeT m a) where
-    readsPrec = readsData $ readsUnary1 "MaybeT" MaybeT
+instance (Show1 m) => Show1 (MaybeT m) where
+    liftShowsPrec sp sl d (MaybeT m) =
+        showsUnaryWith (liftShowsPrec sp' sl') "MaybeT" d m
+      where
+        sp' = liftShowsPrec sp sl
+        sl' = liftShowList sp sl
 
-instance (Show1 m, Show a) => Show (MaybeT m a) where
-    showsPrec d (MaybeT m) = showsUnary1 "MaybeT" d m
+instance (Eq1 m, Eq a) => Eq (MaybeT m a) where (==) = eq1
+instance (Ord1 m, Ord a) => Ord (MaybeT m a) where compare = compare1
+instance (Read1 m, Read a) => Read (MaybeT m a) where readsPrec = readsPrec1
+instance (Show1 m, Show a) => Show (MaybeT m a) where showsPrec = showsPrec1
 
-instance Eq1 m => Eq1 (MaybeT m) where eq1 = (==)
-instance Ord1 m => Ord1 (MaybeT m) where compare1 = compare
-instance Read1 m => Read1 (MaybeT m) where readsPrec1 = readsPrec
-instance Show1 m => Show1 (MaybeT m) where showsPrec1 = showsPrec
+instance (Eq w, Eq1 m) => Eq1 (Lazy.WriterT w m) where
+    liftEq eq (Lazy.WriterT m1) (Lazy.WriterT m2) =
+        liftEq (liftEq2 eq (==)) m1 m2
 
-instance (Eq w, Eq1 m, Eq a) => Eq (Lazy.WriterT w m a) where
-    Lazy.WriterT x == Lazy.WriterT y = eq1 x y
+instance (Ord w, Ord1 m) => Ord1 (Lazy.WriterT w m) where
+    liftCompare comp (Lazy.WriterT m1) (Lazy.WriterT m2) =
+        liftCompare (liftCompare2 comp compare) m1 m2
 
-instance (Ord w, Ord1 m, Ord a) => Ord (Lazy.WriterT w m a) where
-    compare (Lazy.WriterT x) (Lazy.WriterT y) = compare1 x y
+instance (Read w, Read1 m) => Read1 (Lazy.WriterT w m) where
+    liftReadsPrec rp rl = readsData $
+        readsUnaryWith (liftReadsPrec rp' rl') "WriterT" Lazy.WriterT
+      where
+        rp' = liftReadsPrec2 rp rl readsPrec readList
+        rl' = liftReadList2 rp rl readsPrec readList
 
-instance (Read w, Read1 m, Read a) => Read (Lazy.WriterT w m a) where
-    readsPrec = readsData $ readsUnary1 "WriterT" Lazy.WriterT
+instance (Show w, Show1 m) => Show1 (Lazy.WriterT w m) where
+    liftShowsPrec sp sl d (Lazy.WriterT m) =
+        showsUnaryWith (liftShowsPrec sp' sl') "WriterT" d m
+      where
+        sp' = liftShowsPrec2 sp sl showsPrec showList
+        sl' = liftShowList2 sp sl showsPrec showList
 
+instance (Eq w, Eq1 m, Eq a) => Eq (Lazy.WriterT w m a) where
+    (==) = eq1
+instance (Ord w, Ord1 m, Ord a) => Ord (Lazy.WriterT w m a) where
+    compare = compare1
+instance (Read w, Read1 m, Read a) => Read (Lazy.WriterT w m a) where
+    readsPrec = readsPrec1
 instance (Show w, Show1 m, Show a) => Show (Lazy.WriterT w m a) where
-    showsPrec d (Lazy.WriterT m) = showsUnary1 "WriterT" d m
+    showsPrec = showsPrec1
 
-instance (Eq w, Eq1 m) => Eq1 (Lazy.WriterT w m) where eq1 = (==)
-instance (Ord w, Ord1 m) => Ord1 (Lazy.WriterT w m) where compare1 = compare
-instance (Read w, Read1 m) => Read1 (Lazy.WriterT w m) where readsPrec1 = readsPrec
-instance (Show w, Show1 m) => Show1 (Lazy.WriterT w m) where showsPrec1 = showsPrec
+instance (Eq w, Eq1 m) => Eq1 (Strict.WriterT w m) where
+    liftEq eq (Strict.WriterT m1) (Strict.WriterT m2) =
+        liftEq (liftEq2 eq (==)) m1 m2
 
-instance (Eq w, Eq1 m, Eq a) => Eq (Strict.WriterT w m a) where
-    Strict.WriterT x == Strict.WriterT y = eq1 x y
+instance (Ord w, Ord1 m) => Ord1 (Strict.WriterT w m) where
+    liftCompare comp (Strict.WriterT m1) (Strict.WriterT m2) =
+        liftCompare (liftCompare2 comp compare) m1 m2
 
-instance (Ord w, Ord1 m, Ord a) => Ord (Strict.WriterT w m a) where
-    compare (Strict.WriterT x) (Strict.WriterT y) = compare1 x y
+instance (Read w, Read1 m) => Read1 (Strict.WriterT w m) where
+    liftReadsPrec rp rl = readsData $
+        readsUnaryWith (liftReadsPrec rp' rl') "WriterT" Strict.WriterT
+      where
+        rp' = liftReadsPrec2 rp rl readsPrec readList
+        rl' = liftReadList2 rp rl readsPrec readList
 
-instance (Read w, Read1 m, Read a) => Read (Strict.WriterT w m a) where
-    readsPrec = readsData $ readsUnary1 "WriterT" Strict.WriterT
+instance (Show w, Show1 m) => Show1 (Strict.WriterT w m) where
+    liftShowsPrec sp sl d (Strict.WriterT m) =
+        showsUnaryWith (liftShowsPrec sp' sl') "WriterT" d m
+      where
+        sp' = liftShowsPrec2 sp sl showsPrec showList
+        sl' = liftShowList2 sp sl showsPrec showList
 
+instance (Eq w, Eq1 m, Eq a) => Eq (Strict.WriterT w m a) where
+    (==) = eq1
+instance (Ord w, Ord1 m, Ord a) => Ord (Strict.WriterT w m a) where
+    compare = compare1
+instance (Read w, Read1 m, Read a) => Read (Strict.WriterT w m a) where
+    readsPrec = readsPrec1
 instance (Show w, Show1 m, Show a) => Show (Strict.WriterT w m a) where
-    showsPrec d (Strict.WriterT m) = showsUnary1 "WriterT" d m
+    showsPrec = showsPrec1
 
-instance (Eq w, Eq1 m) => Eq1 (Strict.WriterT w m) where eq1 = (==)
-instance (Ord w, Ord1 m) => Ord1 (Strict.WriterT w m) where compare1 = compare
-instance (Read w, Read1 m) => Read1 (Strict.WriterT w m) where readsPrec1 = readsPrec
-instance (Show w, Show1 m) => Show1 (Strict.WriterT w m) where showsPrec1 = showsPrec
+instance (Eq1 f, Eq1 g) => Eq1 (Compose f g) where
+    liftEq eq (Compose x) (Compose y) = liftEq (liftEq eq) x y
 
-instance (Functor f, Eq1 f, Eq1 g, Eq a) => Eq (Compose f g a) where
-    Compose x == Compose y = eq1 (fmap Apply x) (fmap Apply y)
+instance (Ord1 f, Ord1 g) => Ord1 (Compose f g) where
+    liftCompare comp (Compose x) (Compose y) =
+        liftCompare (liftCompare comp) x y
 
-instance (Functor f, Ord1 f, Ord1 g, Ord a) => Ord (Compose f g a) where
-    compare (Compose x) (Compose y) = compare1 (fmap Apply x) (fmap Apply y)
+instance (Read1 f, Read1 g) => Read1 (Compose f g) where
+    liftReadsPrec rp rl = readsData $
+        readsUnaryWith (liftReadsPrec rp' rl') "Compose" Compose
+      where
+        rp' = liftReadsPrec rp rl
+        rl' = liftReadList rp rl
 
-instance (Functor f, Read1 f, Read1 g, Read a) => Read (Compose f g a) where
-    readsPrec = readsData $ readsUnary1 "Compose" (Compose . fmap getApply)
+instance (Show1 f, Show1 g) => Show1 (Compose f g) where
+    liftShowsPrec sp sl d (Compose x) =
+        showsUnaryWith (liftShowsPrec sp' sl') "Compose" d x
+      where
+        sp' = liftShowsPrec sp sl
+        sl' = liftShowList sp sl
 
-instance (Functor f, Show1 f, Show1 g, Show a) => Show (Compose f g a) where
-    showsPrec d (Compose x) = showsUnary1 "Compose" d (fmap Apply x)
+instance (Eq1 f, Eq1 g, Eq a) => Eq (Compose f g a) where
+    (==) = eq1
+instance (Ord1 f, Ord1 g, Ord a) => Ord (Compose f g a) where
+    compare = compare1
+instance (Read1 f, Read1 g, Read a) => Read (Compose f g a) where
+    readsPrec = readsPrec1
+instance (Show1 f, Show1 g, Show a) => Show (Compose f g a) where
+    showsPrec = showsPrec1
 
-instance (Functor f, Eq1 f, Eq1 g) => Eq1 (Compose f g) where eq1 = (==)
-instance (Functor f, Ord1 f, Ord1 g) => Ord1 (Compose f g) where
-    compare1 = compare
-instance (Functor f, Read1 f, Read1 g) => Read1 (Compose f g) where
-    readsPrec1 = readsPrec
-instance (Functor f, Show1 f, Show1 g) => Show1 (Compose f g) where
-    showsPrec1 = showsPrec
+instance (Eq1 f, Eq1 g) => Eq1 (Product f g) where
+    liftEq eq (Pair x1 y1) (Pair x2 y2) = liftEq eq x1 x2 && liftEq eq y1 y2
 
-instance (Eq1 f, Eq1 g, Eq a) => Eq (Product f g a) where
-    Pair x1 y1 == Pair x2 y2 = eq1 x1 x2 && eq1 y1 y2
+instance (Ord1 f, Ord1 g) => Ord1 (Product f g) where
+    liftCompare comp (Pair x1 y1) (Pair x2 y2) =
+        liftCompare comp x1 x2 `mappend` liftCompare comp y1 y2
 
-instance (Ord1 f, Ord1 g, Ord a) => Ord (Product f g a) where
-    compare (Pair x1 y1) (Pair x2 y2) =
-        compare1 x1 x2 `mappend` compare1 y1 y2
+instance (Read1 f, Read1 g) => Read1 (Product f g) where
+    liftReadsPrec rp rl = readsData $
+        readsBinaryWith (liftReadsPrec rp rl) (liftReadsPrec rp rl) "Pair" Pair
 
-instance (Read1 f, Read1 g, Read a) => Read (Product f g a) where
-    readsPrec = readsData $ readsBinary1 "Pair" Pair
+instance (Show1 f, Show1 g) => Show1 (Product f g) where
+    liftShowsPrec sp sl d (Pair x y) =
+        showsBinaryWith (liftShowsPrec sp sl) (liftShowsPrec sp sl) "Pair" d x y
 
+instance (Eq1 f, Eq1 g, Eq a) => Eq (Product f g a)
+    where (==) = eq1
+instance (Ord1 f, Ord1 g, Ord a) => Ord (Product f g a) where
+    compare = compare1
+instance (Read1 f, Read1 g, Read a) => Read (Product f g a) where
+    readsPrec = readsPrec1
 instance (Show1 f, Show1 g, Show a) => Show (Product f g a) where
-    showsPrec d (Pair x y) = showsBinary1 "Pair" d x y
+    showsPrec = showsPrec1
 
-instance (Eq1 f, Eq1 g) => Eq1 (Product f g) where eq1 = (==)
-instance (Ord1 f, Ord1 g) => Ord1 (Product f g) where compare1 = compare
-instance (Read1 f, Read1 g) => Read1 (Product f g) where readsPrec1 = readsPrec
-instance (Show1 f, Show1 g) => Show1 (Product f g) where showsPrec1 = showsPrec
+instance Eq2 Constant where
+    liftEq2 eq _ (Constant x) (Constant y) = eq x y
+instance Ord2 Constant where
+    liftCompare2 comp _ (Constant x) (Constant y) = comp x y
+instance Read2 Constant where
+    liftReadsPrec2 rp _ _ _ = readsData $
+         readsUnaryWith rp "Constant" Constant
+instance Show2 Constant where
+    liftShowsPrec2 sp _ _ _ d (Constant x) = showsUnaryWith sp "Constant" d x
 
-instance Eq a => Eq1 (Constant a) where eq1 = (==)
-instance Ord a => Ord1 (Constant a) where compare1 = compare
-instance Read a => Read1 (Constant a) where readsPrec1 = readsPrec
-instance Show a => Show1 (Constant a) where showsPrec1 = showsPrec
+instance (Eq a) => Eq1 (Constant a) where
+    liftEq = liftEq2 (==)
+instance (Ord a) => Ord1 (Constant a) where
+    liftCompare = liftCompare2 compare
+instance (Read a) => Read1 (Constant a) where
+    liftReadsPrec = liftReadsPrec2 readsPrec readList
+instance (Show a) => Show1 (Constant a) where
+    liftShowsPrec = liftShowsPrec2 showsPrec showList
 
-instance Eq1 Identity where eq1 = (==)
-instance Ord1 Identity where compare1 = compare
-instance Read1 Identity where readsPrec1 = readsPrec
-instance Show1 Identity where showsPrec1 = showsPrec
+instance Eq a => Eq (Constant a b) where
+    Constant a == Constant b = a == b
+instance Ord a => Ord (Constant a b) where
+    compare (Constant a) (Constant b) = compare a b
+instance (Read a) => Read (Constant a b) where
+    readsPrec = readsData $
+         readsUnaryWith readsPrec "Constant" Constant
+instance (Show a) => Show (Constant a b) where
+    showsPrec d (Constant x) = showsUnaryWith showsPrec "Constant" d x
 
--- Instances of Prelude classes
+instance Show a => Show (Identity a) where
+  showsPrec d (Identity a) = showParen (d > 10) $
+    showString "Identity " . showsPrec 11 a
+instance Read a => Read (Identity a) where
+  readsPrec d = readParen (d > 10) (\r -> [(Identity m,t) | ("Identity",s) <- lex r, (m,t) <- readsPrec 11 s])
+instance Eq a   => Eq (Identity a) where
+  Identity a == Identity b = a == b
+instance Ord a  => Ord (Identity a) where
+  compare (Identity a) (Identity b) = compare a b
 
--- kludge to get type with the same instances as g a
-newtype Apply g a = Apply (g a)
+#if MIN_VERSION_transformers(0,3,0)
+instance (Eq1 f) => Eq1 (Lift f) where
+    liftEq eq (Pure x1) (Pure x2) = eq x1 x2
+    liftEq _ (Pure _) (Other _) = False
+    liftEq _ (Other _) (Pure _) = False
+    liftEq eq (Other y1) (Other y2) = liftEq eq y1 y2
 
-getApply :: Apply g a -> g a
-getApply (Apply x) = x
+instance (Ord1 f) => Ord1 (Lift f) where
+    liftCompare comp (Pure x1) (Pure x2) = comp x1 x2
+    liftCompare _ (Pure _) (Other _) = LT
+    liftCompare _ (Other _) (Pure _) = GT
+    liftCompare comp (Other y1) (Other y2) = liftCompare comp y1 y2
 
-instance (Eq1 g, Eq a) => Eq (Apply g a) where
-    Apply x == Apply y = eq1 x y
+instance (Read1 f) => Read1 (Lift f) where
+    liftReadsPrec rp rl = readsData $
+        readsUnaryWith rp "Pure" Pure `mappend`
+        readsUnaryWith (liftReadsPrec rp rl) "Other" Other
 
-instance (Ord1 g, Ord a) => Ord (Apply g a) where
-    compare (Apply x) (Apply y) = compare1 x y
+instance (Show1 f) => Show1 (Lift f) where
+    liftShowsPrec sp _ d (Pure x) = showsUnaryWith sp "Pure" d x
+    liftShowsPrec sp sl d (Other y) =
+        showsUnaryWith (liftShowsPrec sp sl) "Other" d y
 
-instance (Read1 g, Read a) => Read (Apply g a) where
-    readsPrec d s = [(Apply a, t) | (a, t) <- readsPrec1 d s]
+instance (Eq1 f, Eq a) => Eq (Lift f a) where (==) = eq1
+instance (Ord1 f, Ord a) => Ord (Lift f a) where compare = compare1
+instance (Read1 f, Read a) => Read (Lift f a) where readsPrec = readsPrec1
+instance (Show1 f, Show a) => Show (Lift f a) where showsPrec = showsPrec1
 
-instance (Show1 g, Show a) => Show (Apply g a) where
-    showsPrec d (Apply x) = showsPrec1 d x
+instance (Eq1 f) => Eq1 (Backwards f) where
+    liftEq eq (Backwards x) (Backwards y) = liftEq eq x y
 
-#if MIN_VERSION_transformers(0,3,0)
-instance (Eq1 f, Eq a) => Eq (Lift f a) where
-    Pure x1 == Pure x2 = x1 == x2
-    Other y1 == Other y2 = eq1 y1 y2
-    _ == _ = False
+instance (Ord1 f) => Ord1 (Backwards f) where
+    liftCompare comp (Backwards x) (Backwards y) = liftCompare comp x y
 
-instance (Ord1 f, Ord a) => Ord (Lift f a) where
-    compare (Pure x1) (Pure x2) = compare x1 x2
-    compare (Pure _) (Other _) = LT
-    compare (Other _) (Pure _) = GT
-    compare (Other y1) (Other y2) = compare1 y1 y2
+instance (Read1 f) => Read1 (Backwards f) where
+    liftReadsPrec rp rl = readsData $
+        readsUnaryWith (liftReadsPrec rp rl) "Backwards" Backwards
 
-instance (Read1 f, Read a) => Read (Lift f a) where
-    readsPrec = readsData $
-        readsUnary "Pure" Pure `mappend` readsUnary1 "Other" Other
+instance (Show1 f) => Show1 (Backwards f) where
+    liftShowsPrec sp sl d (Backwards x) =
+        showsUnaryWith (liftShowsPrec sp sl) "Backwards" d x
 
-instance (Show1 f, Show a) => Show (Lift f a) where
-    showsPrec d (Pure x) = showsUnary "Pure" d x
-    showsPrec d (Other y) = showsUnary1 "Other" d y
+instance (Eq1 f, Eq a) => Eq (Backwards f a) where (==) = eq1
+instance (Ord1 f, Ord a) => Ord (Backwards f a) where compare = compare1
+instance (Read1 f, Read a) => Read (Backwards f a) where readsPrec = readsPrec1
+instance (Show1 f, Show a) => Show (Backwards f a) where showsPrec = showsPrec1
 
-instance Eq1 f => Eq1 (Lift f) where eq1 = (==)
-instance Ord1 f => Ord1 (Lift f) where compare1 = compare
-instance Read1 f => Read1 (Lift f) where readsPrec1 = readsPrec
-instance Show1 f => Show1 (Lift f) where showsPrec1 = showsPrec
+instance (Eq1 f) => Eq1 (Reverse f) where
+    liftEq eq (Reverse x) (Reverse y) = liftEq eq x y
 
-instance (Eq1 f, Eq a) => Eq (Backwards f a) where
-    Backwards x == Backwards y = eq1 x y
+instance (Ord1 f) => Ord1 (Reverse f) where
+    liftCompare comp (Reverse x) (Reverse y) = liftCompare comp x y
 
-instance (Ord1 f, Ord a) => Ord (Backwards f a) where
-    compare (Backwards x) (Backwards y) = compare1 x y
+instance (Read1 f) => Read1 (Reverse f) where
+    liftReadsPrec rp rl = readsData $
+        readsUnaryWith (liftReadsPrec rp rl) "Reverse" Reverse
 
-instance (Read1 f, Read a) => Read (Backwards f a) where
-    readsPrec = readsData $ readsUnary1 "Backwards" Backwards
+instance (Show1 f) => Show1 (Reverse f) where
+    liftShowsPrec sp sl d (Reverse x) =
+        showsUnaryWith (liftShowsPrec sp sl) "Reverse" d x
 
-instance (Show1 f, Show a) => Show (Backwards f a) where
-    showsPrec d (Backwards x) = showsUnary1 "Backwards" d x
+instance (Eq1 f, Eq a) => Eq (Reverse f a) where (==) = eq1
+instance (Ord1 f, Ord a) => Ord (Reverse f a) where compare = compare1
+instance (Read1 f, Read a) => Read (Reverse f a) where readsPrec = readsPrec1
+instance (Show1 f, Show a) => Show (Reverse f a) where showsPrec = showsPrec1
+#endif
 
-instance Eq1 f => Eq1 (Backwards f) where eq1 = (==)
-instance Ord1 f => Ord1 (Backwards f) where compare1 = compare
-instance Read1 f => Read1 (Backwards f) where readsPrec1 = readsPrec
-instance Show1 f => Show1 (Backwards f) where showsPrec1 = showsPrec
+#ifndef HASKELL98
+# if __GLASGOW_HASKELL__ >= 708
+deriving instance Typeable Eq1
+deriving instance Typeable Eq2
+deriving instance Typeable Ord1
+deriving instance Typeable Ord2
+deriving instance Typeable Read1
+deriving instance Typeable Read2
+deriving instance Typeable Show1
+deriving instance Typeable Show2
+# endif
+#endif
 
-instance (Eq1 f, Eq a) => Eq (Reverse f a) where
-    Reverse x == Reverse y = eq1 x y
+{- $example
+These functions can be used to assemble 'Read' and 'Show' instances for
+new algebraic types.  For example, given the definition
 
-instance (Ord1 f, Ord a) => Ord (Reverse f a) where
-    compare (Reverse x) (Reverse y) = compare1 x y
+> data T f a = Zero a | One (f a) | Two a (f a)
 
-instance (Read1 f, Read a) => Read (Reverse f a) where
-    readsPrec = readsData $ readsUnary1 "Reverse" Reverse
+a standard 'Read1' instance may be defined as
 
-instance (Show1 f, Show a) => Show (Reverse f a) where
-    showsPrec d (Reverse x) = showsUnary1 "Reverse" d x
+> instance (Read1 f) => Read1 (T f) where
+>     liftReadsPrec rp rl = readsData $
+>         readsUnaryWith rp "Zero" Zero `mappend`
+>         readsUnaryWith (liftReadsPrec rp rl) "One" One `mappend`
+>         readsBinaryWith rp (liftReadsPrec rp rl) "Two" Two
 
-instance (Eq1 f) => Eq1 (Reverse f) where eq1 = (==)
-instance (Ord1 f) => Ord1 (Reverse f) where compare1 = compare
-instance (Read1 f) => Read1 (Reverse f) where readsPrec1 = readsPrec
-instance (Show1 f) => Show1 (Reverse f) where showsPrec1 = showsPrec
-#endif
+and the corresponding 'Show1' instance as
+
+> instance (Show1 f) => Show1 (T f) where
+>     liftShowsPrec sp _ d (Zero x) =
+>         showsUnaryWith sp "Zero" d x
+>     liftShowsPrec sp sl d (One x) =
+>         showsUnaryWith (liftShowsPrec sp sl) "One" d x
+>     liftShowsPrec sp sl d (Two x y) =
+>         showsBinaryWith sp (liftShowsPrec sp sl) "Two" d x y
+
+-}
diff --git a/0.3/Data/Functor/Sum.hs b/0.3/Data/Functor/Sum.hs
--- a/0.3/Data/Functor/Sum.hs
+++ b/0.3/Data/Functor/Sum.hs
@@ -1,3 +1,25 @@
+{-# LANGUAGE CPP #-}
+
+#ifndef HASKELL98
+# if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE EmptyDataDecls #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+# endif
+# if __GLASGOW_HASKELL__ >= 704
+{-# LANGUAGE PolyKinds #-}
+# endif
+# if __GLASGOW_HASKELL__ >= 708
+{-# LANGUAGE AutoDeriveTypeable #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE KindSignatures #-}
+# endif
+#endif
 -- |
 -- Module      :  Data.Functor.Sum
 -- Copyright   :  (c) Ross Paterson 2014
@@ -19,32 +41,84 @@
 import Data.Monoid (mappend)
 import Data.Traversable (Traversable(traverse))
 
+#ifndef HASKELL98
+# if __GLASGOW_HASKELL__ >= 702
+import GHC.Generics
+# endif
+# if __GLASGOW_HASKELL__ >= 708
+import Data.Data
+# endif
+#endif
+
 -- | Lifted sum of functors.
 data Sum f g a = InL (f a) | InR (g a)
 
-instance (Eq1 f, Eq1 g, Eq a) => Eq (Sum f g a) where
-    InL x1 == InL x2 = eq1 x1 x2
-    InR y1 == InR y2 = eq1 y1 y2
-    _ == _ = False
+#ifndef HASKELL98
+# if __GLASGOW_HASKELL__ >= 702
+deriving instance Generic (Sum f g a)
 
-instance (Ord1 f, Ord1 g, Ord a) => Ord (Sum f g a) where
-    compare (InL x1) (InL x2) = compare1 x1 x2
-    compare (InL _) (InR _) = LT
-    compare (InR _) (InL _) = GT
-    compare (InR y1) (InR y2) = compare1 y1 y2
+instance Generic1 (Sum f g) where
+    type Rep1 (Sum f g) =
+      D1 MDSum (C1 MCInL (S1 NoSelector (Rec1 f))
+            :+: C1 MCInR (S1 NoSelector (Rec1 g)))
+    from1 (InL f) = M1 (L1 (M1 (M1 (Rec1 f))))
+    from1 (InR g) = M1 (R1 (M1 (M1 (Rec1 g))))
+    to1 (M1 (L1 (M1 (M1 f)))) = InL (unRec1 f)
+    to1 (M1 (R1 (M1 (M1 g)))) = InR (unRec1 g)
 
-instance (Read1 f, Read1 g, Read a) => Read (Sum f g a) where
-    readsPrec = readsData $
-        readsUnary1 "InL" InL `mappend` readsUnary1 "InR" InR
+data MDSum
+data MCInL
+data MCInR
 
-instance (Show1 f, Show1 g, Show a) => Show (Sum f g a) where
-    showsPrec d (InL x) = showsUnary1 "InL" d x
-    showsPrec d (InR y) = showsUnary1 "InR" d y
+instance Datatype MDSum where
+    datatypeName _ = "Sum"
+    moduleName   _ = "Data.Functor.Sum"
 
-instance (Eq1 f, Eq1 g) => Eq1 (Sum f g) where eq1 = (==)
-instance (Ord1 f, Ord1 g) => Ord1 (Sum f g) where compare1 = compare
-instance (Read1 f, Read1 g) => Read1 (Sum f g) where readsPrec1 = readsPrec
-instance (Show1 f, Show1 g) => Show1 (Sum f g) where showsPrec1 = showsPrec
+instance Constructor MCInL where
+    conName _ = "InL"
+
+instance Constructor MCInR where
+    conName _ = "InR"
+# endif
+
+# if __GLASGOW_HASKELL__ >= 708
+deriving instance Typeable Sum
+deriving instance (Data (f a), Data (g a), Typeable f, Typeable g, Typeable a)
+               => Data (Sum (f :: * -> *) (g :: * -> *) (a :: *))
+# endif
+#endif
+
+instance (Eq1 f, Eq1 g) => Eq1 (Sum f g) where
+    liftEq eq (InL x1) (InL x2) = liftEq eq x1 x2
+    liftEq _ (InL _) (InR _) = False
+    liftEq _ (InR _) (InL _) = False
+    liftEq eq (InR y1) (InR y2) = liftEq eq y1 y2
+
+instance (Ord1 f, Ord1 g) => Ord1 (Sum f g) where
+    liftCompare comp (InL x1) (InL x2) = liftCompare comp x1 x2
+    liftCompare _ (InL _) (InR _) = LT
+    liftCompare _ (InR _) (InL _) = GT
+    liftCompare comp (InR y1) (InR y2) = liftCompare comp y1 y2
+
+instance (Read1 f, Read1 g) => Read1 (Sum f g) where
+    liftReadsPrec rp rl = readsData $
+        readsUnaryWith (liftReadsPrec rp rl) "InL" InL `mappend`
+        readsUnaryWith (liftReadsPrec rp rl) "InR" InR
+
+instance (Show1 f, Show1 g) => Show1 (Sum f g) where
+    liftShowsPrec sp sl d (InL x) =
+        showsUnaryWith (liftShowsPrec sp sl) "InL" d x
+    liftShowsPrec sp sl d (InR y) =
+        showsUnaryWith (liftShowsPrec sp sl) "InR" d y
+
+instance (Eq1 f, Eq1 g, Eq a) => Eq (Sum f g a) where
+    (==) = eq1
+instance (Ord1 f, Ord1 g, Ord a) => Ord (Sum f g a) where
+    compare = compare1
+instance (Read1 f, Read1 g, Read a) => Read (Sum f g a) where
+    readsPrec = readsPrec1
+instance (Show1 f, Show1 g, Show a) => Show (Sum f g a) where
+    showsPrec = showsPrec1
 
 instance (Functor f, Functor g) => Functor (Sum f g) where
     fmap f (InL x) = InL (fmap f x)
diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -1,4 +1,4 @@
-Copyright 2012 Edward Kmett
+Copyright 2012-2015 Edward Kmett
 
 All rights reserved.
 
diff --git a/README.markdown b/README.markdown
--- a/README.markdown
+++ b/README.markdown
@@ -1,7 +1,7 @@
 transformers-compat
 ===================
 
-[![Build Status](https://secure.travis-ci.org/ekmett/transformers-compat.png?branch=master)](http://travis-ci.org/ekmett/transformers-compat)
+[![Hackage](https://img.shields.io/hackage/v/transformers-compat.svg)](https://hackage.haskell.org/package/transformers-compat) [![Build Status](https://secure.travis-ci.org/ekmett/transformers-compat.png?branch=master)](http://travis-ci.org/ekmett/transformers-compat)
 
 This provides a thin compatibility shim on top of transformers-0.2 to add the types that were added in transformers-0.3.
 
diff --git a/src/Control/Monad/Trans/Instances.hs b/src/Control/Monad/Trans/Instances.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Monad/Trans/Instances.hs
@@ -0,0 +1,386 @@
+{-# LANGUAGE CPP #-}
+
+#ifndef HASKELL98
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE EmptyDataDecls #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+
+# if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE Trustworthy #-}
+# endif
+
+# if __GLASGOW_HASKELL__ >= 704
+{-# LANGUAGE PolyKinds #-}
+# endif
+
+# if __GLASGOW_HASKELL__ >= 708
+{-# LANGUAGE DataKinds #-}
+# endif
+#endif
+
+{-# OPTIONS_GHC -fno-warn-deprecations #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Monad.Trans.Instances
+-- Copyright   :  (C) 2012-16 Edward Kmett
+-- License     :  BSD-style (see the file LICENSE)
+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Backports orphan instances which are not provided by other modules in
+-- @transformers-compat@.
+----------------------------------------------------------------------------
+module Control.Monad.Trans.Instances () where
+
+#ifndef MIN_VERSION_base
+#define MIN_VERSION_base(a,b,c) 1
+#endif
+
+#ifndef MIN_VERSION_transformers
+#define MIN_VERSION_transformers(a,b,c) 1
+#endif
+
+import           Control.Applicative.Backwards (Backwards(..))
+import           Control.Applicative.Lift (Lift(..))
+import           Control.Monad.IO.Class (MonadIO)
+import           Control.Monad.Trans.Class (MonadTrans)
+import           Control.Monad.Trans.Cont (ContT(..))
+import           Control.Monad.Trans.Error (ErrorT(..))
+import           Control.Monad.Trans.Except ()
+import           Control.Monad.Trans.Identity (IdentityT(..))
+import           Control.Monad.Trans.List (ListT(..))
+import           Control.Monad.Trans.Maybe (MaybeT(..))
+import qualified Control.Monad.Trans.RWS.Lazy as Lazy (RWST(..))
+import qualified Control.Monad.Trans.RWS.Strict as Strict (RWST(..))
+import           Control.Monad.Trans.Reader (ReaderT(..))
+import qualified Control.Monad.Trans.State.Lazy as Lazy (StateT(..))
+import qualified Control.Monad.Trans.State.Strict as Strict (StateT(..))
+import qualified Control.Monad.Trans.Writer.Lazy as Lazy (WriterT(..))
+import qualified Control.Monad.Trans.Writer.Strict as Strict (WriterT(..))
+import           Data.Functor.Classes
+import           Data.Functor.Compose (Compose(..))
+import           Data.Functor.Constant (Constant(..))
+import           Data.Functor.Identity (Identity(..))
+import           Data.Functor.Product (Product(..))
+import           Data.Functor.Reverse (Reverse(..))
+import           Data.Functor.Sum ()
+
+import           Control.Applicative
+import           Control.Monad (MonadPlus(..))
+import           Control.Monad.Fix (MonadFix(..))
+import           Data.Foldable (Foldable(..))
+import           Data.Maybe (fromMaybe)
+import           Data.Monoid (Monoid(..))
+import           Data.Traversable (Traversable(..))
+
+#if MIN_VERSION_base(4,4,0)
+import           Control.Monad.Zip (MonadZip(..))
+#endif
+
+#if MIN_VERSION_base(4,8,0)
+import           Data.Bifunctor (Bifunctor(..))
+#endif
+
+#ifndef HASKELL98
+import           Data.Data (Data)
+import           Data.Typeable
+
+# if __GLASGOW_HASKELL__ >= 702
+import           GHC.Generics
+# endif
+#endif
+
+#if !(MIN_VERSION_transformers(0,3,0))
+-- Foldable/Traversable instances
+instance (Foldable f) => Foldable (ErrorT e f) where
+    foldMap f (ErrorT a) = foldMap (either (const mempty) f) a
+
+instance (Traversable f) => Traversable (ErrorT e f) where
+    traverse f (ErrorT a) =
+        ErrorT <$> traverse (either (pure . Left) (fmap Right . f)) a
+
+instance (Foldable f) => Foldable (IdentityT f) where
+    foldMap f (IdentityT a) = foldMap f a
+
+instance (Traversable f) => Traversable (IdentityT f) where
+    traverse f (IdentityT a) = IdentityT <$> traverse f a
+
+instance (Foldable f) => Foldable (ListT f) where
+    foldMap f (ListT a) = foldMap (foldMap f) a
+
+instance (Traversable f) => Traversable (ListT f) where
+    traverse f (ListT a) = ListT <$> traverse (traverse f) a
+
+instance (Foldable f) => Foldable (MaybeT f) where
+    foldMap f (MaybeT a) = foldMap (foldMap f) a
+
+instance (Traversable f) => Traversable (MaybeT f) where
+    traverse f (MaybeT a) = MaybeT <$> traverse (traverse f) a
+
+instance (Foldable f) => Foldable (Lazy.WriterT w f) where
+    foldMap f = foldMap (f . fst) . Lazy.runWriterT
+
+instance (Traversable f) => Traversable (Lazy.WriterT w f) where
+    traverse f = fmap Lazy.WriterT . traverse f' . Lazy.runWriterT where
+       f' (a, b) = fmap (\ c -> (c, b)) (f a)
+
+instance (Foldable f) => Foldable (Strict.WriterT w f) where
+    foldMap f = foldMap (f . fst) . Strict.runWriterT
+
+instance (Traversable f) => Traversable (Strict.WriterT w f) where
+    traverse f = fmap Strict.WriterT . traverse f' . Strict.runWriterT where
+       f' (a, b) = fmap (\ c -> (c, b)) (f a)
+
+-- MonadFix instances for IdentityT and MaybeT
+instance (MonadFix m) => MonadFix (IdentityT m) where
+    mfix f = IdentityT (mfix (runIdentityT . f))
+
+instance (MonadFix m) => MonadFix (MaybeT m) where
+    mfix f = MaybeT (mfix (runMaybeT . f . fromMaybe bomb))
+      where bomb = error "mfix (MaybeT): inner computation returned Nothing"
+
+# if !(MIN_VERSION_base(4,9,0))
+-- Monad instances for Product
+instance (Monad f, Monad g) => Monad (Product f g) where
+    return x = Pair (return x) (return x)
+    Pair m n >>= f = Pair (m >>= fstP . f) (n >>= sndP . f)
+      where
+        fstP (Pair a _) = a
+        sndP (Pair _ b) = b
+
+instance (MonadPlus f, MonadPlus g) => MonadPlus (Product f g) where
+    mzero = Pair mzero mzero
+    Pair x1 y1 `mplus` Pair x2 y2 = Pair (x1 `mplus` x2) (y1 `mplus` y2)
+
+instance (MonadFix f, MonadFix g) => MonadFix (Product f g) where
+    mfix f = Pair (mfix (fstP . f)) (mfix (sndP . f))
+      where
+        fstP (Pair a _) = a
+        sndP (Pair _ b) = b
+# endif
+#endif
+
+#if !(MIN_VERSION_transformers(0,4,0))
+-- Alternative IO instance
+# if !(MIN_VERSION_base(4,9,0))
+-- The version bounds of transformers prior to 0.4.0.0 should prevent this
+-- instance from being compiled on base-4.8.0.0 and later, but we'll put
+-- a check here just to be safe.
+instance Alternative IO where
+    empty = mzero
+    (<|>) = mplus
+# endif
+#endif
+
+#if MIN_VERSION_transformers(0,4,0) && !(MIN_VERSION_transformers(0,4,3))
+-- transformers-0.4-specific Eq1, Ord1, Read1, and Show1 instances for Const
+instance (Eq a) => Eq1 (Const a) where
+    eq1 (Const x) (Const y) = x == y
+instance (Ord a) => Ord1 (Const a) where
+    compare1 (Const x) (Const y) = compare x y
+instance (Read a) => Read1 (Const a) where
+    readsPrec1 = readsData $ readsUnary "Const" Const
+instance (Show a) => Show1 (Const a) where
+    showsPrec1 d (Const x) = showsUnary "Const" d x
+#endif
+
+#if !(MIN_VERSION_transformers(0,5,0))
+-- Monoid Constant instance
+instance (Monoid a) => Monoid (Constant a b) where
+    mempty = Constant mempty
+    Constant x `mappend` Constant y = Constant (x `mappend` y)
+
+-- MonadZip instances
+# if MIN_VERSION_base(4,4,0)
+instance (MonadZip m) => MonadZip (IdentityT m) where
+    mzipWith f (IdentityT a) (IdentityT b) = IdentityT (mzipWith f a b)
+
+instance (MonadZip m) => MonadZip (ListT m) where
+    mzipWith f (ListT a) (ListT b) = ListT $ mzipWith (zipWith f) a b
+
+instance (MonadZip m) => MonadZip (MaybeT m) where
+    mzipWith f (MaybeT a) (MaybeT b) = MaybeT $ mzipWith (liftA2 f) a b
+
+instance (MonadZip m) => MonadZip (ReaderT r m) where
+    mzipWith f (ReaderT m) (ReaderT n) = ReaderT $ \ a ->
+        mzipWith f (m a) (n a)
+
+instance (Monoid w, MonadZip m) => MonadZip (Lazy.WriterT w m) where
+    mzipWith f (Lazy.WriterT x) (Lazy.WriterT y) = Lazy.WriterT $
+        mzipWith (\ ~(a, w) ~(b, w') -> (f a b, w `mappend` w')) x y
+
+instance (Monoid w, MonadZip m) => MonadZip (Strict.WriterT w m) where
+    mzipWith f (Strict.WriterT x) (Strict.WriterT y) = Strict.WriterT $
+        mzipWith (\ (a, w) (b, w') -> (f a b, w `mappend` w')) x y
+
+#  if !(MIN_VERSION_base(4,8,0))
+instance MonadZip Identity where
+    mzipWith f (Identity x) (Identity y) = Identity (f x y)
+    munzip (Identity (a, b)) = (Identity a, Identity b)
+#  endif
+
+#  if !(MIN_VERSION_base(4,9,0))
+instance (MonadZip f, MonadZip g) => MonadZip (Product f g) where
+    mzipWith f (Pair x1 y1) (Pair x2 y2) = Pair (mzipWith f x1 x2) (mzipWith f y1 y2)
+#  endif
+# endif
+
+# if MIN_VERSION_base(4,8,0)
+-- Bifunctor Constant instance
+instance Bifunctor Constant where
+    first f (Constant x) = Constant (f x)
+    second _ (Constant x) = Constant x
+# else
+-- Monoid Identity instance
+instance (Monoid a) => Monoid (Identity a) where
+    mempty = Identity mempty
+    mappend (Identity x) (Identity y) = Identity (mappend x y)
+# endif
+
+# ifndef HASKELL98
+-- Typeable instances
+#  if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710
+deriving instance Typeable Backwards
+deriving instance Typeable Constant
+deriving instance Typeable ContT
+deriving instance Typeable ErrorT
+deriving instance Typeable IdentityT
+deriving instance Typeable Lift
+deriving instance Typeable ListT
+deriving instance Typeable MaybeT
+deriving instance Typeable MonadTrans
+deriving instance Typeable Lazy.RWST
+deriving instance Typeable Strict.RWST
+deriving instance Typeable ReaderT
+deriving instance Typeable Reverse
+deriving instance Typeable Lazy.StateT
+deriving instance Typeable Strict.StateT
+
+#   if !(MIN_VERSION_base(4,9,0))
+deriving instance Typeable Compose
+deriving instance Typeable MonadIO
+deriving instance Typeable Product
+#   endif
+#  endif
+
+-- Identity instances
+#  if !(MIN_VERSION_base(4,8,0))
+deriving instance Typeable1 Identity
+deriving instance Data a => Data (Identity a)
+
+#   if __GLASGOW_HASKELL__ >= 702
+instance Generic (Identity a) where
+    type Rep (Identity a) = D1 MDIdentity (C1 MCIdentity (S1 MSIdentity (Rec0 a)))
+    from (Identity x) = M1 (M1 (M1 (K1 x)))
+    to (M1 (M1 (M1 (K1 x)))) = Identity x
+
+instance Generic1 Identity where
+    type Rep1 Identity = D1 MDIdentity (C1 MCIdentity (S1 MSIdentity Par1))
+    from1 (Identity x) = M1 (M1 (M1 (Par1 x)))
+    to1 (M1 (M1 (M1 x))) = Identity (unPar1 x)
+
+data MDIdentity
+data MCIdentity
+data MSIdentity
+
+instance Datatype MDIdentity where
+  datatypeName _ = "Identity"
+  moduleName _ = "Data.Functor.Identity"
+#    if __GLASGOW_HASKELL__ >= 708
+  isNewtype _ = True
+#    endif
+
+instance Constructor MCIdentity where
+  conName _ = "Identity"
+  conIsRecord _ = True
+
+instance Selector MSIdentity where
+  selName _ = "runIdentity"
+#   endif
+
+#   if __GLASGOW_HASKELL__ >= 708
+deriving instance Typeable 'Identity
+#   endif
+#  endif
+
+#  if !(MIN_VERSION_base(4,9,0))
+#   if __GLASGOW_HASKELL__ >= 702
+-- Generic(1) instances for Compose
+instance Generic (Compose f g a) where
+    type Rep (Compose f g a) =
+      D1 MDCompose
+        (C1 MCCompose
+          (S1 MSCompose (Rec0 (f (g a)))))
+    from (Compose x) = M1 (M1 (M1 (K1 x)))
+    to (M1 (M1 (M1 (K1 x)))) = Compose x
+
+instance Functor f => Generic1 (Compose f g) where
+    type Rep1 (Compose f g) =
+      D1 MDCompose
+        (C1 MCCompose
+          (S1 MSCompose (f :.: Rec1 g)))
+    from1 (Compose x) = M1 (M1 (M1 (Comp1 (fmap Rec1 x))))
+    to1 (M1 (M1 (M1 x))) = Compose (fmap unRec1 (unComp1 x))
+
+data MDCompose
+data MCCompose
+data MSCompose
+
+instance Datatype MDCompose where
+    datatypeName _ = "Compose"
+    moduleName   _ = "Data.Functor.Compose"
+#    if __GLASGOW_HASKELL__ >= 708
+    isNewtype    _ = True
+#    endif
+
+instance Constructor MCCompose where
+    conName     _ = "Compose"
+    conIsRecord _ = True
+
+instance Selector MSCompose where
+    selName _ = "getCompose"
+
+-- Generic(1) instances for Product
+instance Generic (Product f g a) where
+    type Rep (Product f g a) =
+      D1 MDProduct
+        (C1 MCPair
+          (S1 NoSelector (Rec0 (f a)) :*: S1 NoSelector (Rec0 (g a))))
+    from (Pair f g) = M1 (M1 (M1 (K1 f) :*: M1 (K1 g)))
+    to (M1 (M1 (M1 (K1 f) :*: M1 (K1 g)))) = Pair f g
+
+instance Generic1 (Product f g) where
+    type Rep1 (Product f g) =
+      D1 MDProduct
+        (C1 MCPair
+          (S1 NoSelector (Rec1 f) :*: S1 NoSelector (Rec1 g)))
+    from1 (Pair f g) = M1 (M1 (M1 (Rec1 f) :*: M1 (Rec1 g)))
+    to1 (M1 (M1 (M1 f :*: M1 g))) = Pair (unRec1 f) (unRec1 g)
+
+data MDProduct
+data MCPair
+
+instance Datatype MDProduct where
+    datatypeName _ = "Product"
+    moduleName   _ = "Data.Functor.Product"
+
+instance Constructor MCPair where
+    conName _ = "Pair"
+#   endif
+
+#   if __GLASGOW_HASKELL__ >= 708
+-- Data instances for Compose and Product
+deriving instance (Data (f (g a)), Typeable f, Typeable g, Typeable a)
+               => Data (Compose (f :: * -> *) (g :: * -> *) (a :: *))
+deriving instance (Data (f a), Data (g a), Typeable f, Typeable g, Typeable a)
+               => Data (Product (f :: * -> *) (g :: * -> *) (a :: *))
+#   endif
+#  endif
+# endif
+#endif
diff --git a/transformers-compat.cabal b/transformers-compat.cabal
--- a/transformers-compat.cabal
+++ b/transformers-compat.cabal
@@ -1,6 +1,6 @@
 name:          transformers-compat
 category:      Compatibility
-version:       0.4.0.4
+version:       0.5.0.2
 license:       BSD3
 cabal-version: >= 1.8
 license-file:  LICENSE
@@ -9,11 +9,11 @@
 stability:     provisional
 homepage:      http://github.com/ekmett/transformers-compat/
 bug-reports:   http://github.com/ekmett/transformers-compat/issues
-copyright:     Copyright (C) 2012 Edward A. Kmett
+copyright:     Copyright (C) 2012-2015 Edward A. Kmett
 synopsis:      A small compatibility shim exposing the new types from transformers 0.3 and 0.4 to older Haskell platforms.
 description:
   This package includes backported versions of types that were added
-  to transformers in transformers 0.3 and 0.4 for users who need strict
+  to transformers in transformers 0.3, 0.4, and 0.5 for users who need strict
   transformers 0.2 or 0.3 compatibility to run on old versions of the
   platform, but also need those types.
   .
@@ -39,15 +39,14 @@
   location: git://github.com/ekmett/transformers-compat.git
 
 flag two
-  default: False
-  description: Use transformers 0.2. This must be selected manually and should
-    probably only be used on older GHCs around 7.0.x.
+  default: True
+  description: Use transformers 0.2. This will be selected by cabal picking the appropriate version.
   manual: True
 
 flag three
   default: False
   manual: True
-  description: Use transformers 0.3. This should toggle on/off automatically.
+  description: Use transformers 0.3. This will be selected by cabal picking the appropriate version.
 
 flag mtl
   default: True
@@ -58,6 +57,12 @@
   build-depends:
     base >= 4.3 && < 5
 
+  hs-source-dirs:
+    src
+
+  exposed-modules:
+    Control.Monad.Trans.Instances
+
   other-modules:
     Paths_transformers_compat
 
@@ -73,10 +78,12 @@
         transformers >= 0.2 && < 0.3,
         mtl >= 2.0 && < 2.1
     else
-      build-depends: transformers >= 0.4.1 && < 0.5
+      build-depends: transformers >= 0.4.1 && < 0.6
 
   if !flag(mtl)
     cpp-options: -DHASKELL98
+  else
+    build-depends: ghc-prim
 
   if flag(two)
     exposed-modules: