diff --git a/Distribution/PackageDescription/Configuration.hs b/Distribution/PackageDescription/Configuration.hs
index 85ca4526ed1a010126472a48ed7504897981af59..7777b59093e3b7c684728b7f56b7557ec3434151 100644
--- a/Distribution/PackageDescription/Configuration.hs
+++ b/Distribution/PackageDescription/Configuration.hs
@@ -76,6 +76,11 @@ import Data.Map ( Map, fromListWith, toList )
 import qualified Data.Map as M
 import Data.Monoid
 
+#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ < 606)
+import qualified Text.Read as R
+import qualified Text.Read.Lex as L
+#endif
+
 ------------------------------------------------------------------------------
 
 -- | Simplify the condition and return its free variables.
@@ -307,7 +312,32 @@ resolveWithFlags dom os arch impl constrs trees checkDeps =
 -- | A map of dependencies.  Newtyped since the default monoid instance is not
 --   appropriate.  The monoid instance uses 'IntersectVersionRanges'.
 newtype DependencyMap = DependencyMap { unDependencyMap :: Map String VersionRange }
-    deriving (Eq, Show, Read)
+#if !defined(__GLASGOW_HASKELL__) || (__GLASGOW_HASKELL__ >= 606)
+  deriving (Show, Read)
+#else
+instance Show DependencyMap where
+  showsPrec d (DependencyMap m) =
+      showParen (d > 10) (showString "DependencyMap" . shows (M.toList m))
+
+instance Read DependencyMap where
+  readPrec = parens $ R.prec 10 $ do
+    R.Ident "DependencyMap" <- R.lexP
+    xs <- R.readPrec
+    return (DependencyMap (M.fromList xs))
+      where parens :: R.ReadPrec a -> R.ReadPrec a
+            parens p = optional
+             where
+               optional  = p R.+++ mandatory
+               mandatory = paren optional
+
+            paren :: R.ReadPrec a -> R.ReadPrec a
+            paren p = do L.Punc "(" <- R.lexP
+                         x          <- R.reset p
+                         L.Punc ")" <- R.lexP
+                         return x
+
+  readListPrec = R.readListPrecDefault
+#endif
 
 instance Monoid DependencyMap where
     mempty = DependencyMap M.empty
diff --git a/Distribution/Simple/PackageIndex.hs b/Distribution/Simple/PackageIndex.hs
index fe9eb589bc20443edde1f3cd75c2d3d0fb75faaf..55c6e33c8333ca09ab900cddf35f2c54790ddcd4 100644
--- a/Distribution/Simple/PackageIndex.hs
+++ b/Distribution/Simple/PackageIndex.hs
@@ -67,6 +67,11 @@ import Distribution.Version
          ( Version, withinRange )
 import Distribution.Simple.Utils (lowercase, equating, comparing, isInfixOf)
 
+#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ < 606)
+import Text.Read
+import qualified Text.Read.Lex as L
+#endif
+
 -- | The collection of information about packages from one or more 'PackageDB's.
 --
 -- It can be searched effeciently by package name and version.
@@ -82,7 +87,32 @@ data Package pkg => PackageIndex pkg = PackageIndex
   --
   (Map String [pkg])
 
+#if !defined(__GLASGOW_HASKELL__) || (__GLASGOW_HASKELL__ >= 606)
   deriving (Show, Read)
+#else
+instance (Package pkg, Show pkg) => Show (PackageIndex pkg) where
+  showsPrec d (PackageIndex m) =
+      showParen (d > 10) (showString "PackageIndex" . shows (Map.toList m))
+
+instance (Package pkg, Read pkg) => Read (PackageIndex pkg) where
+  readPrec = parens $ prec 10 $ do
+    Ident "PackageIndex" <- lexP
+    xs <- readPrec
+    return (PackageIndex (Map.fromList xs))
+      where parens :: ReadPrec a -> ReadPrec a
+            parens p = optional
+             where
+               optional  = p +++ mandatory
+               mandatory = paren optional
+
+            paren :: ReadPrec a -> ReadPrec a
+            paren p = do L.Punc "(" <- lexP
+                         x          <- reset p
+                         L.Punc ")" <- lexP
+                         return x
+
+  readListPrec = readListPrecDefault
+#endif
 
 instance Package pkg => Monoid (PackageIndex pkg) where
   mempty  = PackageIndex (Map.empty)