{-# 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))