38 lines
1.1 KiB
Haskell
38 lines
1.1 KiB
Haskell
{-# LANGUAGE FlexibleContexts #-}
|
|
{- LANGUAGE MultiParamTypeClasses #-}
|
|
module Message (
|
|
Connected
|
|
, receive
|
|
, send
|
|
) where
|
|
|
|
import Control.Monad.Reader (MonadReader, ReaderT, ask)
|
|
import Control.Monad.State (StateT)
|
|
import Control.Monad.IO.Class (MonadIO(..))
|
|
import Network.WebSockets (Connection, receiveData, sendTextData)
|
|
import Data.Aeson (encode, eitherDecode')
|
|
import Game (Game)
|
|
import qualified Message.Client as Client (Message)
|
|
import qualified Message.Server as Server (Message(..))
|
|
|
|
type Connected a = ReaderT Connection (StateT Game IO) a
|
|
|
|
{-
|
|
class ReaderIO t c where
|
|
f :: t a -> t c
|
|
liftIO :: (a -> IO b) -> a -> t b
|
|
-}
|
|
|
|
send :: (MonadReader Connection t, MonadIO t) => Server.Message -> t ()
|
|
send message = do
|
|
connection <- ask
|
|
liftIO $ sendTextData connection $ encode message
|
|
|
|
receive :: (MonadReader Connection t, MonadIO t) => t Client.Message
|
|
receive = do
|
|
connection <- ask
|
|
received <- liftIO $ receiveData connection
|
|
case eitherDecode' received of
|
|
Left message -> send (Server.Error message) >> receive
|
|
Right message -> return message
|