diff --git a/chat-bots-contrib/test/Spec.hs b/chat-bots-contrib/test/Spec.hs index bfb3117..9418c23 100644 --- a/chat-bots-contrib/test/Spec.hs +++ b/chat-bots-contrib/test/Spec.hs @@ -5,17 +5,10 @@ module Main where -------------------------------------------------------------------------------- import Data.Chat.Bot (fixBot) -import Data.Chat.Bot.Calculator - ( calculatorBot, - printCalcOutput, - simplifyCalculatorBot, - statementP, - ) -import Data.Chat.Bot.Context - ( sessionize, - simplifySessionBot, - ) -import Data.Chat.Bot.Hello (helloSimpleBot) +import Data.Chat.Bot.Calculator (calculatorBot, calculatorSerializer) +import Data.Chat.Bot.Hello (helloBot, helloBotSerializer) +import Data.Chat.Bot.Sessions (sessionSerializer, sessionize) +import Data.Chat.Serialization qualified as S import Scripts (mkScript) import Test.Hspec (Spec, describe, hspec, it, shouldBe) import TestServer (runTestScript) @@ -31,7 +24,7 @@ main = hspec $ do helloBotSpec :: Spec helloBotSpec = describe "Hello Bot" $ do - let bot = helloSimpleBot + let bot = S.simplifyBot helloBot helloBotSerializer it "responds to precisely its trigger phrase" $ do let scenario = [mkScript| @@ -53,7 +46,7 @@ helloBotSpec = calculatorBotSpec :: Spec calculatorBotSpec = describe "Calculator Bot" $ do - let bot = simplifyCalculatorBot calculatorBot + let bot = S.simplifyBot calculatorBot calculatorSerializer it "performs arithmetic" $ do let scenario = [mkScript| @@ -81,7 +74,7 @@ calculatorBotSpec = sessionizedBotSpec :: Spec sessionizedBotSpec = describe "Sessionized Bot" $ do - let bot = simplifySessionBot printCalcOutput statementP $ sessionize mempty $ calculatorBot + let bot = S.simplifyBot (sessionize mempty calculatorBot) (sessionSerializer calculatorSerializer) it "can instantiate a session" $ do let scenario = [mkScript| diff --git a/cofree-bot/app/Main.hs b/cofree-bot/app/Main.hs index 2b97b24..def6014 100644 --- a/cofree-bot/app/Main.hs +++ b/cofree-bot/app/Main.hs @@ -8,24 +8,28 @@ module Main where import Control.Monad (void, (>=>)) import Control.Monad.Except (ExceptT, runExceptT) import Control.Monad.IO.Class (liftIO) -import Data.Chat.Bot +import Data.Chat.Bot (batch, fixBotPersistent, hoistBot, readState) import Data.Chat.Bot.Calculator -import Data.Chat.Bot.CoinFlip -import Data.Chat.Bot.Context -import Data.Chat.Bot.GHCI -import Data.Chat.Bot.Hello -import Data.Chat.Bot.Jitsi -import Data.Chat.Bot.Magic8Ball -import Data.Chat.Bot.Monoidal -import Data.Chat.Bot.Updog -import Data.Chat.Server -import Data.Chat.Server.Matrix -import Data.Chat.Server.Repl +import Data.Chat.Bot.CoinFlip (coinFlipBot, coinFlipSerializer) +import Data.Chat.Bot.GHCI (ghciBot, ghciConfig, ghciSerializer, hGetOutput) +import Data.Chat.Bot.Hello (helloBot, helloBotSerializer) +import Data.Chat.Bot.Jitsi (jitsiBot, jitsiSerializer) +import Data.Chat.Bot.Magic8Ball (magic8BallBot, magic8BallSerializer) +import Data.Chat.Bot.Monoidal qualified as M +import Data.Chat.Bot.Sessions +import Data.Chat.Bot.Updog (updogBot, updogSerializer) +import Data.Chat.Serialization qualified as S +import Data.Chat.Server (annihilate, loop) +import Data.Chat.Server.Matrix (liftSimpleBot, matrix) +import Data.Chat.Server.Repl (repl) import Data.Foldable (fold) import GHC.Conc (threadDelay) import Network.Matrix.Client (ClientSession, login) -import Options import Options.Applicative qualified as Opt +import Options.Config (fromConfig) +import Options.Env (fromEnv) +import Options.Parser (Command (..), parserInfo) +import Options.Types (toClientSession) import System.Environment.XDG.BaseDir (getUserCacheDir) import System.Process.Typed (getStdout, withProcessWait_) @@ -43,28 +47,30 @@ main = do clientSessionConfigFile <- fromConfig toClientSession (fold [clientSessionArgv, clientSessionEnv, clientSessionConfigFile]) >>= \case Just session -> matrixMain session xdgCache - Nothing -> error "Invaid Client Session" + Nothing -> error "Invalid Client Session" CLI -> cliMain xdgCache -------------------------------------------------------------------------------- -bot process = - let calcBot = - liftSimpleBot $ - simplifySessionBot printCalcOutput statementP $ - sessionize mempty $ - calculatorBot - helloBot = helloMatrixBot - coinFlipBot' = liftSimpleBot $ simplifyCoinFlipBot coinFlipBot - ghciBot' = liftSimpleBot $ ghciBot process - magic8BallBot' = liftSimpleBot $ simplifyMagic8BallBot magic8BallBot - in calcBot - /.\ coinFlipBot' - /.\ helloBot - /.\ ghciBot' - /.\ magic8BallBot' - /.\ updogMatrixBot - /.\ liftSimpleBot jitsiBot +bot' process = + helloBot @_ @() -- <----- polymorphic states need to get asserted to a monoid + M./+\ updogBot @_ @() + M./+\ coinFlipBot + M./+\ magic8BallBot + M./+\ jitsiBot + M./+\ ghciBot process + M./+\ sessionize mempty calculatorBot + +serializer' = + helloBotSerializer + S./+\ updogSerializer + S./+\ coinFlipSerializer + S./+\ magic8BallSerializer + S./+\ jitsiSerializer + S./+\ ghciSerializer + S./+\ sessionSerializer calculatorSerializer + +bot process = S.simplifyBot (bot' process) serializer' -------------------------------------------------------------------------------- @@ -73,7 +79,7 @@ cliMain xdgCache = 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) $ bot process void $ loop $ annihilate repl fixedBot -------------------------------------------------------------------------------- @@ -86,5 +92,5 @@ matrixMain session xdgCache = withProcessWait_ ghciConfig $ \process -> do void $ threadDelay 1e6 void $ hGetOutput (getStdout process) state <- readState xdgCache - fixedBot <- flip (fixBotPersistent xdgCache) (fold state) $ hoistBot liftIO $ bot process - unsafeCrashInIO $ loop $ annihilate (matrix session xdgCache) $ batch fixedBot + fixedBot <- flip (fixBotPersistent xdgCache) (fold state) $ hoistBot liftIO $ liftSimpleBot $ bot process + unsafeCrashInIO $ loop $ annihilate (matrix session xdgCache) $ batch $ fixedBot