diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown
--- a/CHANGELOG.markdown
+++ b/CHANGELOG.markdown
@@ -1,3 +1,8 @@
+0.4.0.3
+-------
+* Add instances for `Const`
+* Add instances for tuples up to 9
+
 0.4.0.2
 -------
 * Mark `Prelude.Extras` as Trustworthy
diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -1,4 +1,4 @@
-Copyright 2011-2014 Edward Kmett
+Copyright 2011-2016 Edward Kmett
 
 All rights reserved.
 
diff --git a/prelude-extras.cabal b/prelude-extras.cabal
--- a/prelude-extras.cabal
+++ b/prelude-extras.cabal
@@ -1,6 +1,6 @@
 name:          prelude-extras
 category:      Polymorphism, Combinators
-version:       0.4.0.2
+version:       0.4.0.3
 license:       BSD3
 cabal-version: >= 1.6
 license-file:  LICENSE
@@ -9,7 +9,7 @@
 stability:     provisional
 homepage:      http://github.com/ekmett/prelude-extras
 bug-reports:   http://github.com/ekmett/prelude-extras/issues
-copyright:     Copyright (C) 2011-2014 Edward A. Kmett
+copyright:     Copyright (C) 2011-2016 Edward A. Kmett
 synopsis:      Higher order versions of Prelude classes
 tested-with: GHC == 7.10.2, GHC == 7.8.4, GHC == 7.6.3, GHC == 7.4.2, GHC == 7.0.4
 description:
diff --git a/src/Prelude/Extras.hs b/src/Prelude/Extras.hs
--- a/src/Prelude/Extras.hs
+++ b/src/Prelude/Extras.hs
@@ -1,12 +1,12 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveFoldable #-}
 {-# LANGUAGE DeriveTraversable #-}
-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 702
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+#if __GLASGOW_HASKELL__ > 702
 #define DEFAULT_SIGNATURES
 {-# LANGUAGE DefaultSignatures #-}
 #endif
-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 701
+#if __GLASGOW_HASKELL__ >= 701
 -- GHC.Conc isn't generally safe, but we're just using TVar
 {-# LANGUAGE Trustworthy #-}
 #endif
@@ -44,13 +44,16 @@
   ) where
 
 import Control.Applicative
-import Control.Arrow (first)
-import Control.Concurrent (Chan, MVar)
-import Data.Complex (Complex)
 import Data.Fixed
 import Data.IORef (IORef)
 import Data.Monoid
+#if MIN_VERSION_base(4,4,0)
+import Data.Complex (Complex)
 import Data.Ratio (Ratio)
+import Control.Concurrent (Chan, MVar)
+#else
+import Control.Concurrent (MVar)
+#endif
 import Foreign.ForeignPtr (ForeignPtr)
 import Foreign.Ptr (Ptr, FunPtr)
 import Foreign.StablePtr (StablePtr)
@@ -80,7 +83,7 @@
 class Eq1 f where
   (==#) :: Eq a => f a -> f a -> Bool
 #ifdef DEFAULT_SIGNATURES
-  default (==#) :: (Eq (f a), Eq a) => f a -> f a -> Bool
+  default (==#) :: Eq (f a) => f a -> f a -> Bool
   (==#) = (==)
 #endif
 
@@ -88,9 +91,7 @@
 a /=# b = not (a ==# b)
 
 instance Eq1 Maybe where
-  Just a  ==# Just b  = a == b
-  Nothing ==# Nothing = True
-  _       ==# _       = False
+  (==#) = (==)
 
 instance Eq a => Eq1 (Either a) where
   (==#) = (==)
@@ -100,7 +101,7 @@
 
 #if MIN_VERSION_base(4,8,0)
 instance Eq1 Identity where (==#) = (==)
-instance Eq1 f => Eq1 (Alt f) where Alt x ==# Alt y = x ==# y
+deriving instance Eq1 f => Eq1 (Alt f)
 #endif
 #if MIN_VERSION_base(4,7,0)
 instance Eq1 Proxy where (==#) = (==)
@@ -111,6 +112,12 @@
 #if MIN_VERSION_base(4,6,0)
 instance Eq1 Down where (==#) = (==)
 #endif
+#if MIN_VERSION_base(4,8,0)
+instance Eq a => Eq1 (Const a) where (==#) = (==)
+#else
+instance Eq a => Eq1 (Const a) where
+  Const a ==# Const b = a == b
+#endif
 instance Eq1 Dual where (==#) = (==)
 instance Eq1 Sum where (==#) = (==)
 instance Eq1 Product where (==#) = (==)
@@ -130,23 +137,48 @@
 instance Eq1 Chan where (==#) = (==)
 #endif
 
+instance Eq a                                                   => Eq1 ((,)         a)                 where (==#) = (==)
+instance (Eq a, Eq b)                                           => Eq1 ((,,)        a b)               where (==#) = (==)
+instance (Eq a, Eq b, Eq c)                                     => Eq1 ((,,,)       a b c)             where (==#) = (==)
+instance (Eq a, Eq b, Eq c, Eq d)                               => Eq1 ((,,,,)      a b c d)           where (==#) = (==)
+instance (Eq a, Eq b, Eq c, Eq d, Eq e)                         => Eq1 ((,,,,,)     a b c d e)         where (==#) = (==)
+instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f)                   => Eq1 ((,,,,,,)    a b c d e f)       where (==#) = (==)
+instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g)             => Eq1 ((,,,,,,,)   a b c d e f g)     where (==#) = (==)
+instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h)       => Eq1 ((,,,,,,,,)  a b c d e f g h)   where (==#) = (==)
+instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, Eq i) => Eq1 ((,,,,,,,,,) a b c d e f g h i) where (==#) = (==)
+
 class Eq2 f where
   (==##) :: (Eq a, Eq b) => f a b -> f a b -> Bool
 #ifdef DEFAULT_SIGNATURES
-  default (==##) :: (Eq (f a b), Eq a, Eq b) => f a b -> f a b -> Bool
+  default (==##) :: Eq (f a b) => f a b -> f a b -> Bool
   (==##) = (==)
 #endif
 
 (/=##) :: (Eq2 f, Eq a, Eq b) => f a b -> f a b -> Bool
 a /=## b = not (a ==## b)
 
-instance Eq2 Either where
-  (==##) = (==)
+instance Eq2 Either where (==##) = (==)
 
+#if MIN_VERSION_base(4,8,0)
+instance Eq2 Const where (==##) = (==)
+#else
+instance Eq2 Const where Const x ==## Const y = x == y
+#endif
+
+instance                                                           Eq2 (,)                              where (==##) = (==)
+instance Eq a                                                   => Eq2 ((,,)         a)                 where (==##) = (==)
+instance (Eq a, Eq b)                                           => Eq2 ((,,,)        a b)               where (==##) = (==)
+instance (Eq a, Eq b, Eq c)                                     => Eq2 ((,,,,)       a b c)             where (==##) = (==)
+instance (Eq a, Eq b, Eq c, Eq d)                               => Eq2 ((,,,,,)      a b c d)           where (==##) = (==)
+instance (Eq a, Eq b, Eq c, Eq d, Eq e)                         => Eq2 ((,,,,,,)     a b c d e)         where (==##) = (==)
+instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f)                   => Eq2 ((,,,,,,,)    a b c d e f)       where (==##) = (==)
+instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g)             => Eq2 ((,,,,,,,,)   a b c d e f g)     where (==##) = (==)
+instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h)       => Eq2 ((,,,,,,,,,)  a b c d e f g h)   where (==##) = (==)
+
 class Eq1 f => Ord1 f where
   compare1 :: Ord a => f a -> f a -> Ordering
 #ifdef DEFAULT_SIGNATURES
-  default compare1 :: (Ord (f a), Ord a) => f a -> f a -> Ordering
+  default compare1 :: Ord (f a) => f a -> f a -> Ordering
   compare1 = compare
 #endif
 
@@ -171,7 +203,7 @@
 instance Ord1 [] where compare1 = compare
 #if MIN_VERSION_base(4,8,0)
 instance Ord1 Identity where compare1 = compare
-instance Ord1 f => Ord1 (Alt f) where compare1 (Alt x) (Alt y) = compare1 x y
+deriving instance Ord1 f => Ord1 (Alt f)
 #endif
 #if MIN_VERSION_base(4,7,0)
 instance Ord1 Proxy where compare1 = compare
@@ -182,6 +214,12 @@
 #if MIN_VERSION_base(4,6,0)
 instance Ord1 Down where compare1 = compare
 #endif
+#if MIN_VERSION_base(4,8,0)
+instance Ord a => Ord1 (Const a) where compare1 = compare
+#else
+instance Ord a => Ord1 (Const a) where
+  compare1 (Const x) (Const y) = compare x y
+#endif
 instance Ord1 Dual where compare1 = compare
 instance Ord1 Sum where compare1 = compare
 instance Ord1 Product where compare1 = compare
@@ -192,14 +230,24 @@
 instance Ord1 ForeignPtr where compare1 = compare
 instance Ord1 Fixed where compare1 = compare
 
+instance Ord a                                                           => Ord1 ((,)         a)                 where compare1 = compare
+instance (Ord a, Ord b)                                                  => Ord1 ((,,)        a b)               where compare1 = compare
+instance (Ord a, Ord b, Ord c)                                           => Ord1 ((,,,)       a b c)             where compare1 = compare
+instance (Ord a, Ord b, Ord c, Ord d)                                    => Ord1 ((,,,,)      a b c d)           where compare1 = compare
+instance (Ord a, Ord b, Ord c, Ord d, Ord e)                             => Ord1 ((,,,,,)     a b c d e)         where compare1 = compare
+instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f)                      => Ord1 ((,,,,,,)    a b c d e f)       where compare1 = compare
+instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g)               => Ord1 ((,,,,,,,)   a b c d e f g)     where compare1 = compare
+instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h)        => Ord1 ((,,,,,,,,)  a b c d e f g h)   where compare1 = compare
+instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h, Ord i) => Ord1 ((,,,,,,,,,) a b c d e f g h i) where compare1 = compare
 
+
 -- needs Haskell 2011
 -- instance Ord1 Complex where compare1 = compare
 
 class Eq2 f => Ord2 f where
   compare2 :: (Ord a, Ord b) => f a b -> f a b -> Ordering
 #ifdef DEFAULT_SIGNATURES
-  default compare2 :: (Ord (f a b), Ord a, Ord b) => f a b -> f a b -> Ordering
+  default compare2 :: Ord (f a b) => f a b -> f a b -> Ordering
   compare2 = compare
 #endif
 
@@ -224,11 +272,26 @@
   | otherwise = y
 
 instance Ord2 Either where compare2 = compare
+#if MIN_VERSION_base(4,8,0)
+instance Ord2 Const where compare2 = compare
+#else
+instance Ord2 Const where Const x `compare2` Const y = compare x y
+#endif
 
+instance                                                                    Ord2 (,)                              where compare2 = compare
+instance Ord a                                                           => Ord2 ((,,)         a)                 where compare2 = compare
+instance (Ord a, Ord b)                                                  => Ord2 ((,,,)        a b)               where compare2 = compare
+instance (Ord a, Ord b, Ord c)                                           => Ord2 ((,,,,)       a b c)             where compare2 = compare
+instance (Ord a, Ord b, Ord c, Ord d)                                    => Ord2 ((,,,,,)      a b c d)           where compare2 = compare
+instance (Ord a, Ord b, Ord c, Ord d, Ord e)                             => Ord2 ((,,,,,,)     a b c d e)         where compare2 = compare
+instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f)                      => Ord2 ((,,,,,,,)    a b c d e f)       where compare2 = compare
+instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g)               => Ord2 ((,,,,,,,,)   a b c d e f g)     where compare2 = compare
+instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h)        => Ord2 ((,,,,,,,,,)  a b c d e f g h)   where compare2 = compare
+
 class Show1 f where
   showsPrec1 :: Show a => Int -> f a -> ShowS
 #ifdef DEFAULT_SIGNATURES
-  default showsPrec1 :: (Show (f a), Show a) => Int -> f a -> ShowS
+  default showsPrec1 :: Show (f a) => Int -> f a -> ShowS
   showsPrec1 = showsPrec
 #endif
   showList1 :: (Show a) => [f a] -> ShowS
@@ -237,14 +300,12 @@
 show1 :: (Show1 f, Show a) => f a -> String
 show1 x = shows1 x ""
 
-
 shows1 :: (Show1 f, Show a) => f a -> ShowS
 shows1 = showsPrec1 0
 
 instance Show1 Maybe where showsPrec1 = showsPrec
 instance Show1 [] where showsPrec1 = showsPrec
 instance Show a => Show1 (Either a) where showsPrec1 = showsPrec
-instance Show a => Show1 ((,) a) where showsPrec1 = showsPrec
 #if MIN_VERSION_base(4,8,0)
 instance Show1 Identity where showsPrec1 = showsPrec
 #endif
@@ -266,6 +327,15 @@
     $ showString "Alt "
     . showsPrec1 11 x
 #endif
+#if MIN_VERSION_base(4,8,0)
+instance Show a => Show1 (Const a) where showsPrec1 = showsPrec
+#else
+instance Show a => Show1 (Const a) where
+  showsPrec1 p (Const x)
+     = showParen (p > 10)
+     $ showString "Const "
+     . showsPrec 11 x
+#endif
 instance Show1 Dual where showsPrec1 = showsPrec
 instance Show1 Sum where showsPrec1 = showsPrec
 instance Show1 Product where showsPrec1 = showsPrec
@@ -278,12 +348,20 @@
 instance Show1 Complex where showsPrec1 = showsPrec
 #endif
 
--- instance Show1 Complex
+instance Show a                                                                   => Show1 ((,)         a)                 where showsPrec1 = showsPrec
+instance (Show a, Show b)                                                         => Show1 ((,,)        a b)               where showsPrec1 = showsPrec
+instance (Show a, Show b, Show c)                                                 => Show1 ((,,,)       a b c)             where showsPrec1 = showsPrec
+instance (Show a, Show b, Show c, Show d)                                         => Show1 ((,,,,)      a b c d)           where showsPrec1 = showsPrec
+instance (Show a, Show b, Show c, Show d, Show e)                                 => Show1 ((,,,,,)     a b c d e)         where showsPrec1 = showsPrec
+instance (Show a, Show b, Show c, Show d, Show e, Show f)                         => Show1 ((,,,,,,)    a b c d e f)       where showsPrec1 = showsPrec
+instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g)                 => Show1 ((,,,,,,,)   a b c d e f g)     where showsPrec1 = showsPrec
+instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h)         => Show1 ((,,,,,,,,)  a b c d e f g h)   where showsPrec1 = showsPrec
+instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i) => Show1 ((,,,,,,,,,) a b c d e f g h i) where showsPrec1 = showsPrec
 
 class Show2 f where
   showsPrec2 :: (Show a, Show b) => Int -> f a b -> ShowS
 #ifdef DEFAULT_SIGNATURES
-  default showsPrec2 :: (Show (f a b), Show a, Show b) => Int -> f a b -> ShowS
+  default showsPrec2 :: Show (f a b) => Int -> f a b -> ShowS
   showsPrec2 = showsPrec
 #endif
   showList2  :: (Show a, Show b) => [f a b] -> ShowS
@@ -296,9 +374,23 @@
 shows2 :: (Show2 f, Show a, Show b) => f a b -> ShowS
 shows2 = showsPrec2 0
 
-instance Show2 (,)    where showsPrec2 = showsPrec
 instance Show2 Either where showsPrec2 = showsPrec
+#if MIN_VERSION_base(4,8,0)
+instance Show2 Const where showsPrec2 = showsPrec
+#else
+instance Show2 Const where showsPrec2 = showsPrec1
+#endif
 
+instance                                                                             Show2 (,)                              where showsPrec2 = showsPrec
+instance Show a                                                                   => Show2 ((,,)         a)                 where showsPrec2 = showsPrec
+instance (Show a, Show b)                                                         => Show2 ((,,,)        a b)               where showsPrec2 = showsPrec
+instance (Show a, Show b, Show c)                                                 => Show2 ((,,,,)       a b c)             where showsPrec2 = showsPrec
+instance (Show a, Show b, Show c, Show d)                                         => Show2 ((,,,,,)      a b c d)           where showsPrec2 = showsPrec
+instance (Show a, Show b, Show c, Show d, Show e)                                 => Show2 ((,,,,,,)     a b c d e)         where showsPrec2 = showsPrec
+instance (Show a, Show b, Show c, Show d, Show e, Show f)                         => Show2 ((,,,,,,,)    a b c d e f)       where showsPrec2 = showsPrec
+instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g)                 => Show2 ((,,,,,,,,)   a b c d e f g)     where showsPrec2 = showsPrec
+instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h)         => Show2 ((,,,,,,,,,)  a b c d e f g h)   where showsPrec2 = showsPrec
+
 showList__ :: (a -> ShowS) ->  [a] -> ShowS
 showList__ _     []     s = "[]" ++ s
 showList__ showx (x:xs) s = '[' : showx x (showl xs)
@@ -309,7 +401,7 @@
 class Read1 f where
   readsPrec1    :: Read a => Int -> ReadS (f a)
 #ifdef DEFAULT_SIGNATURES
-  default readsPrec1 :: (Read (f a), Read a) => Int -> ReadS (f a)
+  default readsPrec1 :: Read (f a) => Int -> ReadS (f a)
   readsPrec1 = readsPrec
 #endif
 
@@ -362,10 +454,6 @@
   readsPrec1 = readsPrec
   readList1 = readList
 
-instance Read a => Read1 ((,) a) where
-  readsPrec1 = readsPrec
-  readList1 = readList
-
 #if MIN_VERSION_base(4,8,0)
 instance Read1 Identity where
   readsPrec1 = readsPrec
@@ -389,7 +477,6 @@
   readList1 = readList
 #else
 instance Read1 ZipList where
-  readList1 = readList1Default
   readsPrec1 _
     = readParen False $ \s ->
       do ("ZipList"   , s1) <- lex s
@@ -407,13 +494,24 @@
   readList1 = readList
 #elif MIN_VERSION_base(4,6,0)
 instance Read1 Down where
-  readList1 = readList1Default
   readsPrec1 p = readParen (p > 10) $ \s ->
     do ("Down",s1) <- lex s
        (x     ,s2) <- readsPrec 11 s1
        return (Down x, s2)
 #endif
 
+#if MIN_VERSION_base(4,8,0)
+instance Read a => Read1 (Const a) where
+  readsPrec1 = readsPrec
+  readList1 = readList
+#else
+instance Read a => Read1 (Const a) where
+  readsPrec1 p = readParen (p > 10) $ \s ->
+    do ("Const",s1) <- lex s
+       (x      ,s2) <- readsPrec 11 s1
+       return (Const x, s2)
+#endif
+
 instance Read1 Dual where
   readsPrec1 = readsPrec
   readList1 = readList
@@ -440,10 +538,20 @@
   readList1 = readList
 #endif
 
+instance Read a                                                                   => Read1 ((,)         a)                 where readsPrec1 = readsPrec; readList1 = readList
+instance (Read a, Read b)                                                         => Read1 ((,,)        a b)               where readsPrec1 = readsPrec; readList1 = readList
+instance (Read a, Read b, Read c)                                                 => Read1 ((,,,)       a b c)             where readsPrec1 = readsPrec; readList1 = readList
+instance (Read a, Read b, Read c, Read d)                                         => Read1 ((,,,,)      a b c d)           where readsPrec1 = readsPrec; readList1 = readList
+instance (Read a, Read b, Read c, Read d, Read e)                                 => Read1 ((,,,,,)     a b c d e)         where readsPrec1 = readsPrec; readList1 = readList
+instance (Read a, Read b, Read c, Read d, Read e, Read f)                         => Read1 ((,,,,,,)    a b c d e f)       where readsPrec1 = readsPrec; readList1 = readList
+instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g)                 => Read1 ((,,,,,,,)   a b c d e f g)     where readsPrec1 = readsPrec; readList1 = readList
+instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h)         => Read1 ((,,,,,,,,)  a b c d e f g h)   where readsPrec1 = readsPrec; readList1 = readList
+instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, Read i) => Read1 ((,,,,,,,,,) a b c d e f g h i) where readsPrec1 = readsPrec; readList1 = readList
+
 class Read2 f where
   readsPrec2    :: (Read a, Read b) => Int -> ReadS (f a b)
 #ifdef DEFAULT_SIGNATURES
-  default readsPrec2 :: (Read (f a b), Read a, Read b) => Int -> ReadS (f a b)
+  default readsPrec2 :: Read (f a b) => Int -> ReadS (f a b)
   readsPrec2 = readsPrec
 #endif
   readList2     :: (Read a, Read b) => ReadS [f a b]
@@ -457,14 +565,30 @@
 readListPrec2 = readS_to_Prec (\_ -> readList2)
 #endif
 
-instance Read2 (,) where
+instance Read2 Either where
   readsPrec2 = readsPrec
   readList2 = readList
 
-instance Read2 Either where
+#if MIN_VERSION_base(4,8,0)
+instance Read2 Const where
   readsPrec2 = readsPrec
   readList2 = readList
+#else
+instance Read2 Const where
+  readsPrec2 = readsPrec1
+  readList2 = readList1
+#endif
 
+instance                                                                             Read2 (,)                              where readsPrec2 = readsPrec; readList2 = readList
+instance Read a                                                                   => Read2 ((,,)         a)                 where readsPrec2 = readsPrec; readList2 = readList
+instance (Read a, Read b)                                                         => Read2 ((,,,)        a b)               where readsPrec2 = readsPrec; readList2 = readList
+instance (Read a, Read b, Read c)                                                 => Read2 ((,,,,)       a b c)             where readsPrec2 = readsPrec; readList2 = readList
+instance (Read a, Read b, Read c, Read d)                                         => Read2 ((,,,,,)      a b c d)           where readsPrec2 = readsPrec; readList2 = readList
+instance (Read a, Read b, Read c, Read d, Read e)                                 => Read2 ((,,,,,,)     a b c d e)         where readsPrec2 = readsPrec; readList2 = readList
+instance (Read a, Read b, Read c, Read d, Read e, Read f)                         => Read2 ((,,,,,,,)    a b c d e f)       where readsPrec2 = readsPrec; readList2 = readList
+instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g)                 => Read2 ((,,,,,,,,)   a b c d e f g)     where readsPrec2 = readsPrec; readList2 = readList
+instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h)         => Read2 ((,,,,,,,,,)  a b c d e f g h)   where readsPrec2 = readsPrec; readList2 = readList
+
 read2  :: (Read2 f, Read a, Read b) => String -> f a b
 read2 s = either error id (readEither2 s)
 
@@ -491,7 +615,7 @@
 readListPrec2Default = list readPrec2
 #endif
 
--- annoying to hav to copy these from Text.Read
+-- annoying to have to copy these from Text.Read
 list :: ReadPrec a -> ReadPrec [a]
 -- ^ @(list p)@ parses a list of things parsed by @p@,
 -- using the usual square-bracket syntax.
@@ -513,38 +637,26 @@
        xs <- listRest True
        return (x:xs)
 
+-- If Show1 and Read1 are ever derived by the same mechanism as
+-- Show and Read, rather than GND, that will change their behavior
+-- here.
 newtype Lift1 f a = Lift1 { lower1 :: f a }
-  deriving (Functor, Foldable, Traversable)
-
-instance Eq1 f   => Eq1 (Lift1 f)   where Lift1 a ==# Lift1 b = a ==# b
-instance Ord1 f  => Ord1 (Lift1 f)  where Lift1 a `compare1` Lift1 b = compare1 a b
-instance Show1 f => Show1 (Lift1 f) where showsPrec1 d (Lift1 a) = showsPrec1 d a
-instance Read1 f => Read1 (Lift1 f) where
-  readsPrec1 d = map (first Lift1) . readsPrec1 d
+  deriving (Functor, Foldable, Traversable, Eq1, Ord1, Show1, Read1)
 
-instance (Eq1 f, Eq a) => Eq (Lift1 f a)       where Lift1 a == Lift1 b = a ==# b
-instance (Ord1 f, Ord a) => Ord (Lift1 f a)    where Lift1 a `compare` Lift1 b = compare1 a b
-instance (Show1 f, Show a) => Show (Lift1 f a) where showsPrec d (Lift1 a) = showsPrec1 d a
-instance (Read1 f, Read a) => Read (Lift1 f a) where
-  readsPrec d = map (first Lift1) . readsPrec1 d
+instance (Eq1 f, Eq a) => Eq (Lift1 f a)       where (==) = (==#)
+instance (Ord1 f, Ord a) => Ord (Lift1 f a)    where compare = compare1
+instance (Show1 f, Show a) => Show (Lift1 f a) where showsPrec = showsPrec1
+instance (Read1 f, Read a) => Read (Lift1 f a) where readsPrec = readsPrec1
 
 newtype Lift2 f a b = Lift2 { lower2 :: f a b }
-  deriving (Functor, Foldable, Traversable)
-
-instance Eq2 f   => Eq2 (Lift2 f)   where Lift2 a ==## Lift2 b = a ==## b
-instance Ord2 f  => Ord2 (Lift2 f)  where Lift2 a `compare2` Lift2 b = compare2 a b
-instance Show2 f => Show2 (Lift2 f) where showsPrec2 d (Lift2 a) = showsPrec2 d a
-instance Read2 f => Read2 (Lift2 f) where
-  readsPrec2 d = map (first Lift2) . readsPrec2 d
+  deriving (Functor, Foldable, Traversable, Eq2, Ord2, Show2, Read2)
 
-instance (Eq2 f, Eq a)     => Eq1 (Lift2 f a)   where Lift2 a ==# Lift2 b = a ==## b
-instance (Ord2 f, Ord a)   => Ord1 (Lift2 f a)  where Lift2 a `compare1` Lift2 b = compare2 a b
-instance (Show2 f, Show a) => Show1 (Lift2 f a) where showsPrec1 d (Lift2 a) = showsPrec2 d a
-instance (Read2 f, Read a) => Read1 (Lift2 f a) where
-  readsPrec1 d = map (first Lift2) . readsPrec2 d
+instance (Eq2 f, Eq a)     => Eq1 (Lift2 f a)   where (==#) = (==##)
+instance (Ord2 f, Ord a)   => Ord1 (Lift2 f a)  where compare1 = compare2
+instance (Show2 f, Show a) => Show1 (Lift2 f a) where showsPrec1 = showsPrec2
+instance (Read2 f, Read a) => Read1 (Lift2 f a) where readsPrec1 = readsPrec2
 
-instance (Eq2 f, Eq a, Eq b)       => Eq (Lift2 f a b)   where Lift2 a == Lift2 b = a ==## b
-instance (Ord2 f, Ord a, Ord b)    => Ord (Lift2 f a b)  where Lift2 a `compare` Lift2 b = compare2 a b
-instance (Show2 f, Show a, Show b) => Show (Lift2 f a b) where showsPrec d (Lift2 a) = showsPrec2 d a
-instance (Read2 f, Read a, Read b) => Read (Lift2 f a b) where
-  readsPrec d = map (first Lift2) . readsPrec2 d
+instance (Eq2 f, Eq a, Eq b)       => Eq (Lift2 f a b)   where (==) = (==##)
+instance (Ord2 f, Ord a, Ord b)    => Ord (Lift2 f a b)  where compare = compare2
+instance (Show2 f, Show a, Show b) => Show (Lift2 f a b) where showsPrec = showsPrec2
+instance (Read2 f, Read a, Read b) => Read (Lift2 f a b) where readsPrec = readsPrec2