{-# 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.Repl 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.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 qualified OpenAI.Types as API
import System.Console.Haskeline
import Text.Megaparsec
import Text.Megaparsec.Char
import Text.Megaparsec.Char.Lexer as L

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 (ReplCommand -> ReplCommand -> Bool
(ReplCommand -> ReplCommand -> Bool)
-> (ReplCommand -> ReplCommand -> Bool) -> Eq ReplCommand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReplCommand -> ReplCommand -> Bool
== :: ReplCommand -> ReplCommand -> Bool
$c/= :: ReplCommand -> ReplCommand -> Bool
/= :: ReplCommand -> ReplCommand -> Bool
Eq, Int -> ReplCommand -> ShowS
[ReplCommand] -> ShowS
ReplCommand -> String
(Int -> ReplCommand -> ShowS)
-> (ReplCommand -> String)
-> ([ReplCommand] -> ShowS)
-> Show ReplCommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReplCommand -> ShowS
showsPrec :: Int -> ReplCommand -> ShowS
$cshow :: ReplCommand -> String
show :: ReplCommand -> String
$cshowList :: [ReplCommand] -> ShowS
showList :: [ReplCommand] -> ShowS
Show)

parseRepl :: Parser ReplCommand
parseRepl :: Parser ReplCommand
parseRepl =
  (ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexm (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
":quit")) ParsecT Void Text Identity (Tokens Text)
-> Parser ReplCommand -> Parser ReplCommand
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReplCommand -> Parser ReplCommand
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReplCommand
Quit)
    Parser ReplCommand -> Parser ReplCommand -> Parser ReplCommand
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexm (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
":clear")) ParsecT Void Text Identity (Tokens Text)
-> Parser ReplCommand -> Parser ReplCommand
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReplCommand -> Parser ReplCommand
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReplCommand
Clear)
    Parser ReplCommand -> Parser ReplCommand -> Parser ReplCommand
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexm (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
":show") ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexm (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"contents")) ParsecT Void Text Identity (Tokens Text)
-> Parser ReplCommand -> Parser ReplCommand
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReplCommand -> Parser ReplCommand
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReplCommand
ShowContents)
    Parser ReplCommand -> Parser ReplCommand -> Parser ReplCommand
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexm (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
":show") ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexm (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"usage")) ParsecT Void Text Identity (Tokens Text)
-> Parser ReplCommand -> Parser ReplCommand
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReplCommand -> Parser ReplCommand
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReplCommand
ShowUsage)
    Parser ReplCommand -> Parser ReplCommand -> Parser ReplCommand
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexm (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
":show") ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexm (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"request")) ParsecT Void Text Identity (Tokens Text)
-> Parser ReplCommand -> Parser ReplCommand
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReplCommand -> Parser ReplCommand
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReplCommand
ShowRequest)
    Parser ReplCommand -> Parser ReplCommand -> Parser ReplCommand
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexm (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
":show") ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexm (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"context")) ParsecT Void Text Identity (Tokens Text)
-> Parser ReplCommand -> Parser ReplCommand
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReplCommand -> Parser ReplCommand
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReplCommand
ShowContext)
    Parser ReplCommand -> Parser ReplCommand -> Parser ReplCommand
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexm (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
":show") ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexm (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"session")) ParsecT Void Text Identity (Tokens Text)
-> Parser ReplCommand -> Parser ReplCommand
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReplCommand -> Parser ReplCommand
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReplCommand
ShowSession)
    Parser ReplCommand -> Parser ReplCommand -> Parser ReplCommand
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexm (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
":read") ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexm (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"image") ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexm ParsecT Void Text Identity String
imagePath) ParsecT Void Text Identity String
-> (String -> Parser ReplCommand) -> Parser ReplCommand
forall a b.
ParsecT Void Text Identity a
-> (a -> ParsecT Void Text Identity b)
-> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ReplCommand -> Parser ReplCommand
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReplCommand -> Parser ReplCommand)
-> (String -> ReplCommand) -> String -> Parser ReplCommand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ReplCommand
ReadImage (Text -> ReplCommand) -> (String -> Text) -> String -> ReplCommand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack)
    Parser ReplCommand -> Parser ReplCommand -> Parser ReplCommand
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexm (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
":list") ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexm (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"sessions")) ParsecT Void Text Identity (Tokens Text)
-> Parser ReplCommand -> Parser ReplCommand
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReplCommand -> Parser ReplCommand
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReplCommand
ListSessions)
    Parser ReplCommand -> Parser ReplCommand -> Parser ReplCommand
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexm (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
":list")) ParsecT Void Text Identity (Tokens Text)
-> Parser ReplCommand -> Parser ReplCommand
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReplCommand -> Parser ReplCommand
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReplCommand
ListSessions)
    Parser ReplCommand -> Parser ReplCommand -> Parser ReplCommand
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ( ParsecT Void Text Identity (Text, Text)
-> ParsecT Void Text Identity (Text, Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try
            ( ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexm (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
":copy") ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexm (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"session") ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Text, Text)
-> ParsecT Void Text Identity (Text, Text)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> do
                Text
from <- String -> Text
T.pack (String -> Text)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexm ParsecT Void Text Identity String
sessionName
                Text
to <- String -> Text
T.pack (String -> Text)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexm ParsecT Void Text Identity String
sessionName
                (Text, Text) -> ParsecT Void Text Identity (Text, Text)
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
from, Text
to)
            )
            ParsecT Void Text Identity (Text, Text)
