sifflet-2.3.0: app/Options.hs

module Options (Options(..), processArgs, showHelp) where

-- ?? import Control.Monad (mapM_)

-- | Options are the interpretation of sifflet command-line arguments.
-- If a function call is requested, the remaining arguments are unparsed,
-- and just saved as strings to be fed into the parser when the
-- function's argument types are known.

data Options = Options { optionsShowFunPad :: Bool
                       , optionsHelp :: Bool
                       , optionsSourceFile :: Maybe FilePath
                       , optionsShowFunction :: Maybe String
                       , optionsCallFunction :: Maybe String
                       , optionsAdditionalArgs :: [String]
                       , optionsErrorMsg :: Maybe String
                       , optionsDebug :: Bool
                       }
             deriving (Eq, Show)

defaultOptions :: Options
defaultOptions = Options { optionsShowFunPad = True
                         , optionsHelp = False
                         , optionsSourceFile = Nothing
                         , optionsShowFunction = Nothing
                         , optionsCallFunction = Nothing
                         , optionsAdditionalArgs = []
                         , optionsErrorMsg = Nothing
                         , optionsDebug = False
                         }

processArgs :: [String] -> Options
processArgs = processArgsLoop defaultOptions 

processArgsLoop :: Options -> [String] -> Options
processArgsLoop options args =
    case args of
      [] -> options
      arg:args' ->
          case arg of
            "--help" -> options {optionsHelp = True,
                                 optionsShowFunPad = False}
            "--file" ->
                case args' of
                  [] -> options {optionsErrorMsg = 
                                     Just "--file: missing file name"}
                  file:args'' ->
                      processArgsLoop (options {optionsSourceFile = Just file})
                                      args''
            "--show" ->
                case args' of
                  [] -> options {optionsErrorMsg =
                                     Just "--show: missing function name"}
                  fname:args'' ->
                      processArgsLoop (options {optionsShowFunction = 
                                                    Just fname,
                                               optionsShowFunPad = False})
                                      args''
            "--call" ->
                case args' of
                  [] -> options {optionsErrorMsg =
                                     Just "--call: missing function name"}
                  fname:args'' ->
                      options {optionsCallFunction = Just fname,
                               optionsAdditionalArgs = args'',
                               optionsShowFunPad = False}
            "--debug" ->
                processArgsLoop (options {optionsDebug = True}) args'
            _ ->
                options {optionsErrorMsg = Just ("unexpected argument: " ++
                                                  arg)}

helpText :: [String]
helpText =
    ["Usage:",
     "sifflet [OPTIONS]",
     "",
     "OPTIONS:",
     "  --file SIFFLET-FILE : loads SIFFLET-FILE at start.",
     "  --show FUNCTION-NAME : displays function FUNCTION-NAME.",
     "  --call FUNCTION-NAME [ARG ...] : calls function FUNCTION-NAME " ++
     "with given arguments ARG ...",
     "  --debug : include context menu items for debugging.",
     "  --help : show this message.",
     "The --help, --show, and --call options suppress the initial appearance of",
     "the Function Pad, though (except with --help) it can still be",
     "activated by the user."]

showHelp :: IO ()
showHelp = mapM_ putStrLn helpText