{-# 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
import           Control.Lens
import           Data.List
import           System.Console.GetOpt
import           System.Process

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

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

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

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