-> ((Text, Text) -> Parser ReplCommand) -> Parser ReplCommand
forall a b.
ParsecT Void Text Identity a
-> (a -> ParsecT Void Text Identity b)
-> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ReplCommand -> Parser ReplCommand
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReplCommand -> Parser ReplCommand)
-> ((Text, Text) -> ReplCommand)
-> (Text, Text)
-> Parser ReplCommand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> ReplCommand
CopySession
        )
    Parser ReplCommand -> Parser ReplCommand -> Parser ReplCommand
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexm (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
":delete") ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexm (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"session") ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexm ParsecT Void Text Identity String
sessionName) ParsecT Void Text Identity String
-> (String -> Parser ReplCommand) -> Parser ReplCommand
forall a b.
ParsecT Void Text Identity a
-> (a -> ParsecT Void Text Identity b)
-> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ReplCommand -> Parser ReplCommand
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReplCommand -> Parser ReplCommand)
-> (String -> ReplCommand) -> String -> Parser ReplCommand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ReplCommand
DeleteSession (Text -> ReplCommand) -> (String -> Text) -> String -> ReplCommand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack)
    Parser ReplCommand -> Parser ReplCommand -> Parser ReplCommand
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexm (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
":switch") ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexm (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"session") ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexm ParsecT Void Text Identity String
sessionName) ParsecT Void Text Identity String
-> (String -> Parser ReplCommand) -> Parser ReplCommand
forall a b.
ParsecT Void Text Identity a
-> (a -> ParsecT Void Text Identity b)
-> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ReplCommand -> Parser ReplCommand
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReplCommand -> Parser ReplCommand)
-> (String -> ReplCommand) -> String -> Parser ReplCommand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ReplCommand
SwitchSession (Text -> ReplCommand) -> (String -> Text) -> String -> ReplCommand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack)
    Parser ReplCommand -> Parser ReplCommand -> Parser ReplCommand
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexm (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
":help")) ParsecT Void Text Identity (Tokens Text)
-> Parser ReplCommand -> Parser ReplCommand
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReplCommand -> Parser ReplCommand
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReplCommand
Help)
  where
    sc :: ParsecT Void Text Identity ()
sc = ParsecT Void Text Identity ()
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
L.space ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space1 ParsecT Void Text Identity ()
forall a. ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a
empty ParsecT Void Text Identity ()
forall a. ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a
empty
    lexm :: ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexm = ParsecT Void Text Identity ()
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
lexeme ParsecT Void Text Identity ()
sc
    sessionName :: ParsecT Void Text Identity String
sessionName = ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void Text Identity Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar
    imagePath :: ParsecT Void Text Identity String
imagePath = ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT Void Text Identity Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'.' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'/' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'-')

