, StandardOptions(..)
, OptCompletion(..)
, ArgCompletion(..)
+ , PersonalityList
, optComplYesNo
, oShowHelp
, oShowVer
, parseYesNo
, parseOpts
, parseOptsInner
+ , parseOptsCmds
+ , genericMainCmds
) where
import Control.Monad (foldM)
import Data.Char (toLower)
-import Data.List (intercalate, stripPrefix)
+import Data.List (intercalate, stripPrefix, sortBy)
import Data.Maybe (fromMaybe)
+import Data.Ord (comparing)
import qualified Data.Version
import System.Console.GetOpt
+import System.Environment
import System.Exit
import System.Info
import System.IO
import Text.Printf (printf)
import Ganeti.BasicTypes
+import qualified Ganeti.Constants as C
import qualified Ganeti.Version as Version (version)
-- | Parameter type.
| OptComplOneIallocator -- ^ One iallocator
| OptComplInstAddNodes -- ^ Either one or two nodes
| OptComplOneGroup -- ^ One group
- | OptComplNumeric -- ^ Float values
+ | OptComplInteger -- ^ Integer values
+ | OptComplFloat -- ^ Float values
| OptComplJobId -- ^ Job Id
| OptComplCommand -- ^ Command (executable)
| OptComplString -- ^ Arbitrary string
| OptComplChoices [String] -- ^ List of string choices
| OptComplSuggest [String] -- ^ Suggested choices
- deriving (Show, Read, Eq)
+ deriving (Show, Eq)
-- | Argument type. This differs from (and wraps) an Option by the
-- fact that it can (and usually does) support multiple repetitions of
-- the same argument, via a min and max limit.
data ArgCompletion = ArgCompletion OptCompletion Int (Maybe Int)
- deriving (Show, Read, Eq)
+ deriving (Show, Eq)
+
+-- | A personality definition.
+type Personality a = ( a -> [String] -> IO () -- The main function
+ , IO [GenericOptType a] -- The options
+ , [ArgCompletion] -- The description of args
+ , String -- Description
+ )
+
+-- | Personality lists type, common across all binaries that expose
+-- multiple personalities.
+type PersonalityList a = [(String, Personality a)]
-- | Yes\/no choices completion.
optComplYesNo :: OptCompletion
parsed_value <- conversion_fn string_opt
updater_fn parsed_value opts)
+-- | Max command length when formatting command list output.
+maxCmdLen :: Int
+maxCmdLen = 60
+
+-- | Formats usage for a multi-personality program.
+formatCmdUsage :: (StandardOptions a) => String -> PersonalityList a -> String
+formatCmdUsage prog personalities =
+ let mlen = min maxCmdLen . maximum $ map (length . fst) personalities
+ sorted = sortBy (comparing fst) personalities
+ header = [ printf "Usage: %s {command} [options...] [argument...]" prog
+ , printf "%s <command> --help to see details, or man %s"
+ prog prog
+ , ""
+ , "Commands:"
+ ]
+ rows = map (\(cmd, (_, _, _, desc)) ->
+ -- FIXME: not wrapped here
+ printf " %-*s - %s" mlen cmd desc::String) sorted
+ in unlines $ header ++ rows
+
+-- | Displays usage for a program and exits.
+showCmdUsage :: (StandardOptions a) =>
+ String -- ^ Program name
+ -> PersonalityList a -- ^ Personality list
+ -> Bool -- ^ Whether the exit code is success or not
+ -> IO b
+showCmdUsage prog personalities success = do
+ let usage = formatCmdUsage prog personalities
+ putStr usage
+ if success
+ then exitSuccess
+ else exitWith $ ExitFailure C.exitFailure
+
+-- | Generates completion information for a multi-command binary.
+multiCmdCompletion :: (StandardOptions a) => PersonalityList a -> String
+multiCmdCompletion personalities =
+ unlines .
+ map argComplToText $
+ map (\(cmd, _) -> ArgCompletion (OptComplChoices [cmd]) 1 (Just 1))
+ personalities
+
+-- | Displays completion information for a multi-command binary and exits.
+showCmdCompletion :: (StandardOptions a) => PersonalityList a -> IO b
+showCmdCompletion personalities =
+ putStr (multiCmdCompletion personalities) >> exitSuccess
+
-- | Command line parser, using a generic 'Options' structure.
parseOpts :: (StandardOptions a) =>
a -- ^ The default options
Right result ->
return result
+-- | Command line parser, for programs with sub-commands.
+parseOptsCmds :: (StandardOptions a) =>
+ a -- ^ The default options
+ -> [String] -- ^ The command line arguments
+ -> String -- ^ The program name
+ -> PersonalityList a -- ^ The supported commands
+ -> [GenericOptType a] -- ^ Generic options
+ -> IO (a, [String], a -> [String] -> IO ())
+ -- ^ The resulting options and leftover arguments
+parseOptsCmds defaults argv progname personalities genopts = do
+ let usage = showCmdUsage progname personalities
+ check c = case c of
+ -- hardcoded option strings here!
+ "--version" -> putStrLn (versionInfo progname) >> exitSuccess
+ "--help" -> usage True
+ "--help-completion" -> showCmdCompletion personalities
+ _ -> return c
+ (cmd, cmd_args) <- case argv of
+ cmd:cmd_args -> do
+ cmd' <- check cmd
+ return (cmd', cmd_args)
+ [] -> usage False
+ case cmd `lookup` personalities of
+ Nothing -> usage False
+ Just (mainfn, optdefs, argdefs, _) -> do
+ optdefs' <- optdefs
+ (opts, args) <- parseOpts defaults cmd_args progname
+ (optdefs' ++ genopts) argdefs
+ return (opts, args, mainfn)
+
-- | Inner parse options. The arguments are similar to 'parseOpts',
-- but it returns either a 'Left' composed of exit code and message,
-- or a 'Right' for the success case.
(_, _, errs) ->
Left (ExitFailure 2, "Command line error: " ++ concat errs ++ "\n" ++
usageHelp progname options)
+
+-- | Parse command line options and execute the main function of a
+-- multi-personality binary.
+genericMainCmds :: (StandardOptions a) =>
+ a
+ -> PersonalityList a
+ -> [GenericOptType a]
+ -> IO ()
+genericMainCmds defaults personalities genopts = do
+ cmd_args <- getArgs
+ prog <- getProgName
+ (opts, args, fn) <-
+ parseOptsCmds defaults cmd_args prog personalities genopts
+ fn opts args
projects / ganeti-local / blobdiff