{-# 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 :: Parser ReplCommand
opts = 
  Mod CommandFields ReplCommand -> Parser ReplCommand
forall a. Mod CommandFields a -> Parser a
subparser
    ( String -> ParserInfo ReplCommand -> Mod CommandFields ReplCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"repl" (Parser ReplCommand -> InfoMod ReplCommand -> ParserInfo ReplCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Text -> ReplCommand
Repl (Text -> ReplCommand) -> Parser Text -> Parser ReplCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Text -> Mod ArgumentFields Text -> Parser Text
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM Text
forall s. IsString s => ReadM s
str (String -> Mod ArgumentFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"SESSION_NAME")) (String -> InfoMod ReplCommand
forall a. String -> InfoMod a
progDesc String
"Start the repl"))
    Mod CommandFields ReplCommand
-> Mod CommandFields ReplCommand -> Mod CommandFields ReplCommand
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo ReplCommand -> Mod CommandFields ReplCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"clear" (Parser ReplCommand -> InfoMod ReplCommand -> ParserInfo ReplCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (ReplCommand -> Parser ReplCommand
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReplCommand
Clear) (String -> InfoMod ReplCommand
forall a. String -> InfoMod a
progDesc String
"Clear the contents"))
    Mod CommandFields ReplCommand
-> Mod CommandFields ReplCommand -> Mod CommandFields ReplCommand
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo ReplCommand -> Mod CommandFields ReplCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"show-contents" (Parser ReplCommand -> InfoMod ReplCommand -> ParserInfo ReplCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (ReplCommand -> Parser ReplCommand
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReplCommand
ShowContents) (String -> InfoMod ReplCommand
forall a. String -> InfoMod a
progDesc String
"Show the contents"))
    Mod CommandFields ReplCommand
-> Mod CommandFields ReplCommand -> Mod CommandFields ReplCommand
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo ReplCommand -> Mod CommandFields ReplCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"show-usage" (Parser ReplCommand -> InfoMod ReplCommand -> ParserInfo ReplCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (ReplCommand -> Parser ReplCommand
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReplCommand
ShowUsage) (String -> InfoMod ReplCommand
forall a. String -> InfoMod a
progDesc String
"Show the usage"))
    Mod CommandFields ReplCommand
-> Mod CommandFields ReplCommand -> Mod CommandFields ReplCommand
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo ReplCommand -> Mod CommandFields ReplCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"show-request" (Parser ReplCommand -> InfoMod ReplCommand -> ParserInfo ReplCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (ReplCommand -> Parser ReplCommand
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReplCommand
ShowRequest) (String -> InfoMod ReplCommand
forall a. String -> InfoMod a
progDesc String
"Show the request"))
    Mod CommandFields ReplCommand
-> Mod CommandFields ReplCommand -> Mod CommandFields ReplCommand
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo ReplCommand -> Mod CommandFields ReplCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"show-context" (Parser ReplCommand -> InfoMod ReplCommand -> ParserInfo ReplCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (ReplCommand -> Parser ReplCommand
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReplCommand
ShowContext) (String -> InfoMod ReplCommand
forall a. String -> InfoMod a
progDesc String
"Show the context"))
    Mod CommandFields ReplCommand
-> Mod CommandFields ReplCommand -> Mod CommandFields ReplCommand
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo ReplCommand -> Mod CommandFields ReplCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"show-session" (Parser ReplCommand -> InfoMod ReplCommand -> ParserInfo ReplCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (ReplCommand -> Parser ReplCommand
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReplCommand
ShowSession) (String -> InfoMod ReplCommand
forall a. String -> InfoMod a
progDesc String
"Show the session"))
    Mod CommandFields ReplCommand
-> Mod CommandFields ReplCommand -> Mod CommandFields ReplCommand
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo ReplCommand -> Mod CommandFields ReplCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"edit" (Parser ReplCommand -> InfoMod ReplCommand -> ParserInfo ReplCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (ReplCommand -> Parser ReplCommand
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReplCommand
Edit) (String -> InfoMod ReplCommand
forall a. String -> InfoMod a
progDesc String
"Edit the contents"))
    Mod CommandFields ReplCommand
-> Mod CommandFields ReplCommand -> Mod CommandFields ReplCommand
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo ReplCommand -> Mod CommandFields ReplCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"edit-request" (Parser ReplCommand -> InfoMod ReplCommand -> ParserInfo ReplCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (ReplCommand -> Parser ReplCommand
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReplCommand
EditRequest) (String -> InfoMod ReplCommand
forall a. String -> InfoMod a
progDesc String
"Edit the config of the current session"))
    Mod CommandFields ReplCommand
-> Mod CommandFields ReplCommand -> Mod CommandFields ReplCommand
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo ReplCommand -> Mod CommandFields ReplCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"edit-contents" (Parser ReplCommand -> InfoMod ReplCommand -> ParserInfo ReplCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (ReplCommand -> Parser ReplCommand
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReplCommand
EditContents) (String -> InfoMod ReplCommand
forall a. String -> InfoMod a
progDesc String
"Edit the contents of the current session"))
    Mod CommandFields ReplCommand
-> Mod CommandFields ReplCommand -> Mod CommandFields ReplCommand
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo ReplCommand -> Mod CommandFields ReplCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"edit-header" (Parser ReplCommand -> InfoMod ReplCommand -> ParserInfo ReplCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (ReplCommand -> Parser ReplCommand
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReplCommand
EditHeader) (String -> InfoMod ReplCommand
forall a. String -> InfoMod a
progDesc String
"Edit the header of the current session"))
    Mod CommandFields ReplCommand
-> Mod CommandFields ReplCommand -> Mod CommandFields ReplCommand
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo ReplCommand -> Mod CommandFields ReplCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"edit-footer" (Parser ReplCommand -> InfoMod ReplCommand -> ParserInfo ReplCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (ReplCommand -> Parser ReplCommand
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReplCommand
EditFooter) (String -> InfoMod ReplCommand
forall a. String -> InfoMod a
progDesc String
"Edit the footer of the current session"))
    Mod CommandFields ReplCommand
-> Mod CommandFields ReplCommand -> Mod CommandFields ReplCommand
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo ReplCommand -> Mod CommandFields ReplCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"list-sessions" (Parser ReplCommand -> InfoMod ReplCommand -> ParserInfo ReplCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (ReplCommand -> Parser ReplCommand
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReplCommand
ListSessions) (String -> InfoMod ReplCommand
forall a. String -> InfoMod a
progDesc String
"List all sessions"))
    Mod CommandFields ReplCommand
-> Mod CommandFields ReplCommand -> Mod CommandFields ReplCommand
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo ReplCommand -> Mod CommandFields ReplCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"copy-session" (Parser ReplCommand -> InfoMod ReplCommand -> ParserInfo ReplCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Text -> Text -> ReplCommand
CopySession (Text -> Text -> ReplCommand)
-> Parser Text -> Parser (Text -> ReplCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Text -> Mod ArgumentFields Text -> Parser Text
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM Text
forall s. IsString s => ReadM s
str (String -> Mod ArgumentFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FROM") Parser (Text -> ReplCommand) -> Parser Text -> Parser ReplCommand
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM Text -> Mod ArgumentFields Text -> Parser Text
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM Text
forall s. IsString s => ReadM s
str (String -> Mod ArgumentFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"TO")) (String -> InfoMod ReplCommand
forall a. String -> InfoMod a
progDesc String
"Copy the session"))
    Mod CommandFields ReplCommand
-> Mod CommandFields ReplCommand -> Mod CommandFields ReplCommand
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo ReplCommand -> Mod CommandFields ReplCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"delete-session" (Parser ReplCommand -> InfoMod ReplCommand -> ParserInfo ReplCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Text -> ReplCommand
DeleteSession (Text -> ReplCommand) -> Parser Text -> Parser ReplCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Text -> Mod ArgumentFields Text -> Parser Text
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM Text
forall s. IsString s => ReadM s
str (String -> Mod ArgumentFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"SESSION_NAME")) (String -> InfoMod ReplCommand
forall a. String -> InfoMod a
progDesc String
"Delete the session"))
    Mod CommandFields ReplCommand
-> Mod CommandFields ReplCommand -> Mod CommandFields ReplCommand
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo ReplCommand -> Mod CommandFields ReplCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"switch-session" (Parser ReplCommand -> InfoMod ReplCommand -> ParserInfo ReplCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Text -> ReplCommand
SwitchSession (Text -> ReplCommand) -> Parser Text -> Parser ReplCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Text -> Mod ArgumentFields Text -> Parser Text
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM Text
forall s. IsString s => ReadM s
str (String -> Mod ArgumentFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"SESSION_NAME")) (String -> InfoMod ReplCommand
forall a. String -> InfoMod a
progDesc String
"Switch the session"))
    Mod CommandFields ReplCommand
