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   , oShowHelp
  33   , oShowVer
  34   , usageHelp
  35   , versionInfo
  36   , reqWithConversion
  37   , parseYesNo
  38   , parseOpts
  39   , parseOptsInner
  40   ) where
  41
  42 import Control.Monad (foldM)
  43 import qualified Data.Version
  44 import System.Console.GetOpt
  45 import System.Exit
  46 import System.Info
  47 import System.IO
  48 import Text.Printf (printf)
  49
  50 import Ganeti.BasicTypes
  51 import qualified Ganeti.Version as Version (version)
  52
  53 -- | Abrreviation for the option type.
  54 type GenericOptType a = OptDescr (a -> Result a)
  55
  56 -- | Type class for options which support help and version.
  57 class StandardOptions a where
  58   helpRequested :: a -> Bool
  59   verRequested  :: a -> Bool
  60   requestHelp   :: a -> a
  61   requestVer    :: a -> a
  62
  63 -- | Options to request help output.
  64 oShowHelp :: (StandardOptions a) => GenericOptType a
  65 oShowHelp = Option "h" ["help"] (NoArg (Ok . requestHelp))
  66             "show help"
  67
  68 oShowVer :: (StandardOptions a) => GenericOptType a
  69 oShowVer = Option "V" ["version"] (NoArg (Ok . requestVer))
  70            "show the version of the program"
  71
  72 -- | Usage info.
  73 usageHelp :: String -> [GenericOptType a] -> String
  74 usageHelp progname =
  75   usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
  76              progname Version.version progname)
  77
  78 -- | Show the program version info.
  79 versionInfo :: String -> String
  80 versionInfo progname =
  81   printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
  82          progname Version.version compilerName
  83          (Data.Version.showVersion compilerVersion)
  84          os arch
  85
  86 -- | Helper for parsing a yes\/no command line flag.
  87 parseYesNo :: Bool         -- ^ Default value (when we get a @Nothing@)
  88            -> Maybe String -- ^ Parameter value
  89            -> Result Bool  -- ^ Resulting boolean value
  90 parseYesNo v Nothing      = return v
  91 parseYesNo _ (Just "yes") = return True
  92 parseYesNo _ (Just "no")  = return False
  93 parseYesNo _ (Just s)     = fail ("Invalid choice '" ++ s ++
  94                                   "', pass one of 'yes' or 'no'")
  95
  96 -- | Helper function for required arguments which need to be converted
  97 -- as opposed to stored just as string.
  98 reqWithConversion :: (String -> Result a)
  99                   -> (a -> b -> Result b)
 100                   -> String
 101                   -> ArgDescr (b -> Result b)
 102 reqWithConversion conversion_fn updater_fn metavar =
 103   ReqArg (\string_opt opts -> do
 104             parsed_value <- conversion_fn string_opt
 105             updater_fn parsed_value opts) metavar
 106
 107 -- | Command line parser, using a generic 'Options' structure.
 108 parseOpts :: (StandardOptions a) =>
 109              a                      -- ^ The default options
 110           -> [String]               -- ^ The command line arguments
 111           -> String                 -- ^ The program name
 112           -> [GenericOptType a]     -- ^ The supported command line options
 113           -> IO (a, [String])       -- ^ The resulting options and
 114                                     -- leftover arguments
 115 parseOpts defaults argv progname options =
 116   case parseOptsInner defaults argv progname options of
 117     Left (code, msg) -> do
 118       hPutStr (if code == ExitSuccess then stdout else stderr) msg
 119       exitWith code
 120     Right result ->
 121       return result
 122
 123 -- | Inner parse options. The arguments are similar to 'parseOpts',
 124 -- but it returns either a 'Left' composed of exit code and message,
 125 -- or a 'Right' for the success case.
 126 parseOptsInner :: (StandardOptions a) =>
 127                   a
 128                -> [String]
 129                -> String
 130                -> [GenericOptType a]
 131                -> Either (ExitCode, String) (a, [String])
 132 parseOptsInner defaults argv progname options  =
 133   case getOpt Permute options argv of
 134     (opts, args, []) ->
 135       case foldM (flip id) defaults opts of
 136            Bad msg -> Left (ExitFailure 1,
 137                             "Error while parsing command line arguments:\n"
 138                             ++ msg ++ "\n")
 139            Ok parsed ->
 140              select (Right (parsed, args))
 141                  [ (helpRequested parsed,
 142                     Left (ExitSuccess, usageHelp progname options))
 143                  , (verRequested parsed,
 144                     Left (ExitSuccess, versionInfo progname))
 145                  ]
 146     (_, _, errs) ->
 147       Left (ExitFailure 2, "Command line error: "  ++ concat errs ++ "\n" ++
 148             usageHelp progname options)