getTextInputLine :: (MonadTrans t) => t (InputT IO) (Maybe T.Text)
getTextInputLine :: forall (t :: (* -> *) -> * -> *).
MonadTrans t =>
t (InputT IO) (Maybe Text)
getTextInputLine = (Maybe String -> Maybe Text)
-> t (InputT IO) (Maybe String) -> t (InputT IO) (Maybe Text)
forall a b. (a -> b) -> t (InputT IO) a -> t (InputT IO) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> Text) -> Maybe String -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack) (InputT IO (Maybe String) -> t (InputT IO) (Maybe String)
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (InputT IO (Maybe String) -> t (InputT IO) (Maybe String))
-> InputT IO (Maybe String) -> t (InputT IO) (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> InputT IO (Maybe String)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m (Maybe String)
getInputLine String
"% ")

getUserCommand :: forall p t. (PersistentBackend p, MonadTrans t) => t (InputT IO) (Either (ParseErrorBundle Text Void) ReplCommand)
getUserCommand :: forall p (t :: (* -> *) -> * -> *).
(PersistentBackend p, MonadTrans t) =>
t (InputT IO) (Either (ParseErrorBundle Text Void) ReplCommand)
getUserCommand = do
  Maybe Text
minput <- t (InputT IO) (Maybe Text)
forall (t :: (* -> *) -> * -> *).
MonadTrans t =>
t (InputT IO) (Maybe Text)
getTextInputLine
  case Maybe Text
minput of
    Maybe Text
Nothing -> Either (ParseErrorBundle Text Void) ReplCommand
-> t (InputT IO) (Either (ParseErrorBundle Text Void) ReplCommand)
forall a. a -> t (InputT IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (ParseErrorBundle Text Void) ReplCommand
 -> t (InputT IO) (Either (ParseErrorBundle Text Void) ReplCommand))
-> Either (ParseErrorBundle Text Void) ReplCommand
-> t (InputT IO) (Either (ParseErrorBundle Text Void) ReplCommand)
forall a b. (a -> b) -> a -> b
$ ReplCommand -> Either (ParseErrorBundle Text Void) ReplCommand
forall a b. b -> Either a b
Right ReplCommand
Quit
    Just Text
input ->
      if Text -> Text -> Bool
T.isPrefixOf Text
":" Text
input
        then case Parser ReplCommand
-> String
-> Text
-> Either (ParseErrorBundle Text Void) ReplCommand
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser Parser ReplCommand
parseRepl String
"stdin" Text
input of
          Right ReplCommand
v -> Either (ParseErrorBundle Text Void) ReplCommand
-> t (InputT IO) (Either (ParseErrorBundle Text Void) ReplCommand)
forall a. a -> t (InputT IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (ParseErrorBundle Text Void) ReplCommand
 -> t (InputT IO) (Either (ParseErrorBundle Text Void) ReplCommand))
-> Either (ParseErrorBundle Text Void) ReplCommand
-> t (InputT IO) (Either (ParseErrorBundle Text Void) ReplCommand)
forall a b. (a -> b) -> a -> b
$ ReplCommand -> Either (ParseErrorBundle Text Void) ReplCommand
forall a b. b -> Either a b
Right ReplCommand
v
          Left ParseErrorBundle Text Void
err -> Either (ParseErrorBundle Text Void) ReplCommand
-> t (InputT IO) (Either (ParseErrorBundle Text Void) ReplCommand)
forall a. a -> t (InputT IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (ParseErrorBundle Text Void) ReplCommand
 -> t (InputT IO) (Either (ParseErrorBundle Text Void) ReplCommand))
-> Either (ParseErrorBundle Text Void) ReplCommand
-> t (InputT IO) (Either (ParseErrorBundle Text Void) ReplCommand)
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text Void
-> Either (ParseErrorBundle Text Void) ReplCommand
forall a b. a -> Either a b
Left ParseErrorBundle Text Void
err
        else Either (ParseErrorBundle Text Void) ReplCommand
-> t (InputT IO) (Either (ParseErrorBundle Text Void) ReplCommand)
forall a. a -> t (InputT IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (ParseErrorBundle Text Void) ReplCommand
 -> t (InputT IO) (Either (ParseErrorBundle Text Void) ReplCommand))
-> Either (ParseErrorBundle Text Void) ReplCommand
-> t (InputT IO) (Either (ParseErrorBundle Text Void) ReplCommand)
forall a b. (a -> b) -> a -> b
$ ReplCommand -> Either (ParseErrorBundle Text Void) ReplCommand
forall a b. b -> Either a b
Right (Text -> ReplCommand
UserInput Text
input)

runRepl' :: forall p. (PersistentBackend p) => Prompt (InputT IO) ()
runRepl' :: forall p. PersistentBackend p => Prompt (InputT IO) ()
runRepl' = do
  forall p (t :: (* -> *) -> * -> *).
(PersistentBackend p, MonadTrans t) =>
t (InputT IO) (Either (ParseErrorBundle Text Void) ReplCommand)
getUserCommand @p StateT
  PromptEnv
  (InputT IO)
  (Either (ParseErrorBundle Text Void) ReplCommand)
-> (Either (ParseErrorBundle Text Void) ReplCommand
    -> Prompt (InputT IO) ())
-> Prompt (InputT IO) ()
forall a b.
StateT PromptEnv (InputT IO) a
-> (a -> StateT PromptEnv (InputT IO) b)
-> StateT PromptEnv (InputT IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left ParseErrorBundle Text Void
err -> do
      IO () -> Prompt (InputT IO) ()
forall a. IO a -> StateT PromptEnv (InputT IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Prompt (InputT IO) ()) -> IO () -> Prompt (InputT IO) ()
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text Void -> IO ()
forall a. Show a => a -> IO ()
print ParseErrorBundle Text Void
err
      forall p. PersistentBackend p => Prompt (InputT IO) ()
runRepl' @p
    Right ReplCommand
Quit -> () -> Prompt (InputT IO) ()
forall a. a -> StateT PromptEnv (InputT IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Right ReplCommand
Clear -> do
      forall p (m :: * -> *).
(MonadIO m, MonadFail m, PersistentBackend p) =>
Prompt m ()
clear @p
      forall p. PersistentBackend p => Prompt (InputT IO) ()
runRepl' @p
    Right ReplCommand
ShowContents -> do
      Context
context <- Prompt (InputT IO) Context
forall (m :: * -> *). (MonadIO m, MonadFail m) => Prompt m Context
getContext
      Contents -> Prompt (InputT IO) ()
forall (m :: * -> *). MonadIO m => Contents -> m ()
showContents Context
context.contextBody
      forall p. PersistentBackend p => Prompt (InputT IO) ()
runRepl' @p
    Right ReplCommand
ShowUsage -> do
      Context
context <- Prompt (InputT IO) Context
forall (m :: * -> *). (MonadIO m, MonadFail m) => Prompt m Context
getContext
      IO () -> Prompt (InputT IO) ()
forall a. IO a -> StateT PromptEnv (InputT IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Prompt (InputT IO) ()) -> IO () -> Prompt (InputT IO) ()
forall a b. (a -> b) -> a -> b
$ do
        Int -> IO ()
forall a. Show a => a -> IO ()
print Context
context.contextTotalTokens
      forall p. PersistentBackend p => Prompt (InputT IO) ()
runRepl' @p
    Right ReplCommand
ShowRequest -> do
      Context
prev <- Prompt (InputT IO) Context
forall (m :: * -> *). (MonadIO m, MonadFail m) => Prompt m Context
getContext
      let req :: CreateChatCompletionRequest
req = CreateChatCompletionRequest
-> Contents -> CreateChatCompletionRequest
forall a.
ChatCompletion a =>
CreateChatCompletionRequest -> a -> CreateChatCompletionRequest
toRequest Context
prev.contextRequest (Context
prev.contextHeader Contents -> Contents -> Contents
forall a. Semigroup a => a -> a -> a
<> Context
prev.contextBody Contents -> Contents -> Contents
forall a. Semigroup a => a -> a -> a
<> Context
prev.contextFooter)
      IO () -> Prompt (InputT IO) ()
forall a. IO a -> StateT PromptEnv (InputT IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Prompt (InputT IO) ()) -> IO () -> Prompt (InputT IO) ()
forall a b. (a -> b) -> a -> b
$ do
        ByteString -> IO ()
BS.putStr (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ CreateChatCompletionRequest -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty CreateChatCompletionRequest
req
        Text -> IO ()
T.putStrLn Text
""
      forall p. PersistentBackend p => Prompt (InputT IO) ()
runRepl' @p
    Right ReplCommand
ShowContext -> do
      Context
prev <- Prompt (InputT IO) Context
forall (m :: * -> *). (MonadIO m, MonadFail m) => Prompt m Context
getContext
      IO () -> Prompt (InputT IO) ()
forall a. IO a -> StateT PromptEnv (InputT IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Prompt (InputT IO) ()) -> IO () -> Prompt (InputT IO) ()
forall a b. (a -> b) -> a -> b
$ do
        String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Context -> String
forall a. Show a => a -> String
show Context
prev
      forall p. PersistentBackend p => Prompt (InputT IO) ()
runRepl' @p
    Right ReplCommand
ShowSession -> do
      Context
prev <- Prompt (InputT IO) Context
forall (m :: * -> *). (MonadIO m, MonadFail m) => Prompt m Context
getContext
      IO () -> Prompt (InputT IO) ()
forall a. IO a -> StateT PromptEnv (InputT IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Prompt (InputT IO) ()) -> IO () -> Prompt (InputT IO) ()
forall a b. (a -> b) -> a -> b
$ do
        Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Context
prev.contextSessionName
      forall p. PersistentBackend p => Prompt (InputT IO) ()
runRepl' @p
    Right ReplCommand
ListSessions -> do
      IO () -> Prompt (InputT IO) ()
forall a. IO a -> StateT PromptEnv (InputT IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Prompt (InputT IO) ()) -> IO () -> Prompt (InputT IO) ()
forall a b. (a -> b) -> a -> b
$ do
        [Text]
list <- forall p (m :: * -> *) a.
(MonadIO m, MonadFail m, PersistentBackend p) =>
(Conn p -> m a) -> m a
withDB @p ((Conn p -> IO [Text]) -> IO [Text])
-> (Conn p -> IO [Text]) -> IO [Text]
forall a b. (a -> b) -> a -> b
$ \Conn p
conn -> forall p (m :: * -> *).
(PersistentBackend p, MonadIO m, MonadFail m) =>
Conn p -> m [Text]
listSessions @p Conn p
conn
        [Text] -> (Text -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Text]
list ((Text -> IO ()) -> IO ()) -> (Text -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Text
sessionName' -> Text -> IO ()
T.putStrLn Text
sessionName'
      forall p. PersistentBackend p => Prompt (InputT IO) ()
runRepl' @p
    Right (CopySession (Text
from', Text
to')) -> do
      IO () -> Prompt (InputT IO) ()
forall a. IO a -> StateT PromptEnv (InputT IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Prompt (InputT IO) ()) -> IO () -> Prompt (InputT IO) ()
forall a b. (a -> b) -> a -> b
$ do
        forall p (m :: * -> *) a.
(MonadIO m, MonadFail m, PersistentBackend p) =>
(Conn p -> m a) -> m a
withDB @p ((Conn p -> IO ()) -> IO ()) -> (Conn p -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Conn p
conn -> do
          Maybe Context
mv <- forall p (m :: * -> *).
(PersistentBackend p, MonadIO m, MonadFail m) =>
Conn p -> Text -> m (Maybe Context)
load @p Conn p
conn Text
from'
          case Maybe Context
mv of
            Just Context
v -> do
              Maybe (Key Context)
_ <- forall p (m :: * -> *).
(PersistentBackend p, MonadIO m, MonadFail m) =>
Conn p -> Context -> m (Maybe (Key Context))
save @p Conn p
conn (Context
v {contextSessionName = to'})
              () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Maybe Context
Nothing -> Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Failed to load " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
from'
      forall p. PersistentBackend p => Prompt (InputT IO) ()
runRepl' @p
    Right (DeleteSession Text
session) -> do
      forall p (m :: * -> *) a.
(MonadIO m, MonadFail m, PersistentBackend p) =>
(Conn p -> m a) -> m a
withDB @p ((Conn p -> Prompt (InputT IO) ()) -> Prompt (InputT IO) ())
-> (Conn p -> Prompt (InputT IO) ()) -> Prompt (InputT IO) ()
forall a b. (a -> b) -> a -> b
$ \Conn p
conn -> forall p (m :: * -> *).
(PersistentBackend p, MonadIO m, MonadFail m) =>
Conn p -> Text -> m ()
deleteSession @p Conn p
conn Text
session
      forall p. PersistentBackend p => Prompt (InputT IO) ()
runRepl' @p
    Right (SwitchSession Text
session) -> do
      Maybe Context
mv <- forall p (m :: * -> *) a.
(MonadIO m, MonadFail m, PersistentBackend p) =>
(Conn p -> m a) -> m a
withDB @p ((Conn p -> StateT PromptEnv (InputT IO) (Maybe Context))
 -> StateT PromptEnv (InputT IO) (Maybe Context))
-> (Conn p -> StateT PromptEnv (InputT IO) (Maybe Context))
-> StateT PromptEnv (InputT IO) (Maybe Context)
forall a b. (a -> b) -> a -> b
$ \Conn p
conn -> forall p (m :: * -> *).
(PersistentBackend p, MonadIO m, MonadFail m) =>
Conn p -> Text -> m (Maybe Context)
load @p Conn p
conn Text
session
      case Maybe Context
mv of
        Just Context
v -> do
          (PromptEnv
env :: PromptEnv) <- StateT PromptEnv (InputT IO) PromptEnv
forall (m :: * -> *) s. Monad m => StateT s m s
get
          PromptEnv -> Prompt (InputT IO) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (PromptEnv -> Prompt (InputT IO) ())
-> PromptEnv -> Prompt (InputT IO) ()
forall a b. (a -> b) -> a -> b
$ PromptEnv
env {context = v}
        Maybe Context
Nothing -> IO () -> Prompt (InputT IO) ()
forall a. IO a -> StateT PromptEnv (InputT IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Prompt (InputT IO) ()) -> IO () -> Prompt (InputT IO) ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Failed to load " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
session
      forall p. PersistentBackend p => Prompt (InputT IO) ()
runRepl' @p
    Right (ReadImage Text
imagePath) -> do
      forall p (m :: * -> *).
(MonadIO m, MonadFail m, PersistentBackend p) =>
Text -> Prompt m Contents
callWithImage @p Text
imagePath Prompt (InputT IO) Contents
-> (Contents -> Prompt (InputT IO) ()) -> Prompt (InputT IO) ()
forall a b.
StateT PromptEnv (InputT IO) a
-> (a -> StateT PromptEnv (InputT IO) b)
-> StateT PromptEnv (InputT IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Contents -> Prompt (InputT IO) ()
forall (m :: * -> *). MonadIO m => Contents -> m ()
showContents
      forall p. PersistentBackend p => Prompt (InputT IO) ()
runRepl' @p
    Right ReplCommand
Help -> do
      IO () -> Prompt (InputT IO) ()
forall a. IO a -> StateT PromptEnv (InputT IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Prompt (InputT IO) ()) -> IO () -> Prompt (InputT IO) ()
forall a b. (a -> b) -> a -> b
$ do
        String -> IO ()
putStrLn String
":quit"
        String -> IO ()
putStrLn String
":clear"
        String -> IO ()
putStrLn String
":show contents"
        String -> IO ()
putStrLn String
":show usage"
        String -> IO ()
putStrLn String
":show request"
        String -> IO ()
putStrLn String
":show context"
        String -> IO ()
putStrLn String
":show session"
        String -> IO ()
putStrLn String
":list sessions"
        String -> IO ()
putStrLn String
":copy session <from> <to>"
        String -> IO ()
putStrLn String
":delete session <session name>"
        String -> IO ()
putStrLn String
":switch session <session name>"
        String -> IO ()
putStrLn String
":help"
      forall p. PersistentBackend p => Prompt (InputT IO) ()
runRepl' @p
    Right (UserInput Text
input) -> do
      forall p (m :: * -> *).
(MonadIO m, MonadFail m, PersistentBackend p) =>
Text -> Prompt m Contents
callWithText @p Text
input Prompt (InputT IO) Contents
-> (Contents -> Prompt (InputT IO) ()) -> Prompt (InputT IO) ()
forall a b.
StateT PromptEnv (InputT IO) a
-> (a -> StateT PromptEnv (InputT IO) b)
-> StateT PromptEnv (InputT IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Contents -> Prompt (InputT IO) ()
forall (m :: * -> *). MonadIO m => Contents -> m ()
showContents
      forall p. PersistentBackend p => Prompt (InputT IO) ()
runRepl' @p

runRepl :: forall p. (PersistentBackend p) => [ToolProxy] -> [CustomInstructionProxy] -> Text -> API.CreateChatCompletionRequest -> Contents -> IO ()
runRepl :: forall p.
PersistentBackend p =>
[ToolProxy]
-> [CustomInstructionProxy]
-> Text
-> CreateChatCompletionRequest
-> Contents
-> IO ()
runRepl [ToolProxy]
tools [CustomInstructionProxy]
customs Text
sessionName CreateChatCompletionRequest
defaultReq Contents
contents = do
  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 (m :: * -> *).
(MonadIO m, MonadFail m, PersistentBackend p) =>
Contents -> Prompt m ()
push @p Contents
contents Prompt (InputT IO) ()
-> Prompt (InputT IO) () -> Prompt (InputT IO) ()
forall a b.
StateT PromptEnv (InputT IO) a
-> StateT PromptEnv (InputT IO) b -> StateT PromptEnv (InputT IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall p. PersistentBackend p => Prompt (InputT IO) ()
runRepl' @p))