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 +6/−1
- app/repl.hs +3/−27
- intelli-monad.cabal +8/−1
- src/IntelliMonad/Cmd.hs +101/−0
- src/IntelliMonad/Repl.hs +147/−36
- src/IntelliMonad/Tools.hs +12/−3
- src/IntelliMonad/Tools/Arxiv.hs +138/−0
- src/IntelliMonad/Types.hs +40/−0
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)+