{-# LANGUAGE DeriveFunctor, TemplateHaskell, BangPatterns, OverloadedStrings #-}
module Client.Commands.Exec
(
ExecCmd(..)
, Target(..)
, 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 :: Target String
, _execOutputChannel :: Target String
, _execCommand :: String
, _execStdIn :: String
, _execArguments :: [String]
}
deriving (Read,Show)
data Target a = Unspecified | Current | Specified a
deriving (Show, Read, Eq, Ord, Functor)
makeLenses ''ExecCmd
emptyExecCmd :: ExecCmd
emptyExecCmd = ExecCmd
{ _execOutputNetwork = Unspecified
, _execOutputChannel = Unspecified
, _execCommand = error "no default command"
, _execStdIn = ""
, _execArguments = []
}
options :: [OptDescr (ExecCmd -> ExecCmd)]
options =
let specified = maybe Current Specified in
[ Option "n" ["network"]
(OptArg (set execOutputNetwork . specified) "NETWORK")
"Set network target"
, Option "c" ["channel"]
(OptArg (set execOutputChannel . specified) "CHANNEL")
"Set channel target"
, Option "i" ["input"]
(ReqArg (set execStdIn) "INPUT")
"Use string as stdin"
]
parseExecCmd ::
String ->
Either [String] ExecCmd
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
runExecCmd ::
ExecCmd ->
IO (Either [String] [String])
runExecCmd cmd =
do res <- try (readProcessWithExitCode
(view execCommand cmd)
(view execArguments cmd)
(view execStdIn cmd))
return $! case res of
Left er -> Left [displayException (er :: IOError)]
Right (_code, out, _err) -> Right (lines out)
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)