Skip to content

Commit

Permalink
Adds an OpenAI Behavior
Browse files Browse the repository at this point in the history
  • Loading branch information
solomon-b committed Jan 20, 2023
1 parent 3787251 commit d7769f1
Show file tree
Hide file tree
Showing 5 changed files with 86 additions and 17 deletions.
31 changes: 18 additions & 13 deletions app/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,10 @@ import Control.Monad.Except
import Control.Monad.IO.Class (liftIO)
import Data.Foldable
import GHC.Conc (threadDelay)
import Network.HTTP.Client qualified as HTTP
import Network.HTTP.Client.TLS qualified as HTTP.TLS
import Network.Matrix.Client
import OpenAI.Client (makeOpenAIClient)
import Options.Applicative qualified as Opt
import OptionsParser
import System.Environment.XDG.BaseDir (getUserCacheDir)
Expand All @@ -23,17 +26,17 @@ main :: IO ()
main = do
command <- Opt.execParser parserInfo
xdgCache <- getUserCacheDir "cofree-bot"

httpManager <- HTTP.newManager HTTP.TLS.tlsManagerSettings
case command of
LoginCmd cred -> do
LoginCmd cred openAIKey -> do
session <- login cred
matrixMain session xdgCache
TokenCmd TokenCredentials {..} -> do
matrixMain session xdgCache httpManager openAIKey
TokenCmd TokenCredentials {..} openAIKey -> do
session <- createSession (getMatrixServer matrixServer) matrixToken
matrixMain session xdgCache
CLI -> cliMain xdgCache
matrixMain session xdgCache httpManager openAIKey
CLI openAIKey -> cliMain xdgCache httpManager openAIKey

bot process =
bot process manager (OpenAIKey aiKey) =
let calcBot =
embedTextBot $
simplifySessionBot printCalcOutput statementP $
Expand All @@ -43,29 +46,31 @@ bot process =
coinFlipBot' = embedTextBot $ simplifyCoinFlipBot coinFlipBot
ghciBot' = embedTextBot $ ghciBot process
magic8BallBot' = embedTextBot $ simplifyMagic8BallBot magic8BallBot
openAIBot' = openAIBot $ makeOpenAIClient aiKey manager 2
in calcBot
/.\ coinFlipBot'
/.\ helloBot
/.\ ghciBot'
/.\ magic8BallBot'
/.\ updogMatrixBot
/.\ embedTextBot jitsiBot
/.\ embedTextBot openAIBot'

cliMain :: FilePath -> IO ()
cliMain xdgCache = withProcessWait_ ghciConfig $ \process -> do
cliMain :: FilePath -> HTTP.Manager -> OpenAIKey -> IO ()
cliMain xdgCache manager openAIKey = withProcessWait_ ghciConfig $ \process -> do
void $ threadDelay 1e6
void $ hGetOutput (getStdout process)
state <- readState xdgCache
fixedBot <- flip (fixBotPersistent xdgCache) (fold state) $ simplifyMatrixBot $ bot process
fixedBot <- flip (fixBotPersistent xdgCache) (fold state) $ simplifyMatrixBot $ bot process manager openAIKey
void $ loop $ annihilate repl fixedBot

unsafeCrashInIO :: Show e => ExceptT e IO a -> IO a
unsafeCrashInIO = runExceptT >=> either (fail . show) pure

matrixMain :: ClientSession -> FilePath -> IO ()
matrixMain session xdgCache = withProcessWait_ ghciConfig $ \process -> do
matrixMain :: ClientSession -> FilePath -> HTTP.Manager -> OpenAIKey -> IO ()
matrixMain session xdgCache manager openAIKey = withProcessWait_ ghciConfig $ \process -> do
void $ threadDelay 1e6
void $ hGetOutput (getStdout process)
state <- readState xdgCache
fixedBot <- flip (fixBotPersistent xdgCache) (fold state) $ hoistBot liftIO $ bot process
fixedBot <- flip (fixBotPersistent xdgCache) (fold state) $ hoistBot liftIO $ bot process manager openAIKey
unsafeCrashInIO $ loop $ annihilate (matrix session xdgCache) $ batch fixedBot
25 changes: 21 additions & 4 deletions app/OptionsParser.hs
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
module OptionsParser where

import Control.Applicative
import Data.Text qualified as T
import Network.Matrix.Client
import Options.Applicative qualified as Opt
Expand Down Expand Up @@ -93,30 +94,46 @@ parseServer =
"Matrix Homeserver"
)

-----------------------
--- Behavior Config ---
-----------------------

newtype OpenAIKey = OpenAIKey T.Text

parseOpenAIKey :: Opt.Parser OpenAIKey
parseOpenAIKey =
OpenAIKey
<$> Opt.strOption
( Opt.long "openai_key"
<> Opt.metavar "OPENAI_KEY"
<> Opt.help
"OpenAI API Key"
)

