intelli-monad 0.1.0.1 → 0.1.0.2

raw patch · 18 files changed

+539/−181 lines, 18 filesdep +yamlPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: yaml

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• app/auto-talk.hs +9/−9
• app/calc.hs +35/−5
• app/repl.hs +1/−1
• intelli-monad.cabal +3/−1
• src/IntelliMonad/Cmd.hs +47/−46
• src/IntelliMonad/CustomInstructions.hs +16/−4
• src/IntelliMonad/Persist.hs +28/−14
• src/IntelliMonad/Prompt.hs +72/−6
• src/IntelliMonad/Repl.hs +59/−31
• src/IntelliMonad/Tools.hs +2/−2
• src/IntelliMonad/Tools/Arxiv.hs +37/−32
• src/IntelliMonad/Tools/Bash.hs +2/−1
• src/IntelliMonad/Tools/DallE3.hs +1/−1
• src/IntelliMonad/Tools/KeyValue.hs +131/−0
• src/IntelliMonad/Tools/TextToSpeech.hs +4/−3
• src/IntelliMonad/Tools/Utils.hs +7/−7
• src/IntelliMonad/Types.hs +78/−18

@@ -1,5 +1,12 @@ # Revision history for intelli-monad +## 0.1.0.2 -- 2024-03-30++* Add 'generate' function with typed input and output.+* Add system hook functionality to customize system flow+* Support for key value store++ ## 0.1.0.1 -- 2024-03-21  * Add CLI options

@@ -17,20 +17,20 @@ data Haruhi = Haruhi  instance CustomInstruction Haruhi where-  customHeader = [(Content System (Message "あなたは涼宮ハルヒとして会話してください。話す時は'haruhi: 'をつけて話してください。") "" defaultUTCTime)]-  customFooter = []+  customHeader _ = [(Content System (Message "あなたは涼宮ハルヒとして会話してください。話す時は'haruhi: 'をつけて話してください。") "" defaultUTCTime)]+  customFooter _ = []  data Kyon = Kyon  instance CustomInstruction Kyon where-  customHeader = [(Content System (Message "あなたは涼宮ハルヒの同級生のキョンとして会話してください。話す時は'kyon: 'をつけて話してください。") "" defaultUTCTime)]-  customFooter = []+  customHeader _ = [(Content System (Message "あなたは涼宮ハルヒの同級生のキョンとして会話してください。話す時は'kyon: 'をつけて話してください。") "" defaultUTCTime)]+  customFooter _ = []  data Env = Env  instance CustomInstruction Env where-  customHeader = [(Content System (Message "あなたは涼宮ハルヒの世界の環境として状況を設定してください。話す時は'env: 'をつけて話してください。") "" defaultUTCTime)]-  customFooter = []+  customHeader _ = [(Content System (Message "あなたは涼宮ハルヒの世界の環境として状況を設定してください。話す時は'env: 'をつけて話してください。") "" defaultUTCTime)]+  customFooter _ = []  toUser :: Content -> Content toUser c =@@ -40,9 +40,9 @@  main :: IO () main = do-  e <- initializePrompt @StatelessConf [] [CustomInstructionProxy (Proxy @Env)] "env" (fromModel "gpt-4")-  h <- initializePrompt @StatelessConf [] [CustomInstructionProxy (Proxy @Haruhi)] "haruhi" (fromModel "gpt-4")-  k <- initializePrompt @StatelessConf [] [CustomInstructionProxy (Proxy @Kyon)] "kyon" (fromModel "gpt-4")+  e <- initializePrompt @StatelessConf [] [CustomInstructionProxy Env]"env" (fromModel "gpt-4")+  h <- initializePrompt @StatelessConf [] [CustomInstructionProxy Haruhi] "haruhi" (fromModel "gpt-4")+  k <- initializePrompt @StatelessConf [] [CustomInstructionProxy Kyon] "kyon" (fromModel "gpt-4")   let init' = [Content User (Message "ある駄菓子屋の前での出来ことで話を作ってください。Let's start!") "default" defaultUTCTime]   loop init' [] [] [] e h k   where

@@ -5,10 +5,12 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DuplicateRecordFields #-}  module Main where  import Data.Aeson+import Data.Text (Text) import Data.Proxy import GHC.Generics import IntelliMonad.Persist@@ -34,14 +36,42 @@     }     deriving (Eq, Show, Generic, FromJSON, ToJSON)   toolExec _ = return $ ValidateNumberOutput 0 "" ""+  toolHeader = [(Content System (Message "Calcurate user input, then output just the number. Then call 'output_number' function.") "" defaultUTCTime)] -data Math = Math -instance CustomInstruction Math where-  customHeader = [(Content System (Message "Calcurate user input, then output just the number. Then call 'output_number' function.") "" defaultUTCTime)]-  customFooter = []+data Number = Number+  { number :: Double+  }+  deriving (Eq, Show, Generic, JSONSchema, FromJSON, ToJSON) +instance HasFunctionObject Number where+  getFunctionName = "number"+  getFunctionDescription = "validate input"+  getFieldDescription "number" = "A number"++instance Tool Number where+  data Output Number = NumberOutput+    { code :: Int,+      stdout :: String,+      stderr :: String+    }+    deriving (Eq, Show, Generic, FromJSON, ToJSON)+  toolExec _ = return $ NumberOutput 0 "" ""++data Input = Input+  { formula :: Text+  }+  deriving (Eq, Show, Generic, JSONSchema, FromJSON, ToJSON)++instance HasFunctionObject Input where+  getFunctionName = "formula"+  getFunctionDescription = "Describe a formula"+  getFieldDescription "formula" = "A formula"+ main :: IO () main = do-  v <- runPromptWithValidation @ValidateNumber @StatelessConf [] [CustomInstructionProxy (Proxy @Math)] "default" (fromModel "gpt-4") "2+3+3+sin(3)"+  v <- runPromptWithValidation @ValidateNumber @StatelessConf [] [] "default" (fromModel "gpt-4") "2+3+3+sin(3)"   print (v :: Maybe ValidateNumber)++  v <- generate [user "Calcurate a formula"] (Input "1+3")+  print (v :: Maybe Number)

@@ -1,6 +1,6 @@ module Main where+ import qualified IntelliMonad.Cmd  main :: IO () main = IntelliMonad.Cmd.main-

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               intelli-monad-version:            0.1.0.1+version:            0.1.0.2 synopsis:           Type level prompt with openai. description:        Type level prompt with openai. This allows us to define function calls and value validation using types. homepage:           https://github.com/junjihashimoto/intelli-monad@@ -43,6 +43,7 @@                     , IntelliMonad.Tools.TextToSpeech                     , IntelliMonad.Tools.DallE3                     , IntelliMonad.Tools.Utils+                    , IntelliMonad.Tools.KeyValue                     , IntelliMonad.Persist                     , IntelliMonad.Repl                     , IntelliMonad.Cmd@@ -81,6 +82,7 @@                     , optparse-applicative >= 0.18 && < 0.19                     , temporary >= 1.3 && < 1.4                     , xml-conduit >= 1.9 && < 2.0+                    , yaml >= 0.11 && < 0.12     -- Directories containing source files.     hs-source-dirs:   src 

@@ -20,73 +20,76 @@ import Control.Monad.IO.Class import Control.Monad.Trans.Class (MonadTrans, lift) import Control.Monad.Trans.State (get, put)-import Data.Aeson.Encode.Pretty (encodePretty) import qualified Data.Aeson as A+import Data.Aeson.Encode.Pretty (encodePretty) import qualified Data.ByteString as BS import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.IO as T import Data.Void+import Database.Persist.Sqlite (SqliteConf)+import GHC.IO.Exception import IntelliMonad.Persist import IntelliMonad.Prompt-import IntelliMonad.Types import IntelliMonad.Repl import IntelliMonad.Tools+import IntelliMonad.Types import qualified OpenAI.Types as API+import Options.Applicative import System.Console.Haskeline+import System.Environment (lookupEnv)+import System.IO (hClose)+import System.IO.Temp+import System.Process import Text.Megaparsec import Text.Megaparsec.Char import Text.Megaparsec.Char.Lexer as L-import GHC.IO.Exception-import System.Process-import System.Environment (lookupEnv)-import System.IO.Temp-import System.IO (hClose)-import Options.Applicative-import Database.Persist.Sqlite (SqliteConf) - opts :: Options.Applicative.Parser ReplCommand-opts = +opts =   subparser     ( command "repl" (info (Repl <$> argument str (metavar "SESSION_NAME")) (progDesc "Start the repl"))-    <> command "clear" (info (pure Clear) (progDesc "Clear the contents"))-    <> command "show-contents" (info (pure ShowContents) (progDesc "Show the contents"))-    <> command "show-usage" (info (pure ShowUsage) (progDesc "Show the usage"))-    <> command "show-request" (info (pure ShowRequest) (progDesc "Show the request"))-    <> command "show-context" (info (pure ShowContext) (progDesc "Show the context"))-    <> command "show-session" (info (pure ShowSession) (progDesc "Show the session"))-    <> command "edit" (info (pure Edit) (progDesc "Edit the contents"))-    <> command "edit-request" (info (pure EditRequest) (progDesc "Edit the config of the current session"))-    <> command "edit-contents" (info (pure EditContents) (progDesc "Edit the contents of the current session"))-    <> command "edit-header" (info (pure EditHeader) (progDesc "Edit the header of the current session"))-    <> command "edit-footer" (info (pure EditFooter) (progDesc "Edit the footer of the current session"))-    <> command "list-sessions" (info (pure ListSessions) (progDesc "List all sessions"))-    <> command "copy-session" (info (CopySession <$> argument str (metavar "FROM") <*> argument str (metavar "TO")) (progDesc "Copy the session"))-    <> command "delete-session" (info (DeleteSession <$> argument str (metavar "SESSION_NAME")) (progDesc "Delete the session"))-    <> command "switch-session" (info (SwitchSession <$> argument str (metavar "SESSION_NAME")) (progDesc "Switch the session"))-    <> command "read-image" (info (ReadImage <$> argument str (metavar "IMAGE_PATH")) (progDesc "Read the image and call a prompt"))-    <> command "read-input" (info (UserInput <$> argument str (metavar "USER_INPUT")) (progDesc "User input as a text and call a prompt"))-    <> command "help" (info (pure Help) (progDesc "Show the help"))+        <> command "clear" (info (pure Clear) (progDesc "Clear the contents"))+        <> command "show-contents" (info (pure ShowContents) (progDesc "Show the contents"))+        <> command "show-usage" (info (pure ShowUsage) (progDesc "Show the usage"))+        <> command "show-request" (info (pure ShowRequest) (progDesc "Show the request"))+        <> command "show-context" (info (pure ShowContext) (progDesc "Show the context"))+        <> command "show-session" (info (pure ShowSession) (progDesc "Show the session"))+        <> command "edit" (info (pure Edit) (progDesc "Edit the contents"))+        <> command "edit-request" (info (pure EditRequest) (progDesc "Edit the config of the current session"))+        <> command "edit-contents" (info (pure EditContents) (progDesc "Edit the contents of the current session"))+        <> command "edit-header" (info (pure EditHeader) (progDesc "Edit the header of the current session"))+        <> command "edit-footer" (info (pure EditFooter) (progDesc "Edit the footer of the current session"))+        <> command "list-sessions" (info (pure ListSessions) (progDesc "List all sessions"))+        <> command "copy-session" (info (CopySession <$> argument str (metavar "FROM") <*> argument str (metavar "TO")) (progDesc "Copy the session"))+        <> command "delete-session" (info (DeleteSession <$> argument str (metavar "SESSION_NAME")) (progDesc "Delete the session"))+        <> command "switch-session" (info (SwitchSession <$> argument str (metavar "SESSION_NAME")) (progDesc "Switch the session"))+        <> command "read-image" (info (ReadImage <$> argument str (metavar "IMAGE_PATH")) (progDesc "Read the image and call a prompt"))+        <> command "read-input" (info (UserInput <$> argument str (metavar "USER_INPUT")) (progDesc "User input as a text and call a prompt"))+        <> command "list-keys" (info (pure ListKeys) (progDesc "List all keys"))+        <> command "get-key" (info (GetKey <$> optional (argument str (metavar "NAMESPACE")) <*> argument str (metavar "KEY_NAME")) (progDesc "Get the key"))+        <> command "set-key" (info (SetKey <$> optional (argument str (metavar "NAMESPACE")) <*> argument str (metavar "KEY_NAME") <*> argument str (metavar "KEY_VALUE")) (progDesc "Set the key"))+        <> command "delete-key" (info (DeleteKey <$> optional (argument str (metavar "NAMESPACE")) <*> argument str (metavar "KEY_NAME")) (progDesc "Delete the key"))+        <> command "help" (info (pure Help) (progDesc "Show the help"))     )  runCmd :: forall p. (PersistentBackend p) => ReplCommand -> IO () runCmd cmd = do-    let tools = defaultTools-        customs = []-        sessionName = "default"-        defaultReq = defaultRequest-            { API.createChatCompletionRequestModel = API.CreateChatCompletionRequestModel "gpt-4"-            }-    runInputT-        ( Settings-            { complete = completeFilename,-                historyFile = Just "intelli-monad.history",-                autoAddHistory = True-            }-        )-        (runPrompt @p tools customs sessionName defaultReq (runCmd' @p (Right cmd) Nothing))-+  let tools = defaultTools+      customs = []+      sessionName = "default"+      defaultReq =+        defaultRequest+          { API.createChatCompletionRequestModel = API.CreateChatCompletionRequestModel "gpt-4"+          }+  runInputT+    ( Settings+        { complete = completeFilename,+          historyFile = Just "intelli-monad.history",+          autoAddHistory = True+        }+    )+    (runPrompt @p tools customs sessionName defaultReq (runCmd' @p (Right cmd) Nothing))  main :: IO () main = do@@ -97,5 +100,3 @@       Nothing -> return "gpt-4"   cmd <- customExecParser (prefs showHelpOnEmpty) (info (helper <*> opts) (fullDesc <> progDesc "intelli-monad"))   runCmd @SqliteConf cmd--  

@@ -52,17 +52,29 @@ data Math = Math  instance CustomInstruction Math where-  customHeader = [(Content System (Message "Calcurate user input, then output just the number. Then call 'output_number' function.") "" defaultUTCTime)]-  customFooter = []+  customHeader _ = [(Content System (Message "Calcurate user input, then output just the number. Then call 'output_number' function.") "" defaultUTCTime)]+  customFooter _ = []  headers :: [CustomInstructionProxy] -> Contents headers [] = [] headers (tool : tools') =   case tool of-    (CustomInstructionProxy (_ :: Proxy a)) -> customHeader @a <> headers tools'+    (CustomInstructionProxy a) -> customHeader a <> headers tools'  footers :: [CustomInstructionProxy] -> Contents footers [] = [] footers (tool : tools') =   case tool of-    (CustomInstructionProxy (_ :: Proxy a)) -> customFooter @a <> footers tools'+    (CustomInstructionProxy a) -> customFooter a <> footers tools'++toolHeaders :: [ToolProxy] -> Contents+toolHeaders [] = []+toolHeaders (tool : tools') =+  case tool of+    (ToolProxy (_ :: Proxy a)) -> toolHeader @a <> toolHeaders tools'++toolFooters :: [ToolProxy] -> Contents+toolFooters [] = []+toolFooters (tool : tools') =+  case tool of+    (ToolProxy (_ :: Proxy a)) -> toolFooter @a <> toolFooters tools'

@@ -29,24 +29,13 @@ import Data.List (maximumBy) import qualified Data.Set as S import Data.Text (Text)-import Database.Persist-import Database.Persist.Sqlite+import Database.Persist hiding (get)+import Database.Persist.Sqlite hiding (get) import IntelliMonad.Types+import Control.Monad.Trans.State (get)  data StatelessConf = StatelessConf -class PersistentBackend p where-  type Conn p-  config :: p-  setup :: (MonadIO m, MonadFail m) => p -> m (Maybe (Conn p))-  initialize :: (MonadIO m, MonadFail m) => Conn p -> Context -> m ()-  load :: (MonadIO m, MonadFail m) => Conn p -> SessionName -> m (Maybe Context)-  loadByKey :: (MonadIO m, MonadFail m) => Conn p -> (Key Context) -> m (Maybe Context)-  save :: (MonadIO m, MonadFail m) => Conn p -> Context -> m (Maybe (Key Context))-  saveContents :: (MonadIO m, MonadFail m) => Conn p -> [Content] -> m ()-  listSessions :: (MonadIO m, MonadFail m) => Conn p -> m [Text]-  deleteSession :: (MonadIO m, MonadFail m) => Conn p -> SessionName -> m ()- instance PersistentBackend SqliteConf where   type Conn SqliteConf = ConnectionPool   config =@@ -86,6 +75,20 @@   deleteSession conn sessionName = do     liftIO $ runPool (config @SqliteConf) (deleteWhere [ContextSessionName ==. sessionName]) conn +  listKeys conn = do+    (a :: [Entity KeyValue]) <- liftIO $ runPool (config @SqliteConf) (selectList [] []) conn+    return $ concat $ map (\(Entity _ v) -> persistUniqueKeys v) a+  getKey conn key = do+    (a :: Maybe (Entity KeyValue)) <- liftIO $ runPool (config @SqliteConf) (getBy key) conn+    case a of+      Nothing -> return Nothing+      Just (Entity _ v) -> return $ Just $ keyValueValue v+  setKey conn (KeyName n' k') value = do+    let d = KeyValue n' k' value+    liftIO $ runPool (config @SqliteConf) (putMany [d]) conn+  deleteKey conn key = do+    liftIO $ runPool (config @SqliteConf) (deleteBy key) conn+ instance PersistentBackend StatelessConf where   type Conn StatelessConf = ()   config = StatelessConf@@ -97,9 +100,20 @@   saveContents _ _ = return ()   listSessions _ = return []   deleteSession _ _ = return ()+  listKeys _ = return []+  getKey _ _ = return Nothing+  setKey _ _ _ = return ()+  deleteKey _ _ = return ()  withDB :: forall p m a. (MonadIO m, MonadFail m, PersistentBackend p) => (Conn p -> m a) -> m a withDB func =   setup (config @p) >>= \case     Nothing -> fail "Can not open a database."     Just (conn :: Conn p) -> func conn++withBackend :: forall a m. (MonadIO m, MonadFail m) => (forall p. PersistentBackend p => p -> Prompt m a) -> Prompt m a+withBackend func = do+  (env :: PromptEnv) <- get+  case (env) of+    (PromptEnv _ _ _ (PersistProxy v) _) -> func v+

@@ -53,6 +53,9 @@   _ <- withDB @p $ \conn -> save @p (conn :: Conn p) context   return () +getSessionName :: (MonadIO m, MonadFail m) => Prompt m Text+getSessionName = contextSessionName <$> getContext+ switchContext :: (MonadIO m, MonadFail m) => Context -> Prompt m () switchContext context = do   env <- get@@ -100,10 +103,24 @@   withDB @p $ \conn -> saveContents @p conn contents   return () +callPreHook :: forall p m. (MonadIO m, MonadFail m, PersistentBackend p) => Prompt m ()+callPreHook = do+  env <- get+  forM_ env.hooks $ \(HookProxy (h :: h)) -> do+    preHook @h @p h+  ++callPostHook :: forall p m. (MonadIO m, MonadFail m, PersistentBackend p) => Prompt m ()+callPostHook = do+  env <- get+  forM_ env.hooks $ \(HookProxy (h :: h)) -> do+    postHook @h @p h+ call :: forall p m. (MonadIO m, MonadFail m, PersistentBackend p) => Prompt m Contents call = loop []   where     loop ret = do+      callPreHook @p       prev <- getContext       ((contents, finishReason), res) <- liftIO $ runRequest prev.contextSessionName prev.contextRequest (prev.contextHeader <> prev.contextBody <> prev.contextFooter)       let current_total_tokens = fromMaybe 0 $ API.completionUsageTotalUnderscoretokens <$> API.createChatCompletionResponseUsage res@@ -114,6 +131,7 @@               }       setContext @p next       push @p contents+      callPostHook @p        let ret' = ret <> contents @@ -127,7 +145,7 @@     callTool next contents ret = do       showContents contents       env <- get-      retTool <- tryToolExec env.tools next.contextSessionName contents+      retTool <- tryToolExec @p env.tools next.contextSessionName contents       showContents retTool       pushToolReturn @p retTool       v <- call @p@@ -156,7 +174,9 @@     A.FromJSON (Output validation),     A.ToJSON validation,     A.ToJSON (Output validation)-  ) => Contents -> Prompt m (Maybe validation)+  ) =>+  Contents ->+  Prompt m (Maybe validation) callWithValidation contents = do   let valid = ToolProxy (Proxy :: Proxy validation)   case findToolCall valid contents of@@ -190,6 +210,48 @@   let valid = ToolProxy (Proxy :: Proxy validation)   runPrompt @p (valid : tools) customs sessionName req (callWithText @p input >>= callWithValidation @validation @p) +user :: Text -> Content+user input = Content User (Message input) "default" defaultUTCTime++system :: Text -> Content+system input = Content System (Message input) "default" defaultUTCTime++assistant :: Text -> Content+assistant input = Content Assistant (Message input) "default" defaultUTCTime++generate ::+  forall input output m p.+  ( MonadIO m,+    MonadFail m,+    p ~ StatelessConf,+    A.ToJSON input,+    A.FromJSON input,+    JSONSchema input,+    Tool output,+    A.FromJSON output,+    A.FromJSON (Output output),+    A.ToJSON output,+    A.ToJSON (Output output)+  ) => Contents -> input -> m (Maybe output)+generate userContext input = do+  let valid = ToolProxy (Proxy :: Proxy output)+      req = (fromModel "gpt-4")+  runPrompt @p [valid] [] "default" req $ do+    time <- liftIO getCurrentTime+    context <- getContext+    let schemaText :: Text+        schemaText = T.decodeUtf8Lenient $ BS.toStrict $ A.encode $ toAeson (schema @input)+        inputText :: Text+        inputText = T.decodeUtf8Lenient $ BS.toStrict $ A.encode input+        contents = userContext +++          [ user ("#User-input format is as follows:\n" <> schemaText)+          , user ("#User-input is as follows:\n" <> inputText)+          , user ("#Save the processing results using " <> toolFunctionName @output <> " function")+          ]+    +    push @p contents+    call @p >>= callWithValidation @output @StatelessConf+ initializePrompt :: forall p m. (MonadIO m, MonadFail m, PersistentBackend p) => [ToolProxy] -> [CustomInstructionProxy] -> Text -> API.CreateChatCompletionRequest -> m PromptEnv initializePrompt tools customs sessionName req = do   let settings = addTools tools (req {API.createChatCompletionRequestTools = Nothing})@@ -200,7 +262,9 @@           PromptEnv             { context = v,               tools = tools,-              customInstructions = customs+              customInstructions = customs,+              backend = (PersistProxy (config @p)),+              hooks = []             }       Nothing -> do         time <- liftIO getCurrentTime@@ -210,15 +274,17 @@                     Context                       { contextRequest = settings,                         contextResponse = Nothing,-                        contextHeader = headers customs,+                        contextHeader = headers customs ++ toolHeaders tools,                         contextBody = [],-                        contextFooter = footers customs,+                        contextFooter = toolFooters tools ++ footers customs,                         contextTotalTokens = 0,                         contextSessionName = sessionName,                         contextCreated = time                       },                   tools = tools,-                  customInstructions = customs+                  customInstructions = customs,+                  backend = (PersistProxy (config @p)),+                  hooks = []                 }         initialize @p conn (init'.context)         return init'

@@ -20,26 +20,28 @@ import Control.Monad.IO.Class import Control.Monad.Trans.Class (MonadTrans, lift) import Control.Monad.Trans.State (get, put)-import Data.Aeson.Encode.Pretty (encodePretty) import qualified Data.Aeson as A+import Data.Aeson.Encode.Pretty (encodePretty)+import qualified Data.Yaml as Y+import qualified Data.Yaml.Pretty as Y import qualified Data.ByteString as BS import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.IO as T import Data.Void+import GHC.IO.Exception import IntelliMonad.Persist-import IntelliMonad.Prompt+import IntelliMonad.Prompt hiding (user, system, assistant) import IntelliMonad.Types import qualified OpenAI.Types as API import System.Console.Haskeline+import System.Environment (lookupEnv)+import System.IO (hClose)+import System.IO.Temp+import System.Process import Text.Megaparsec import Text.Megaparsec.Char import Text.Megaparsec.Char.Lexer as L-import GHC.IO.Exception-import System.Process-import System.Environment (lookupEnv)-import System.IO.Temp-import System.IO (hClose)  type Parser = Parsec Void Text @@ -91,7 +93,7 @@           Left err -> return $ Left err         else return $ Right (UserInput input) -editWithEditor :: forall m. ( MonadIO m, MonadFail m) => m (Maybe T.Text)+editWithEditor :: forall m. (MonadIO m, MonadFail m) => m (Maybe T.Text) editWithEditor = do   liftIO $ withSystemTempFile "tempfile.txt" $ \filePath fileHandle -> do     hClose fileHandle@@ -104,11 +106,11 @@       ExitSuccess -> Just <$> T.readFile filePath       ExitFailure _ -> return Nothing -editRequestWithEditor :: forall m. ( MonadIO m, MonadFail m) => API.CreateChatCompletionRequest -> m (Maybe API.CreateChatCompletionRequest)+editRequestWithEditor :: forall m. (MonadIO m, MonadFail m) => API.CreateChatCompletionRequest -> m (Maybe API.CreateChatCompletionRequest) editRequestWithEditor req = do-  liftIO $ withSystemTempFile "tempfile.json" $ \filePath fileHandle -> do+  liftIO $ withSystemTempFile "tempfile.yaml" $ \filePath fileHandle -> do     hClose fileHandle-    BS.writeFile filePath $ BS.toStrict $ encodePretty req+    BS.writeFile filePath $ Y.encodePretty Y.defConfig req     editor <- do       lookupEnv "EDITOR" >>= \case         Just editor' -> return editor'@@ -116,17 +118,19 @@     code <- system (editor <> " " <> filePath)     case code of       ExitSuccess -> do-        newReq <- A.decodeFileStrict @API.CreateChatCompletionRequest filePath+        newReq <- Y.decodeFileEither @API.CreateChatCompletionRequest filePath         case newReq of-          Just newReq' -> return $ Just newReq'-          Nothing -> return Nothing+          Right newReq' -> return $ Just newReq'+          Left err -> do+            print err+            return Nothing       ExitFailure _ -> return Nothing -editContentsWithEditor :: forall m. ( MonadIO m, MonadFail m) => Contents -> m (Maybe Contents)+editContentsWithEditor :: forall m. (MonadIO m, MonadFail m) => Contents -> m (Maybe Contents) editContentsWithEditor contents = do-  liftIO $ withSystemTempFile "tempfile.json" $ \filePath fileHandle -> do+  liftIO $ withSystemTempFile "tempfile.yaml" $ \filePath fileHandle -> do     hClose fileHandle-    BS.writeFile filePath $ BS.toStrict $ encodePretty contents+    BS.writeFile filePath $ Y.encodePretty Y.defConfig contents     editor <- do       lookupEnv "EDITOR" >>= \case         Just editor' -> return editor'@@ -134,10 +138,12 @@     code <- system (editor <> " " <> filePath)     case code of       ExitSuccess -> do-        newContents <- A.decodeFileStrict @Contents filePath+        newContents <- Y.decodeFileEither @Contents filePath         case newContents of-          Just newContents' -> return $ Just newContents'-          Nothing -> return Nothing+          Right newContents' -> return $ Just newContents'+          Left err -> do+            print err+            return Nothing       ExitFailure _ -> return Nothing  runCmd' :: forall p. (PersistentBackend p) => Either (ParseErrorBundle Text Void) ReplCommand -> Maybe (Prompt (InputT IO) ()) -> Prompt (InputT IO) ()@@ -244,9 +250,8 @@       let req = toRequest prev.contextRequest (prev.contextHeader <> prev.contextBody <> prev.contextFooter)       editRequestWithEditor req >>= \case         Just req' -> do-          (env :: PromptEnv) <- get           let newContext = prev {contextRequest = req'}-          put $ env {context = newContext}+          setContext @p newContext           repl         Nothing -> do           liftIO $ putStrLn "Failed to open the editor."@@ -255,9 +260,8 @@       prev <- getContext       editContentsWithEditor prev.contextBody >>= \case         Just contents' -> do-          (env :: PromptEnv) <- get           let newContext = prev {contextBody = contents'}-          put $ env {context = newContext}+          setContext @p newContext           repl         Nothing -> do           liftIO $ putStrLn "Failed to open the editor."@@ -266,26 +270,51 @@       prev <- getContext       editContentsWithEditor prev.contextHeader >>= \case         Just contents' -> do-          (env :: PromptEnv) <- get           let newContext = prev {contextHeader = contents'}-          put $ env {context = newContext}-          repl+          setContext @p newContext         Nothing -> do           liftIO $ putStrLn "Failed to open the editor."-          repl  +          repl     Right EditFooter -> do       prev <- getContext       editContentsWithEditor prev.contextFooter >>= \case         Just contents' -> do-          (env :: PromptEnv) <- get           let newContext = prev {contextFooter = contents'}-          put $ env {context = newContext}+          setContext @p newContext           repl         Nothing -> do           liftIO $ putStrLn "Failed to open the editor."           repl     Right (Repl sessionName) -> do       runRepl' @p+    Right (ListKeys) -> do+      liftIO $ do+        list <- withDB @p $ \conn -> listKeys @p conn+        forM_ list $ \(KeyName namespace keyName) -> T.putStrLn $ namespace <> ":" <> keyName+      repl+    Right (GetKey namespace keyName) -> do+      namespace' <- case namespace of+        Just v -> return v+        Nothing -> getSessionName+      mv <- withDB @p $ \conn -> getKey @p conn (KeyName namespace' keyName)+      case mv of+        Just v -> do+          liftIO $ T.putStrLn v+        Nothing -> do+          liftIO $ T.putStrLn $ "Failed to get " <> keyName+      repl+    Right (SetKey namespace keyName keyValue) -> do+      namespace' <- case namespace of+        Just v -> return v+        Nothing -> getSessionName+      withDB @p $ \conn -> setKey @p conn (KeyName namespace' keyName) keyValue+      repl+    Right (DeleteKey namespace keyName) -> do+      namespace' <- case namespace of+        Just v -> return v+        Nothing -> getSessionName+      withDB @p $ \conn -> deleteKey @p conn (KeyName namespace' keyName)+      repl  runRepl' :: forall p. (PersistentBackend p) => Prompt (InputT IO) () runRepl' = do@@ -302,4 +331,3 @@         }     )     (runPrompt @p tools customs sessionName defaultReq (push @p contents >> runRepl' @p))-

@@ -45,6 +45,6 @@  defaultTools :: [ToolProxy] defaultTools =-  [ bash-  , arxiv+  [ bash,+    arxiv   ]

@@ -1,8 +1,8 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-}@@ -30,43 +30,46 @@ module IntelliMonad.Tools.Arxiv where  import qualified Codec.Picture as P+-- Import HttpClient to make the REST API call++-- import Network.HTTP.Conduit++import Control.Exception (SomeException, catch)+import Control.Monad.IO.Class import Control.Monad.Trans.State (StateT) import Data.Aeson (FromJSON, ToJSON, eitherDecode, encode, (.:)) import qualified Data.Aeson as A import qualified Data.Aeson.Key as A import qualified Data.Aeson.KeyMap as A-import qualified Data.ByteString.Char8 as BC import Data.ByteString (ByteString, fromStrict, toStrict)+import qualified Data.ByteString.Char8 as BC import Data.Coerce import Data.Kind (Type) import qualified Data.Map as M+import Data.Maybe (fromMaybe, mapMaybe) import Data.Proxy import Data.Text (Text) import qualified Data.Text as T-import qualified Data.Text.Lazy as TL import qualified Data.Text.Encoding as T+import qualified Data.Text.Lazy as TL import Data.Time import qualified Data.Vector as V import Database.Persist import Database.Persist.Sqlite import Database.Persist.TH import GHC.Generics-import qualified OpenAI.Types as API--- Import HttpClient to make the REST API call+import IntelliMonad.Types import Network.HTTP.Client import Network.HTTP.Client.TLS import Network.HTTP.Simple (setRequestQueryString)--- import Network.HTTP.Conduit-import IntelliMonad.Types+import qualified OpenAI.Types as API import Text.XML-import Text.XML.Cursor (Cursor, attributeIs, content, element, fromDocument, ($//), (&/), (&//), Axis, checkName)-import Control.Exception (SomeException, catch)-import Data.Maybe (mapMaybe, fromMaybe)+import Text.XML.Cursor (Axis, Cursor, attributeIs, checkName, content, element, fromDocument, ($//), (&/), (&//))  data Arxiv = Arxiv-  { searchQuery :: Text-  , maxResults :: Maybe Int-  , start :: Maybe Int+  { searchQuery :: Text,+    maxResults :: Maybe Int,+    start :: Maybe Int   }   deriving (Eq, Show, Generic, JSONSchema, A.FromJSON, A.ToJSON) @@ -78,19 +81,20 @@   getFieldDescription "start" = "The start index of the results. If not specified, the default is 0."  arxivSearch :: Arxiv -> IO ByteString-arxivSearch Arxiv{..} = do+arxivSearch Arxiv {..} = do   manager <- newManager tlsManagerSettings-  let request = setRequestQueryString-                  [ ("search_query", Just $ T.encodeUtf8 searchQuery)-                  , ("max_results", Just $ fromMaybe "10" (BC.pack . show <$> maxResults))-                  , ("start", Just $ fromMaybe "0" (BC.pack . show <$> start))-                  ]-                  "https://export.arxiv.org/api/query"+  let request =+        setRequestQueryString+          [ ("search_query", Just $ T.encodeUtf8 searchQuery),+            ("max_results", Just $ fromMaybe "10" (BC.pack . show <$> maxResults)),+            ("start", Just $ fromMaybe "0" (BC.pack . show <$> start))+          ]+          "https://export.arxiv.org/api/query"   response <- httpLbs request manager   return $ toStrict $ responseBody response  element' :: Text -> Axis-element' name = checkName (\n ->  nameLocalName n == name)+element' name = checkName (\n -> nameLocalName n == name)  queryArxiv :: Arxiv -> IO [ArxivEntry] queryArxiv keyword = do@@ -98,24 +102,25 @@   return $ parseArxivXML jsonSource  data ArxivEntry = ArxivEntry-  { arxivId   :: Text-  , published :: Text-  , title     :: Text-  , summary   :: Text-  } deriving (Eq, Show, Generic, A.FromJSON, A.ToJSON)+  { arxivId :: Text,+    published :: Text,+    title :: Text,+    summary :: Text+  }+  deriving (Eq, Show, Generic, A.FromJSON, A.ToJSON)  headDef :: a -> [a] -> a headDef d [] = d-headDef _ (x:_) = x+headDef _ (x : _) = x  -- | Parser for an Arxiv Entry in XML parseEntry :: Cursor -> Maybe ArxivEntry parseEntry c =-  let arxivId   = headDef "" $ c $// element' "id" &/ content+  let arxivId = headDef "" $ c $// element' "id" &/ content       published = headDef "" $ c $// element' "published" &/ content-      title     = headDef "" $ c $// element' "title" &/ content-      summary   = headDef "" $ c $// element' "summary" &/ content-  in  Just $ ArxivEntry arxivId published title summary+      title = headDef "" $ c $// element' "title" &/ content+      summary = headDef "" $ c $// element' "summary" &/ content+   in Just $ ArxivEntry arxivId published title summary  -- | Parser for an Arxiv Result in XML parseArxivResult :: Cursor -> [ArxivEntry]@@ -133,6 +138,6 @@     }     deriving (Eq, Show, Generic, A.FromJSON, A.ToJSON) -  toolExec args = do+  toolExec args = liftIO $ do     papers <- queryArxiv args     return $ ArxivOutput papers

@@ -20,6 +20,7 @@  module IntelliMonad.Tools.Bash where +import Control.Monad.IO.Class import qualified Data.Aeson as A import GHC.Generics import GHC.IO.Exception@@ -45,7 +46,7 @@     }     deriving (Eq, Show, Generic, A.FromJSON, A.ToJSON) -  toolExec args = do+  toolExec args = liftIO $ do     (code, stdout, stderr) <- readCreateProcessWithExitCode (shell args.script) ""     let code' = case code of           ExitSuccess -> 0

@@ -78,7 +78,7 @@       url :: Text     }     deriving (Eq, Show, Generic, A.FromJSON, A.ToJSON)-  toolExec args = do+  toolExec args = liftIO $ do     api_key <- (API.clientAuth . T.pack) <$> getEnv "OPENAI_API_KEY"     url <- parseBaseUrl "https://api.openai.com/v1/"     manager <- newManager tlsManagerSettings

@@ -0,0 +1,131 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++module IntelliMonad.Tools.KeyValue where++import Control.Monad.IO.Class+import qualified Data.Aeson as A+import Data.Text (Text)+import Database.Persist.Sqlite (SqliteConf)+import GHC.Generics+import GHC.IO.Exception+import IntelliMonad.Persist+import IntelliMonad.Prompt+import IntelliMonad.Types+import qualified OpenAI.Types as API+import System.Process+import Data.Proxy++data GetKey = GetKey+  { key :: Text+  }+  deriving (Eq, Show, Generic, JSONSchema, A.FromJSON, A.ToJSON)++instance HasFunctionObject GetKey where+  getFunctionName = "get_key"+  getFunctionDescription = "Get a key from the key-value store"+  getFieldDescription "key" = "The key to get"++data SetKey = SetKey+  { key :: Text,+    value :: Text+  }+  deriving (Eq, Show, Generic, JSONSchema, A.FromJSON, A.ToJSON)++instance HasFunctionObject SetKey where+  getFunctionName = "set_key"+  getFunctionDescription = "Set a key in the key-value store"+  getFieldDescription "key" = "The key to set"+  getFieldDescription "value" = "The value to set"++data DeleteKey = DeleteKey+  { key :: Text+  }+  deriving (Eq, Show, Generic, JSONSchema, A.FromJSON, A.ToJSON)++instance HasFunctionObject DeleteKey where+  getFunctionName = "delete_key"+  getFunctionDescription = "Delete a key from the key-value store"+  getFieldDescription "key" = "The key to delete"++data ListKeys = ListKeys ()+  deriving (Eq, Show, Generic, JSONSchema, A.FromJSON, A.ToJSON)++instance HasFunctionObject ListKeys where+  getFunctionName = "list_keys"+  getFunctionDescription = "List all keys in the key-value store"++instance Tool GetKey where+  data Output GetKey = GetKeyOutput+    { value :: Text,+      code :: Int,+      stderr :: Text+    }+    deriving (Eq, Show, Generic, A.FromJSON, A.ToJSON)++  toolExec args = do+    withBackend $ \(_ :: p) -> do+      namespace' <- getSessionName+      mv <- withDB @p $ \conn -> getKey @p conn (KeyName namespace' args.key)+      case mv of+        Just v -> return $ GetKeyOutput v 0 ""+        Nothing -> return $ GetKeyOutput "" 1 "Key not found"++instance Tool SetKey where+  data Output SetKey = SetKeyOutput+    { code :: Int,+      stderr :: Text+    }+    deriving (Eq, Show, Generic, A.FromJSON, A.ToJSON)++  toolExec args = do+    withBackend $ \(_ :: p) -> do+      namespace' <- getSessionName+      withDB @p $ \conn -> setKey @p conn (KeyName namespace' args.key) args.value+      return $ SetKeyOutput 0 ""++instance Tool DeleteKey where+  data Output DeleteKey = DeleteKeyOutput+    { code :: Int,+      stderr :: Text+    }+    deriving (Eq, Show, Generic, A.FromJSON, A.ToJSON)++  toolExec args = do+    withBackend $ \(_ :: p) -> do+      namespace' <- getSessionName+      withDB @p $ \conn -> deleteKey @p conn (KeyName namespace' args.key)+      return $ DeleteKeyOutput 0 ""++instance Tool ListKeys where+  data Output ListKeys = ListKeysOutput+    { keys :: [Text],+      code :: Int,+      stderr :: Text+    }+    deriving (Eq, Show, Generic, A.FromJSON, A.ToJSON)++  toolExec args = do+    withBackend $ \(_ :: p) -> do+      namespace' <- getSessionName+      keys <- withDB @p $ \conn -> listKeys @p conn+      return $ ListKeysOutput (map (\(KeyName _ key) -> key) keys) 0 ""

@@ -20,6 +20,7 @@  module IntelliMonad.Tools.TextToSpeech where +import Control.Monad.IO.Class import qualified Data.Aeson as A import qualified Data.ByteString as BS import qualified Data.Text as T@@ -51,15 +52,15 @@       stderr :: String     }     deriving (Eq, Show, Generic, A.FromJSON, A.ToJSON)-  toolExec args = do-    api_key <- (API.clientAuth . T.pack) <$> getEnv "OPENAI_API_KEY"+  toolExec args = liftIO $ do+    api_key <- (API.clientAuth . T.pack) <$> (getEnv "OPENAI_API_KEY")     url <- parseBaseUrl "https://api.openai.com/v1/"     manager <- newManager tlsManagerSettings     let API.OpenAIBackend {..} = API.createOpenAIClient     let request =           API.CreateSpeechRequest             { API.createSpeechRequestModel = API.CreateSpeechRequestModel "tts-1",-              API.createSpeechRequestInput = args.script,+              API.createSpeechRequestInput = (script args :: T.Text),               API.createSpeechRequestVoice = "alloy",               API.createSpeechRequestResponseUnderscoreformat = Just "mp3",               API.createSpeechRequestSpeed = Nothing

@@ -39,8 +39,8 @@     (ToolProxy (_ :: Proxy a)) -> addTools tools' (toolAdd @a v)  toolExec' ::-  forall t m.-  (MonadIO m, MonadFail m, Tool t, A.FromJSON t, A.ToJSON (Output t)) =>+  forall t p m.+  (PersistentBackend p, MonadIO m, MonadFail m, Tool t, A.FromJSON t, A.ToJSON (Output t)) =>   Text ->   Text ->   Text ->@@ -51,7 +51,7 @@     then case (A.eitherDecode (BS.fromStrict (T.encodeUtf8 args')) :: Either String t) of       Left _ -> return Nothing       Right input -> do-        output <- liftIO $ toolExec input+        output <- toolExec @t @p @m input         time <- liftIO getCurrentTime         return $ Just $ (Content Tool (ToolReturn id' name' (T.decodeUtf8Lenient (BS.toStrict (encode output)))) sessionName time)     else return Nothing@@ -72,11 +72,11 @@     Just v -> return (Just v)     Nothing -> tool1 sessionName id' name' args' -mergeToolCall :: (MonadIO m, MonadFail m) => [ToolProxy] -> Text -> Text -> Text -> Text -> Prompt m (Maybe Content)+mergeToolCall :: forall p m. (PersistentBackend p, MonadIO m, MonadFail m) => [ToolProxy] -> Text -> Text -> Text -> Text -> Prompt m (Maybe Content) mergeToolCall [] _ _ _ _ = return Nothing mergeToolCall (tool : tools') sessionName id' name' args' = do   case tool of-    (ToolProxy (_ :: Proxy a)) -> (toolExec' @a <||> mergeToolCall tools') sessionName id' name' args'+    (ToolProxy (_ :: Proxy a)) -> (toolExec' @a @p <||> mergeToolCall @p tools') sessionName id' name' args'  hasToolCall :: Contents -> Bool hasToolCall cs =@@ -92,10 +92,10 @@       loop (_ : cs') = loop cs'    in loop cs -tryToolExec :: (MonadIO m, MonadFail m) => [ToolProxy] -> Text -> Contents -> Prompt m Contents+tryToolExec :: forall p m. (PersistentBackend p, MonadIO m, MonadFail m) => [ToolProxy] -> Text -> Contents -> Prompt m Contents tryToolExec tools sessionName contents = do   cs <- forM (filterToolCall contents) $ \(Content _ (ToolCall id' name' args') _ _) -> do-    mergeToolCall tools sessionName id' name' args'+    mergeToolCall @p tools sessionName id' name' args'   return $ catMaybes cs  findToolCall :: ToolProxy -> Contents -> Maybe Content

@@ -1,8 +1,8 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-}@@ -25,11 +25,13 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ExistentialQuantification #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  module IntelliMonad.Types where  import qualified Codec.Picture as P+import Control.Monad.IO.Class import Control.Monad.Trans.State (StateT) import Data.Aeson (FromJSON, ToJSON, eitherDecode, encode) import qualified Data.Aeson as A@@ -198,20 +200,43 @@     deriving Show     deriving Eq     deriving Ord+KeyValue+    namespace Text+    key Text+    value Text+    KeyName namespace key+    deriving Show+    deriving Eq+    deriving Ord |]  data ToolProxy = forall t. (Tool t, A.FromJSON t, A.ToJSON t, A.FromJSON (Output t), A.ToJSON (Output t)) => ToolProxy (Proxy t)  class CustomInstruction a where-  customHeader :: Contents-  customFooter :: Contents+  customHeader :: a -> Contents+  customFooter :: a -> Contents -data CustomInstructionProxy = forall t. (CustomInstruction t) => CustomInstructionProxy (Proxy t)+data CustomInstructionProxy = forall t. (CustomInstruction t) => CustomInstructionProxy t +class Hook a where+  preHook :: forall p m. (MonadIO m, MonadFail m, PersistentBackend p) => a -> Prompt m ()+  postHook :: forall p m. (MonadIO m, MonadFail m, PersistentBackend p) => a -> Prompt m ()++data HookProxy = forall t. (Hook t) => HookProxy t++data PersistProxy = forall t. (PersistentBackend t) => PersistProxy t+ data PromptEnv = PromptEnv-  { tools :: [ToolProxy],-    customInstructions :: [CustomInstructionProxy],-    context :: Context+  { tools :: [ToolProxy]+  -- ^ The list of function calling+  , customInstructions :: [CustomInstructionProxy]+  -- ^ This system sends a prompt that includes headers, bodies and footers. Then the message that LLM outputs is added to bodies. customInstructions generates headers and footers.+  , context :: Context+  -- ^ The request settings like model and prompt logs+  , backend :: PersistProxy+  -- ^ The backend for prompt logging+  , hooks :: [HookProxy]+  -- ^ The hook functions before or after calling LLM   }  type Contents = [Content]@@ -258,8 +283,14 @@   default toolSchema :: (HasFunctionObject a, JSONSchema a, Generic a, GSchema a (Rep a)) => API.ChatCompletionTool   toolSchema = toChatCompletionTool @a -  toolExec :: a -> IO (Output a)+  toolExec :: forall p m. (MonadIO m, MonadFail m, PersistentBackend p) => a -> Prompt m (Output a) +  toolHeader :: Contents+  toolHeader = []+  toolFooter :: Contents+  toolFooter = []++ toChatCompletionTool :: forall a. (HasFunctionObject a, JSONSchema a) => API.ChatCompletionTool toChatCompletionTool =   API.ChatCompletionTool@@ -427,20 +458,49 @@   | EditFooter   | ListSessions   | CopySession-  { sessionNameFrom :: Text-  , sessionNameTo :: Text-  }+      { sessionNameFrom :: Text,+        sessionNameTo :: Text+      }   | DeleteSession-  { sessionName :: Text-  }+      { sessionName :: Text+      }   | SwitchSession-  { sessionName :: Text-  }+      { sessionName :: Text+      }   | ReadImage Text   | UserInput Text   | Help-  | Repl -  { sessionName :: Text-  }+  | Repl+      { sessionName :: Text+      }+  | ListKeys+  | GetKey+      { nameSpace :: Maybe Text,+        keyName :: Text+      }+  | SetKey+      { nameSpace :: Maybe Text,+        keyName :: Text,+        value :: Text+      }+  | DeleteKey+      { nameSpace :: Maybe Text,+        keyName :: Text+      }   deriving (Eq, Show) +class PersistentBackend p where+  type Conn p+  config :: p+  setup :: (MonadIO m, MonadFail m) => p -> m (Maybe (Conn p))+  initialize :: (MonadIO m, MonadFail m) => Conn p -> Context -> m ()+  load :: (MonadIO m, MonadFail m) => Conn p -> SessionName -> m (Maybe Context)+  loadByKey :: (MonadIO m, MonadFail m) => Conn p -> (Key Context) -> m (Maybe Context)+  save :: (MonadIO m, MonadFail m) => Conn p -> Context -> m (Maybe (Key Context))+  saveContents :: (MonadIO m, MonadFail m) => Conn p -> [Content] -> m ()+  listSessions :: (MonadIO m, MonadFail m) => Conn p -> m [Text]+  deleteSession :: (MonadIO m, MonadFail m) => Conn p -> SessionName -> m ()+  listKeys :: (MonadIO m, MonadFail m) => Conn p -> m [Unique KeyValue]+  getKey :: (MonadIO m, MonadFail m) => Conn p -> Unique KeyValue -> m (Maybe Text)+  setKey :: (MonadIO m, MonadFail m) => Conn p -> Unique KeyValue -> Text -> m ()+  deleteKey :: (MonadIO m, MonadFail m) => Conn p -> Unique KeyValue -> m ()