{-# 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))
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]
(Int -> ReadS ExecCmd)
-> ReadS [ExecCmd]
-> ReadPrec ExecCmd
-> ReadPrec [ExecCmd]
-> Read ExecCmd
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ExecCmd
readsPrec :: Int -> ReadS ExecCmd
$creadList :: ReadS [ExecCmd]
readList :: ReadS [ExecCmd]
$creadPrec :: ReadPrec ExecCmd
readPrec :: ReadPrec ExecCmd
$creadListPrec :: ReadPrec [ExecCmd]
readListPrec :: ReadPrec [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
$cshowsPrec :: Int -> ExecCmd -> ShowS
showsPrec :: Int -> ExecCmd -> ShowS
$cshow :: ExecCmd -> String
show :: ExecCmd -> String
$cshowList :: [ExecCmd] -> ShowS
showList :: [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
$cshowsPrec :: forall a. Show a => Int -> Target a -> ShowS
showsPrec :: Int -> Target a -> ShowS
$cshow :: forall a. Show a => Target a -> String
show :: Target a -> String
$cshowList :: forall a. Show a => [Target a] -> ShowS
showList :: [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
$creadsPrec :: forall a. Read a => Int -> ReadS (Target a)
readsPrec :: Int -> ReadS (Target a)
$creadList :: forall a. Read a => ReadS [Target a]
readList :: ReadS [Target a]
$creadPrec :: forall a. Read a => ReadPrec (Target a)
readPrec :: ReadPrec (Target a)
$creadListPrec :: forall a. Read a => ReadPrec [Target a]
readListPrec :: ReadPrec [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
$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
/= :: 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
$ccompare :: forall a. Ord a => Target a -> Target a -> Ordering
compare :: Target a -> Target a -> Ordering
$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
>= :: Target a -> Target a -> Bool
$cmax :: forall a. Ord a => Target a -> Target a -> Target a
max :: Target a -> Target a -> Target a
$cmin :: forall a. Ord a => Target a -> Target a -> Target a
min :: Target a -> Target a -> Target a
Ord, (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
$cfmap :: forall a b. (a -> b) -> Target a -> Target b
fmap :: forall a b. (a -> b) -> Target a -> Target b
$c<$ :: forall a b. a -> Target b -> Target a
<$ :: forall a b. a -> Target b -> Target a
Functor)

makeLenses ''ExecCmd

-- | Default values for @/exec@ to be overridden by flags.
emptyExecCmd :: ExecCmd
emptyExecCmd :: ExecCmd
emptyExecCmd = 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     = []
  , _execIgnoreError :: Bool
_execIgnoreError   = Bool
False
  }

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"
  , String
-> [String]
-> ArgDescr (ExecCmd -> ExecCmd)
-> String
-> OptDescr (ExecCmd -> ExecCmd)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"e" [String
"error"]
        ((ExecCmd -> ExecCmd) -> ArgDescr (ExecCmd -> ExecCmd)
forall a. a -> ArgDescr a
NoArg (ASetter ExecCmd ExecCmd Bool Bool -> Bool -> ExecCmd -> ExecCmd
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ExecCmd ExecCmd Bool Bool
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 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 b a. (b -> a -> b) -> 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) (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

-- | 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 <-
      ProcessConfig () () () -> IO (ExitCode, ByteString)
forall (m :: * -> *) stdin stdoutIgnored stderr.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderr
-> m (ExitCode, ByteString)
readProcessStdout
        (StreamSpec 'STInput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
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 (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)))))
        (String -> [String] -> ProcessConfig () () ()
proc (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)))
    Either [String] [String] -> IO (Either [String] [String])
forall a. a -> IO a
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 (ExitCode, ByteString)
res of
      (ExitFailure Int
code, ByteString
_) | Bool -> Bool
not (Getting Bool ExecCmd Bool -> ExecCmd -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool ExecCmd Bool
Lens' ExecCmd Bool
execIgnoreError ExecCmd
cmd) ->
        [String] -> Either [String] [String]
forall a b. a -> Either a b
Left [String
"Process failed with exit code " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
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 -> [String] -> Either [String] [String]
forall a b. b -> Either a b
Right (String -> [String]
lines (Text -> String
Text.unpack Text
str))
          Left UnicodeException
e -> [String] -> Either [String] [String]
forall a b. a -> Either a b
Left [UnicodeException -> String
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 = (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 a. [a] -> 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)