{-# LANGUAGE DeriveFunctor, TemplateHaskell, BangPatterns, OverloadedStrings #-}
module Client.Commands.Exec
(
ExecCmd(..)
, Target(..)
, execOutputNetwork
, execOutputChannel
, parseExecCmd
, runExecCmd
) where
import Control.Exception (Exception(displayException), try)
import Control.Lens (view, (??), set, makeLenses)
import Data.ByteString.Lazy qualified as L
import Data.List (unfoldr)
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text
import System.Console.GetOpt (getOpt, ArgDescr(ReqArg, OptArg, NoArg), ArgOrder(RequireOrder), OptDescr(..))
import System.Process.Typed (byteStringInput, proc, readProcessStdout, setStdin, ExitCode (ExitFailure))
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]
, ExecCmd -> Bool
_execIgnoreError :: Bool
}
deriving (ReadPrec [ExecCmd]
ReadPrec ExecCmd
Int -> ReadS ExecCmd
ReadS [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
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
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)
ReadS [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
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, Target a -> Target a -> Bool
Target a -> Target a -> Ordering
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
Ord, 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
<$ :: forall a b. a -> Target b -> Target a
$c<$ :: forall a b. a -> Target b -> Target a
fmap :: forall a b. (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
{ _execOutputNetwork :: Target String
_execOutputNetwork = forall a. Target a
Unspecified
, _execOutputChannel :: Target String
_execOutputChannel = forall a. Target a
Unspecified
, _execCommand :: String
_execCommand = forall a. HasCallStack => String -> a
error String
"no default command"
, _execStdIn :: String
_execStdIn = String
""
, _execArguments :: [String]
_execArguments = []
, _execIgnoreError :: Bool
_execIgnoreError = Bool
False
}
options :: [OptDescr (ExecCmd -> ExecCmd)]
options :: [OptDescr (ExecCmd -> ExecCmd)]
options =
let specified :: Maybe a -> Target a
specified = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Target a
Current forall a. a -> Target a
Specified in
[ forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"n" [String
"network"]
(forall a. (Maybe String -> a) -> String -> ArgDescr a
OptArg (forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ExecCmd (Target String)
execOutputNetwork forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Maybe a -> Target a
specified) String
"NETWORK")
String
"Set network target"
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"c" [String
"channel"]
(forall a. (Maybe String -> a) -> String -> ArgDescr a
OptArg (forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ExecCmd (Target String)
execOutputChannel forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Maybe a -> Target a
specified) String
"CHANNEL")
String
"Set channel target"
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"i" [String
"input"]
(forall a. (String -> a) -> String -> ArgDescr a
ReqArg (forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ExecCmd String
execStdIn) String
"INPUT")
String
"Use string as stdin"
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"e" [String
"error"]
(forall a. a -> ArgDescr a
NoArg (forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ExecCmd Bool
execIgnoreError Bool
True))
String
"Ignore process error codes"
]
parseExecCmd ::
String ->
Either [String] ExecCmd
parseExecCmd :: String -> Either [String] ExecCmd
parseExecCmd String
str =
case forall a.
ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String])
getOpt forall a. ArgOrder a
RequireOrder [OptDescr (ExecCmd -> ExecCmd)]
options (String -> [String]
powerWords String
str) of
([ExecCmd -> ExecCmd]
_, [] , [String]
errs) -> forall a b. a -> Either a b
Left (String
"No command specified"forall a. a -> [a] -> [a]
:[String]
errs)
([ExecCmd -> ExecCmd]
fs, String
cmd:[String]
args, []) -> forall a b. b -> Either a b
Right
forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ExecCmd
x ExecCmd -> ExecCmd
f -> ExecCmd -> ExecCmd
f ExecCmd
x) forall (f :: * -> *) a b. Functor f => f (a -> b) -> a -> f b
?? [ExecCmd -> ExecCmd]
fs
forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ExecCmd String
execCommand String
cmd
forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ExecCmd [String]
execArguments [String]
args
forall a b. (a -> b) -> a -> b
$ ExecCmd
emptyExecCmd
([ExecCmd -> ExecCmd]
_,[String]
_, [String]
errs) -> 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 (ExitCode, ByteString)
res <-
forall (m :: * -> *) stdin stdoutIgnored stderr.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderr
-> m (ExitCode, ByteString)
readProcessStdout
(forall stdin stdin0 stdout stderr.
StreamSpec 'STInput stdin
-> ProcessConfig stdin0 stdout stderr
-> ProcessConfig stdin stdout stderr
setStdin (ByteString -> StreamSpec 'STInput ()
byteStringInput (ByteString -> ByteString
L.fromStrict (Text -> ByteString
Text.encodeUtf8 (String -> Text
Text.pack (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ExecCmd String
execStdIn ExecCmd
cmd)))))
(String -> [String] -> ProcessConfig () () ()
proc (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ExecCmd String
execCommand ExecCmd
cmd) (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ExecCmd [String]
execArguments ExecCmd
cmd)))
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! case (ExitCode, ByteString)
res of
(ExitFailure Int
code, ByteString
_) | Bool -> Bool
not (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ExecCmd Bool
execIgnoreError ExecCmd
cmd) ->
forall a b. a -> Either a b
Left [String
"Process failed with exit code " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
code]
(ExitCode
_, ByteString
out) ->
case ByteString -> Either UnicodeException Text
Text.decodeUtf8' (ByteString -> ByteString
L.toStrict ByteString
out) of
Right Text
str -> forall a b. b -> Either a b
Right (String -> [String]
lines (Text -> String
Text.unpack Text
str))
Left UnicodeException
e -> forall a b. a -> Either a b
Left [forall e. Exception e => e -> String
displayException UnicodeException
e]
powerWords :: String -> [String]
powerWords :: String -> [String]
powerWords = forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (String -> Maybe (String, String)
splitWord forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSp)
where
isSp :: Char -> Bool
isSp Char
x = Char
x forall a. Eq a => a -> a -> Bool
== Char
' '
splitWord :: String -> Maybe (String, String)
splitWord String
xs
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
xs = forall a. Maybe a
Nothing
| [(String, String)
x] <- forall a. Read a => ReadS a
reads String
xs = forall a. a -> Maybe a
Just (String, String)
x
| Bool
otherwise = forall a. a -> Maybe a
Just (forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isSp String
xs)