Revision 097ad7ee htools/Ganeti/Common.hs

b/htools/Ganeti/Common.hs
33 33 
  , optComplYesNo
34 34 
  , oShowHelp
35 35 
  , oShowVer
36 
  , oShowComp
36 37 
  , usageHelp
37 38 
  , versionInfo
38 39 
  , reqWithConversion
......
42 43 
  ) where
43 44 

  		





  44
  45
  
    
import Control.Monad (foldM)


  		





  
  46
  
    
import Data.Char (toLower)


  		





  
  47
  
    
import Data.List (intercalate, stripPrefix)


  		





  
  48
  
    
import Data.Maybe (fromMaybe)


  		





  45
  49
  
    
import qualified Data.Version


  		





  46
  50
  
    
import System.Console.GetOpt


  		





  47
  51
  
    
import System.Exit


  		





  ......




  75
  79
  
    
optComplYesNo :: OptCompletion


  		





  76
  80
  
    
optComplYesNo = OptComplChoices ["yes", "no"]


  		





  77
  81
  
    

  		





  
  82
  
    
-- | Text serialisation for 'OptCompletion', used on the Python side.


  		





  
  83
  
    
complToText :: OptCompletion -> String


  		





  
  84
  
    
complToText (OptComplChoices choices) = "choices " ++ intercalate "," choices


  		





  
  85
  
    
complToText compl =


  		





  
  86
  
    
  let show_compl = show compl


  		





  
  87
  
    
      stripped = stripPrefix "OptCompl" show_compl


  		





  
  88
  
    
  in map toLower $ fromMaybe show_compl stripped


  		





  
  89
  
    

  		





  78
  90
  
    
-- | Abrreviation for the option type.


  		





  79
  91
  
    
type GenericOptType a = (OptDescr (a -> Result a), OptCompletion)


  		





  80
  92
  
    

  		





  ......




  82
  94
  
    
class StandardOptions a where


  		





  83
  95
  
    
  helpRequested :: a -> Bool


  		





  84
  96
  
    
  verRequested  :: a -> Bool


  		





  
  97
  
    
  compRequested :: a -> Bool


  		





  85
  98
  
    
  requestHelp   :: a -> a


  		





  86
  99
  
    
  requestVer    :: a -> a


  		





  
  100
  
    
  requestComp   :: a -> a


  		





  87
  101
  
    

  		





  88
  
  
    
-- | Options to request help output.


  		





  
  102
  
    
-- | Option to request help output.


  		





  89
  103
  
    
oShowHelp :: (StandardOptions a) => GenericOptType a


  		





  90
  104
  
    
oShowHelp = (Option "h" ["help"] (NoArg (Ok . requestHelp)) "show help",


  		





  91
  105
  
    
             OptComplNone)


  		





  ......




  96
  110
  
    
            "show the version of the program",


  		





  97
  111
  
    
            OptComplNone)


  		





  98
  112
  
    

  		





  
  113
  
    
-- | Option to request completion information


  		





  
  114
  
    
oShowComp :: (StandardOptions a) => GenericOptType a


  		





  
  115
  
    
oShowComp =


  		





  
  116
  
    
  (Option "" ["help-completion"] (NoArg (Ok . requestComp) )


  		





  
  117
  
    
   "show completion info", OptComplNone)


  		





  
  118
  
    

  		





  99
  119
  
    
-- | Usage info.


  		





  100
  120
  
    
usageHelp :: String -> [GenericOptType a] -> String


  		





  101
  121
  
    
usageHelp progname =


  		





  ......




  110
  130
  
    
         (Data.Version.showVersion compilerVersion)


  		





  111
  131
  
    
         os arch


  		





  112
  132
  
    

  		





  
  133
  
    
-- | Show completion info.


  		





  
  134
  
    
completionInfo :: String -> [GenericOptType a] -> String


  		





  
  135
  
    
completionInfo _ =


  		





  
  136
  
    
  unlines .


  		





  
  137
  
    
  map (\(Option shorts longs _ _, compinfo) ->


  		





  
  138
  
    
         let all_opts = map (\c -> ['-', c]) shorts ++ map ("--" ++) longs


  		





  
  139
  
    
         in intercalate "," all_opts ++ " " ++ complToText compinfo


  		





  
  140
  
    
      )


  		





  
  141
  
    

  		





  113
  142
  
    
-- | Helper for parsing a yes\/no command line flag.


  		





  114
  143
  
    
parseYesNo :: Bool         -- ^ Default value (when we get a @Nothing@)


  		





  115
  144
  
    
           -> Maybe String -- ^ Parameter value


  		





  ......




  169
  198
  
    
                    Left (ExitSuccess, usageHelp progname options))


  		





  170
  199
  
    
                 , (verRequested parsed,


  		





  171
  200
  
    
                    Left (ExitSuccess, versionInfo progname))


  		





  
  201
  
    
                 , (compRequested parsed,


  		





  
  202
  
    
                    Left (ExitSuccess, completionInfo progname options))


  		





  172
  203
  
    
                 ]


  		





  173
  204
  
    
    (_, _, errs) ->


  		





  174
  205
  
    
      Left (ExitFailure 2, "Command line error: "  ++ concat errs ++ "\n" ++


  		












Also available in:
  Unified diff