Switch daemon startup to pipe-based error reporting

[ganeti-local] / htools / Ganeti / Common.hs

diff --git a/htools/Ganeti/Common.hs b/htools/Ganeti/Common.hs
index f300205..4e5a275 100644 (file)
--- a/htools/Ganeti/Common.hs
+++ b/htools/Ganeti/Common.hs
@@ -30,9 +30,11 @@ module Ganeti.Common
   ( GenericOptType
   , StandardOptions(..)
   , OptCompletion(..)
+  , ArgCompletion(..)
   , optComplYesNo
   , oShowHelp
   , oShowVer
+  , oShowComp
   , usageHelp
   , versionInfo
   , reqWithConversion
@@ -42,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
@@ -66,15 +71,39 @@ data OptCompletion = OptComplNone             -- ^ No parameter to this option
                    | 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)
 
+-- | 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), OptCompletion)
 
@@ -82,10 +111,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 +127,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 +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
@@ -137,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
@@ -155,8 +203,9 @@ parseOptsInner :: (StandardOptions a) =>
                -> [String]
                -> String
                -> [GenericOptType a]
+               -> [ArgCompletion]
                -> Either (ExitCode, String) (a, [String])
-parseOptsInner defaults argv progname options  =
+parseOptsInner defaults argv progname options arguments  =
   case getOpt Permute (map fst options) argv of
     (opts, args, []) ->
       case foldM (flip id) defaults opts of
@@ -169,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" ++