{-# LANGUAGE RankNTypes #-}
module Matterhorn.Scripts
  ( findAndRunScript
  , listScripts
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Control.Concurrent ( takeMVar, newEmptyMVar )
import qualified Control.Concurrent.STM as STM
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import           Lens.Micro.Platform ( Lens' )
import           System.Exit ( ExitCode(..) )

import           Matterhorn.FilePaths ( Script(..), getAllScripts, locateScriptPath )
import           Matterhorn.State.Common
import           Matterhorn.State.Messages ( sendMessage )
import           Matterhorn.Types


findAndRunScript :: Lens' ChatState (EditState Name) -> Text -> Text -> MH ()
findAndRunScript :: Lens' ChatState (EditState Name) -> Text -> Text -> MH ()
findAndRunScript Lens' ChatState (EditState Name)
which Text
scriptName Text
input = do
    Script
fpMb <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO Script
locateScriptPath (Text -> FilePath
T.unpack Text
scriptName)
    TChan ProgramOutput
outputChan <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources (TChan ProgramOutput)
crSubprocessLog)
    case Script
fpMb of
      ScriptPath FilePath
scriptPath -> do
        AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt forall a b. (a -> b) -> a -> b
$ Lens' ChatState (EditState Name)
-> TChan ProgramOutput -> FilePath -> Text -> IO (Maybe (MH ()))
runScript Lens' ChatState (EditState Name)
which TChan ProgramOutput
outputChan FilePath
scriptPath Text
input
      NonexecScriptPath FilePath
scriptPath -> do
        let msg :: Text
msg = (Text
"The script `" forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
scriptPath forall a. Semigroup a => a -> a -> a
<> Text
"` cannot be " forall a. Semigroup a => a -> a -> a
<>
             Text
"executed. Try running\n" forall a. Semigroup a => a -> a -> a
<>
             Text
"```\n" forall a. Semigroup a => a -> a -> a
<>
             Text
"$ chmod u+x " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
scriptPath forall a. Semigroup a => a -> a -> a
<> Text
"\n" forall a. Semigroup a => a -> a -> a
<>
             Text
"```\n" forall a. Semigroup a => a -> a -> a
<>
             Text
"to correct this error. " forall a. Semigroup a => a -> a -> a
<> Text
scriptHelpAddendum)
        MHError -> MH ()
mhError forall a b. (a -> b) -> a -> b
$ Text -> MHError
GenericError Text
msg
      Script
ScriptNotFound -> do
        MHError -> MH ()
mhError forall a b. (a -> b) -> a -> b
$ Text -> MHError
NoSuchScript Text
scriptName

runScript :: Lens' ChatState (EditState Name)
          -> STM.TChan ProgramOutput
          -> FilePath
          -> Text
          -> IO (Maybe (MH ()))
runScript :: Lens' ChatState (EditState Name)
-> TChan ProgramOutput -> FilePath -> Text -> IO (Maybe (MH ()))
runScript Lens' ChatState (EditState Name)
which TChan ProgramOutput
outputChan FilePath
fp Text
text = do
  MVar ProgramOutput
outputVar <- forall a. IO (MVar a)
newEmptyMVar
  TChan ProgramOutput
-> FilePath
-> [FilePath]
-> Maybe ByteString
-> Maybe (MVar ProgramOutput)
-> IO ()
runLoggedCommand TChan ProgramOutput
outputChan FilePath
fp [] (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSL.fromStrict forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 Text
text) (forall a. a -> Maybe a
Just MVar ProgramOutput
outputVar)
  ProgramOutput
po <- forall a. MVar a -> IO a
takeMVar MVar ProgramOutput
outputVar
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case ProgramOutput -> ExitCode
programExitCode ProgramOutput
po of
    ExitCode
ExitSuccess -> do
        case forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ ProgramOutput -> FilePath
programStderr ProgramOutput
po of
            Bool
True -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
                EditMode
mode <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EditMode
esEditMode)
                ChannelId
cId <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) ChannelId
esChannelId)
                ChannelId -> EditMode -> Text -> [AttachmentData] -> MH ()
sendMessage ChannelId
cId EditMode
mode (FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ ProgramOutput -> FilePath
programStdout ProgramOutput
po) []
            Bool
False -> forall a. Maybe a
Nothing
    ExitFailure Int
_ -> forall a. Maybe a
Nothing

listScripts :: MH ()
listScripts :: MH ()
listScripts = do
  ([FilePath]
execs, [FilePath]
nonexecs) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ([FilePath], [FilePath])
getAllScripts
  let scripts :: Text
scripts = (Text
"Available scripts are:\n" forall a. Semigroup a => a -> a -> a
<>
                 forall a. Monoid a => [a] -> a
mconcat [ Text
"  - " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
cmd forall a. Semigroup a => a -> a -> a
<> Text
"\n"
                         | FilePath
cmd <- [FilePath]
execs
                         ])
  Text -> MH ()
postInfoMessage Text
scripts
  case [FilePath]
nonexecs of
    [] -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    [FilePath]
_  -> do
      let errMsg :: Text
errMsg = (Text
"Some non-executable script files are also " forall a. Semigroup a => a -> a -> a
<>
                    Text
"present. If you want to run these as scripts " forall a. Semigroup a => a -> a -> a
<>
                    Text
"in Matterhorn, mark them executable with \n" forall a. Semigroup a => a -> a -> a
<>
                    Text
"```\n" forall a. Semigroup a => a -> a -> a
<>
                    Text
"$ chmod u+x [script path]\n" forall a. Semigroup a => a -> a -> a
<>
                    Text
"```\n" forall a. Semigroup a => a -> a -> a
<>
                    Text
"\n" forall a. Semigroup a => a -> a -> a
<>
                    forall a. Monoid a => [a] -> a
mconcat [ Text
"  - " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
cmd forall a. Semigroup a => a -> a -> a
<> Text
"\n"
                            | FilePath
cmd <- [FilePath]
nonexecs
                            ] forall a. Semigroup a => a -> a -> a
<> Text
"\n" forall a. Semigroup a => a -> a -> a
<> Text
scriptHelpAddendum)
      MHError -> MH ()
mhError forall a b. (a -> b) -> a -> b
$ Text -> MHError
GenericError Text
errMsg

scriptHelpAddendum :: Text
scriptHelpAddendum :: Text
scriptHelpAddendum =
  Text
"For more help with scripts, run the command\n" forall a. Semigroup a => a -> a -> a
<>
  Text
"```\n/help scripts\n```\n"