{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module IntelliMonad.Tools.Bash where

import Control.Monad.IO.Class
import qualified Data.Aeson as A
import GHC.Generics
import GHC.IO.Exception
import IntelliMonad.Types
import qualified OpenAI.Types as API
import System.Process

data Bash = Bash
  { Bash -> String
script :: String
  }
  deriving (Bash -> Bash -> Bool
(Bash -> Bash -> Bool) -> (Bash -> Bash -> Bool) -> Eq Bash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Bash -> Bash -> Bool
== :: Bash -> Bash -> Bool
$c/= :: Bash -> Bash -> Bool
/= :: Bash -> Bash -> Bool
Eq, Int -> Bash -> ShowS
[Bash] -> ShowS
Bash -> String
(Int -> Bash -> ShowS)
-> (Bash -> String) -> ([Bash] -> ShowS) -> Show Bash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Bash -> ShowS
showsPrec :: Int -> Bash -> ShowS
$cshow :: Bash -> String
show :: Bash -> String
$cshowList :: [Bash] -> ShowS
showList :: [Bash] -> ShowS
Show, (forall x. Bash -> Rep Bash x)
-> (forall x. Rep Bash x -> Bash) -> Generic Bash
forall x. Rep Bash x -> Bash
forall x. Bash -> Rep Bash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Bash -> Rep Bash x
from :: forall x. Bash -> Rep Bash x
$cto :: forall x. Rep Bash x -> Bash
to :: forall x. Rep Bash x -> Bash
Generic, Schema
Schema -> JSONSchema Bash
forall r. Schema -> JSONSchema r
$cschema :: Schema
schema :: Schema
JSONSchema, Maybe Bash
Value -> Parser [Bash]
Value -> Parser Bash
(Value -> Parser Bash)
-> (Value -> Parser [Bash]) -> Maybe Bash -> FromJSON Bash
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Bash
parseJSON :: Value -> Parser Bash
$cparseJSONList :: Value -> Parser [Bash]
parseJSONList :: Value -> Parser [Bash]
$comittedField :: Maybe Bash
omittedField :: Maybe Bash
A.FromJSON, [Bash] -> Value
[Bash] -> Encoding
Bash -> Bool
Bash -> Value
Bash -> Encoding
(Bash -> Value)
-> (Bash -> Encoding)
-> ([Bash] -> Value)
-> ([Bash] -> Encoding)
-> (Bash -> Bool)
-> ToJSON Bash
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Bash -> Value
toJSON :: Bash -> Value
$ctoEncoding :: Bash -> Encoding
toEncoding :: Bash -> Encoding
$ctoJSONList :: [Bash] -> Value
toJSONList :: [Bash] -> Value
$ctoEncodingList :: [Bash] -> Encoding
toEncodingList :: [Bash] -> Encoding
$comitField :: Bash -> Bool
omitField :: Bash -> Bool
A.ToJSON)

instance HasFunctionObject Bash where
  getFunctionName :: String
getFunctionName = String
"call_bash_script"
  getFunctionDescription :: String
getFunctionDescription = String
"Call a bash script in a local environment"
  getFieldDescription :: ShowS
getFieldDescription String
"script" = String
"A script executing in a local environment"

instance Tool Bash where
  data Output Bash = BashOutput
    { Output Bash -> Int
code :: Int,
      Output Bash -> String
stdout :: String,
      Output Bash -> String
stderr :: String
    }
    deriving (Output Bash -> Output Bash -> Bool
(Output Bash -> Output Bash -> Bool)
-> (Output Bash -> Output Bash -> Bool) -> Eq (Output Bash)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Output Bash -> Output Bash -> Bool
== :: Output Bash -> Output Bash -> Bool
$c/= :: Output Bash -> Output Bash -> Bool
/= :: Output Bash -> Output Bash -> Bool
Eq, Int -> Output Bash -> ShowS
[Output Bash] -> ShowS
Output Bash -> String
(Int -> Output Bash -> ShowS)
-> (Output Bash -> String)
-> ([Output Bash] -> ShowS)
-> Show (Output Bash)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Output Bash -> ShowS
showsPrec :: Int -> Output Bash -> ShowS
$cshow :: Output Bash -> String
show :: Output Bash -> String
$cshowList :: [Output Bash] -> ShowS
showList :: [Output Bash] -> ShowS
Show, (forall x. Output Bash -> Rep (Output Bash) x)
-> (forall x. Rep (Output Bash) x -> Output Bash)
-> Generic (Output Bash)
forall x. Rep (Output Bash) x -> Output Bash
forall x. Output Bash -> Rep (Output Bash) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Output Bash -> Rep (Output Bash) x
from :: forall x. Output Bash -> Rep (Output Bash) x
$cto :: forall x. Rep (Output Bash) x -> Output Bash
to :: forall x. Rep (Output Bash) x -> Output Bash
Generic, Maybe (Output Bash)
Value -> Parser [Output Bash]
Value -> Parser (Output Bash)
(Value -> Parser (Output Bash))
-> (Value -> Parser [Output Bash])
-> Maybe (Output Bash)
-> FromJSON (Output Bash)
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser (Output Bash)
parseJSON :: Value -> Parser (Output Bash)
$cparseJSONList :: Value -> Parser [Output Bash]
parseJSONList :: Value -> Parser [Output Bash]
$comittedField :: Maybe (Output Bash)
omittedField :: Maybe (Output Bash)
A.FromJSON, [Output Bash] -> Value
[Output Bash] -> Encoding
Output Bash -> Bool
Output Bash -> Value
Output Bash -> Encoding
(Output Bash -> Value)
-> (Output Bash -> Encoding)
-> ([Output Bash] -> Value)
-> ([Output Bash] -> Encoding)
-> (Output Bash -> Bool)
-> ToJSON (Output Bash)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Output Bash -> Value
toJSON :: Output Bash -> Value
$ctoEncoding :: Output Bash -> Encoding
toEncoding :: Output Bash -> Encoding
$ctoJSONList :: [Output Bash] -> Value
toJSONList :: [Output Bash] -> Value
$ctoEncodingList :: [Output Bash] -> Encoding
toEncodingList :: [Output Bash] -> Encoding
$comitField :: Output Bash -> Bool
omitField :: Output Bash -> Bool
A.ToJSON)

  toolExec :: forall p (m :: * -> *).
(MonadIO m, MonadFail m, PersistentBackend p) =>
Bash -> Prompt m (Output Bash)
toolExec Bash
args = IO (Output Bash) -> StateT PromptEnv m (Output Bash)
forall a. IO a -> StateT PromptEnv m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Output Bash) -> StateT PromptEnv m (Output Bash))
-> IO (Output Bash) -> StateT PromptEnv m (Output Bash)
forall a b. (a -> b) -> a -> b
$ do
    (ExitCode
code, String
stdout, String
stderr) <- CreateProcess -> String -> IO (ExitCode, String, String)
readCreateProcessWithExitCode (String -> CreateProcess
shell Bash
args.script) String
""
    let code' :: Int
code' = case ExitCode
code of
          ExitCode
ExitSuccess -> Int
0
          ExitFailure Int
v -> Int
v
    Output Bash -> IO (Output Bash)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Output Bash -> IO (Output Bash))
-> Output Bash -> IO (Output Bash)
forall a b. (a -> b) -> a -> b
$ Int -> String -> String -> Output Bash
BashOutput Int
code' String
stdout String
stderr