module EventLoop.EventProcessor(eventloop, IOMessage, readRequest, sendResponse) where import qualified Network.WebSockets as WS import qualified Data.Text as T import Data.String (String) import Data.Char (isLower, isDigit) import Control.Monad (sequence) import EventLoop.Json import EventLoop.Config type IOMessage = JSONMessage -- Start connection eventloop :: (a -> IOMessage -> ([IOMessage], a)) -> a -> IO () eventloop eh beginState = WS.server ipadres (fromIntegral port) $ doEvents eh beginState -- Event Loop doEvents :: (a -> IOMessage -> ([IOMessage], a)) -> a -> WS.Connection -> WS.StdOutMutex -> WS.ConnectionSendMutex -> IO () doEvents eh state conn stdoutM connSendM = do request <- readRequest conn stdoutM let (resp, state') = eh state request sendActions = map (sendResponse connSendM conn stdoutM) resp sequence sendActions doEvents eh state' conn stdoutM connSendM readRequest :: WS.Connection -> WS.StdOutMutex -> IO IOMessage readRequest conn stdoutM = do msg <- WS.receiveData conn :: IO T.Text let string = T.unpack msg request = stringToJsonObject string --WS.safePutStr stdoutM string return request sendResponse :: WS.ConnectionSendMutex -> WS.Connection -> WS.StdOutMutex -> IOMessage -> IO () sendResponse mu conn stdoutM response = do let string = show response text = T.pack string --WS.safePutStr stdoutM string WS.safeSendText mu conn text