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)