diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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. diff --git a/app/repl.hs b/app/repl.hs --- a/app/repl.hs +++ b/app/repl.hs @@ -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 + diff --git a/intelli-monad.cabal b/intelli-monad.cabal --- a/intelli-monad.cabal +++ b/intelli-monad.cabal @@ -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 diff --git a/src/IntelliMonad/Cmd.hs b/src/IntelliMonad/Cmd.hs new file mode 100644 --- /dev/null +++ b/src/IntelliMonad/Cmd.hs @@ -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 + + diff --git a/src/IntelliMonad/Repl.hs b/src/IntelliMonad/Repl.hs --- a/src/IntelliMonad/Repl.hs +++ b/src/IntelliMonad/Repl.hs @@ -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 " putStrLn ":switch session " 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)) + diff --git a/src/IntelliMonad/Tools.hs b/src/IntelliMonad/Tools.hs --- a/src/IntelliMonad/Tools.hs +++ b/src/IntelliMonad/Tools.hs @@ -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 ] diff --git a/src/IntelliMonad/Tools/Arxiv.hs b/src/IntelliMonad/Tools/Arxiv.hs new file mode 100644 --- /dev/null +++ b/src/IntelliMonad/Tools/Arxiv.hs @@ -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 diff --git a/src/IntelliMonad/Types.hs b/src/IntelliMonad/Types.hs --- a/src/IntelliMonad/Types.hs +++ b/src/IntelliMonad/Types.hs @@ -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) +