{-# 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.Aeson as A
import qualified Data.ByteString as BS
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Void
import IntelliMonad.Persist
import IntelliMonad.Prompt
import IntelliMonad.Types
import qualified OpenAI.Types as API
import System.Console.Haskeline
import Text.Megaparsec
import Text.Megaparsec.Char
import Text.Megaparsec.Char.Lexer as L
import GHC.IO.Exception
import System.Process
import System.Environment (lookupEnv)
import System.IO.Temp
import System.IO (hClose)

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.json" (([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
$ 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
    [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
        Maybe CreateChatCompletionRequest
newReq <- forall a. FromJSON a => [Char] -> IO (Maybe a)
A.decodeFileStrict @API.CreateChatCompletionRequest [Char]
filePath
        case Maybe CreateChatCompletionRequest
newReq of
          Just 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'
          Maybe CreateChatCompletionRequest
Nothing -> 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.json" (([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
$ ByteString -> ByteString
BS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Contents -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty 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
        Maybe Contents
newContents <- forall a. FromJSON a => [Char] -> IO (Maybe a)
A.decodeFileStrict @Contents [Char]
filePath
        case Maybe Contents
newContents of
          Just 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'
          Maybe Contents
Nothing -> 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
          (PromptEnv
env :: PromptEnv) <- StateT PromptEnv (InputT IO) PromptEnv
forall (m :: * -> *) s. Monad m => StateT s m s
get
          let newContext :: Context
newContext = Context
prev {contextRequest = req'}
          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 = 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
          (PromptEnv
env :: PromptEnv) <- StateT PromptEnv (InputT IO) PromptEnv
forall (m :: * -> *) s. Monad m => StateT s m s
get
          let newContext :: Context
newContext = Context
prev {contextBody = contents'}
          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 = 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
          (PromptEnv
env :: PromptEnv) <- StateT PromptEnv (InputT IO) PromptEnv
forall (m :: * -> *) s. Monad m => StateT s m s
get
          let newContext :: Context
newContext = Context
prev {contextHeader = contents'}
          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 = 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
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
          (PromptEnv
env :: PromptEnv) <- StateT PromptEnv (InputT IO) PromptEnv
forall (m :: * -> *) s. Monad m => StateT s m s
get
          let newContext :: Context
newContext = Context
prev {contextFooter = contents'}
          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 = 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

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