{-# LANGUAGE OverloadedStrings #-} module Eventloop.Module.Websocket.Mouse.Mouse ( defaultMouseModuleConfiguration , defaultMouseModuleIOState , mouseModuleIdentifier , mouseInitializer , mouseEventRetriever , mouseTeardown ) where import Data.Aeson import Data.Aeson.Types import Control.Monad import Control.Applicative import Data.Maybe import qualified Data.ByteString.Lazy.Char8 as BL import qualified Eventloop.Utility.BufferedWebsockets as WS import Eventloop.Types.EventTypes import Eventloop.Types.Common import Eventloop.Module.Websocket.Mouse.Types import Eventloop.Utility.Config defaultMouseModuleConfiguration :: EventloopModuleConfiguration defaultMouseModuleConfiguration = ( EventloopModuleConfiguration mouseModuleIdentifier defaultMouseModuleIOState (Just mouseInitializer) (Just mouseEventRetriever) Nothing Nothing (Just mouseTeardown) Nothing ) defaultMouseModuleIOState :: IOState defaultMouseModuleIOState = MouseState undefined undefined undefined mouseModuleIdentifier :: EventloopModuleIdentifier mouseModuleIdentifier = "mouse" instance FromJSON Mouse where parseJSON (Object v) = (v .: "type") >>= (parseMouseEvent v) parseMouseEvent :: Object -> [Char] -> Parser Mouse parseMouseEvent v eventType = case eventType of "click" -> Click <$> buttonP <*> posP "dblclick" -> DoubleClick <$> buttonP <*> posP "mousedown" -> MouseDown <$> buttonP <*> posP "mouseup" -> MouseUp <$> buttonP <*> posP "mouseenter" -> MouseEnter <$> posP "mouseleave" -> MouseLeave <$> posP "mousemove" -> MouseMove <$> posP where buttonP = parseMouseButton <$> (v.: "button") posP = parseMousePosition v parseMouseButton :: [Char] -> MouseButton parseMouseButton "left" = MouseLeft parseMouseButton "middle" = MouseMiddle parseMouseButton "right" = MouseRight parseMousePosition :: Object -> Parser Point parseMousePosition v = (\x y -> (x, y)) <$> xP <*> yP where xP = v .: "x" yP = v .: "y" mouseInitializer :: Initializer mouseInitializer sharedIO _ = do (recvBuffer, clientConn, serverSock) <- WS.setupWebsocketConnection ipAddress mousePort return (sharedIO, MouseState recvBuffer clientConn serverSock) mouseEventRetriever :: EventRetriever mouseEventRetriever sharedIO mouseState = do messages <- WS.takeMessages (receiveBuffer mouseState) return (sharedIO, mouseState, map ((.) InMouse messageToMouseIn) messages) messageToMouseIn :: WS.Message -> Mouse messageToMouseIn message = fromJust.decode $ BL.pack message mouseTeardown :: Teardown mouseTeardown sharedIO ms@(MouseState _ clientConn serverSock) = do WS.closeWebsocketConnection serverSock clientConn return (sharedIO, ms)