{-# 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
{ ExecCmd -> Target String
_execOutputNetwork :: Target String
, ExecCmd -> Target String
_execOutputChannel :: Target String
, ExecCmd -> String
_execCommand :: String
, ExecCmd -> String
_execStdIn :: String
, ExecCmd -> [String]
_execArguments :: [String]
}
deriving (ReadPrec [ExecCmd]
ReadPrec ExecCmd
Int -> ReadS ExecCmd
ReadS [ExecCmd]
(Int -> ReadS ExecCmd)
-> ReadS [ExecCmd]
-> ReadPrec ExecCmd
-> ReadPrec [ExecCmd]
-> Read ExecCmd
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExecCmd]
$creadListPrec :: ReadPrec [ExecCmd]
readPrec :: ReadPrec ExecCmd
$creadPrec :: ReadPrec ExecCmd
readList :: ReadS [ExecCmd]
$creadList :: ReadS [ExecCmd]
readsPrec :: Int -> ReadS ExecCmd
$creadsPrec :: Int -> ReadS ExecCmd
Read,Int -> ExecCmd -> ShowS
[ExecCmd] -> ShowS
ExecCmd -> String
(Int -> ExecCmd -> ShowS)
-> (ExecCmd -> String) -> ([ExecCmd] -> ShowS) -> Show ExecCmd
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExecCmd] -> ShowS
$cshowList :: [ExecCmd] -> ShowS
show :: ExecCmd -> String
$cshow :: ExecCmd -> String
showsPrec :: Int -> ExecCmd -> ShowS
$cshowsPrec :: Int -> ExecCmd -> ShowS
Show)
data Target a = Unspecified | Current | Specified a
deriving (Int -> Target a -> ShowS
[Target a] -> ShowS
Target a -> String
(Int -> Target a -> ShowS)
-> (Target a -> String) -> ([Target a] -> ShowS) -> Show (Target a)
forall a. Show a => Int -> Target a -> ShowS
forall a. Show a => [Target a] -> ShowS
forall a. Show a => Target a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Target a] -> ShowS
$cshowList :: forall a. Show a => [Target a] -> ShowS
show :: Target a -> String
$cshow :: forall a. Show a => Target a -> String
showsPrec :: Int -> Target a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Target a -> ShowS
Show, ReadPrec [Target a]
ReadPrec (Target a)
Int -> ReadS (Target a)
ReadS [Target a]
(Int -> ReadS (Target a))
-> ReadS [Target a]
-> ReadPrec (Target a)
-> ReadPrec [Target a]
-> Read (Target a)
forall a. Read a => ReadPrec [Target a]
forall a. Read a => ReadPrec (Target a)
forall a. Read a => Int -> ReadS (Target a)
forall a. Read a => ReadS [Target a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Target a]
$creadListPrec :: forall a. Read a => ReadPrec [Target a]
readPrec :: ReadPrec (Target a)
$creadPrec :: forall a. Read a => ReadPrec (Target a)
readList :: ReadS [Target a]
$creadList :: forall a. Read a => ReadS [Target a]
readsPrec :: Int -> ReadS (Target a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Target a)
Read, Target a -> Target a -> Bool
(Target a -> Target a -> Bool)
-> (Target a -> Target a -> Bool) -> Eq (Target a)
forall a. Eq a => Target a -> Target a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Target a -> Target a -> Bool
$c/= :: forall a. Eq a => Target a -> Target a -> Bool
== :: Target a -> Target a -> Bool
$c== :: forall a. Eq a => Target a -> Target a -> Bool
Eq, Eq (Target a)
Eq (Target a)
-> (Target a -> Target a -> Ordering)
-> (Target a -> Target a -> Bool)
-> (Target a -> Target a -> Bool)
-> (Target a -> Target a -> Bool)
-> (Target a -> Target a -> Bool)
-> (Target a -> Target a -> Target a)
-> (Target a -> Target a -> Target a)
-> Ord (Target a)
Target a -> Target a -> Bool
Target a -> Target a -> Ordering
Target a -> Target a -> Target a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Target a)
forall a. Ord a => Target a -> Target a -> Bool
forall a. Ord a => Target a -> Target a -> Ordering
forall a. Ord a => Target a -> Target a -> Target a
min :: Target a -> Target a -> Target a
$cmin :: forall a. Ord a => Target a -> Target a -> Target a
max :: Target a -> Target a -> Target a
$cmax :: forall a. Ord a => Target a -> Target a -> Target a
>= :: Target a -> Target a -> Bool
$c>= :: forall a. Ord a => Target a -> Target a -> Bool
> :: Target a -> Target a -> Bool
$c> :: forall a. Ord a => Target a -> Target a -> Bool
<= :: Target a -> Target a -> Bool
$c<= :: forall a. Ord a => Target a -> Target a -> Bool
< :: Target a -> Target a -> Bool
$c< :: forall a. Ord a => Target a -> Target a -> Bool
compare :: Target a -> Target a -> Ordering
$ccompare :: forall a. Ord a => Target a -> Target a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Target a)
Ord, a -> Target b -> Target a
(a -> b) -> Target a -> Target b
(forall a b. (a -> b) -> Target a -> Target b)
-> (forall a b. a -> Target b -> Target a) -> Functor Target
forall a b. a -> Target b -> Target a
forall a b. (a -> b) -> Target a -> Target b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Target b -> Target a
$c<$ :: forall a b. a -> Target b -> Target a
fmap :: (a -> b) -> Target a -> Target b
$cfmap :: forall a b. (a -> b) -> Target a -> Target b
Functor)
makeLenses ''ExecCmd
emptyExecCmd :: ExecCmd
emptyExecCmd :: ExecCmd
emptyExecCmd = ExecCmd :: Target String
-> Target String -> String -> String -> [String] -> ExecCmd
ExecCmd
{ _execOutputNetwork :: Target String
_execOutputNetwork = Target String
forall a. Target a
Unspecified
, _execOutputChannel :: Target String
_execOutputChannel = Target String
forall a. Target a
Unspecified
, _execCommand :: String
_execCommand = ShowS
forall a. HasCallStack => String -> a
error String
"no default command"
, _execStdIn :: String
_execStdIn = String
""
, _execArguments :: [String]
_execArguments = []
}
options :: [OptDescr (ExecCmd -> ExecCmd)]
options :: [OptDescr (ExecCmd -> ExecCmd)]
options =
let specified :: Maybe a -> Target a
specified = Target a -> (a -> Target a) -> Maybe a -> Target a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Target a
forall a. Target a
Current a -> Target a
forall a. a -> Target a
Specified in
[ String
-> [String]
-> ArgDescr (ExecCmd -> ExecCmd)
-> String
-> OptDescr (ExecCmd -> ExecCmd)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"n" [String
"network"]
((Maybe String -> ExecCmd -> ExecCmd)
-> String -> ArgDescr (ExecCmd -> ExecCmd)
forall a. (Maybe String -> a) -> String -> ArgDescr a
OptArg (ASetter ExecCmd ExecCmd (Target String) (Target String)
-> Target String -> ExecCmd -> ExecCmd
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ExecCmd ExecCmd (Target String) (Target String)
Lens' ExecCmd (Target String)
execOutputNetwork (Target String -> ExecCmd -> ExecCmd)
-> (Maybe String -> Target String)
-> Maybe String
-> ExecCmd
-> ExecCmd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> Target String
forall a. Maybe a -> Target a
specified) String
"NETWORK")
String
"Set network target"
, String
-> [String]
-> ArgDescr (ExecCmd -> ExecCmd)
-> String
-> OptDescr (ExecCmd -> ExecCmd)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"c" [String
"channel"]
((Maybe String -> ExecCmd -> ExecCmd)
-> String -> ArgDescr (ExecCmd -> ExecCmd)
forall a. (Maybe String -> a) -> String -> ArgDescr a
OptArg (ASetter ExecCmd ExecCmd (Target String) (Target String)
-> Target String -> ExecCmd -> ExecCmd
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ExecCmd ExecCmd (Target String) (Target String)
Lens' ExecCmd (Target String)
execOutputChannel (Target String -> ExecCmd -> ExecCmd)
-> (Maybe String -> Target String)
-> Maybe String
-> ExecCmd
-> ExecCmd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> Target String
forall a. Maybe a -> Target a
specified) String
"CHANNEL")
String
"Set channel target"
, String
-> [String]
-> ArgDescr (ExecCmd -> ExecCmd)
-> String
-> OptDescr (ExecCmd -> ExecCmd)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"i" [String
"input"]
((String -> ExecCmd -> ExecCmd)
-> String -> ArgDescr (ExecCmd -> ExecCmd)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (ASetter ExecCmd ExecCmd String String
-> String -> ExecCmd -> ExecCmd
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ExecCmd ExecCmd String String
Lens' ExecCmd String
execStdIn) String
"INPUT")
String
"Use string as stdin"
]
parseExecCmd ::
String ->
Either [String] ExecCmd
parseExecCmd :: String -> Either [String] ExecCmd
parseExecCmd String
str =
case ArgOrder (ExecCmd -> ExecCmd)
-> [OptDescr (ExecCmd -> ExecCmd)]
-> [String]
-> ([ExecCmd -> ExecCmd], [String], [String])
forall a.
ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String])
getOpt ArgOrder (ExecCmd -> ExecCmd)
forall a. ArgOrder a
RequireOrder [OptDescr (ExecCmd -> ExecCmd)]
options (String -> [String]
powerWords String
str) of
([ExecCmd -> ExecCmd]
_, [] , [String]
errs) -> [String] -> Either [String] ExecCmd
forall a b. a -> Either a b
Left (String
"No command specified"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
errs)
([ExecCmd -> ExecCmd]
fs, String
cmd:[String]
args, []) -> ExecCmd -> Either [String] ExecCmd
forall a b. b -> Either a b
Right
(ExecCmd -> Either [String] ExecCmd)
-> ExecCmd -> Either [String] ExecCmd
forall a b. (a -> b) -> a -> b
$ (ExecCmd -> (ExecCmd -> ExecCmd) -> ExecCmd)
-> ExecCmd -> [ExecCmd -> ExecCmd] -> ExecCmd
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ExecCmd
x ExecCmd -> ExecCmd
f -> ExecCmd -> ExecCmd
f ExecCmd
x) (ExecCmd -> [ExecCmd -> ExecCmd] -> ExecCmd)
-> [ExecCmd -> ExecCmd] -> ExecCmd -> ExecCmd
forall (f :: * -> *) a b. Functor f => f (a -> b) -> a -> f b
?? [ExecCmd -> ExecCmd]
fs
(ExecCmd -> ExecCmd) -> ExecCmd -> ExecCmd
forall a b. (a -> b) -> a -> b
$ ASetter ExecCmd ExecCmd String String
-> String -> ExecCmd -> ExecCmd
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ExecCmd ExecCmd String String
Lens' ExecCmd String
execCommand String
cmd
(ExecCmd -> ExecCmd) -> ExecCmd -> ExecCmd
forall a b. (a -> b) -> a -> b
$ ASetter ExecCmd ExecCmd [String] [String]
-> [String] -> ExecCmd -> ExecCmd
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ExecCmd ExecCmd [String] [String]
Lens' ExecCmd [String]
execArguments [String]
args
(ExecCmd -> ExecCmd) -> ExecCmd -> ExecCmd
forall a b. (a -> b) -> a -> b
$ ExecCmd
emptyExecCmd
([ExecCmd -> ExecCmd]
_,[String]
_, [String]
errs) -> [String] -> Either [String] ExecCmd
forall a b. a -> Either a b
Left [String]
errs
runExecCmd ::
ExecCmd ->
IO (Either [String] [String])
runExecCmd :: ExecCmd -> IO (Either [String] [String])
runExecCmd ExecCmd
cmd =
do Either IOError (ExitCode, String, String)
res <- IO (ExitCode, String, String)
-> IO (Either IOError (ExitCode, String, String))
forall e a. Exception e => IO a -> IO (Either e a)
try (String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode
(Getting String ExecCmd String -> ExecCmd -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String ExecCmd String
Lens' ExecCmd String
execCommand ExecCmd
cmd)
(Getting [String] ExecCmd [String] -> ExecCmd -> [String]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [String] ExecCmd [String]
Lens' ExecCmd [String]
execArguments ExecCmd
cmd)
(Getting String ExecCmd String -> ExecCmd -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String ExecCmd String
Lens' ExecCmd String
execStdIn ExecCmd
cmd))
Either [String] [String] -> IO (Either [String] [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [String] [String] -> IO (Either [String] [String]))
-> Either [String] [String] -> IO (Either [String] [String])
forall a b. (a -> b) -> a -> b
$! case Either IOError (ExitCode, String, String)
res of
Left IOError
er -> [String] -> Either [String] [String]
forall a b. a -> Either a b
Left [IOError -> String
forall e. Exception e => e -> String
displayException (IOError
er :: IOError)]
Right (ExitCode
_code, String
out, String
_err) -> [String] -> Either [String] [String]
forall a b. b -> Either a b
Right (String -> [String]
lines String
out)
powerWords :: String -> [String]
powerWords :: String -> [String]
powerWords = (String -> Maybe (String, String)) -> String -> [String]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (String -> Maybe (String, String)
splitWord (String -> Maybe (String, String))
-> ShowS -> String -> Maybe (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSp)
where
isSp :: Char -> Bool
isSp Char
x = Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' '
splitWord :: String -> Maybe (String, String)
splitWord String
xs
| String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
xs = Maybe (String, String)
forall a. Maybe a
Nothing
| [(String, String)
x] <- ReadS String
forall a. Read a => ReadS a
reads String
xs = (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String, String)
x
| Bool
otherwise = (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just ((Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isSp String
xs)