-------------------
--- Main Parser ---
-------------------

data Command = LoginCmd LoginCredentials | TokenCmd TokenCredentials | CLI
data Command = LoginCmd LoginCredentials OpenAIKey | TokenCmd TokenCredentials OpenAIKey | CLI OpenAIKey

mainParser :: Opt.Parser Command
mainParser =
Opt.subparser
( Opt.command
"gen-token"
( Opt.info
(fmap LoginCmd parseLogin)
(liftA2 LoginCmd parseLogin parseOpenAIKey)
(Opt.progDesc "Generate a token from a username/password")
)
<> Opt.command
"run"
( Opt.info
(fmap TokenCmd parseTokenCredentials)
(liftA2 TokenCmd parseTokenCredentials parseOpenAIKey)
(Opt.progDesc "Run the bot with an auth token")
)
<> Opt.command
"cli"
(Opt.info (pure CLI) (Opt.progDesc "Run the bot in the CLI"))
(Opt.info (fmap CLI parseOpenAIKey) (Opt.progDesc "Run the bot in the CLI"))
)

parserInfo :: Opt.ParserInfo Command
Expand Down
5 changes: 5 additions & 0 deletions cofree-bot.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -67,7 +67,10 @@ executable cofree-bot
hs-source-dirs: app
build-depends:
, cofree-bot
, http-client
, http-client-tls
, mtl
, openai-hs
, optparse-applicative
, xdg-basedir

Expand All @@ -93,6 +96,7 @@ library
CofreeBot.Bot.Behaviors.Jitsi
CofreeBot.Bot.Behaviors.Jitsi.Dictionary
CofreeBot.Bot.Behaviors.Magic8Ball
CofreeBot.Bot.Behaviors.OpenAI
CofreeBot.Bot.Behaviors.Updog
CofreeBot.Bot.Context
CofreeBot.Utils
Expand All @@ -110,6 +114,7 @@ library
, lens
, monad-loops
, mtl
, openai-hs
, pretty-simple
, process
, random
Expand Down
2 changes: 2 additions & 0 deletions src/CofreeBot/Bot/Behaviors.hs
Original file line number Diff line number Diff line change
Expand Up @@ -5,12 +5,14 @@ module CofreeBot.Bot.Behaviors
module Hello,
module Jitsi,
module Magic8Ball,
module OpenAI,
module Updog,
)
where

import CofreeBot.Bot.Behaviors.Calculator as Calculator
import CofreeBot.Bot.Behaviors.CoinFlip as CoinFlip
import CofreeBot.Bot.Behaviors.OpenAI as OpenAI
import CofreeBot.Bot.Behaviors.GHCI as GHCI
import CofreeBot.Bot.Behaviors.Hello as Hello
import CofreeBot.Bot.Behaviors.Jitsi as Jitsi
Expand Down
40 changes: 40 additions & 0 deletions src/CofreeBot/Bot/Behaviors/OpenAI.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,40 @@
{-# LANGUAGE ViewPatterns #-}

-- | A bot for general interactions with OpenAI's GPT LLM.
module CofreeBot.Bot.Behaviors.OpenAI
( openAIBot,
)
where

--------------------------------------------------------------------------------

import CofreeBot.Bot
import CofreeBot.Utils.ListT (emptyListT)
import Control.Monad.IO.Class (MonadIO (..))
import Data.Attoparsec.Text
import Data.Text (Text)
import Data.Text qualified as T
import Data.Vector qualified as V
import OpenAI.Client qualified as OpenAI

--------------------------------------------------------------------------------

openAIBot :: OpenAI.OpenAIClient -> Bot IO () Text Text
openAIBot client =
contraMapMaybeBot (either (const Nothing) Just . parseOnly openAIBotParser) $
Bot $ \s (buildPrompt -> i) -> do
liftIO (OpenAI.completeText client (OpenAI.EngineId "text-davinci-003") (i { OpenAI.tccrMaxTokens = Just 2096} )) >>= \case
Left _err -> emptyListT
Right OpenAI.TextCompletion {tcChoices} ->
let OpenAI.TextCompletionChoice {..} = V.head tcChoices
in pure (T.strip tccText, s)

buildPrompt :: Text -> OpenAI.TextCompletionCreate
buildPrompt input =
let preamble = "You are a friendly chat bot named Cofree-Bot on a server dedicated to functional programming. Please respond to the following prompt:"
in OpenAI.defaultTextCompletionCreate $ preamble <> input

openAIBotParser :: Parser Text
openAIBotParser = do
_ <- "chat: "
T.pack <$> many1 anyChar

0 comments on commit d7769f1

Please sign in to comment.