Skip to content
Snippets Groups Projects
Commit 625a7e44 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

It appears that the ReadS variants reqArg'' and optArg'' are unused

parent c1ef8b6f
No related branches found
No related tags found
No related merge requests found
......@@ -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
......
......@@ -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
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment