X-Git-Url: https://code.grnet.gr/git/ganeti-local/blobdiff_plain/5b11f8db6abaa39c4fb08043a7dde65b9ed209e2..b9612abb7e31ea1bddfd390c52a5eb6db2f74c97:/htools/Ganeti/Common.hs

diff --git a/htools/Ganeti/Common.hs b/htools/Ganeti/Common.hs
index 43caf27..4e5a275 100644
--- a/htools/Ganeti/Common.hs
+++ b/htools/Ganeti/Common.hs
@@ -29,8 +29,12 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 module Ganeti.Common
   ( GenericOptType
   , StandardOptions(..)
+  , OptCompletion(..)
+  , ArgCompletion(..)
+  , optComplYesNo
   , oShowHelp
   , oShowVer
+  , oShowComp
   , usageHelp
   , versionInfo
   , reqWithConversion
@@ -40,6 +44,9 @@ module Ganeti.Common
   ) 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
@@ -50,30 +57,87 @@ import Text.Printf (printf)
 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
@@ -83,6 +147,16 @@ versionInfo progname =
          (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
@@ -110,10 +184,11 @@ 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
@@ -128,9 +203,10 @@ parseOptsInner :: (StandardOptions a) =>
                -> [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,
@@ -142,6 +218,9 @@ parseOptsInner defaults argv progname options  =
                     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" ++