diff --git a/Distribution/ReadE.hs b/Distribution/ReadE.hs
index 2bb5a101a02d038bb2b7f56caf952a350b2f98ea..784f2e3aebf85cb3be08c2da99eba31cd7a39738 100644
--- a/Distribution/ReadE.hs
+++ b/Distribution/ReadE.hs
@@ -44,7 +44,6 @@ module Distribution.ReadE (
    -- * ReadE
    ReadE(..), succeedReadE, failReadE,
    -- * Projections
-   readS_to_E, readS_to_E', readP_to_E, readP_to_E',
    parseReadE, readEOrFail,
   ) where
 
@@ -66,26 +65,6 @@ succeedReadE f = ReadE (Right . f)
 failReadE :: ErrorMsg -> ReadE a
 failReadE = ReadE . const Left
 
-readS_to_E :: (String -> ErrorMsg) -> ReadS a -> ReadE a
-readS_to_E err r = ReadE$ \txt -> case r txt of
-                           [(a,[])] -> Right a
-                           _        -> Left (err txt)
-
-readS_to_E' :: String -> String -> ReadS a -> ReadE a
-readS_to_E' name arg_desc r =
-    ReadE $ \txt -> case r txt of
-              [(a,[])] -> Right a
-              _ -> error (concat ["Failed to parse ", name,
-                                  ". Expected " ++ arg_desc,
-                                  ", found " ++ show txt])
-
-readP_to_E :: (String -> ErrorMsg) -> ReadP a a -> ReadE a
-readP_to_E err = readS_to_E err . readP_to_S
-
-readP_to_E' :: String -> String -> ReadP a a -> ReadE a
-readP_to_E' name arg_descr = readS_to_E' name arg_descr . readP_to_S
-
-
 parseReadE :: ReadE a -> ReadP r a
 parseReadE (ReadE p) = do
   txt <- look
diff --git a/Distribution/Simple/Command.hs b/Distribution/Simple/Command.hs
index 8827d7cc4ae3187de14abce88a45f2ead7b0092e..0485d0e135de2f39a3770006947a380dce943682 100644
--- a/Distribution/Simple/Command.hs
+++ b/Distribution/Simple/Command.hs
@@ -73,7 +73,7 @@ module Distribution.Simple.Command (
 
 -- ** OptDescr 'smart' constructors
   MkOptDescr,
-  reqArg, reqArg', reqArg'', optArg, optArg', optArg'', noArg,
+  reqArg, reqArg', optArg, optArg', noArg,
   boolOpt, boolOpt', choiceOpt, choiceOptFromEnum
 
   ) where
@@ -180,21 +180,6 @@ optArg' ad mkflag showflag =
     optArg ad (succeedReadE (mkflag . Just)) def showflag
       where def = mkflag Nothing
 
--- | ReadS variant of "reqArg"
-reqArg'' :: Monoid b => ArgPlaceHolder -> ReadS b -> (b -> [String])
-                     -> MkOptDescr (a -> b) (b -> a -> a) a
-reqArg'' ad mkflag showflag sf lf@(n:_) =
-    reqArg ad (readS_to_E' n ad mkflag) showflag sf lf
-reqArg'' _ _ _ _ _ = error "Distribution.command.reqArg'': unreachable"
-
--- | ReadS variant of "optArg"
-optArg'' :: Monoid b => ArgPlaceHolder -> (Maybe String -> [(b,String)]) -> (b -> [Maybe String])
-                     -> MkOptDescr (a -> b) (b -> a -> a) a
-optArg'' ad mkflag showflag sf lf@(n:_) =
-    optArg ad (readS_to_E' n ad (mkflag . Just)) def showflag sf lf
-      where def = let [(x,"")] = mkflag Nothing in x
-optArg'' _ _ _ _ _ = error "Distribution.command.optArg'': unreachable"
-
 noArg :: (Eq b, Monoid b) => b -> MkOptDescr (a -> b) (b -> a -> a) a
 noArg flag sf lf d = choiceOpt [(flag, (sf,lf), d)] sf lf d