{-# LANGUAGE TemplateHaskell, BangPatterns, OverloadedStrings #-}
module Client.Commands.Exec
(
ExecCmd(..)
, execOutputNetwork
, execOutputChannel
, parseExecCmd
, runExecCmd
) where
import Control.Exception
import Control.Lens
import Data.List
import System.Console.GetOpt
import System.Process
data ExecCmd = ExecCmd
{ _execOutputNetwork :: Maybe String
, _execOutputChannel :: Maybe String
, _execCommand :: String
, _execStdIn :: String
, _execArguments :: [String]
}
deriving (Read,Show)
makeLenses ''ExecCmd
-- | Default values for @/exec@ to be overridden by flags.
emptyExecCmd :: ExecCmd
emptyExecCmd = ExecCmd
{ _execOutputNetwork = Nothing
, _execOutputChannel = Nothing
, _execCommand = error "no default command"
, _execStdIn = ""
, _execArguments = []
}
options :: [OptDescr (ExecCmd -> ExecCmd)]
options =
[ Option "n" ["network"]
(ReqArg (set execOutputNetwork . Just) "NETWORK")
"Set network target"
, Option "c" ["channel"]
(ReqArg (set execOutputChannel . Just) "CHANNEL")
"Set channel target"
, Option "i" ["input"]
(ReqArg (set execStdIn) "INPUT")
"Use string as stdin"
]
-- | Parse the arguments to @/exec@ looking for various flags
-- and the command and its arguments.
parseExecCmd ::
String {- ^ exec arguments -} ->
Either [String] ExecCmd {- ^ error or parsed command -}
parseExecCmd str =
case getOpt RequireOrder options (powerWords str) of
(_, [] , errs) -> Left ("No command specified":errs)
(fs, cmd:args, []) -> Right
$ foldl (\x f -> f x) ?? fs
$ set execCommand cmd
$ set execArguments args
$ emptyExecCmd
(_,_, errs) -> Left errs
-- | Execute the requested command synchronously and return
-- the output.
runExecCmd ::
ExecCmd {- ^ exec configuration -} ->
IO (Either [String] [String]) {- ^ error lines or output lines -}
runExecCmd e =
do res <- try (readProcess (view execCommand e)
(view execArguments e)
(view execStdIn e))
return $ case res of
Left er -> Left [show (er :: IOError)]
Right x -> Right (lines x)
-- | Power words is similar to 'words' except that when it encounters
-- a word formatted as a Haskell 'String' literal it parses it as
-- such. Only space is used as a delimiter.
powerWords :: String -> [String]
powerWords = unfoldr (splitWord . dropWhile isSp)
where
isSp x = x == ' '
splitWord xs
| null xs = Nothing
| [x] <- reads xs = Just x
| otherwise = Just (break isSp xs)