-> Mod CommandFields ReplCommand -> Mod CommandFields ReplCommand
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo ReplCommand -> Mod CommandFields ReplCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"read-image" (Parser ReplCommand -> InfoMod ReplCommand -> ParserInfo ReplCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Text -> ReplCommand
ReadImage (Text -> ReplCommand) -> Parser Text -> Parser ReplCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Text -> Mod ArgumentFields Text -> Parser Text
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM Text
forall s. IsString s => ReadM s
str (String -> Mod ArgumentFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"IMAGE_PATH")) (String -> InfoMod ReplCommand
forall a. String -> InfoMod a
progDesc String
"Read the image and call a prompt"))
    Mod CommandFields ReplCommand
-> Mod CommandFields ReplCommand -> Mod CommandFields ReplCommand
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo ReplCommand -> Mod CommandFields ReplCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"read-input" (Parser ReplCommand -> InfoMod ReplCommand -> ParserInfo ReplCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Text -> ReplCommand
UserInput (Text -> ReplCommand) -> Parser Text -> Parser ReplCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Text -> Mod ArgumentFields Text -> Parser Text
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM Text
forall s. IsString s => ReadM s
str (String -> Mod ArgumentFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"USER_INPUT")) (String -> InfoMod ReplCommand
forall a. String -> InfoMod a
progDesc String
"User input as a text and call a prompt"))
    Mod CommandFields ReplCommand
