Arguments.hs

module Bein.Minion.Arguments where

import System.Console.GetOpt
    ( OptDescr(..),
      ArgOrder(RequireOrder),
      ArgDescr(NoArg, ReqArg),
      getOpt,
      usageInfo )
import System.Environment ( getArgs, getProgName )
import System.Exit ( exitSuccess, exitFailure )
import System.IO ( hPutStrLn, stderr )
import Bein.Minion.Types ( ExecutionID(..), Settings(..) )

getSettings :: IO Settings
getSettings = do
  args <- getArgs
  case getOpt RequireOrder options args of
    (actions, _, []) -> do opts <- foldl (>>=) (return defaultSettings) actions
                           case valid opts of
                             Left err -> printHelpAndDie (Just err)
                             Right o -> return o
    (_, _, errs) -> printHelpAndDie (Just $ concat errs)
                            
valid :: Settings -> Either String Settings                            
valid opts = 
  if setScratchDir opts == "" && setExecution opts == ExecutionID (-1)
    then Left "Must specify scratch directory and execution."
    else Right opts                              

printHelpAndDie :: Maybe String -> IO a
printHelpAndDie msg = do
  case msg of
      Nothing -> help >> exitSuccess
      Just m -> hPutStrLn stderr m >> help >> exitFailure
    where help = do 
            programName <- getProgName
            hPutStrLn stderr (usageInfo programName options)

options :: [OptDescr (Settings -> IO Settings)]
options = [
  
  Option "h" ["help"] 
         (NoArg (\_ -> printHelpAndDie Nothing))
         "Show help",
  
  Option "v" ["verbose"] 
         (NoArg (\opt -> return opt { setVerbose = True })) 
         "Be verbose.",
  
  Option "x" ["execution"] 
         (ReqArg (\arg opt -> 
                   let ex = ExecutionID (read arg)
                   in return opt { setExecution = ex }) "EXECUTIONID") 
         "Execution to process",
  
  Option "d" ["scratchdir"] 
         (ReqArg (\arg opt -> return opt { setScratchDir = arg }) "DIRECTORY") 
         "Scratch directory"
  
  ]
          
defaultSettings :: Settings
defaultSettings = Settings { setVerbose = False,
                             setScratchDir = "",
                             setExecution = ExecutionID (-1) }