{-# LANGUAGE DeriveFunctor, TemplateHaskell, BangPatterns, OverloadedStrings #-}

{-|
Module      : Client.Commands
Description : Implementation of slash commands
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

This module renders the lines used in the channel mask list. A mask list
can show channel bans, quiets, invites, and exceptions.
-}

module Client.Commands.Exec
  ( -- * Exec command configuration
    ExecCmd(..)
  , Target(..)

  -- * Lenses
  , execOutputNetwork
  , execOutputChannel

  -- * Operations
  , 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))

-- | Settings for @/exec@ command.
--
-- When no network or channel are specified the output is sent to the client
-- window.
--
-- When only a network is specified the output is sent as raw IRC commands to
-- that network.
--
-- When only a channel is specified the output is sent as messages on the
-- current network to the given channel.
--
-- When the network and channel are specified the output is sent as messages
-- to the given channel on the given network.
data ExecCmd = ExecCmd
  { ExecCmd -> Target String
_execOutputNetwork :: Target String -- ^ output network
  , ExecCmd -> Target String
_execOutputChannel :: Target String -- ^ output channel
  , ExecCmd -> String
_execCommand       :: String        -- ^ command filename
  , ExecCmd -> String
_execStdIn         :: String        -- ^ stdin source
  , ExecCmd -> [String]
_execArguments     :: [String]      -- ^ command arguments
  , ExecCmd -> Bool
_execIgnoreError   :: Bool          -- ^ ignore the process exit code
  }
  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

-- | Default values for @/exec@ to be overridden by flags.
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"
  ]

-- | 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 :: 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

-- | Execute the requested command synchronously and return
-- the output.
runExecCmd ::
  ExecCmd                       {- ^ exec configuration          -} ->
  IO (Either [String] [String]) {- ^ error lines or output lines -}
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]

-- | 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 :: 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)