Commit 8c5ca96a authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Add liftOption for making derived command parsers

liftOption :: (b -> a) -> (a -> (b -> b)) -> Option a -> Option b
For example:
liftOption fst (\a (_,b) -> (a,b)) :: Option a -> Option (a,b)
Needed to be able to make a CommandUI (a, b) using an existing CommandUI a.
That's what we want to do in cabal-install where the 'install' command
to support all the 'configure' flags and some extra of it's own, for example
--dry-run and probably several more in future.
parent c971406c
......@@ -49,7 +49,8 @@ module Distribution.Simple.Command (
-- * Constructing commands
ShowOrParseArgs(..),
makeCommand,
Option, option, ArgDescr, noArg, reqArg, optArg,
Option, option, liftOption,
ArgDescr, noArg, reqArg, optArg,
-- * Associating actions with commands
Command,
......@@ -99,6 +100,16 @@ argDescrToGetOpt (NoArg f _) = GetOpt.NoArg f
argDescrToGetOpt (ReqArg d f _) = GetOpt.ReqArg f d
argDescrToGetOpt (OptArg d f _) = GetOpt.OptArg f d
liftOption :: (b -> a) -> (a -> (b -> b)) -> Option a -> Option b
liftOption get set (Option cs ss d arg) =
Option cs ss d (liftArgDescr get set arg)
liftArgDescr :: (b -> a) -> (a -> (b -> b)) -> ArgDescr a -> ArgDescr b
liftArgDescr get set arg = case arg of
NoArg f t -> NoArg (\ b -> set (f (get b)) b) (t . get)
ReqArg d f t -> ReqArg d (\s b -> set (f s (get b)) b) (t . get)
OptArg d f t -> OptArg d (\s b -> set (f s (get b)) b) (t . get)
noArg :: Monoid a => a -> (a -> Bool)
->(b -> a) -> (a -> (b -> b)) -> ArgDescr b
noArg flag showflag get set = NoArg (\b -> set (get b `mappend` flag) b) (showflag . get)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment