packages feed

intelli-monad 0.1.0.0 → 0.1.0.1

raw patch · 8 files changed

+455/−68 lines, 8 filesdep +http-conduitdep +optparse-applicativedep +temporaryPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: http-conduit, optparse-applicative, temporary, xml-conduit

API changes (from Hackage documentation)

- IntelliMonad.Repl: Clear :: ReplCommand
- IntelliMonad.Repl: CopySession :: (Text, Text) -> ReplCommand
- IntelliMonad.Repl: DeleteSession :: Text -> ReplCommand
- IntelliMonad.Repl: Help :: ReplCommand
- IntelliMonad.Repl: ListSessions :: ReplCommand
- IntelliMonad.Repl: Quit :: ReplCommand
- IntelliMonad.Repl: ReadImage :: Text -> ReplCommand
- IntelliMonad.Repl: ShowContents :: ReplCommand
- IntelliMonad.Repl: ShowContext :: ReplCommand
- IntelliMonad.Repl: ShowRequest :: ReplCommand
- IntelliMonad.Repl: ShowSession :: ReplCommand
- IntelliMonad.Repl: ShowUsage :: ReplCommand
- IntelliMonad.Repl: SwitchSession :: Text -> ReplCommand
- IntelliMonad.Repl: UserInput :: Text -> ReplCommand
- IntelliMonad.Repl: data ReplCommand
- IntelliMonad.Repl: instance GHC.Classes.Eq IntelliMonad.Repl.ReplCommand
- IntelliMonad.Repl: instance GHC.Show.Show IntelliMonad.Repl.ReplCommand
+ IntelliMonad.Cmd: main :: IO ()
+ IntelliMonad.Cmd: opts :: Parser ReplCommand
+ IntelliMonad.Cmd: runCmd :: forall p. PersistentBackend p => ReplCommand -> IO ()
+ IntelliMonad.Repl: editContentsWithEditor :: forall m. (MonadIO m, MonadFail m) => Contents -> m (Maybe Contents)
+ IntelliMonad.Repl: editRequestWithEditor :: forall m. (MonadIO m, MonadFail m) => CreateChatCompletionRequest -> m (Maybe CreateChatCompletionRequest)
+ IntelliMonad.Repl: editWithEditor :: forall m. (MonadIO m, MonadFail m) => m (Maybe Text)
+ IntelliMonad.Repl: runCmd' :: forall p. PersistentBackend p => Either (ParseErrorBundle Text Void) ReplCommand -> Maybe (Prompt (InputT IO) ()) -> Prompt (InputT IO) ()
+ IntelliMonad.Tools.Arxiv: Arxiv :: Text -> Maybe Int -> Maybe Int -> Arxiv
+ IntelliMonad.Tools.Arxiv: ArxivEntry :: Text -> Text -> Text -> Text -> ArxivEntry
+ IntelliMonad.Tools.Arxiv: [$sel:arxivId:ArxivEntry] :: ArxivEntry -> Text
+ IntelliMonad.Tools.Arxiv: [$sel:maxResults:Arxiv] :: Arxiv -> Maybe Int
+ IntelliMonad.Tools.Arxiv: [$sel:published:ArxivEntry] :: ArxivEntry -> Text
+ IntelliMonad.Tools.Arxiv: [$sel:searchQuery:Arxiv] :: Arxiv -> Text
+ IntelliMonad.Tools.Arxiv: [$sel:start:Arxiv] :: Arxiv -> Maybe Int
+ IntelliMonad.Tools.Arxiv: [$sel:summary:ArxivEntry] :: ArxivEntry -> Text
+ IntelliMonad.Tools.Arxiv: [$sel:title:ArxivEntry] :: ArxivEntry -> Text
+ IntelliMonad.Tools.Arxiv: arxivSearch :: Arxiv -> IO ByteString
+ IntelliMonad.Tools.Arxiv: data Arxiv
+ IntelliMonad.Tools.Arxiv: data ArxivEntry
+ IntelliMonad.Tools.Arxiv: element' :: Text -> Axis
+ IntelliMonad.Tools.Arxiv: headDef :: a -> [a] -> a
+ IntelliMonad.Tools.Arxiv: instance Data.Aeson.Types.FromJSON.FromJSON (IntelliMonad.Types.Output IntelliMonad.Tools.Arxiv.Arxiv)
+ IntelliMonad.Tools.Arxiv: instance Data.Aeson.Types.FromJSON.FromJSON IntelliMonad.Tools.Arxiv.Arxiv
+ IntelliMonad.Tools.Arxiv: instance Data.Aeson.Types.FromJSON.FromJSON IntelliMonad.Tools.Arxiv.ArxivEntry
+ IntelliMonad.Tools.Arxiv: instance Data.Aeson.Types.ToJSON.ToJSON (IntelliMonad.Types.Output IntelliMonad.Tools.Arxiv.Arxiv)
+ IntelliMonad.Tools.Arxiv: instance Data.Aeson.Types.ToJSON.ToJSON IntelliMonad.Tools.Arxiv.Arxiv
+ IntelliMonad.Tools.Arxiv: instance Data.Aeson.Types.ToJSON.ToJSON IntelliMonad.Tools.Arxiv.ArxivEntry
+ IntelliMonad.Tools.Arxiv: instance GHC.Classes.Eq (IntelliMonad.Types.Output IntelliMonad.Tools.Arxiv.Arxiv)
+ IntelliMonad.Tools.Arxiv: instance GHC.Classes.Eq IntelliMonad.Tools.Arxiv.Arxiv
+ IntelliMonad.Tools.Arxiv: instance GHC.Classes.Eq IntelliMonad.Tools.Arxiv.ArxivEntry
+ IntelliMonad.Tools.Arxiv: instance GHC.Generics.Generic (IntelliMonad.Types.Output IntelliMonad.Tools.Arxiv.Arxiv)
+ IntelliMonad.Tools.Arxiv: instance GHC.Generics.Generic IntelliMonad.Tools.Arxiv.Arxiv
+ IntelliMonad.Tools.Arxiv: instance GHC.Generics.Generic IntelliMonad.Tools.Arxiv.ArxivEntry
+ IntelliMonad.Tools.Arxiv: instance GHC.Show.Show (IntelliMonad.Types.Output IntelliMonad.Tools.Arxiv.Arxiv)
+ IntelliMonad.Tools.Arxiv: instance GHC.Show.Show IntelliMonad.Tools.Arxiv.Arxiv
+ IntelliMonad.Tools.Arxiv: instance GHC.Show.Show IntelliMonad.Tools.Arxiv.ArxivEntry
+ IntelliMonad.Tools.Arxiv: instance IntelliMonad.Types.HasFunctionObject IntelliMonad.Tools.Arxiv.Arxiv
+ IntelliMonad.Tools.Arxiv: instance IntelliMonad.Types.JSONSchema IntelliMonad.Tools.Arxiv.Arxiv
+ IntelliMonad.Tools.Arxiv: instance IntelliMonad.Types.Tool IntelliMonad.Tools.Arxiv.Arxiv
+ IntelliMonad.Tools.Arxiv: parseArxivResult :: Cursor -> [ArxivEntry]
+ IntelliMonad.Tools.Arxiv: parseArxivXML :: ByteString -> [ArxivEntry]
+ IntelliMonad.Tools.Arxiv: parseEntry :: Cursor -> Maybe ArxivEntry
+ IntelliMonad.Tools.Arxiv: queryArxiv :: Arxiv -> IO [ArxivEntry]
+ IntelliMonad.Types: Clear :: ReplCommand
+ IntelliMonad.Types: CopySession :: Text -> Text -> ReplCommand
+ IntelliMonad.Types: DeleteSession :: Text -> ReplCommand
+ IntelliMonad.Types: Edit :: ReplCommand
+ IntelliMonad.Types: EditContents :: ReplCommand
+ IntelliMonad.Types: EditFooter :: ReplCommand
+ IntelliMonad.Types: EditHeader :: ReplCommand
+ IntelliMonad.Types: EditRequest :: ReplCommand
+ IntelliMonad.Types: Help :: ReplCommand
+ IntelliMonad.Types: ListSessions :: ReplCommand
+ IntelliMonad.Types: Quit :: ReplCommand
+ IntelliMonad.Types: ReadImage :: Text -> ReplCommand
+ IntelliMonad.Types: Repl :: Text -> ReplCommand
+ IntelliMonad.Types: ShowContents :: ReplCommand
+ IntelliMonad.Types: ShowContext :: ReplCommand
+ IntelliMonad.Types: ShowRequest :: ReplCommand
+ IntelliMonad.Types: ShowSession :: ReplCommand
+ IntelliMonad.Types: ShowUsage :: ReplCommand
+ IntelliMonad.Types: SwitchSession :: Text -> ReplCommand
+ IntelliMonad.Types: UserInput :: Text -> ReplCommand
+ IntelliMonad.Types: [$sel:sessionName:Quit] :: ReplCommand -> Text
+ IntelliMonad.Types: [$sel:sessionNameFrom:Quit] :: ReplCommand -> Text
+ IntelliMonad.Types: [$sel:sessionNameTo:Quit] :: ReplCommand -> Text
+ IntelliMonad.Types: data ReplCommand
+ IntelliMonad.Types: instance Data.Aeson.Types.FromJSON.FromJSON IntelliMonad.Types.Content
+ IntelliMonad.Types: instance Data.Aeson.Types.ToJSON.ToJSON IntelliMonad.Types.Content
+ IntelliMonad.Types: instance GHC.Classes.Eq IntelliMonad.Types.ReplCommand
+ IntelliMonad.Types: instance GHC.Generics.Generic IntelliMonad.Types.Content
+ IntelliMonad.Types: instance GHC.Show.Show IntelliMonad.Types.ReplCommand
+ IntelliMonad.Types: instance IntelliMonad.Types.JSONSchema GHC.Types.Int

Files

CHANGELOG.md view
@@ -1,5 +1,10 @@ # Revision history for intelli-monad -## 0.1.0.0 -- YYYY-mm-dd+## 0.1.0.1 -- 2024-03-21++* Add CLI options+* Support for arxiv++## 0.1.0.0 -- 2024-03-15  * First version. Released on an unsuspecting world.
app/repl.hs view
@@ -1,30 +1,6 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-}- module Main where--import qualified Data.Text as T-import Database.Persist.Sqlite (SqliteConf)-import IntelliMonad.CustomInstructions-import IntelliMonad.Repl-import IntelliMonad.Tools-import IntelliMonad.Types-import qualified OpenAI.Types as API-import System.Environment (lookupEnv)+import qualified IntelliMonad.Cmd  main :: IO ()-main = do-  model <- do-    lookupEnv "OPENAI_MODEL" >>= \case-      Just model -> return $ T.pack model-      --      Nothing -> return "gpt-4-vision-preview"-      Nothing -> return "gpt-4"-  runRepl @SqliteConf-    defaultTools-    []-    "default"-    defaultRequest-      { API.createChatCompletionRequestModel = API.CreateChatCompletionRequestModel model-      }-    mempty+main = IntelliMonad.Cmd.main+
intelli-monad.cabal view
@@ -1,8 +1,9 @@ cabal-version:      3.0 name:               intelli-monad-version:            0.1.0.0+version:            0.1.0.1 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 license:            MIT  -- The file containing the license text.@@ -37,12 +38,14 @@     exposed-modules:  IntelliMonad.Prompt                     , IntelliMonad.Types                     , IntelliMonad.Tools+                    , IntelliMonad.Tools.Arxiv                     , IntelliMonad.Tools.Bash                     , IntelliMonad.Tools.TextToSpeech                     , IntelliMonad.Tools.DallE3                     , IntelliMonad.Tools.Utils                     , IntelliMonad.Persist                     , IntelliMonad.Repl+                    , IntelliMonad.Cmd                     , IntelliMonad.CustomInstructions      -- Modules included in this library but not exported.@@ -67,6 +70,7 @@                     , haskeline >= 0.8.2 && < 0.9                     , http-client >= 0.7.16 && < 0.8                     , http-client-tls >= 0.3.6 && < 0.4+                    , http-conduit >= 2.2 && < 2.4                     , megaparsec >= 9.5 && < 9.7                     , openai-servant-gen >= 0.1.0 && < 0.2                     , servant >= 0.20.1 && < 0.21@@ -74,6 +78,9 @@                     , persistent >= 2.14.6 && < 2.15                     , persistent-sqlite >= 2.13.3 && < 2.14                     , sixel >= 0.1.2 && < 0.2+                    , optparse-applicative >= 0.18 && < 0.19+                    , temporary >= 1.3 && < 1.4+                    , xml-conduit >= 1.9 && < 2.0     -- Directories containing source files.     hs-source-dirs:   src 
+ src/IntelliMonad/Cmd.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module IntelliMonad.Cmd where++import Control.Monad (forM_)+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 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 IntelliMonad.Persist+import IntelliMonad.Prompt+import IntelliMonad.Types+import IntelliMonad.Repl+import IntelliMonad.Tools+import qualified OpenAI.Types as API+import System.Console.Haskeline+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 = +  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"))+    )++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))+++main :: IO ()+main = do+  model <- do+    lookupEnv "OPENAI_MODEL" >>= \case+      Just model -> return $ T.pack model+      --      Nothing -> return "gpt-4-vision-preview"+      Nothing -> return "gpt-4"+  cmd <- customExecParser (prefs showHelpOnEmpty) (info (helper <*> opts) (fullDesc <> progDesc "intelli-monad"))+  runCmd @SqliteConf cmd++  
src/IntelliMonad/Repl.hs view
@@ -21,6 +21,7 @@ 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 qualified Data.ByteString as BS import Data.Text (Text) import qualified Data.Text as T@@ -34,26 +35,14 @@ 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 -data ReplCommand-  = Quit-  | Clear-  | ShowContents-  | ShowUsage-  | ShowRequest-  | ShowContext-  | ShowSession-  | ListSessions-  | CopySession (Text, Text)-  | DeleteSession Text-  | SwitchSession Text-  | ReadImage Text-  | UserInput Text-  | Help-  deriving (Eq, Show)- parseRepl :: Parser ReplCommand parseRepl =   (try (lexm (string ":quit")) >> pure Quit)@@ -70,13 +59,17 @@             ( lexm (string ":copy") >> lexm (string "session") >> do                 from <- T.pack <$> lexm sessionName                 to <- T.pack <$> lexm sessionName-                return (from, to)+                return $ CopySession from to             )-            >>= pure . CopySession         )     <|> (try (lexm (string ":delete") >> lexm (string "session") >> lexm sessionName) >>= pure . DeleteSession . T.pack)     <|> (try (lexm (string ":switch") >> lexm (string "session") >> lexm sessionName) >>= pure . SwitchSession . T.pack)     <|> (try (lexm (string ":help")) >> pure Help)+    <|> (try (lexm (string ":edit") >> lexm (string "request")) >> pure EditRequest)+    <|> (try (lexm (string ":edit") >> lexm (string "contents")) >> pure EditContents)+    <|> (try (lexm (string ":edit") >> lexm (string "header")) >> pure EditHeader)+    <|> (try (lexm (string ":edit") >> lexm (string "footer")) >> pure EditFooter)+    <|> (try (lexm (string ":edit")) >> pure Edit)   where     sc = L.space space1 empty empty     lexm = lexeme sc@@ -98,48 +91,100 @@           Left err -> return $ Left err         else return $ Right (UserInput input) -runRepl' :: forall p. (PersistentBackend p) => Prompt (InputT IO) ()-runRepl' = do-  getUserCommand @p >>= \case+editWithEditor :: forall m. ( MonadIO m, MonadFail m) => m (Maybe T.Text)+editWithEditor = do+  liftIO $ withSystemTempFile "tempfile.txt" $ \filePath fileHandle -> do+    hClose fileHandle+    editor <- do+      lookupEnv "EDITOR" >>= \case+        Just editor' -> return editor'+        Nothing -> return "vim"+    code <- system (editor <> " " <> filePath)+    case code of+      ExitSuccess -> Just <$> T.readFile filePath+      ExitFailure _ -> return Nothing++editRequestWithEditor :: forall m. ( MonadIO m, MonadFail m) => API.CreateChatCompletionRequest -> m (Maybe API.CreateChatCompletionRequest)+editRequestWithEditor req = do+  liftIO $ withSystemTempFile "tempfile.json" $ \filePath fileHandle -> do+    hClose fileHandle+    BS.writeFile filePath $ BS.toStrict $ encodePretty req+    editor <- do+      lookupEnv "EDITOR" >>= \case+        Just editor' -> return editor'+        Nothing -> return "vim"+    code <- system (editor <> " " <> filePath)+    case code of+      ExitSuccess -> do+        newReq <- A.decodeFileStrict @API.CreateChatCompletionRequest filePath+        case newReq of+          Just newReq' -> return $ Just newReq'+          Nothing -> return Nothing+      ExitFailure _ -> return Nothing++editContentsWithEditor :: forall m. ( MonadIO m, MonadFail m) => Contents -> m (Maybe Contents)+editContentsWithEditor contents = do+  liftIO $ withSystemTempFile "tempfile.json" $ \filePath fileHandle -> do+    hClose fileHandle+    BS.writeFile filePath $ BS.toStrict $ encodePretty contents+    editor <- do+      lookupEnv "EDITOR" >>= \case+        Just editor' -> return editor'+        Nothing -> return "vim"+    code <- system (editor <> " " <> filePath)+    case code of+      ExitSuccess -> do+        newContents <- A.decodeFileStrict @Contents filePath+        case newContents of+          Just newContents' -> return $ Just newContents'+          Nothing -> return Nothing+      ExitFailure _ -> return Nothing++runCmd' :: forall p. (PersistentBackend p) => Either (ParseErrorBundle Text Void) ReplCommand -> Maybe (Prompt (InputT IO) ()) -> Prompt (InputT IO) ()+runCmd' cmd ret = do+  let repl = case ret of+        Just ret' -> ret'+        Nothing -> return ()+  case cmd of     Left err -> do       liftIO $ print err-      runRepl' @p+      repl     Right Quit -> return ()     Right Clear -> do       clear @p-      runRepl' @p+      repl     Right ShowContents -> do       context <- getContext       showContents context.contextBody-      runRepl' @p+      repl     Right ShowUsage -> do       context <- getContext       liftIO $ do         print context.contextTotalTokens-      runRepl' @p+      repl     Right ShowRequest -> do       prev <- getContext       let req = toRequest prev.contextRequest (prev.contextHeader <> prev.contextBody <> prev.contextFooter)       liftIO $ do         BS.putStr $ BS.toStrict $ encodePretty req         T.putStrLn ""-      runRepl' @p+      repl     Right ShowContext -> do       prev <- getContext       liftIO $ do         putStrLn $ show prev-      runRepl' @p+      repl     Right ShowSession -> do       prev <- getContext       liftIO $ do         T.putStrLn $ prev.contextSessionName-      runRepl' @p+      repl     Right ListSessions -> do       liftIO $ do         list <- withDB @p $ \conn -> listSessions @p conn         forM_ list $ \sessionName' -> T.putStrLn sessionName'-      runRepl' @p-    Right (CopySession (from', to')) -> do+      repl+    Right (CopySession from' to') -> do       liftIO $ do         withDB @p $ \conn -> do           mv <- load @p conn from'@@ -148,10 +193,10 @@               _ <- save @p conn (v {contextSessionName = to'})               return ()             Nothing -> T.putStrLn $ "Failed to load " <> from'-      runRepl' @p+      repl     Right (DeleteSession session) -> do       withDB @p $ \conn -> deleteSession @p conn session-      runRepl' @p+      repl     Right (SwitchSession session) -> do       mv <- withDB @p $ \conn -> load @p conn session       case mv of@@ -159,10 +204,10 @@           (env :: PromptEnv) <- get           put $ env {context = v}         Nothing -> liftIO $ T.putStrLn $ "Failed to load " <> session-      runRepl' @p+      repl     Right (ReadImage imagePath) -> do       callWithImage @p imagePath >>= showContents-      runRepl' @p+      repl     Right Help -> do       liftIO $ do         putStrLn ":quit"@@ -177,11 +222,76 @@         putStrLn ":delete session <session name>"         putStrLn ":switch session <session name>"         putStrLn ":help"-      runRepl' @p+      repl     Right (UserInput input) -> do       callWithText @p input >>= showContents+      repl+    Right Edit -> do+      -- Open a temporary file with the default editor of the system.+      -- Then send it as user input.+      editWithEditor >>= \case+        Just input -> do+          callWithText @p input >>= showContents+          repl+        Nothing -> do+          liftIO $ putStrLn "Failed to open the editor."+          repl+    Right EditRequest -> do+      -- Open a json file of request and edit it with the default editor of the system.+      -- Then, read the file and parse it as a request.+      -- Finally, update the context with the new request.+      prev <- getContext+      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}+          repl+        Nothing -> do+          liftIO $ putStrLn "Failed to open the editor."+          repl+    Right EditContents -> do+      prev <- getContext+      editContentsWithEditor prev.contextBody >>= \case+        Just contents' -> do+          (env :: PromptEnv) <- get+          let newContext = prev {contextBody = contents'}+          put $ env {context = newContext}+          repl+        Nothing -> do+          liftIO $ putStrLn "Failed to open the editor."+          repl+    Right EditHeader -> do+      prev <- getContext+      editContentsWithEditor prev.contextHeader >>= \case+        Just contents' -> do+          (env :: PromptEnv) <- get+          let newContext = prev {contextHeader = contents'}+          put $ env {context = newContext}+          repl+        Nothing -> do+          liftIO $ putStrLn "Failed to open the editor."+          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}+          repl+        Nothing -> do+          liftIO $ putStrLn "Failed to open the editor."+          repl+    Right (Repl sessionName) -> do       runRepl' @p +runRepl' :: forall p. (PersistentBackend p) => Prompt (InputT IO) ()+runRepl' = do+  cmd <- getUserCommand @p+  runCmd' @p cmd (Just (runRepl' @p))+ runRepl :: forall p. (PersistentBackend p) => [ToolProxy] -> [CustomInstructionProxy] -> Text -> API.CreateChatCompletionRequest -> Contents -> IO () runRepl tools customs sessionName defaultReq contents = do   runInputT@@ -192,3 +302,4 @@         }     )     (runPrompt @p tools customs sessionName defaultReq (push @p contents >> runRepl' @p))+
src/IntelliMonad/Tools.hs view
@@ -19,6 +19,7 @@  module IntelliMonad.Tools   ( module IntelliMonad.Tools.Utils,+    module IntelliMonad.Tools.Arxiv,     module IntelliMonad.Tools.Bash,     module IntelliMonad.Tools.TextToSpeech,     module IntelliMonad.Tools.DallE3,@@ -27,15 +28,23 @@ where  import Data.Proxy+import IntelliMonad.Tools.Arxiv import IntelliMonad.Tools.Bash import IntelliMonad.Tools.DallE3 import IntelliMonad.Tools.TextToSpeech import IntelliMonad.Tools.Utils import IntelliMonad.Types +arxiv = ToolProxy (Proxy :: Proxy Arxiv)++bash = ToolProxy (Proxy :: Proxy Bash)++textToSpeech = ToolProxy (Proxy :: Proxy TextToSpeech)++dallE3 = ToolProxy (Proxy :: Proxy DallE3)+ defaultTools :: [ToolProxy] defaultTools =-  [ ToolProxy (Proxy :: Proxy Bash),-    ToolProxy (Proxy :: Proxy TextToSpeech),-    ToolProxy (Proxy :: Proxy DallE3)+  [ bash+  , arxiv   ]
+ src/IntelliMonad/Tools/Arxiv.hs view
@@ -0,0 +1,138 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module IntelliMonad.Tools.Arxiv where++import qualified Codec.Picture as P+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 Data.Coerce+import Data.Kind (Type)+import qualified Data.Map as M+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 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 Network.HTTP.Client+import Network.HTTP.Client.TLS+import Network.HTTP.Simple (setRequestQueryString)+-- import Network.HTTP.Conduit+import IntelliMonad.Types+import Text.XML+import Text.XML.Cursor (Cursor, attributeIs, content, element, fromDocument, ($//), (&/), (&//), Axis, checkName)+import Control.Exception (SomeException, catch)+import Data.Maybe (mapMaybe, fromMaybe)++data Arxiv = Arxiv+  { searchQuery :: Text+  , maxResults :: Maybe Int+  , start :: Maybe Int+  }+  deriving (Eq, Show, Generic, JSONSchema, A.FromJSON, A.ToJSON)++instance HasFunctionObject Arxiv where+  getFunctionName = "search_arxiv"+  getFunctionDescription = "Search Arxiv with a keyword"+  getFieldDescription "searchQuery" = "The keyword to search for on Arxiv: This keyword is used as a input of 'http://export.arxiv.org/api/query?search_query='. "+  getFieldDescription "maxResults" = "The maximum number of results to return. If not specified, the default is 10."+  getFieldDescription "start" = "The start index of the results. If not specified, the default is 0."++arxivSearch :: Arxiv -> IO ByteString+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"+  response <- httpLbs request manager+  return $ toStrict $ responseBody response++element' :: Text -> Axis+element' name = checkName (\n ->  nameLocalName n == name)++queryArxiv :: Arxiv -> IO [ArxivEntry]+queryArxiv keyword = do+  jsonSource <- arxivSearch keyword :: IO ByteString+  return $ parseArxivXML jsonSource++data ArxivEntry = ArxivEntry+  { 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++-- | Parser for an Arxiv Entry in XML+parseEntry :: Cursor -> Maybe ArxivEntry+parseEntry c =+  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++-- | Parser for an Arxiv Result in XML+parseArxivResult :: Cursor -> [ArxivEntry]+parseArxivResult c = mapMaybe parseEntry (c $// element' "entry")++parseArxivXML :: ByteString -> [ArxivEntry]+parseArxivXML xml =+  case parseText def (TL.fromStrict $ T.decodeUtf8 xml) of+    Left _ -> []+    Right v -> parseArxivResult $ fromDocument v++instance Tool Arxiv where+  data Output Arxiv = ArxivOutput+    { papers :: [ArxivEntry]+    }+    deriving (Eq, Show, Generic, A.FromJSON, A.ToJSON)++  toolExec args = do+    papers <- queryArxiv args+    return $ ArxivOutput papers
src/IntelliMonad/Types.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-}@@ -182,6 +183,9 @@     deriving Show     deriving Eq     deriving Ord+    deriving ToJSON+    deriving FromJSON+    deriving Generic Context     request API.CreateChatCompletionRequest     response API.CreateChatCompletionResponse Maybe@@ -354,6 +358,9 @@ instance JSONSchema Integer where   schema = Integer' +instance JSONSchema Int where+  schema = Integer'+ instance JSONSchema Double where   schema = Number' @@ -404,3 +411,36 @@  defaultUTCTime :: UTCTime defaultUTCTime = UTCTime (coerce (0 :: Integer)) 0++data ReplCommand+  = Quit+  | Clear+  | ShowContents+  | ShowUsage+  | ShowRequest+  | ShowContext+  | ShowSession+  | Edit+  | EditRequest+  | EditContents+  | EditHeader+  | EditFooter+  | ListSessions+  | CopySession+  { sessionNameFrom :: Text+  , sessionNameTo :: Text+  }+  | DeleteSession+  { sessionName :: Text+  }+  | SwitchSession+  { sessionName :: Text+  }+  | ReadImage Text+  | UserInput Text+  | Help+  | Repl +  { sessionName :: Text+  }+  deriving (Eq, Show)+