Add option for displaying completion information

This patch adds support for a --help-completion option, which will
display the defined options and their completion information, in a
format designed to be parsed easily from Python, for integration into
build-bash-completion.

The alternative would have been to duplicate the build-bash-completion
functionality on the Haskell side, but that would have been lots of
duplication for not enough gain (since that is only run at build
time).

Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Agata Murawska <agatamurawska@google.com>

htools/Ganeti/Common.hs

@@ -33,6 +33,7 @@ module Ganeti.Common
   , optComplYesNo
   , oShowHelp
   , oShowVer
+  , oShowComp
   , usageHelp
   , versionInfo
   , reqWithConversion
@@ -42,6 +43,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
@@ -75,6 +79,14 @@ data OptCompletion = OptComplNone             -- ^ No parameter to this option
 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 compl =
+  let show_compl = show compl
+      stripped = stripPrefix "OptCompl" show_compl
+  in map toLower $ fromMaybe show_compl stripped
+
 -- | Abrreviation for the option type.
 type GenericOptType a = (OptDescr (a -> Result a), OptCompletion)
 
@@ -82,10 +94,12 @@ type GenericOptType a = (OptDescr (a -> Result a), OptCompletion)
 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",
              OptComplNone)
@@ -96,6 +110,12 @@ 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 =
@@ -110,6 +130,15 @@ versionInfo progname =
          (Data.Version.showVersion compilerVersion)
          os arch
 
+-- | Show completion info.
+completionInfo :: String -> [GenericOptType a] -> String
+completionInfo _ =
+  unlines .
+  map (\(Option shorts longs _ _, compinfo) ->
+         let all_opts = map (\c -> ['-', c]) shorts ++ map ("--" ++) longs
+         in intercalate "," all_opts ++ " " ++ complToText compinfo
+      )
+
 -- | Helper for parsing a yes\/no command line flag.
 parseYesNo :: Bool         -- ^ Default value (when we get a @Nothing@)
            -> Maybe String -- ^ Parameter value
@@ -169,6 +198,8 @@ parseOptsInner defaults argv progname options  =
                     Left (ExitSuccess, usageHelp progname options))
                  , (verRequested parsed,
                     Left (ExitSuccess, versionInfo progname))
+                 , (compRequested parsed,
+                    Left (ExitSuccess, completionInfo progname options))
                  ]
     (_, _, errs) ->
       Left (ExitFailure 2, "Command line error: "  ++ concat errs ++ "\n" ++

htools/Ganeti/Daemon.hs

@@ -81,6 +81,7 @@ devNull = "/dev/null"
 data DaemonOptions = DaemonOptions
   { optShowHelp     :: Bool           -- ^ Just show the help
   , optShowVer      :: Bool           -- ^ Just show the program version
+  , optShowComp     :: Bool           -- ^ Just show the completion info
   , optDaemonize    :: Bool           -- ^ Whether to daemonize or not
   , optPort         :: Maybe Word16   -- ^ Override for the network port
   , optDebug        :: Bool           -- ^ Enable debug messages
@@ -94,6 +95,7 @@ defaultOptions :: DaemonOptions
 defaultOptions  = DaemonOptions
   { optShowHelp     = False
   , optShowVer      = False
+  , optShowComp     = False
   , optDaemonize    = True
   , optPort         = Nothing
   , optDebug        = False
@@ -105,8 +107,10 @@ defaultOptions  = DaemonOptions
 instance StandardOptions DaemonOptions where
   helpRequested = optShowHelp
   verRequested  = optShowVer
+  compRequested = optShowComp
   requestHelp o = o { optShowHelp = True }
   requestVer  o = o { optShowVer  = True }
+  requestComp o = o { optShowComp = True }
 
 -- | Abrreviation for the option type.
 type OptType = GenericOptType DaemonOptions
@@ -165,6 +169,7 @@ oSyslogUsage =
 genericOpts :: [OptType]
 genericOpts = [ oShowHelp
               , oShowVer
+              , oShowComp
               ]
 
 -- | Small wrapper over getArgs and 'parseOpts'.

htools/Ganeti/HTools/CLI.hs

@@ -77,6 +77,7 @@ module Ganeti.HTools.CLI
   , oSelInst
   , oShowHelp
   , oShowVer
+  , oShowComp
   , oStdSpec
   , oTieredSpec
   , oVerbose
@@ -132,6 +133,7 @@ data Options = Options
   , optSaveCluster :: Maybe FilePath -- ^ Save cluster state to this file
   , optShowCmds    :: Maybe FilePath -- ^ Whether to show the command list
   , optShowHelp    :: Bool           -- ^ Just show the help
+  , optShowComp    :: Bool           -- ^ Just show the completion info
   , optShowInsts   :: Bool           -- ^ Whether to show the instance map
   , optShowNodes   :: Maybe [String] -- ^ Whether to show node status
   , optShowVer     :: Bool           -- ^ Just show the program version
@@ -175,6 +177,7 @@ defaultOptions  = Options
   , optSaveCluster = Nothing
   , optShowCmds    = Nothing
   , optShowHelp    = False
+  , optShowComp    = False
   , optShowInsts   = False
   , optShowNodes   = Nothing
   , optShowVer     = False
@@ -191,8 +194,10 @@ type OptType = GenericOptType Options
 instance StandardOptions Options where
   helpRequested = optShowHelp
   verRequested  = optShowVer
+  compRequested = optShowComp
   requestHelp o = o { optShowHelp = True }
   requestVer  o = o { optShowVer  = True }
+  requestComp o = o { optShowComp = True }
 
 -- * Helper functions
 
@@ -512,6 +517,7 @@ oVerbose =
 genericOpts :: [GenericOptType Options]
 genericOpts =  [ oShowVer
                , oShowHelp
+               , oShowComp
                ]
 
 -- * Functions