module Ganeti.Common
( GenericOptType
, StandardOptions(..)
+ , OptCompletion(..)
+ , ArgCompletion(..)
+ , optComplYesNo
, oShowHelp
, oShowVer
+ , oShowComp
, usageHelp
, versionInfo
, reqWithConversion
) where
import Control.Monad (foldM)
+import Data.Char (toLower)
+import Data.List (intercalate, stripPrefix)
+import Data.Maybe (fromMaybe)
import qualified Data.Version
import System.Console.GetOpt
import System.Exit
import Ganeti.BasicTypes
import qualified Ganeti.Version as Version (version)
+-- | Parameter type.
+data OptCompletion = OptComplNone -- ^ No parameter to this option
+ | OptComplFile -- ^ An existing file
+ | OptComplDir -- ^ An existing directory
+ | OptComplHost -- ^ Host name
+ | OptComplInetAddr -- ^ One ipv4\/ipv6 address
+ | OptComplOneNode -- ^ One node
+ | OptComplManyNodes -- ^ Many nodes, comma-sep
+ | OptComplOneInstance -- ^ One instance
+ | OptComplManyInstances -- ^ Many instances, comma-sep
+ | OptComplOneOs -- ^ One OS name
+ | OptComplOneIallocator -- ^ One iallocator
+ | OptComplInstAddNodes -- ^ Either one or two nodes
+ | OptComplOneGroup -- ^ One group
+ | 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)
+
+-- | 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)
+
+-- | Yes\/no choices completion.
+optComplYesNo :: OptCompletion
+optComplYesNo = OptComplChoices ["yes", "no"]
+
+-- | Text serialisation for 'OptCompletion', used on the Python side.
+complToText :: OptCompletion -> String
+complToText (OptComplChoices choices) = "choices=" ++ intercalate "," choices
+complToText (OptComplSuggest choices) = "suggest=" ++ intercalate "," choices
+complToText compl =
+ let show_compl = show compl
+ stripped = stripPrefix "OptCompl" show_compl
+ in map toLower $ fromMaybe show_compl stripped
+
+-- | Tex serialisation for 'ArgCompletion'.
+argComplToText :: ArgCompletion -> String
+argComplToText (ArgCompletion optc min_cnt max_cnt) =
+ complToText optc ++ " " ++ show min_cnt ++ " " ++ maybe "none" show max_cnt
+
-- | Abrreviation for the option type.
-type GenericOptType a = OptDescr (a -> Result a)
+type GenericOptType a = (OptDescr (a -> Result a), OptCompletion)
-- | Type class for options which support help and version.
class StandardOptions a where
helpRequested :: a -> Bool
verRequested :: a -> Bool
+ compRequested :: a -> Bool
requestHelp :: a -> a
requestVer :: a -> a
+ requestComp :: a -> a
--- | Options to request help output.
+-- | Option to request help output.
oShowHelp :: (StandardOptions a) => GenericOptType a
-oShowHelp = Option "h" ["help"] (NoArg (Ok . requestHelp))
- "show help"
+oShowHelp = (Option "h" ["help"] (NoArg (Ok . requestHelp)) "show help",
+ OptComplNone)
+-- | Option to request version information.
oShowVer :: (StandardOptions a) => GenericOptType a
-oShowVer = Option "V" ["version"] (NoArg (Ok . requestVer))
- "show the version of the program"
+oShowVer = (Option "V" ["version"] (NoArg (Ok . requestVer))
+ "show the version of the program",
+ OptComplNone)
+
+-- | Option to request completion information
+oShowComp :: (StandardOptions a) => GenericOptType a
+oShowComp =
+ (Option "" ["help-completion"] (NoArg (Ok . requestComp) )
+ "show completion info", OptComplNone)
-- | Usage info.
usageHelp :: String -> [GenericOptType a] -> String
usageHelp progname =
usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
- progname Version.version progname)
+ progname Version.version progname) . map fst
-- | Show the program version info.
versionInfo :: String -> String
(Data.Version.showVersion compilerVersion)
os arch
+-- | Show completion info.
+completionInfo :: String -> [GenericOptType a] -> [ArgCompletion] -> String
+completionInfo _ opts args =
+ unlines $
+ map (\(Option shorts longs _ _, compinfo) ->
+ let all_opts = map (\c -> ['-', c]) shorts ++ map ("--" ++) longs
+ in intercalate "," all_opts ++ " " ++ complToText compinfo
+ ) opts ++
+ map argComplToText args
+
-- | Helper for parsing a yes\/no command line flag.
parseYesNo :: Bool -- ^ Default value (when we get a @Nothing@)
-> Maybe String -- ^ Parameter value
-> (a -> b -> Result b)
-> String
-> ArgDescr (b -> Result b)
-reqWithConversion conversion_fn updater_fn metavar =
+reqWithConversion conversion_fn updater_fn =
ReqArg (\string_opt opts -> do
parsed_value <- conversion_fn string_opt
- updater_fn parsed_value opts) metavar
+ updater_fn parsed_value opts)
-- | Command line parser, using a generic 'Options' structure.
parseOpts :: (StandardOptions a) =>
-> [String] -- ^ The command line arguments
-> String -- ^ The program name
-> [GenericOptType a] -- ^ The supported command line options
+ -> [ArgCompletion] -- ^ The supported command line arguments
-> IO (a, [String]) -- ^ The resulting options and
-- leftover arguments
-parseOpts defaults argv progname options =
- case parseOptsInner defaults argv progname options of
+parseOpts defaults argv progname options arguments =
+ case parseOptsInner defaults argv progname options arguments of
Left (code, msg) -> do
hPutStr (if code == ExitSuccess then stdout else stderr) msg
exitWith code
-> [String]
-> String
-> [GenericOptType a]
+ -> [ArgCompletion]
-> Either (ExitCode, String) (a, [String])
-parseOptsInner defaults argv progname options =
- case getOpt Permute options argv of
+parseOptsInner defaults argv progname options arguments =
+ case getOpt Permute (map fst options) argv of
(opts, args, []) ->
case foldM (flip id) defaults opts of
Bad msg -> Left (ExitFailure 1,
Left (ExitSuccess, usageHelp progname options))
, (verRequested parsed,
Left (ExitSuccess, versionInfo progname))
+ , (compRequested parsed,
+ Left (ExitSuccess, completionInfo progname options
+ arguments))
]
(_, _, errs) ->
Left (ExitFailure 2, "Command line error: " ++ concat errs ++ "\n" ++
projects / ganeti-local / blobdiff