Permalink
Find file
Fetching contributors…
Cannot retrieve contributors at this time
622 lines (533 sloc) 24.6 KB
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Simple.Command
-- Copyright : Duncan Coutts 2007
-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : non-portable (ExistentialQuantification)
--
-- This is to do with command line handling. The Cabal command line is
-- organised into a number of named sub-commands (much like darcs). The
-- 'CommandUI' abstraction represents one of these sub-commands, with a name,
-- description, a set of flags. Commands can be associated with actions and
-- run. It handles some common stuff automatically, like the @--help@ and
-- command line completion flags. It is designed to allow other tools make
-- derived commands. This feature is used heavily in @cabal-install@.
module Distribution.Simple.Command (
-- * Command interface
CommandUI(..),
commandShowOptions,
CommandParse(..),
commandParseArgs,
getNormalCommandDescriptions,
helpCommandUI,
-- ** Constructing commands
ShowOrParseArgs(..),
usageDefault,
usageAlternatives,
mkCommandUI,
hiddenCommand,
-- ** Associating actions with commands
Command,
commandAddAction,
noExtraFlags,
-- ** Building lists of commands
CommandType(..),
CommandSpec(..),
commandFromSpec,
-- ** Running commands
commandsRun,
-- * Option Fields
OptionField(..), Name,
-- ** Constructing Option Fields
option, multiOption,
-- ** Liftings & Projections
liftOption, viewAsFieldDescr,
-- * Option Descriptions
OptDescr(..), Description, SFlags, LFlags, OptFlags, ArgPlaceHolder,
-- ** OptDescr 'smart' constructors
MkOptDescr,
reqArg, reqArg', optArg, optArg', noArg,
boolOpt, boolOpt', choiceOpt, choiceOptFromEnum
) where
import Prelude ()
import Distribution.Compat.Prelude hiding (get)
import qualified Distribution.GetOpt as GetOpt
import Distribution.Text
import Distribution.ParseUtils
import Distribution.ReadE
import Distribution.Simple.Utils
import Text.PrettyPrint ( punctuate, cat, comma, text )
import Text.PrettyPrint as PP ( empty )
data CommandUI flags = CommandUI {
-- | The name of the command as it would be entered on the command line.
-- For example @\"build\"@.
commandName :: String,
-- | A short, one line description of the command to use in help texts.
commandSynopsis :: String,
-- | A function that maps a program name to a usage summary for this
-- command.
commandUsage :: String -> String,
-- | Additional explanation of the command to use in help texts.
commandDescription :: Maybe (String -> String),
-- | Post-Usage notes and examples in help texts
commandNotes :: Maybe (String -> String),
-- | Initial \/ empty flags
commandDefaultFlags :: flags,
-- | All the Option fields for this command
commandOptions :: ShowOrParseArgs -> [OptionField flags]
}
data ShowOrParseArgs = ShowArgs | ParseArgs
type Name = String
type Description = String
-- | We usually have a data type for storing configuration values, where
-- every field stores a configuration option, and the user sets
-- the value either via command line flags or a configuration file.
-- An individual OptionField models such a field, and we usually
-- build a list of options associated to a configuration data type.
data OptionField a = OptionField {
optionName :: Name,
optionDescr :: [OptDescr a] }
-- | An OptionField takes one or more OptDescrs, describing the command line
-- interface for the field.
data OptDescr a = ReqArg Description OptFlags ArgPlaceHolder
(ReadE (a->a)) (a -> [String])
| OptArg Description OptFlags ArgPlaceHolder
(ReadE (a->a)) (a->a) (a -> [Maybe String])
| ChoiceOpt [(Description, OptFlags, a->a, a -> Bool)]
| BoolOpt Description OptFlags{-True-} OptFlags{-False-}
(Bool -> a -> a) (a-> Maybe Bool)
-- | Short command line option strings
type SFlags = [Char]
-- | Long command line option strings
type LFlags = [String]
type OptFlags = (SFlags,LFlags)
type ArgPlaceHolder = String
-- | Create an option taking a single OptDescr.
-- No explicit Name is given for the Option, the name is the first LFlag given.
option :: SFlags -> LFlags -> Description -> get -> set -> MkOptDescr get set a
-> OptionField a
option sf lf@(n:_) d get set arg = OptionField n [arg sf lf d get set]
option _ _ _ _ _ _ = error $ "Distribution.command.option: "
++ "An OptionField must have at least one LFlag"
-- | Create an option taking several OptDescrs.
-- You will have to give the flags and description individually to the
-- OptDescr constructor.
multiOption :: Name -> get -> set
-> [get -> set -> OptDescr a] -- ^MkOptDescr constructors partially
-- applied to flags and description.
-> OptionField a
multiOption n get set args = OptionField n [arg get set | arg <- args]
type MkOptDescr get set a = SFlags -> LFlags -> Description -> get -> set
-> OptDescr a
-- | Create a string-valued command line interface.
reqArg :: Monoid b => ArgPlaceHolder -> ReadE b -> (b -> [String])
-> MkOptDescr (a -> b) (b -> a -> a) a
reqArg ad mkflag showflag sf lf d get set =
ReqArg d (sf,lf) ad (fmap (\a b -> set (get b `mappend` a) b) mkflag)
(showflag . get)
-- | Create a string-valued command line interface with a default value.
optArg :: Monoid b => ArgPlaceHolder -> ReadE b -> b -> (b -> [Maybe String])
-> MkOptDescr (a -> b) (b -> a -> a) a
optArg ad mkflag def showflag sf lf d get set =
OptArg d (sf,lf) ad (fmap (\a b -> set (get b `mappend` a) b) mkflag)
(\b -> set (get b `mappend` def) b)
(showflag . get)
-- | (String -> a) variant of "reqArg"
reqArg' :: Monoid b => ArgPlaceHolder -> (String -> b) -> (b -> [String])
-> MkOptDescr (a -> b) (b -> a -> a) a
reqArg' ad mkflag showflag =
reqArg ad (succeedReadE mkflag) showflag
-- | (String -> a) variant of "optArg"
optArg' :: Monoid b => ArgPlaceHolder -> (Maybe String -> b)
-> (b -> [Maybe String])
-> MkOptDescr (a -> b) (b -> a -> a) a
optArg' ad mkflag showflag =
optArg ad (succeedReadE (mkflag . Just)) def showflag
where def = mkflag Nothing
noArg :: (Eq b) => b -> MkOptDescr (a -> b) (b -> a -> a) a
noArg flag sf lf d = choiceOpt [(flag, (sf,lf), d)] sf lf d
boolOpt :: (b -> Maybe Bool) -> (Bool -> b) -> SFlags -> SFlags
-> MkOptDescr (a -> b) (b -> a -> a) a
boolOpt g s sfT sfF _sf _lf@(n:_) d get set =
BoolOpt d (sfT, ["enable-"++n]) (sfF, ["disable-"++n]) (set.s) (g.get)
boolOpt _ _ _ _ _ _ _ _ _ = error
"Distribution.Simple.Setup.boolOpt: unreachable"
boolOpt' :: (b -> Maybe Bool) -> (Bool -> b) -> OptFlags -> OptFlags
-> MkOptDescr (a -> b) (b -> a -> a) a
boolOpt' g s ffT ffF _sf _lf d get set = BoolOpt d ffT ffF (set.s) (g . get)
-- | create a Choice option
choiceOpt :: Eq b => [(b,OptFlags,Description)]
-> MkOptDescr (a -> b) (b -> a -> a) a
choiceOpt aa_ff _sf _lf _d get set = ChoiceOpt alts
where alts = [(d,flags, set alt, (==alt) . get) | (alt,flags,d) <- aa_ff]
-- | create a Choice option out of an enumeration type.
-- As long flags, the Show output is used. As short flags, the first character
-- which does not conflict with a previous one is used.
choiceOptFromEnum :: (Bounded b, Enum b, Show b, Eq b) =>
MkOptDescr (a -> b) (b -> a -> a) a
choiceOptFromEnum _sf _lf d get =
choiceOpt [ (x, (sf, [map toLower $ show x]), d')
| (x, sf) <- sflags'
, let d' = d ++ show x]
_sf _lf d get
where sflags' = foldl f [] [firstOne..]
f prev x = let prevflags = concatMap snd prev in
prev ++ take 1 [(x, [toLower sf])
| sf <- show x, isAlpha sf
, toLower sf `notElem` prevflags]
firstOne = minBound `asTypeOf` get undefined
commandGetOpts :: ShowOrParseArgs -> CommandUI flags
-> [GetOpt.OptDescr (flags -> flags)]
commandGetOpts showOrParse command =
concatMap viewAsGetOpt (commandOptions command showOrParse)
viewAsGetOpt :: OptionField a -> [GetOpt.OptDescr (a->a)]
viewAsGetOpt (OptionField _n aa) = concatMap optDescrToGetOpt aa
where
optDescrToGetOpt (ReqArg d (cs,ss) arg_desc set _) =
[GetOpt.Option cs ss (GetOpt.ReqArg set' arg_desc) d]
where set' = readEOrFail set
optDescrToGetOpt (OptArg d (cs,ss) arg_desc set def _) =
[GetOpt.Option cs ss (GetOpt.OptArg set' arg_desc) d]
where set' Nothing = def
set' (Just txt) = readEOrFail set txt
optDescrToGetOpt (ChoiceOpt alts) =
[GetOpt.Option sf lf (GetOpt.NoArg set) d | (d,(sf,lf),set,_) <- alts ]
optDescrToGetOpt (BoolOpt d (sfT, lfT) ([], []) set _) =
[ GetOpt.Option sfT lfT (GetOpt.NoArg (set True)) d ]
optDescrToGetOpt (BoolOpt d ([], []) (sfF, lfF) set _) =
[ GetOpt.Option sfF lfF (GetOpt.NoArg (set False)) d ]
optDescrToGetOpt (BoolOpt d (sfT,lfT) (sfF, lfF) set _) =
[ GetOpt.Option sfT lfT (GetOpt.NoArg (set True)) ("Enable " ++ d)
, GetOpt.Option sfF lfF (GetOpt.NoArg (set False)) ("Disable " ++ d) ]
-- | to view as a FieldDescr, we sort the list of interfaces (Req > Bool >
-- Choice > Opt) and consider only the first one.
viewAsFieldDescr :: OptionField a -> FieldDescr a
viewAsFieldDescr (OptionField _n []) =
error "Distribution.command.viewAsFieldDescr: unexpected"
viewAsFieldDescr (OptionField n dd) = FieldDescr n get set
where
optDescr = head $ sortBy cmp dd
cmp :: OptDescr a -> OptDescr a -> Ordering
ReqArg{} `cmp` ReqArg{} = EQ
ReqArg{} `cmp` _ = GT
BoolOpt{} `cmp` ReqArg{} = LT
BoolOpt{} `cmp` BoolOpt{} = EQ
BoolOpt{} `cmp` _ = GT
ChoiceOpt{} `cmp` ReqArg{} = LT
ChoiceOpt{} `cmp` BoolOpt{} = LT
ChoiceOpt{} `cmp` ChoiceOpt{} = EQ
ChoiceOpt{} `cmp` _ = GT
OptArg{} `cmp` OptArg{} = EQ
OptArg{} `cmp` _ = LT
-- get :: a -> Doc
get t = case optDescr of
ReqArg _ _ _ _ ppr ->
(cat . punctuate comma . map text . ppr) t
OptArg _ _ _ _ _ ppr ->
case ppr t of [] -> PP.empty
(Nothing : _) -> text "True"
(Just a : _) -> text a
ChoiceOpt alts ->
fromMaybe PP.empty $ listToMaybe
[ text lf | (_,(_,lf:_), _,enabled) <- alts, enabled t]
BoolOpt _ _ _ _ enabled -> (maybe PP.empty disp . enabled) t
-- set :: LineNo -> String -> a -> ParseResult a
set line val a =
case optDescr of
ReqArg _ _ _ readE _ -> ($ a) `liftM` runE line n readE val
-- We parse for a single value instead of a
-- list, as one can't really implement
-- parseList :: ReadE a -> ReadE [a] with
-- the current ReadE definition
ChoiceOpt{} ->
case getChoiceByLongFlag optDescr val of
Just f -> return (f a)
_ -> syntaxError line val
BoolOpt _ _ _ setV _ -> (`setV` a) `liftM` runP line n parse val
OptArg _ _ _ readE _ _ -> ($ a) `liftM` runE line n readE val
-- Optional arguments are parsed just like
-- required arguments here; we don't
-- provide a method to set an OptArg field
-- to the default value.
getChoiceByLongFlag :: OptDescr b -> String -> Maybe (b->b)
getChoiceByLongFlag (ChoiceOpt alts) val = listToMaybe
[ set | (_,(_sf,lf:_), set, _) <- alts
, lf == val]
getChoiceByLongFlag _ _ =
error "Distribution.command.getChoiceByLongFlag: expected a choice option"
getCurrentChoice :: OptDescr a -> a -> [String]
getCurrentChoice (ChoiceOpt alts) a =
[ lf | (_,(_sf,lf:_), _, currentChoice) <- alts, currentChoice a]
getCurrentChoice _ _ = error "Command.getChoice: expected a Choice OptDescr"
liftOption :: (b -> a) -> (a -> (b -> b)) -> OptionField a -> OptionField b
liftOption get' set' opt =
opt { optionDescr = liftOptDescr get' set' `map` optionDescr opt}
liftOptDescr :: (b -> a) -> (a -> (b -> b)) -> OptDescr a -> OptDescr b
liftOptDescr get' set' (ChoiceOpt opts) =
ChoiceOpt [ (d, ff, liftSet get' set' set , (get . get'))
| (d, ff, set, get) <- opts]
liftOptDescr get' set' (OptArg d ff ad set def get) =
OptArg d ff ad (liftSet get' set' `fmap` set)
(liftSet get' set' def) (get . get')
liftOptDescr get' set' (ReqArg d ff ad set get) =
ReqArg d ff ad (liftSet get' set' `fmap` set) (get . get')
liftOptDescr get' set' (BoolOpt d ffT ffF set get) =
BoolOpt d ffT ffF (liftSet get' set' . set) (get . get')
liftSet :: (b -> a) -> (a -> (b -> b)) -> (a -> a) -> b -> b
liftSet get' set' set x = set' (set $ get' x) x
-- | Show flags in the standard long option command line format
commandShowOptions :: CommandUI flags -> flags -> [String]
commandShowOptions command v = concat
[ showOptDescr v od | o <- commandOptions command ParseArgs
, od <- optionDescr o]
where
maybePrefix [] = []
maybePrefix (lOpt:_) = ["--" ++ lOpt]
showOptDescr :: a -> OptDescr a -> [String]
showOptDescr x (BoolOpt _ (_,lfTs) (_,lfFs) _ enabled)
= case enabled x of
Nothing -> []
Just True -> maybePrefix lfTs
Just False -> maybePrefix lfFs
showOptDescr x c@ChoiceOpt{}
= ["--" ++ val | val <- getCurrentChoice c x]
showOptDescr x (ReqArg _ (_ssff,lf:_) _ _ showflag)
= [ "--"++lf++"="++flag
| flag <- showflag x ]
showOptDescr x (OptArg _ (_ssff,lf:_) _ _ _ showflag)
= [ case flag of
Just s -> "--"++lf++"="++s
Nothing -> "--"++lf
| flag <- showflag x ]
showOptDescr _ _
= error "Distribution.Simple.Command.showOptDescr: unreachable"
commandListOptions :: CommandUI flags -> [String]
commandListOptions command =
concatMap listOption $
addCommonFlags ShowArgs $ -- This is a slight hack, we don't want
-- "--list-options" showing up in the
-- list options output, so use ShowArgs
commandGetOpts ShowArgs command
where
listOption (GetOpt.Option shortNames longNames _ _) =
[ "-" ++ [name] | name <- shortNames ]
++ [ "--" ++ name | name <- longNames ]
-- | The help text for this command with descriptions of all the options.
commandHelp :: CommandUI flags -> String -> String
commandHelp command pname =
commandSynopsis command
++ "\n\n"
++ commandUsage command pname
++ ( case commandDescription command of
Nothing -> ""
Just desc -> '\n': desc pname)
++ "\n"
++ ( if cname == ""
then "Global flags:"
else "Flags for " ++ cname ++ ":" )
++ ( GetOpt.usageInfo ""
. addCommonFlags ShowArgs
$ commandGetOpts ShowArgs command )
++ ( case commandNotes command of
Nothing -> ""
Just notes -> '\n': notes pname)
where cname = commandName command
-- | Default "usage" documentation text for commands.
usageDefault :: String -> String -> String
usageDefault name pname =
"Usage: " ++ pname ++ " " ++ name ++ " [FLAGS]\n\n"
++ "Flags for " ++ name ++ ":"
-- | Create "usage" documentation from a list of parameter
-- configurations.
usageAlternatives :: String -> [String] -> String -> String
usageAlternatives name strs pname = unlines
[ start ++ pname ++ " " ++ name ++ " " ++ s
| let starts = "Usage: " : repeat " or: "
, (start, s) <- zip starts strs
]
-- | Make a Command from standard 'GetOpt' options.
mkCommandUI :: String -- ^ name
-> String -- ^ synopsis
-> [String] -- ^ usage alternatives
-> flags -- ^ initial\/empty flags
-> (ShowOrParseArgs -> [OptionField flags]) -- ^ options
-> CommandUI flags
mkCommandUI name synopsis usages flags options = CommandUI
{ commandName = name
, commandSynopsis = synopsis
, commandDescription = Nothing
, commandNotes = Nothing
, commandUsage = usageAlternatives name usages
, commandDefaultFlags = flags
, commandOptions = options
}
-- | Common flags that apply to every command
data CommonFlag = HelpFlag | ListOptionsFlag
commonFlags :: ShowOrParseArgs -> [GetOpt.OptDescr CommonFlag]
commonFlags showOrParseArgs = case showOrParseArgs of
ShowArgs -> [help]
ParseArgs -> [help, list]
where
help = GetOpt.Option helpShortFlags ["help"] (GetOpt.NoArg HelpFlag)
"Show this help text"
helpShortFlags = case showOrParseArgs of
ShowArgs -> ['h']
ParseArgs -> ['h', '?']
list = GetOpt.Option [] ["list-options"] (GetOpt.NoArg ListOptionsFlag)
"Print a list of command line flags"
addCommonFlags :: ShowOrParseArgs
-> [GetOpt.OptDescr a]
-> [GetOpt.OptDescr (Either CommonFlag a)]
addCommonFlags showOrParseArgs options =
map (fmapOptDesc Left) (commonFlags showOrParseArgs)
++ map (fmapOptDesc Right) options
where fmapOptDesc f (GetOpt.Option s l d m) =
GetOpt.Option s l (fmapArgDesc f d) m
fmapArgDesc f (GetOpt.NoArg a) = GetOpt.NoArg (f a)
fmapArgDesc f (GetOpt.ReqArg s d) = GetOpt.ReqArg (f . s) d
fmapArgDesc f (GetOpt.OptArg s d) = GetOpt.OptArg (f . s) d
-- | Parse a bunch of command line arguments
--
commandParseArgs :: CommandUI flags
-> Bool -- ^ Is the command a global or subcommand?
-> [String]
-> CommandParse (flags -> flags, [String])
commandParseArgs command global args =
let options = addCommonFlags ParseArgs
$ commandGetOpts ParseArgs command
order | global = GetOpt.RequireOrder
| otherwise = GetOpt.Permute
in case GetOpt.getOpt' order options args of
(flags, _, _, _)
| any listFlag flags -> CommandList (commandListOptions command)
| any helpFlag flags -> CommandHelp (commandHelp command)
where listFlag (Left ListOptionsFlag) = True; listFlag _ = False
helpFlag (Left HelpFlag) = True; helpFlag _ = False
(flags, opts, opts', [])
| global || null opts' -> CommandReadyToGo (accum flags, mix opts opts')
| otherwise -> CommandErrors (unrecognised opts')
(_, _, _, errs) -> CommandErrors errs
where -- Note: It is crucial to use reverse function composition here or to
-- reverse the flags here as we want to process the flags left to right
-- but data flow in function composition is right to left.
accum flags = foldr (flip (.)) id [ f | Right f <- flags ]
unrecognised opts = [ "unrecognized "
++ "'" ++ (commandName command) ++ "'"
++ " option `" ++ opt ++ "'\n"
| opt <- opts ]
-- For unrecognised global flags we put them in the position just after
-- the command, if there is one. This gives us a chance to parse them
-- as sub-command rather than global flags.
mix [] ys = ys
mix (x:xs) ys = x:ys++xs
data CommandParse flags = CommandHelp (String -> String)
| CommandList [String]
| CommandErrors [String]
| CommandReadyToGo flags
instance Functor CommandParse where
fmap _ (CommandHelp help) = CommandHelp help
fmap _ (CommandList opts) = CommandList opts
fmap _ (CommandErrors errs) = CommandErrors errs
fmap f (CommandReadyToGo flags) = CommandReadyToGo (f flags)
data CommandType = NormalCommand | HiddenCommand
data Command action =
Command String String ([String] -> CommandParse action) CommandType
-- | Mark command as hidden. Hidden commands don't show up in the 'progname
-- help' or 'progname --help' output.
hiddenCommand :: Command action -> Command action
hiddenCommand (Command name synopsys f _cmdType) =
Command name synopsys f HiddenCommand
commandAddAction :: CommandUI flags
-> (flags -> [String] -> action)
-> Command action
commandAddAction command action =
Command (commandName command)
(commandSynopsis command)
(fmap (uncurry applyDefaultArgs) . commandParseArgs command False)
NormalCommand
where applyDefaultArgs mkflags args =
let flags = mkflags (commandDefaultFlags command)
in action flags args
commandsRun :: CommandUI a
-> [Command action]
-> [String]
-> CommandParse (a, CommandParse action)
commandsRun globalCommand commands args =
case commandParseArgs globalCommand True args of
CommandHelp help -> CommandHelp help
CommandList opts -> CommandList (opts ++ commandNames)
CommandErrors errs -> CommandErrors errs
CommandReadyToGo (mkflags, args') -> case args' of
("help":cmdArgs) -> handleHelpCommand cmdArgs
(name:cmdArgs) -> case lookupCommand name of
[Command _ _ action _]
-> CommandReadyToGo (flags, action cmdArgs)
_ -> CommandReadyToGo (flags, badCommand name)
[] -> CommandReadyToGo (flags, noCommand)
where flags = mkflags (commandDefaultFlags globalCommand)
where
lookupCommand cname = [ cmd | cmd@(Command cname' _ _ _) <- commands'
, cname' == cname ]
noCommand = CommandErrors ["no command given (try --help)\n"]
badCommand cname = CommandErrors ["unrecognised command: " ++ cname
++ " (try --help)\n"]
commands' = commands ++ [commandAddAction helpCommandUI undefined]
commandNames = [ name | (Command name _ _ NormalCommand) <- commands' ]
-- A bit of a hack: support "prog help" as a synonym of "prog --help"
-- furthermore, support "prog help command" as "prog command --help"
handleHelpCommand cmdArgs =
case commandParseArgs helpCommandUI True cmdArgs of
CommandHelp help -> CommandHelp help
CommandList list -> CommandList (list ++ commandNames)
CommandErrors _ -> CommandHelp globalHelp
CommandReadyToGo (_,[]) -> CommandHelp globalHelp
CommandReadyToGo (_,(name:cmdArgs')) ->
case lookupCommand name of
[Command _ _ action _] ->
case action ("--help":cmdArgs') of
CommandHelp help -> CommandHelp help
CommandList _ -> CommandList []
_ -> CommandHelp globalHelp
_ -> badCommand name
where globalHelp = commandHelp globalCommand
-- | Utility function, many commands do not accept additional flags. This
-- action fails with a helpful error message if the user supplies any extra.
--
noExtraFlags :: [String] -> IO ()
noExtraFlags [] = return ()
noExtraFlags extraFlags =
die $ "Unrecognised flags: " ++ intercalate ", " extraFlags
--TODO: eliminate this function and turn it into a variant on commandAddAction
-- instead like commandAddActionNoArgs that doesn't supply the [String]
-- | Helper function for creating globalCommand description
getNormalCommandDescriptions :: [Command action] -> [(String, String)]
getNormalCommandDescriptions cmds =
[ (name, description)
| Command name description _ NormalCommand <- cmds ]
helpCommandUI :: CommandUI ()
helpCommandUI =
(mkCommandUI
"help"
"Help about commands."
["[FLAGS]", "COMMAND [FLAGS]"]
()
(const []))
{
commandNotes = Just $ \pname ->
"Examples:\n"
++ " " ++ pname ++ " help help\n"
++ " Oh, appararently you already know this.\n"
}
-- | wraps a @CommandUI@ together with a function that turns it into a @Command@.
-- By hiding the type of flags for the UI allows construction of a list of all UIs at the
-- top level of the program. That list can then be used for generation of manual page
-- as well as for executing the selected command.
data CommandSpec action
= forall flags. CommandSpec (CommandUI flags) (CommandUI flags -> Command action) CommandType
commandFromSpec :: CommandSpec a -> Command a
commandFromSpec (CommandSpec ui action _) = action ui