Skip to content

Commit 5f4819b

Browse files
committed
Adds basic history to OpenAIBot
1 parent 01ecdfc commit 5f4819b

File tree

3 files changed

+50
-9
lines changed

3 files changed

+50
-9
lines changed

cofree-bot.cabal

+1
Original file line numberDiff line numberDiff line change
@@ -117,6 +117,7 @@ library
117117
, openai-hs
118118
, pretty-simple
119119
, process
120+
, QuasiText
120121
, random
121122
, vector
122123
, xdg-basedir

src/CofreeBot/Bot/Behaviors/OpenAI.hs

+42-9
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE QuasiQuotes #-}
12
{-# LANGUAGE ViewPatterns #-}
23

34
-- | A bot for general interactions with OpenAI's GPT LLM.
@@ -10,6 +11,7 @@ where
1011
--------------------------------------------------------------------------------
1112

1213
import CofreeBot.Bot
14+
import CofreeBot.Utils ((...))
1315
import CofreeBot.Utils.ListT (emptyListT)
1416
import Control.Monad.IO.Class (MonadIO (..))
1517
import Control.Monad.Reader (ReaderT (..), ask)
@@ -19,32 +21,63 @@ import Data.Text (Text)
1921
import Data.Text qualified as T
2022
import Data.Vector qualified as V
2123
import OpenAI.Client qualified as OpenAI
24+
import Text.QuasiText qualified as QT
2225

2326
--------------------------------------------------------------------------------
2427

25-
openAIBot :: Bot (ReaderT OpenAI.OpenAIClient IO) () Text Text
28+
data Interaction = Interaction {prompt :: Text, completion :: Text}
29+
deriving (Show, Read)
30+
31+
prettyInteraction :: Interaction -> Text
32+
prettyInteraction Interaction {..} =
33+
[QT.embed|
34+
User: $prompt
35+
Cofree-bot: $completion
36+
37+
|]
38+
39+
prettyHistory :: [Interaction] -> Text
40+
prettyHistory = foldMap prettyInteraction
41+
42+
openAIBot :: Bot (ReaderT OpenAI.OpenAIClient IO) [Interaction] Text Text
2643
openAIBot =
2744
contraMapMaybeBot (either (const Nothing) Just . parseOnly openAIBotParser) $
28-
Bot $ \() (buildPrompt -> i) -> do
45+
Bot $ \history i -> do
46+
let prompt = buildPrompt i history
2947
client <- lift ask
30-
liftIO (callOpenAI client i) >>= \case
48+
liftIO (callOpenAI client prompt) >>= \case
3149
Left err -> liftIO (print err) >> emptyListT
3250
Right OpenAI.TextCompletion {tcChoices} ->
3351
let OpenAI.TextCompletionChoice {..} = V.head tcChoices
34-
in pure (T.strip tccText, ())
52+
response = T.strip tccText
53+
in pure (response, Interaction i response : history)
3554

3655
runOpenAIBot :: Functor m => r -> Bot (ReaderT r m) s i o -> Bot m s i o
3756
runOpenAIBot r bot = hoistBot (`runReaderT` r) bot
3857

3958
callOpenAI :: OpenAI.OpenAIClient -> OpenAI.TextCompletionCreate -> IO (Either OpenAI.ClientError OpenAI.TextCompletion)
4059
callOpenAI client i = OpenAI.completeText client (OpenAI.EngineId "text-davinci-003") (i {OpenAI.tccrMaxTokens = Just 2096})
4160

42-
buildPrompt :: Text -> OpenAI.TextCompletionCreate
43-
buildPrompt input =
44-
let preamble = "You are a friendly chat bot named Cofree-Bot on a server dedicated to functional programming. Please respond to the following prompt:"
45-
in OpenAI.defaultTextCompletionCreate $ preamble <> input
61+
preamble :: Text -> [Interaction] -> Text
62+
preamble prompt (prettyHistory -> history) =
63+
[QT.embed|
64+
Chat History:
65+
```
66+
$history
67+
```
68+
69+
You are a friendly chat bot named Cofree-Bot on a server dedicated to functional programming.
70+
Given the Chat History defined above, please respond to the following prompt, but do not prepend your statmements with your name:
71+
72+
```
73+
$prompt
74+
```
75+
|]
76+
77+
buildPrompt :: Text -> [Interaction] -> OpenAI.TextCompletionCreate
78+
buildPrompt = OpenAI.defaultTextCompletionCreate ... preamble
4679

4780
openAIBotParser :: Parser Text
4881
openAIBotParser = do
49-
_ <- "chat: "
82+
-- _ <- "chat: "
5083
T.pack <$> many1 anyChar

src/CofreeBot/Utils.hs

+7
Original file line numberDiff line numberDiff line change
@@ -22,6 +22,7 @@ module CofreeBot.Utils
2222
-- * Misc
2323
distinguish,
2424
PointedChoice (..),
25+
(...),
2526
)
2627
where
2728

@@ -103,3 +104,9 @@ distinguish f x
103104
class PointedChoice p where
104105
pleft :: p a b -> p (x \*/ a) (x \*/ b)
105106
pright :: p a b -> p (a \*/ x) (b \*/ x)
107+
108+
infixr 9 ...
109+
110+
-- | The blackbird operator.
111+
(...) :: (c -> d) -> (a -> b -> c) -> a -> b -> d
112+
(...) = (.) . (.)

0 commit comments

Comments
 (0)