code.grnet.gr Git - ganeti-local/blob - htools/Ganeti/Common.hs

   1 {-| Base common functionality.
   2
   3 This module holds common functionality shared across Ganeti daemons,
   4 HTools and any other programs.
   5
   6 -}
   7
   8 {-
   9
  10 Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
  11
  12 This program is free software; you can redistribute it and/or modify
  13 it under the terms of the GNU General Public License as published by
  14 the Free Software Foundation; either version 2 of the License, or
  15 (at your option) any later version.
  16
  17 This program is distributed in the hope that it will be useful, but
  18 WITHOUT ANY WARRANTY; without even the implied warranty of
  19 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 General Public License for more details.
  21
  22 You should have received a copy of the GNU General Public License
  23 along with this program; if not, write to the Free Software
  24 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  25 02110-1301, USA.
  26
  27 -}
  28
  29 module Ganeti.Common
  30   ( GenericOptType
  31   , StandardOptions(..)
  32   , OptCompletion(..)
  33   , optComplYesNo
  34   , oShowHelp
  35   , oShowVer
  36   , usageHelp
  37   , versionInfo
  38   , reqWithConversion
  39   , parseYesNo
  40   , parseOpts
  41   , parseOptsInner
  42   ) where
  43
  44 import Control.Monad (foldM)
  45 import qualified Data.Version
  46 import System.Console.GetOpt
  47 import System.Exit
  48 import System.Info
  49 import System.IO
  50 import Text.Printf (printf)
  51
  52 import Ganeti.BasicTypes
  53 import qualified Ganeti.Version as Version (version)
  54
  55 -- | Parameter type.
  56 data OptCompletion = OptComplNone             -- ^ No parameter to this option
  57                    | OptComplFile             -- ^ An existing file
  58                    | OptComplDir              -- ^ An existing directory
  59                    | OptComplHost             -- ^ Host name
  60                    | OptComplInetAddr         -- ^ One ipv4\/ipv6 address
  61                    | OptComplOneNode          -- ^ One node
  62                    | OptComplManyNodes        -- ^ Many nodes, comma-sep
  63                    | OptComplOneInstance      -- ^ One instance
  64                    | OptComplManyInstances    -- ^ Many instances, comma-sep
  65                    | OptComplOneOs            -- ^ One OS name
  66                    | OptComplOneIallocator    -- ^ One iallocator
  67                    | OptComplInstAddNodes     -- ^ Either one or two nodes
  68                    | OptComplOneGroup         -- ^ One group
  69                    | OptComplNumeric          -- ^ Float values
  70                    | OptComplString           -- ^ Arbitrary string
  71                    | OptComplChoices [String] -- ^ List of string choices
  72                    deriving (Show, Read, Eq)
  73
  74 -- | Yes\/no choices completion.
  75 optComplYesNo :: OptCompletion
  76 optComplYesNo = OptComplChoices ["yes", "no"]
  77
  78 -- | Abrreviation for the option type.
  79 type GenericOptType a = (OptDescr (a -> Result a), OptCompletion)
  80
  81 -- | Type class for options which support help and version.
  82 class StandardOptions a where
  83   helpRequested :: a -> Bool
  84   verRequested  :: a -> Bool
  85   requestHelp   :: a -> a
  86   requestVer    :: a -> a
  87
  88 -- | Options to request help output.
  89 oShowHelp :: (StandardOptions a) => GenericOptType a
  90 oShowHelp = (Option "h" ["help"] (NoArg (Ok . requestHelp)) "show help",
  91              OptComplNone)
  92
  93 -- | Option to request version information.
  94 oShowVer :: (StandardOptions a) => GenericOptType a
  95 oShowVer = (Option "V" ["version"] (NoArg (Ok . requestVer))
  96             "show the version of the program",
  97             OptComplNone)
  98
  99 -- | Usage info.
 100 usageHelp :: String -> [GenericOptType a] -> String
 101 usageHelp progname =
 102   usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
 103              progname Version.version progname) . map fst
 104
 105 -- | Show the program version info.
 106 versionInfo :: String -> String
 107 versionInfo progname =
 108   printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
 109          progname Version.version compilerName
 110          (Data.Version.showVersion compilerVersion)
 111          os arch
 112
 113 -- | Helper for parsing a yes\/no command line flag.
 114 parseYesNo :: Bool         -- ^ Default value (when we get a @Nothing@)
 115            -> Maybe String -- ^ Parameter value
 116            -> Result Bool  -- ^ Resulting boolean value
 117 parseYesNo v Nothing      = return v
 118 parseYesNo _ (Just "yes") = return True
 119 parseYesNo _ (Just "no")  = return False
 120 parseYesNo _ (Just s)     = fail ("Invalid choice '" ++ s ++
 121                                   "', pass one of 'yes' or 'no'")
 122
 123 -- | Helper function for required arguments which need to be converted
 124 -- as opposed to stored just as string.
 125 reqWithConversion :: (String -> Result a)
 126                   -> (a -> b -> Result b)
 127                   -> String
 128                   -> ArgDescr (b -> Result b)
 129 reqWithConversion conversion_fn updater_fn =
 130   ReqArg (\string_opt opts -> do
 131             parsed_value <- conversion_fn string_opt
 132             updater_fn parsed_value opts)
 133
 134 -- | Command line parser, using a generic 'Options' structure.
 135 parseOpts :: (StandardOptions a) =>
 136              a                      -- ^ The default options
 137           -> [String]               -- ^ The command line arguments
 138           -> String                 -- ^ The program name
 139           -> [GenericOptType a]     -- ^ The supported command line options
 140           -> IO (a, [String])       -- ^ The resulting options and
 141                                     -- leftover arguments
 142 parseOpts defaults argv progname options =
 143   case parseOptsInner defaults argv progname options of
 144     Left (code, msg) -> do
 145       hPutStr (if code == ExitSuccess then stdout else stderr) msg
 146       exitWith code
 147     Right result ->
 148       return result
 149
 150 -- | Inner parse options. The arguments are similar to 'parseOpts',
 151 -- but it returns either a 'Left' composed of exit code and message,
 152 -- or a 'Right' for the success case.
 153 parseOptsInner :: (StandardOptions a) =>
 154                   a
 155                -> [String]
 156                -> String
 157                -> [GenericOptType a]
 158                -> Either (ExitCode, String) (a, [String])
 159 parseOptsInner defaults argv progname options  =
 160   case getOpt Permute (map fst options) argv of
 161     (opts, args, []) ->
 162       case foldM (flip id) defaults opts of
 163            Bad msg -> Left (ExitFailure 1,
 164                             "Error while parsing command line arguments:\n"
 165                             ++ msg ++ "\n")
 166            Ok parsed ->
 167              select (Right (parsed, args))
 168                  [ (helpRequested parsed,
 169                     Left (ExitSuccess, usageHelp progname options))
 170                  , (verRequested parsed,
 171                     Left (ExitSuccess, versionInfo progname))
 172                  ]
 173     (_, _, errs) ->
 174       Left (ExitFailure 2, "Command line error: "  ++ concat errs ++ "\n" ++
 175             usageHelp progname options)