-> Mod CommandFields ReplCommand -> Mod CommandFields ReplCommand
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo ReplCommand -> Mod CommandFields ReplCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"help" (Parser ReplCommand -> InfoMod ReplCommand -> ParserInfo ReplCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (ReplCommand -> Parser ReplCommand
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReplCommand
Help) (String -> InfoMod ReplCommand
forall a. String -> InfoMod a
progDesc String
"Show the help"))
    )

runCmd :: forall p. (PersistentBackend p) => ReplCommand -> IO ()
runCmd :: forall p. PersistentBackend p => ReplCommand -> IO ()
runCmd ReplCommand
cmd = do
    let tools :: [ToolProxy]
tools = [ToolProxy]
defaultTools
        customs :: [CustomInstructionProxy]
customs = []
        sessionName :: Text
sessionName = Text
"default"
        defaultReq :: CreateChatCompletionRequest
defaultReq = CreateChatCompletionRequest
defaultRequest
            { API.createChatCompletionRequestModel = API.CreateChatCompletionRequestModel "gpt-4"
            }
    Settings IO -> InputT IO () -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Settings m -> InputT m a -> m a
runInputT
        ( Settings
            { complete :: CompletionFunc IO
complete = CompletionFunc IO
forall (m :: * -> *). MonadIO m => CompletionFunc m
completeFilename,
                historyFile :: Maybe String
historyFile = String -> Maybe String
forall a. a -> Maybe a
Just String
"intelli-monad.history",
                autoAddHistory :: Bool
autoAddHistory = Bool
True
            }
        )
        (forall p (m :: * -> *) a.
(MonadIO m, MonadFail m, PersistentBackend p) =>
[ToolProxy]
-> [CustomInstructionProxy]
-> Text
-> CreateChatCompletionRequest
-> Prompt m a
-> m a
runPrompt @p [ToolProxy]
tools [CustomInstructionProxy]
customs Text
sessionName CreateChatCompletionRequest
defaultReq (forall p.
PersistentBackend p =>
Either (ParseErrorBundle Text Void) ReplCommand
-> Maybe (Prompt (InputT IO) ()) -> Prompt (InputT IO) ()
runCmd' @p (ReplCommand -> Either (ParseErrorBundle Text Void) ReplCommand
forall a b. b -> Either a b
Right ReplCommand
cmd) Maybe (Prompt (InputT IO) ())
forall a. Maybe a
Nothing))


main :: IO ()
main :: IO ()
main = do
  Text
model <- do
    String -> IO (Maybe String)
lookupEnv String
"OPENAI_MODEL" IO (Maybe String) -> (Maybe String -> IO Text) -> IO Text
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just String
model -> Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
model
      --      Nothing -> return "gpt-4-vision-preview"
      Maybe String
Nothing -> Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"gpt-4"
  ReplCommand
cmd <- ParserPrefs -> ParserInfo ReplCommand -> IO ReplCommand
forall a. ParserPrefs -> ParserInfo a -> IO a
customExecParser (PrefsMod -> ParserPrefs
prefs PrefsMod
showHelpOnEmpty) (Parser ReplCommand -> InfoMod ReplCommand -> ParserInfo ReplCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (ReplCommand -> ReplCommand)
forall a. Parser (a -> a)
helper Parser (ReplCommand -> ReplCommand)
-> Parser ReplCommand -> Parser ReplCommand
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ReplCommand
opts) (InfoMod ReplCommand
forall a. InfoMod a
fullDesc InfoMod ReplCommand -> InfoMod ReplCommand -> InfoMod ReplCommand
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod ReplCommand
forall a. String -> InfoMod a
progDesc String
"intelli-monad"))
  forall p. PersistentBackend p => ReplCommand -> IO ()
runCmd @SqliteConf ReplCommand
cmd