{-# 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 qualified Data.Aeson as A
import Data.Aeson.Encode.Pretty (encodePretty)
import qualified Data.Yaml as Y
import qualified Data.Yaml.Pretty as Y
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 GHC.IO.Exception
import IntelliMonad.Persist
import IntelliMonad.Prompt hiding (user, system, assistant)
import IntelliMonad.Types
import qualified OpenAI.Types as API
import System.Console.Haskeline
import System.Environment (lookupEnv)
import System.IO (hClose)
import System.IO.Temp
import System.Process
import Text.Megaparsec
import Text.Megaparsec.Char
import Text.Megaparsec.Char.Lexer as L

type Parser = Parsec Void Text

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 [Char]
-> ParsecT Void Text Identity [Char]
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 [Char]
-> ParsecT Void Text Identity [Char]
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 [Char]
-> ParsecT Void Text Identity [Char]
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexm ParsecT Void Text Identity [Char]
imagePath) ParsecT Void Text Identity [Char]
-> ([Char] -> 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)
-> ([Char] -> ReplCommand) -> [Char] -> Parser ReplCommand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ReplCommand
ReadImage (Text -> ReplCommand) -> ([Char] -> Text) -> [Char] -> ReplCommand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> 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
<|> ( Parser ReplCommand -> Parser ReplCommand
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)
-> 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
>> do
                Text
from <- [Char] -> Text
T.pack ([Char] -> Text)
-> ParsecT Void Text Identity [Char]
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [Char]
-> ParsecT Void Text Identity [Char]
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexm ParsecT Void Text Identity [Char]
sessionName
                Text
to <- [Char] -> Text
T.pack ([Char] -> Text)
-> ParsecT Void Text Identity [Char]
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [Char]
-> ParsecT Void Text Identity [Char]
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexm ParsecT Void Text Identity [Char]
sessionName
                ReplCommand -> Parser ReplCommand
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ReplCommand -> Parser ReplCommand)
-> ReplCommand -> Parser ReplCommand
forall a b. (a -> b) -> a -> b
$ Text -> Text -> ReplCommand
CopySession Text
from Text
to
            )
        )
    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 [Char]
-> ParsecT Void Text Identity [Char]
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 [Char]
-> ParsecT Void Text Identity [Char]
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 [Char]
-> ParsecT Void Text Identity [Char]
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexm ParsecT Void Text Identity [Char]
sessionName) ParsecT Void Text Identity [Char]
-> ([Char] -> 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)
-> ([Char] -> ReplCommand) -> [Char] -> Parser ReplCommand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ReplCommand
DeleteSession (Text -> ReplCommand) -> ([Char] -> Text) -> [Char] -> ReplCommand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> 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 [Char]
-> ParsecT Void Text Identity [Char]
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 [Char]
-> ParsecT Void Text Identity [Char]
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 [Char]
-> ParsecT Void Text Identity [Char]
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
lexm ParsecT Void Text Identity [Char]
sessionName) ParsecT Void Text Identity [Char]
-> ([Char] -> 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)
-> ([Char] -> ReplCommand) -> [Char] -> Parser ReplCommand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ReplCommand
SwitchSession (Text -> ReplCommand) -> ([Char] -> Text) -> [Char] -> ReplCommand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> 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)
    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
":edit") 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
EditRequest)
    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
":edit") 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
EditContents)
    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
":edit") 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
"header")) 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
EditHeader)
    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
":edit") 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
"footer")) 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
EditFooter)
    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
":edit")) 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
Edit)
  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 [Char]
sessionName = ParsecT Void Text Identity Char
-> ParsecT Void Text Identity [Char]
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 [Char]
imagePath = ParsecT Void Text Identity Char
-> ParsecT Void Text Identity [Char]
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 [Char] -> Maybe Text)
-> t (InputT IO) (Maybe [Char]) -> 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 (([Char] -> Text) -> Maybe [Char] -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> Text
T.pack) (InputT IO (Maybe [Char]) -> t (InputT IO) (Maybe [Char])
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 [Char]) -> t (InputT IO) (Maybe [Char]))
-> InputT IO (Maybe [Char]) -> t (InputT IO) (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> InputT IO (Maybe [Char])
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
[Char] -> InputT m (Maybe [Char])
getInputLine [Char]
"% ")

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
-> [Char]
-> Text
-> Either (ParseErrorBundle Text Void) ReplCommand
forall e s a.
Parsec e s a -> [Char] -> s -> Either (ParseErrorBundle s e) a
runParser Parser ReplCommand
parseRepl [Char]
"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)

editWithEditor :: forall m. (MonadIO m, MonadFail m) => m (Maybe T.Text)
editWithEditor :: forall (m :: * -> *). (MonadIO m, MonadFail m) => m (Maybe Text)
editWithEditor = do
  IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ [Char] -> ([Char] -> Handle -> IO (Maybe Text)) -> IO (Maybe Text)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
[Char] -> ([Char] -> Handle -> m a) -> m a
withSystemTempFile [Char]
"tempfile.txt" (([Char] -> Handle -> IO (Maybe Text)) -> IO (Maybe Text))
-> ([Char] -> Handle -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \[Char]
filePath Handle
fileHandle -> do
    Handle -> IO ()
hClose Handle
fileHandle
    [Char]
editor <- do
      [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"EDITOR" IO (Maybe [Char]) -> (Maybe [Char] -> IO [Char]) -> IO [Char]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just [Char]
editor' -> [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
editor'
        Maybe [Char]
Nothing -> [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
"vim"
    ExitCode
code <- [Char] -> IO ExitCode
system ([Char]
editor [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
filePath)
    case ExitCode
code of
      ExitCode
ExitSuccess -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> IO Text -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO Text
T.readFile [Char]
filePath
      ExitFailure Int
_ -> Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing

editRequestWithEditor :: forall m. (MonadIO m, MonadFail m) => API.CreateChatCompletionRequest -> m (Maybe API.CreateChatCompletionRequest)
editRequestWithEditor :: forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
CreateChatCompletionRequest
-> m (Maybe CreateChatCompletionRequest)
editRequestWithEditor CreateChatCompletionRequest
req = do
  IO (Maybe CreateChatCompletionRequest)
-> m (Maybe CreateChatCompletionRequest)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe CreateChatCompletionRequest)
 -> m (Maybe CreateChatCompletionRequest))
-> IO (Maybe CreateChatCompletionRequest)
-> m (Maybe CreateChatCompletionRequest)
forall a b. (a -> b) -> a -> b
$ [Char]
-> ([Char] -> Handle -> IO (Maybe CreateChatCompletionRequest))
-> IO (Maybe CreateChatCompletionRequest)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
[Char] -> ([Char] -> Handle -> m a) -> m a
withSystemTempFile [Char]
"tempfile.yaml" (([Char] -> Handle -> IO (Maybe CreateChatCompletionRequest))
 -> IO (Maybe CreateChatCompletionRequest))
-> ([Char] -> Handle -> IO (Maybe CreateChatCompletionRequest))
-> IO (Maybe CreateChatCompletionRequest)
forall a b. (a -> b) -> a -> b
$ \[Char]
filePath Handle
fileHandle -> do
    Handle -> IO ()
hClose Handle
fileHandle
    [Char] -> ByteString -> IO ()
BS.writeFile [Char]
filePath (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Config -> CreateChatCompletionRequest -> ByteString
forall a. ToJSON a => Config -> a -> ByteString
Y.encodePretty Config
Y.defConfig CreateChatCompletionRequest
req
    [Char]
editor <- do
      [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"EDITOR" IO (Maybe [Char]) -> (Maybe [Char] -> IO [Char]) -> IO [Char]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just [Char]
editor' -> [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
editor'
        Maybe [Char]
Nothing -> [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
"vim"
    ExitCode
code <- [Char] -> IO ExitCode
system ([Char]
editor [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
filePath)
    case ExitCode
code of
      ExitCode
ExitSuccess -> do
        Either ParseException CreateChatCompletionRequest
newReq <- forall a. FromJSON a => [Char] -> IO (Either ParseException a)
Y.decodeFileEither @API.CreateChatCompletionRequest [Char]
filePath
        case Either ParseException CreateChatCompletionRequest
newReq of
          Right CreateChatCompletionRequest
newReq' -> Maybe CreateChatCompletionRequest
-> IO (Maybe CreateChatCompletionRequest)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe CreateChatCompletionRequest
 -> IO (Maybe CreateChatCompletionRequest))
-> Maybe CreateChatCompletionRequest
-> IO (Maybe CreateChatCompletionRequest)
forall a b. (a -> b) -> a -> b
$ CreateChatCompletionRequest -> Maybe CreateChatCompletionRequest
forall a. a -> Maybe a
Just CreateChatCompletionRequest
newReq'
          Left ParseException
err -> do
            ParseException -> IO ()
forall a. Show a => a -> IO ()
print ParseException
err
            Maybe CreateChatCompletionRequest
-> IO (Maybe CreateChatCompletionRequest)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CreateChatCompletionRequest
forall a. Maybe a
Nothing
      ExitFailure Int
_ -> Maybe CreateChatCompletionRequest
-> IO (Maybe CreateChatCompletionRequest)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CreateChatCompletionRequest
forall a. Maybe a
Nothing

editContentsWithEditor :: forall m. (MonadIO m, MonadFail m) => Contents -> m (Maybe Contents)
editContentsWithEditor :: forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
Contents -> m (Maybe Contents)
editContentsWithEditor Contents
contents = do
  IO (Maybe Contents) -> m (Maybe Contents)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Contents) -> m (Maybe Contents))
-> IO (Maybe Contents) -> m (Maybe Contents)
forall a b. (a -> b) -> a -> b
$ [Char]
-> ([Char] -> Handle -> IO (Maybe Contents)) -> IO (Maybe Contents)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
[Char] -> ([Char] -> Handle -> m a) -> m a
withSystemTempFile [Char]
"tempfile.yaml" (([Char] -> Handle -> IO (Maybe Contents)) -> IO (Maybe Contents))
-> ([Char] -> Handle -> IO (Maybe Contents)) -> IO (Maybe Contents)
forall a b. (a -> b) -> a -> b
$ \[Char]
filePath Handle
fileHandle -> do
    Handle -> IO ()
hClose Handle
fileHandle
    [Char] -> ByteString -> IO ()
BS.writeFile [Char]
filePath (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Config -> Contents -> ByteString
forall a. ToJSON a => Config -> a -> ByteString
Y.encodePretty Config
Y.defConfig Contents
contents
    [Char]
editor <- do
      [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"EDITOR" IO (Maybe [Char]) -> (Maybe [Char] -> IO [Char]) -> IO [Char]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just [Char]
editor' -> [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
editor'
        Maybe [Char]
Nothing -> [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
"vim"
    ExitCode
code <- [Char] -> IO ExitCode
system ([Char]
editor [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
filePath)
    case ExitCode
code of
      ExitCode
ExitSuccess -> do
        Either ParseException Contents
newContents <- forall a. FromJSON a => [Char] -> IO (Either ParseException a)
Y.decodeFileEither @Contents [Char]
filePath
        case Either ParseException Contents
newContents of
          Right Contents
newContents' -> Maybe Contents -> IO (Maybe Contents)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Contents -> IO (Maybe Contents))
-> Maybe Contents -> IO (Maybe Contents)
forall a b. (a -> b) -> a -> b
$ Contents -> Maybe Contents
forall a. a -> Maybe a
Just Contents
newContents'
          Left ParseException
err -> do
            ParseException -> IO ()
forall a. Show a => a -> IO ()
print ParseException
err
            Maybe Contents -> IO (Maybe Contents)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Contents
forall a. Maybe a
Nothing
      ExitFailure Int
_ -> Maybe Contents -> IO (Maybe Contents)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Contents
forall a. Maybe a
Nothing

runCmd' :: forall p. (PersistentBackend p) => Either (ParseErrorBundle Text Void) ReplCommand -> Maybe (Prompt (InputT IO) ()) -> Prompt (InputT IO) ()
runCmd' :: forall p.
PersistentBackend p =>
Either (ParseErrorBundle Text Void) ReplCommand
-> Maybe (Prompt (InputT IO) ()) -> Prompt (InputT IO) ()
runCmd' Either (ParseErrorBundle Text Void) ReplCommand
cmd Maybe (Prompt (InputT IO) ())
ret = do
  let repl :: Prompt (InputT IO) ()
repl = case Maybe (Prompt (InputT IO) ())
ret of
        Just Prompt (InputT IO) ()
ret' -> Prompt (InputT IO) ()
ret'
        Maybe (Prompt (InputT IO) ())
Nothing -> () -> Prompt (InputT IO) ()
forall a. a -> StateT PromptEnv (InputT IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  case Either (ParseErrorBundle Text Void) ReplCommand
cmd of
    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
      Prompt (InputT IO) ()
repl
    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
      Prompt (InputT IO) ()
repl
    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
      Prompt (InputT IO) ()
repl
    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
      Prompt (InputT IO) ()
repl
    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
""
      Prompt (InputT IO) ()
repl
    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
        [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ Context -> [Char]
forall a. Show a => a -> [Char]
show Context
prev
      Prompt (InputT IO) ()
repl
    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
      Prompt (InputT IO) ()
repl
    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'
      Prompt (InputT IO) ()
repl
    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'
      Prompt (InputT IO) ()
repl
    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
      Prompt (InputT IO) ()
repl
    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
      Prompt (InputT IO) ()
repl
    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
      Prompt (InputT IO) ()
repl
    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
        [Char] -> IO ()
putStrLn [Char]
":quit"
        [Char] -> IO ()
putStrLn [Char]
":clear"
        [Char] -> IO ()
putStrLn [Char]
":show contents"
        [Char] -> IO ()
putStrLn [Char]
":show usage"
        [Char] -> IO ()
putStrLn [Char]
":show request"
        [Char] -> IO ()
putStrLn [Char]
":show context"
        [Char] -> IO ()
putStrLn [Char]
":show session"
        [Char] -> IO ()
putStrLn [Char]
":list sessions"
        [Char] -> IO ()
putStrLn [Char]
":copy session <from> <to>"
        [Char] -> IO ()
putStrLn [Char]
":delete session <session name>"
        [Char] -> IO ()
putStrLn [Char]
":switch session <session name>"
        [Char] -> IO ()
putStrLn [Char]
":help"
      Prompt (InputT IO) ()
repl
    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
      Prompt (InputT IO) ()
repl
    Right ReplCommand
Edit -> do
      -- Open a temporary file with the default editor of the system.
      -- Then send it as user input.
      StateT PromptEnv (InputT IO) (Maybe Text)
forall (m :: * -> *). (MonadIO m, MonadFail m) => m (Maybe Text)
editWithEditor StateT PromptEnv (InputT IO) (Maybe Text)
-> (Maybe Text -> 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
        Just 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
          Prompt (InputT IO) ()
repl
        Maybe Text
Nothing -> 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
$ [Char] -> IO ()
putStrLn [Char]
"Failed to open the editor."
          Prompt (InputT IO) ()
repl
    Right ReplCommand
EditRequest -> do
      -- Open a json file of request and edit it with the default editor of the system.
      -- Then, read the file and parse it as a request.
      -- Finally, update the context with the new request.
      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)
      CreateChatCompletionRequest
-> StateT PromptEnv (InputT IO) (Maybe CreateChatCompletionRequest)
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
CreateChatCompletionRequest
-> m (Maybe CreateChatCompletionRequest)
editRequestWithEditor CreateChatCompletionRequest
req StateT PromptEnv (InputT IO) (Maybe CreateChatCompletionRequest)
-> (Maybe CreateChatCompletionRequest -> 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
        Just CreateChatCompletionRequest
req' -> do
          let newContext :: Context
newContext = Context
prev {contextRequest = req'}
          forall p (m :: * -> *).
(MonadIO m, MonadFail m, PersistentBackend p) =>
Context -> Prompt m ()
setContext @p Context
newContext
          Prompt (InputT IO) ()
repl
        Maybe CreateChatCompletionRequest
Nothing -> 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
$ [Char] -> IO ()
putStrLn [Char]
"Failed to open the editor."
          Prompt (InputT IO) ()
repl
    Right ReplCommand
EditContents -> do
      Context
prev <- Prompt (InputT IO) Context
forall (m :: * -> *). (MonadIO m, MonadFail m) => Prompt m Context
getContext
      Contents -> StateT PromptEnv (InputT IO) (Maybe Contents)
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
Contents -> m (Maybe Contents)
editContentsWithEditor Context
prev.contextBody StateT PromptEnv (InputT IO) (Maybe Contents)
-> (Maybe 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
>>= \case
        Just Contents
contents' -> do
          let newContext :: Context
newContext = Context
prev {contextBody = contents'}
          forall p (m :: * -> *).
(MonadIO m, MonadFail m, PersistentBackend p) =>
Context -> Prompt m ()
setContext @p Context
newContext
          Prompt (InputT IO) ()
repl
        Maybe Contents
Nothing -> 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
$ [Char] -> IO ()
putStrLn [Char]
"Failed to open the editor."
          Prompt (InputT IO) ()
repl
    Right ReplCommand
EditHeader -> do
      Context
prev <- Prompt (InputT IO) Context
forall (m :: * -> *). (MonadIO m, MonadFail m) => Prompt m Context
getContext
      Contents -> StateT PromptEnv (InputT IO) (Maybe Contents)
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
Contents -> m (Maybe Contents)
editContentsWithEditor Context
prev.contextHeader StateT PromptEnv (InputT IO) (Maybe Contents)
-> (Maybe 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
>>= \case
        Just Contents
contents' -> do
          let newContext :: Context
newContext = Context
prev {contextHeader = contents'}
          forall p (m :: * -> *).
(MonadIO m, MonadFail m, PersistentBackend p) =>
Context -> Prompt m ()
setContext @p Context
newContext
        Maybe Contents
Nothing -> 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
$ [Char] -> IO ()
putStrLn [Char]
"Failed to open the editor."
          Prompt (InputT IO) ()
repl
    Right ReplCommand
EditFooter -> do
      Context
prev <- Prompt (InputT IO) Context
forall (m :: * -> *). (MonadIO m, MonadFail m) => Prompt m Context
getContext
      Contents -> StateT PromptEnv (InputT IO) (Maybe Contents)
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
Contents -> m (Maybe Contents)
editContentsWithEditor Context
prev.contextFooter StateT PromptEnv (InputT IO) (Maybe Contents)
-> (Maybe 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
>>= \case
        Just Contents
contents' -> do
          let newContext :: Context
newContext = Context
prev {contextFooter = contents'}
          forall p (m :: * -> *).
(MonadIO m, MonadFail m, PersistentBackend p) =>
Context -> Prompt m ()
setContext @p Context
newContext
          Prompt (InputT IO) ()
repl
        Maybe Contents
Nothing -> 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
$ [Char] -> IO ()
putStrLn [Char]
"Failed to open the editor."
          Prompt (InputT IO) ()
repl
    Right (Repl Text
sessionName) -> do
      forall p. PersistentBackend p => Prompt (InputT IO) ()
runRepl' @p
    Right (ReplCommand
ListKeys) -> 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
        [Unique KeyValue]
list <- forall p (m :: * -> *) a.
(MonadIO m, MonadFail m, PersistentBackend p) =>
(Conn p -> m a) -> m a
withDB @p ((Conn p -> IO [Unique KeyValue]) -> IO [Unique KeyValue])
-> (Conn p -> IO [Unique KeyValue]) -> IO [Unique KeyValue]
forall a b. (a -> b) -> a -> b
$ \Conn p
conn -> forall p (m :: * -> *).
(PersistentBackend p, MonadIO m, MonadFail m) =>
Conn p -> m [Unique KeyValue]
listKeys @p Conn p
conn
        [Unique KeyValue] -> (Unique KeyValue -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Unique KeyValue]
list ((Unique KeyValue -> IO ()) -> IO ())
-> (Unique KeyValue -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(KeyName Text
namespace Text
keyName) -> Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
namespace Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
keyName
      Prompt (InputT IO) ()
repl
    Right (GetKey Maybe Text
namespace Text
keyName) -> do
      Text
namespace' <- case Maybe Text
namespace of
        Just Text
v -> Text -> StateT PromptEnv (InputT IO) Text
forall a. a -> StateT PromptEnv (InputT IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
v
        Maybe Text
Nothing -> StateT PromptEnv (InputT IO) Text
forall (m :: * -> *). (MonadIO m, MonadFail m) => Prompt m Text
getSessionName
      Maybe Text
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 Text))
 -> StateT PromptEnv (InputT IO) (Maybe Text))
-> (Conn p -> StateT PromptEnv (InputT IO) (Maybe Text))
-> StateT PromptEnv (InputT IO) (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Conn p
conn -> forall p (m :: * -> *).
(PersistentBackend p, MonadIO m, MonadFail m) =>
Conn p -> Unique KeyValue -> m (Maybe Text)
getKey @p Conn p
conn (Text -> Text -> Unique KeyValue
KeyName Text
namespace' Text
keyName)
      case Maybe Text
mv of
        Just Text
v -> 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
$ Text -> IO ()
T.putStrLn Text
v
        Maybe Text
Nothing -> 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
$ Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Failed to get " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
keyName
      Prompt (InputT IO) ()
repl
    Right (SetKey Maybe Text
namespace Text
keyName Text
keyValue) -> do
      Text
namespace' <- case Maybe Text
namespace of
        Just Text
v -> Text -> StateT PromptEnv (InputT IO) Text
forall a. a -> StateT PromptEnv (InputT IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
v
        Maybe Text
Nothing -> StateT PromptEnv (InputT IO) Text
forall (m :: * -> *). (MonadIO m, MonadFail m) => Prompt m Text
getSessionName
      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 -> Unique KeyValue -> Text -> m ()
setKey @p Conn p
conn (Text -> Text -> Unique KeyValue
KeyName Text
namespace' Text
keyName) Text
keyValue
      Prompt (InputT IO) ()
repl
    Right (DeleteKey Maybe Text
namespace Text
keyName) -> do
      Text
namespace' <- case Maybe Text
namespace of
        Just Text
v -> Text -> StateT PromptEnv (InputT IO) Text
forall a. a -> StateT PromptEnv (InputT IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
v
        Maybe Text
Nothing -> StateT PromptEnv (InputT IO) Text
forall (m :: * -> *). (MonadIO m, MonadFail m) => Prompt m Text
getSessionName
      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 -> Unique KeyValue -> m ()
deleteKey @p Conn p
conn (Text -> Text -> Unique KeyValue
KeyName Text
namespace' Text
keyName)
      Prompt (InputT IO) ()
repl

runRepl' :: forall p. (PersistentBackend p) => Prompt (InputT IO) ()
runRepl' :: forall p. PersistentBackend p => Prompt (InputT IO) ()
runRepl' = do
  Either (ParseErrorBundle Text Void) ReplCommand
cmd <- forall p (t :: (* -> *) -> * -> *).
(PersistentBackend p, MonadTrans t) =>
t (InputT IO) (Either (ParseErrorBundle Text Void) ReplCommand)
getUserCommand @p
  forall p.
PersistentBackend p =>
Either (ParseErrorBundle Text Void) ReplCommand
-> Maybe (Prompt (InputT IO) ()) -> Prompt (InputT IO) ()
runCmd' @p Either (ParseErrorBundle Text Void) ReplCommand
cmd (Prompt (InputT IO) () -> Maybe (Prompt (InputT IO) ())
forall a. a -> Maybe a
Just (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 [Char]
historyFile = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"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))