Synnefo » snf-ganeti » ganeti-local

  , parseOptsCmds

  , genericMainCmds

import Data.List (intercalate, stripPrefix, sortBy)

import Data.Ord (comparing)

import System.Environment

import qualified Ganeti.Constants as C

-- | Max command length when formatting command list output.

maxCmdLen :: Int

maxCmdLen = 60

-- | Formats usage for a multi-personality program.

formatCmdUsage :: (StandardOptions a) => String -> PersonalityList a -> String

formatCmdUsage prog personalities =

  let mlen = min maxCmdLen . maximum $ map (length . fst) personalities

      sorted = sortBy (comparing fst) personalities

      header = [ printf "Usage: %s {command} [options...] [argument...]" prog

               , printf "%s <command> --help to see details, or man %s"

                   prog prog

               , ""

               , "Commands:"

               ]

      rows = map (\(cmd, _) ->

                    printf " %-*s" mlen cmd::String) sorted

  in unlines $ header ++ rows

-- | Displays usage for a program and exits.

showCmdUsage :: (StandardOptions a) =>

                String            -- ^ Program name

             -> PersonalityList a -- ^ Personality list

             -> Bool              -- ^ Whether the exit code is success or not

             -> IO b

showCmdUsage prog personalities success = do

  let usage = formatCmdUsage prog personalities

  putStr usage

  if success

    then exitSuccess

    else exitWith $ ExitFailure C.exitFailure

-- | Command line parser, for programs with sub-commands.

parseOptsCmds :: (StandardOptions a) =>

                 a                      -- ^ The default options

              -> [String]               -- ^ The command line arguments

              -> String                 -- ^ The program name

              -> PersonalityList a      -- ^ The supported commands

              -> [GenericOptType a]     -- ^ Generic options

              -> IO (a, [String], a -> [String] -> IO ())

                     -- ^ The resulting options and leftover arguments

parseOptsCmds defaults argv progname personalities genopts = do

  let usage = showCmdUsage progname personalities

      check c = case c of

                  -- hardcoded option strings here!

                  "--version" -> putStrLn (versionInfo progname) >> exitSuccess

                  "--help"    -> usage True

                  _           -> return c

  (cmd, cmd_args) <- case argv of

                       cmd:cmd_args -> do

                         cmd' <- check cmd

                         return (cmd', cmd_args)

                       [] -> usage False

  case cmd `lookup` personalities of

    Nothing -> usage False

    Just (mainfn, optdefs, argdefs) -> do

      optdefs' <- optdefs

      (opts, args) <- parseOpts defaults cmd_args progname

                      (optdefs' ++ genopts) argdefs

      return (opts, args, mainfn)

-- | Parse command line options and execute the main function of a

-- multi-personality binary.

genericMainCmds :: (StandardOptions a) =>

                   a

                -> PersonalityList a

                -> [GenericOptType a]

                -> IO ()

genericMainCmds defaults personalities genopts = do

  cmd_args <- getArgs

  prog <- getProgName

  (opts, args, fn) <-

    parseOptsCmds defaults cmd_args prog personalities genopts

  fn opts args