diff --git a/Cabal/Distribution/Version.hs b/Cabal/Distribution/Version.hs
index 8f5b8758e3ce673a73755f8a1652adff8dbcef7b..b79b3f4341bb4d652691d250a5b99ce107b35049 100644
--- a/Cabal/Distribution/Version.hs
+++ b/Cabal/Distribution/Version.hs
@@ -92,6 +92,8 @@ import qualified Text.PrettyPrint as Disp
 import Text.PrettyPrint ((<+>))
 import Control.Exception (assert)
 
+import qualified Text.Read as Read
+
 -- -----------------------------------------------------------------------------
 -- Versions
 
@@ -113,7 +115,7 @@ data Version = PV0 {-# UNPACK #-} !Word64
              -- which all fall into the [0..0xfffe] range), then PV0
              -- MUST be used. This is essential for the 'Eq' instance
              -- to work.
-             deriving (Data,Eq,Generic,Show,Read,Typeable)
+             deriving (Data,Eq,Generic,Typeable)
 
 instance Ord Version where
     compare (PV0 x)    (PV0 y)    = compare x y
@@ -137,6 +139,17 @@ instance Ord Version where
         y3 = fromIntegral ((w `shiftR` 16) .&. 0xffff) - 1
         y4 = fromIntegral               (w .&. 0xffff) - 1
 
+instance Show Version where
+    showsPrec d v = showParen (d > 10)
+        $ showString "mkVersion "
+        . showsPrec 11 (versionNumbers v)
+
+instance Read Version where
+    readPrec = Read.parens $ do
+        Read.Ident "mkVersion" <- Read.lexP
+        v <- Read.step Read.readPrec
+        return (mkVersion v)
+
 instance Binary Version
 
 instance NFData Version where
diff --git a/Cabal/tests/UnitTests/Distribution/Version.hs b/Cabal/tests/UnitTests/Distribution/Version.hs
index 4d07f26920fe0bbae939d834ff5ca81ad46ce956..98cb03c2f8f6b95a74f0531da5866a296cd95b08 100644
--- a/Cabal/tests/UnitTests/Distribution/Version.hs
+++ b/Cabal/tests/UnitTests/Distribution/Version.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# OPTIONS_GHC -fno-warn-orphans
                 -fno-warn-incomplete-patterns
                 -fno-warn-deprecations
@@ -21,6 +22,9 @@ import Data.Maybe (isJust, fromJust)
 import Data.List (sort, sortBy, nub)
 import Data.Ord  (comparing)
 import Data.Function (on)
+#if MIN_VERSION_base(4,6,0)
+import Text.Read (readMaybe)
+#endif
 
 versionTests :: [TestTree]
 versionTests =
@@ -40,6 +44,9 @@ versionTests =
   , property prop_VersionOrd
   , property prop_VersionOrd2
 
+  , property prop_ShowRead
+  , property prop_ShowRead_example
+
     -- the basic syntactic version range functions
   , property prop_anyVersion
   , property prop_noVersion
@@ -204,6 +211,17 @@ prop_VersionOrd2 :: VersionArb -> VersionArb -> Bool
 prop_VersionOrd2 (VersionArb v1) (VersionArb v2) =
     (==) v1 v2 == ((==) `on` mkVersion) v1 v2
 
+prop_ShowRead :: Version -> Property
+#if MIN_VERSION_base(4,6,0)
+prop_ShowRead v = Just v === readMaybe (show v)
+#else
+-- readMaybe is since base-4.6
+prop_ShowRead v = v === read (show v)
+#endif
+
+prop_ShowRead_example :: Bool
+prop_ShowRead_example = show (mkVersion [1,2,3]) == "mkVersion [1,2,3]"
+
 ---------------------------
 -- VersionRange properties
 --