{-# 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"