Shell.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RankNTypes #-}
-- | This module contains definitions for client interactive shell implementation.
module Batchd.Client.Shell (commandHandler) where

import Control.Monad.State
import Data.Maybe
import qualified Data.Text.Lazy.IO as TLIO
import Data.Text.Format.Heavy
import Options.Applicative
import System.Console.Haskeline
import System.Environment (getProgName)

import Batchd.Core.Common.Localize
import Batchd.Client.Types
import Batchd.Client.Logging
import Batchd.Client.Actions
import Batchd.Client.CmdLine
import Batchd.Client.Monad
import Batchd.Client.Http

detectMode :: CrudMode -> [Command -> Bool] -> Command -> CrudMode
detectMode mode mods cmd =
  if mode == Delete
    then Delete
    else if mode == Add
           then Add
           else if mode == Update || or [mod cmd | mod <- mods]
                  then Update
                  else View

-- | Handle client command line.
commandHandler :: Client ()
commandHandler = do
  opts <- gets (cmdCommand . csCmdline)
  case opts of
    Enqueue {} -> doEnqueue
    List {} -> doList
    Stats {} -> doStats
    Type {} -> doType
    Hosts -> doHosts
    Job {} -> do
      let mode = detectMode (jobMode opts) [isJust . status, isJust . hostName, isJust . jobNotes, isJust . startTime, isJust . queueName, isJust . prioritize] opts
      case mode of
        View -> viewJob
        Update -> updateJob
        Delete -> deleteJob
    Queue {} -> do
      let mode = detectMode (queueMode opts) [isJust . scheduleName, isJust . hostName, isJust . title, isJust . enabled] opts
      case mode of
        Add -> addQueue
        Update -> updateQueue
        Delete -> deleteQueue
    Schedule {} -> 
      case scheduleMode opts of
        View -> doListSchedules
        Add -> doAddSchedule
        Delete -> doDeleteSchedule
    Monitor {} -> doMonitor
    User {} ->
      case userMode opts of
        View -> doListUsers
        Add -> doAddUser
        Update -> doChangePassword
    Grant {} ->
      case grantMode opts of
        View -> doListPermissions
        Add -> doAddPermission
        Delete -> doRevokePermission
    RunShell {} -> do
      obtainCredentials
      message (__ "This is batch client shell. Type `--help' for list of available commands or `some_command --help' (without quotes) for help message on particular command.") ()
      runShell

errorHandler :: ClientException -> Client ()
errorHandler (ClientException e) =
  liftIO $ TLIO.putStrLn =<< (__f "Error: {}" (Single e))

-- | Interactive shell REPL.
runShell :: Client ()
runShell = runInputT defaultSettings loop
  where
    loop = do
      mbLine <- getInputLine "batch> "
      case mbLine of
        Nothing -> return ()
        Just "exit" -> return ()
        Just "quit" -> return ()
        Just "" -> loop
        Just line -> do
            let res = execParserPure Options.Applicative.defaultPrefs parserInfo (words line)
            case res of
              (Success cmd) -> lift $ do
                modify $ \st -> st {csCmdline = cmd}
                commandHandler `catchC` errorHandler
              (Failure failure) -> do
                progn <- liftIO $ getProgName
                let (msg,_) = renderFailure failure progn
                liftIO $ putStrLn msg
              (CompletionInvoked _) -> do
                liftIO $ putStrLn "bash-completion is not supported in interactive shell."
            loop