diff --git a/Cabal/src/Distribution/GetOpt.hs b/Cabal/src/Distribution/GetOpt.hs index a55599496c6..e77c8fd7c55 100644 --- a/Cabal/src/Distribution/GetOpt.hs +++ b/Cabal/src/Distribution/GetOpt.hs @@ -63,12 +63,12 @@ data ArgDescr a | -- | option requires argument ReqArg (String -> Either String a) String | -- | optional argument - OptArg String (Maybe String -> Either String a) String + OptArg (Maybe String -> Either String a) String instance Functor ArgDescr where fmap f (NoArg a) = NoArg (f a) fmap f (ReqArg g s) = ReqArg (fmap f . g) s - fmap f (OptArg dv g s) = OptArg dv (fmap f . g) s + fmap f (OptArg g s) = OptArg (fmap f . g) s data OptKind a -- kind of cmd line arg (internal use only): = Opt a -- an option @@ -140,7 +140,7 @@ fmtShort (NoArg _) so = "-" ++ [so] fmtShort (ReqArg _ ad) so = let opt = "-" ++ [so] in opt ++ " " ++ ad ++ " or " ++ opt ++ ad -fmtShort (OptArg _ _ ad) so = +fmtShort (OptArg _ ad) so = let opt = "-" ++ [so] in opt ++ "[" ++ ad ++ "]" @@ -158,7 +158,7 @@ fmtLong (NoArg _) lo = "--" ++ lo fmtLong (ReqArg _ ad) lo = let opt = "--" ++ lo in opt ++ "=" ++ ad -fmtLong (OptArg _ _ ad) lo = +fmtLong (OptArg _ ad) lo = let opt = "--" ++ lo in opt ++ "[=" ++ ad ++ "]" @@ -250,8 +250,8 @@ longOpt ls rs optDescr = long ads arg rs long [ReqArg _ d] [] [] = (errReq d optStr, []) long [ReqArg f _] [] (r : rest) = (fromRes (f r), rest) long [ReqArg f _] ('=' : xs) rest = (fromRes (f xs), rest) - long [OptArg _ f _] [] rest = (fromRes (f Nothing), rest) - long [OptArg _ f _] ('=' : xs) rest = (fromRes (f (Just xs)), rest) + long [OptArg f _] [] rest = (fromRes (f Nothing), rest) + long [OptArg f _] ('=' : xs) rest = (fromRes (f (Just xs)), rest) long _ _ rest = (UnreqOpt ("--" ++ ls), rest) -- handle short option @@ -269,8 +269,8 @@ shortOpt y ys rs optDescr = short ads ys rs short (ReqArg _ d : _) [] [] = (errReq d optStr, []) short (ReqArg f _ : _) [] (r : rest) = (fromRes (f r), rest) short (ReqArg f _ : _) xs rest = (fromRes (f xs), rest) - short (OptArg _ f _ : _) [] rest = (fromRes (f Nothing), rest) - short (OptArg _ f _ : _) xs rest = (fromRes (f (Just xs)), rest) + short (OptArg f _ : _) [] rest = (fromRes (f Nothing), rest) + short (OptArg f _ : _) xs rest = (fromRes (f (Just xs)), rest) short [] [] rest = (UnreqOpt optStr, rest) short [] xs rest = (UnreqOpt (optStr ++ xs), rest) diff --git a/Cabal/src/Distribution/Simple/Command.hs b/Cabal/src/Distribution/Simple/Command.hs index 937662b1d33..d3cff2db4e8 100644 --- a/Cabal/src/Distribution/Simple/Command.hs +++ b/Cabal/src/Distribution/Simple/Command.hs @@ -73,7 +73,6 @@ module Distribution.Simple.Command , reqArg' , optArg , optArg' - , optArgDef' , noArg , boolOpt , boolOpt' @@ -139,7 +138,7 @@ data OptDescr a OptFlags ArgPlaceHolder (ReadE (a -> a)) - (String, a -> a) + (a -> a) (a -> [Maybe String]) | ChoiceOpt [(Description, OptFlags, a -> a, a -> Bool)] | BoolOpt @@ -152,7 +151,7 @@ data OptDescr a fmapOptDescr :: forall a b. (b -> a) -> (a -> (b -> b)) -> OptDescr a -> OptDescr b fmapOptDescr x u = \case ReqArg d o p upd get -> ReqArg d o p (fmap m upd) (get . x) - OptArg d o p upd (str, g) get -> OptArg d o p (fmap m upd) (str, m g) (get . x) + OptArg d o p upd g get -> OptArg d o p (fmap m upd) (m g) (get . x) ChoiceOpt opts -> ChoiceOpt $ fmap (\(d, o, upd, get) -> (d, o, m upd, get . x)) opts BoolOpt d true false upd get -> BoolOpt d true false (\b -> m $ upd b) (get . x) where @@ -242,16 +241,16 @@ optArg :: Monoid b => ArgPlaceHolder -> ReadE b - -> (String, b) + -> b -> (b -> [Maybe String]) -> MkOptDescr (a -> b) (b -> a -> a) a -optArg ad mkflag (dv, mkDef) showflag sf lf d get set = +optArg ad mkflag mkDef showflag sf lf d get set = OptArg d (sf, lf) ad (fmap (\a b -> set (get b <> a) b) mkflag) - (dv, \b -> set (get b <> mkDef) b) + (\b -> set (get b <> mkDef) b) (showflag . get) -- | (String -> a) variant of "reqArg" @@ -272,16 +271,7 @@ optArg' -> (b -> [Maybe String]) -> MkOptDescr (a -> b) (b -> a -> a) a optArg' ad mkflag showflag = - optArg ad (succeedReadE (mkflag . Just)) ("", mkflag Nothing) showflag - -optArgDef' - :: Monoid b - => ArgPlaceHolder - -> (String, Maybe String -> b) - -> (b -> [Maybe String]) - -> MkOptDescr (a -> b) (b -> a -> a) a -optArgDef' ad (dv, mkflag) showflag = - optArg ad (succeedReadE (mkflag . Just)) (dv, mkflag Nothing) showflag + optArg ad (succeedReadE (mkflag . Just)) (mkflag Nothing) showflag noArg :: Eq b => b -> MkOptDescr (a -> b) (b -> a -> a) a noArg flag sf lf d = choiceOpt [(flag, (sf, lf), d)] sf lf d @@ -357,8 +347,8 @@ viewAsGetOpt (OptionField _n aa) = concatMap optDescrToGetOpt aa where optDescrToGetOpt (ReqArg d (cs, ss) arg_desc set _) = [GetOpt.Option cs ss (GetOpt.ReqArg (runReadE set) arg_desc) d] - optDescrToGetOpt (OptArg d (cs, ss) arg_desc set (dv, def) _) = - [GetOpt.Option cs ss (GetOpt.OptArg dv set' arg_desc) d] + optDescrToGetOpt (OptArg d (cs, ss) arg_desc set def _) = + [GetOpt.Option cs ss (GetOpt.OptArg set' arg_desc) d] where set' Nothing = Right def set' (Just txt) = runReadE set txt @@ -392,13 +382,13 @@ liftOptDescr get' set' (ChoiceOpt opts) = [ (d, ff, liftSet get' set' set, get . get') | (d, ff, set, get) <- opts ] -liftOptDescr get' set' (OptArg d ff ad set (dv, mkDef) get) = +liftOptDescr get' set' (OptArg d ff ad set mkDef get) = OptArg d ff ad (liftSet get' set' `fmap` set) - (dv, liftSet get' set' mkDef) + (liftSet get' set' mkDef) (get . get') liftOptDescr get' set' (ReqArg d ff ad set get) = ReqArg d ff ad (liftSet get' set' `fmap` set) (get . get') diff --git a/Cabal/src/Distribution/Simple/Setup/Common.hs b/Cabal/src/Distribution/Simple/Setup/Common.hs index 83ed76a16ed..eafc89f47fc 100644 --- a/Cabal/src/Distribution/Simple/Setup/Common.hs +++ b/Cabal/src/Distribution/Simple/Setup/Common.hs @@ -400,7 +400,7 @@ optionVerbosity get set = ( optArg "n" (fmap Flag flagToVerbosity) - (show verbose, Flag verbose) -- default Value if no n is given + (Flag verbose) (fmap (Just . showForCabal) . flagToList) ) @@ -418,7 +418,7 @@ optionNumJobs get set = ( optArg "NUM" (fmap Flag numJobsParser) - ("$ncpus", Flag Nothing) + (Flag Nothing) (map (Just . maybe "$ncpus" show) . flagToList) ) where diff --git a/Cabal/src/Distribution/Simple/Setup/Config.hs b/Cabal/src/Distribution/Simple/Setup/Config.hs index 839241eed0f..7e26a085b73 100644 --- a/Cabal/src/Distribution/Simple/Setup/Config.hs +++ b/Cabal/src/Distribution/Simple/Setup/Config.hs @@ -567,9 +567,9 @@ configureOptions showOrParseArgs = "optimization" configOptimization (\v flags -> flags{configOptimization = v}) - [ optArgDef' + [ optArg' "n" - (show NoOptimisation, Flag . flagToOptimisationLevel) + (Flag . flagToOptimisationLevel) ( \case Flag NoOptimisation -> [] Flag NormalOptimisation -> [Nothing] diff --git a/cabal-install/src/Distribution/Client/CmdOutdated.hs b/cabal-install/src/Distribution/Client/CmdOutdated.hs index 54279f74ef9..e0d65c78fdb 100644 --- a/cabal-install/src/Distribution/Client/CmdOutdated.hs +++ b/cabal-install/src/Distribution/Client/CmdOutdated.hs @@ -201,7 +201,7 @@ outdatedOptions _showOrParseArgs = ( optArg "PKGS" ignoreMajorVersionBumpsParser - ("", Just IgnoreMajorVersionBumpsAll) + (Just IgnoreMajorVersionBumpsAll) ignoreMajorVersionBumpsPrinter ) ] diff --git a/cabal-install/src/Distribution/Client/Setup.hs b/cabal-install/src/Distribution/Client/Setup.hs index 3acbd6b8f0c..1e2282a2d0e 100644 --- a/cabal-install/src/Distribution/Client/Setup.hs +++ b/cabal-install/src/Distribution/Client/Setup.hs @@ -1017,7 +1017,7 @@ configureExOptions _showOrParseArgs src = ( optArg "DEPS" (parsecToReadEErr unexpectMsgString relaxDepsParser) - (show RelaxDepsAll, Just RelaxDepsAll) + (Just RelaxDepsAll) relaxDepsPrinter ) , option @@ -1029,7 +1029,7 @@ configureExOptions _showOrParseArgs src = ( optArg "DEPS" (parsecToReadEErr unexpectMsgString relaxDepsParser) - (show RelaxDepsAll, Just RelaxDepsAll) + (Just RelaxDepsAll) relaxDepsPrinter ) , option @@ -1948,7 +1948,7 @@ getCommand = (const "invalid source-repository") (fmap (toFlag . Just) parsec) ) - ("", Flag Nothing) + (Flag Nothing) (map (fmap show) . flagToList) ) , option @@ -2832,7 +2832,7 @@ optionNumJobs get set = ( optArg "NUM" (fmap Flag numJobsParser) - ("", Flag Nothing) + (Flag Nothing) (map (Just . maybe "$ncpus" show) . flagToList) ) where