module DRcon.EvalParser (
CommandErrorType(..),
EvalVar(..),
VarValue(..),
InputType(..),
EvalCmd,
parseCommand,
internalAutoComplete,
helpMessage,
helpVars,
showVar
) where
import Prelude hiding (break, concat)
import Data.Char (isSpace)
import Data.Maybe
import Data.Text hiding (filter, map)
import qualified Data.Text as T
import Data.Text.Read
import Control.Monad.Error
import Control.Applicative ((<$>))
import DRcon.CommandArgs (parseRconMode, parseEncoding, showEncoding)
import DRcon.Prompt (readPrompt)
import DarkPlaces.Rcon (RconMode)
import DarkPlaces.Text (DecodeType(..))
import Data.Monoid
import Text.Printf
data CommandErrorType = UnknownCommand Text
| WrongArgumentType Text Text
| CommandTakesNoArgumens Text Text
| OtherError Text
deriving(Eq)
data EvalVar = Mode
| TimeDiff
| Timeout
| Encoding
| Color
| PromptVar
deriving(Eq, Ord, Bounded, Enum)
data VarValue = SetMode RconMode
| SetTimeDiff Int
| SetTimeout Float
| SetEncoding DecodeType
| SetColor Bool
| SetPrompt String
deriving(Eq)
data InputType = Empty
| Quit
| Help
| Version
| RepeatLast
| Login
| ListVars
| Show EvalVar
| Set VarValue
| History (Maybe Int)
| RconCommand Text
deriving(Show, Eq)
type EvalCmd = Either CommandErrorType InputType
instance Show CommandErrorType where
show (UnknownCommand cmd) = printf badCmd $ unpack cmd
where
badCmd = "unknown command '%s'\nuse :? for help."
show (WrongArgumentType cmd _) = case cmd of
":history" -> "Wrong argument\nSyntax: :history [n]"
_ -> printf "Wrong argument for command \"%s\"" $ unpack cmd
show (CommandTakesNoArgumens cmd _) = printf noArgs $ unpack cmd
where
noArgs = "Error: command \"%s\" takes no arguments"
show (OtherError msg) = unpack msg
instance Show EvalVar where
show Mode = "mode"
show TimeDiff = "timediff"
show Timeout = "timeout"
show Encoding = "encoding"
show Color = "color"
show PromptVar = "prompt"
instance Show VarValue where
show v = show (getVarName v) ++ " " ++ showVar v
cmdInfo :: [(Text, Text)]
cmdInfo = [
("<rcon command>", "execute command via rcon"),
(":", "repeat last command"),
(":help, :?", "display list of commands"),
(":history [n]", "show n (10 by default) last commands"),
(":login", "promp for server password"),
(":set", "list available options"),
(":set <option>", "display option value"),
(":set <option> <args>", "change option value"),
(":quit", "quit from drcon"),
(":version", "print program version")]
topLevelCommands :: [Text]
topLevelCommands = [":help", ":quit", ":set", ":login",
":history", ":version", ":", ":?"]
helpMessage :: Text
helpMessage = " Available commands:\n\n" <> cmdList
where
cmdList = T.concat $ map (uncurry formatCmd) cmdInfo
formatCmd name info = T.concat [
T.replicate 3 " ",
justifyLeft 28 ' ' name,
info, "\n"]
helpVars :: Text
helpVars = " Available vars:\n\n" <> varsList
where
varsList = intercalate "\n" $ map (T.replicate 3 " " `append`) varsText
vars :: [EvalVar]
vars = enumFromTo minBound maxBound
varsText = map (pack . show) vars
parseEvalVar :: Text -> Maybe EvalVar
parseEvalVar var = case var of
"mode" -> Just Mode
"timediff" -> Just TimeDiff
"timeout" -> Just Timeout
"encoding" -> Just Encoding
"color" -> Just Color
"prompt" -> Just PromptVar
_ -> Nothing
showBool :: Bool -> String
showBool True = "yes"
showBool False = "no"
showVar :: VarValue -> String
showVar (SetMode m) = show $ fromEnum m
showVar (SetTimeDiff d) = show d
showVar (SetTimeout tm) = show tm
showVar (SetEncoding enc) = showEncoding enc
showVar (SetColor c) = showBool c
showVar (SetPrompt p) = show p
getVarName :: VarValue -> EvalVar
getVarName (SetMode _) = Mode
getVarName (SetTimeDiff _) = TimeDiff
getVarName (SetTimeout _) = Timeout
getVarName (SetEncoding _) = Encoding
getVarName (SetColor _) = Color
getVarName (SetPrompt _) = PromptVar
parseBool :: Text -> Either String Bool
parseBool val = case toLower val of
"y" -> return True
"n" -> return False
"yes" -> return True
"no" -> return False
"true" -> return True
"false" -> return False
"1" -> return True
"0" -> return False
"on" -> return True
"off" -> return False
_ -> throwError "Value should be: yes or no"
parseSetVar :: EvalVar -> Text -> Either String VarValue
parseSetVar Mode val = SetMode <$> parseRconMode (unpack val)
parseSetVar TimeDiff val = case signed decimal val of
Right (num, "") -> return $ SetTimeDiff num
_ -> throwError "Value shoud be decimal"
parseSetVar Timeout val = case rational val of
Right (num, "") -> return $ SetTimeout num
_ -> throwError "Value should be float"
parseSetVar Encoding val = SetEncoding <$> parseEncoding (unpack val)
parseSetVar Color val = SetColor <$> parseBool val
parseSetVar PromptVar val = SetPrompt <$> readPrompt (unpack val)
disambiguate :: Text -> Maybe Text
disambiguate cmd
| T.length cmd > 1 = listToMaybe search_cmds
| otherwise = Nothing
where
search_cmds = filter (isPrefixOf cmd) topLevelCommands
firstMap :: (a -> a) -> [a] -> [a]
firstMap _ [] = []
firstMap fun (x:xs) = fun x : xs
internalAutoComplete :: Text -> Text -> [Text]
internalAutoComplete prev cmd = case prev_cmds of
[] -> searchComp topLevelCommands
[":set"] -> searchComp setVars
[":set", "color"] -> searchComp bools
[":set", "encoding"] -> searchComp encodings
_ -> []
where
sprev = T.reverse $ strip prev
prev_cmds = firstMap firstCmd $ T.words sprev
firstCmd cmd = fromMaybe cmd $ disambiguate cmd
vars :: [EvalVar]
vars = enumFromTo minBound maxBound
setVars = map (pack . show) vars
searchComp = filter (isPrefixOf cmd)
bools = map (pack . showBool) [True, False]
encodings = map (pack . showEncoding) $ enumFromTo minBound maxBound
parseCommand :: String -> EvalCmd
parseCommand command
| tcommand == empty = return Empty
| isPrefixOf ":" tcommand = parseInternalCommand dcmd (strip args)
| otherwise = return $ RconCommand tcommand
where
tcommand = strip $ pack command
(cmd, args) = break isSpace tcommand
dcmd = fromMaybe cmd $ disambiguate cmd
parseInternalCommand :: Text -> Text -> EvalCmd
parseInternalCommand ":quit" _ = return Quit
parseInternalCommand ":help" "" = return Help
parseInternalCommand ":?" "" = return Help
parseInternalCommand ":" "" = return RepeatLast
parseInternalCommand ":login" "" = return Login
parseInternalCommand ":version" "" = return Version
parseInternalCommand ":history" "" = return $ History Nothing
parseInternalCommand ":history" v = case decimal v of
(Right (num, "")) -> return $ History (Just num)
_ -> throwError $ WrongArgumentType ":history" v
parseInternalCommand ":set" "" = return ListVars
parseInternalCommand ":set" v = case margs of
Just (var, "") -> return $ Show var
Just (var, arg) -> either toErr return (Set <$> parseSetVar var arg)
Nothing -> throwError $ WrongArgumentType ":set" v
where
(var_str, var_arg) = break isSpace v
margs = (\v -> (v, strip var_arg)) <$> parseEvalVar var_str
toErr = throwError . OtherError . pack
parseInternalCommand cmd args
| cmd `elem` withoutArgs = throwError $ CommandTakesNoArgumens cmd args
| otherwise = throwError $ UnknownCommand cmd
where
withoutArgs = [":", ":help", ":?", ":version", ":login"]