{-# LANGUAGE OverloadedStrings #-}

module Eventloop.Module.Websocket.Mouse.Mouse

    ( setupMouseModuleConfiguration

    , mouseModuleIdentifier

    , mouseInitializer

    , mouseEventRetriever

    , mouseEventSender

    ) where



import Control.Applicative

import Control.Monad

import Control.Concurrent.MVar

import Control.Concurrent.SafePrint

import Data.Aeson

import Data.Aeson.Types

import qualified Data.ByteString.Lazy.Char8 as BL

import Data.Maybe



import Eventloop.Module.Websocket.Mouse.Types

import Eventloop.Types.Common

import Eventloop.Types.Events

import Eventloop.Types.System

import Eventloop.Utility.Websockets

import Eventloop.Utility.Config

import Eventloop.Utility.Vectors



setupMouseModuleConfiguration :: EventloopSetupModuleConfiguration

setupMouseModuleConfiguration = ( EventloopSetupModuleConfiguration 

                                    mouseModuleIdentifier

                                    (Just mouseInitializer)

                                    (Just mouseEventRetriever)

                                    Nothing

                                    Nothing

                                    (Just mouseEventSender)

                                    Nothing

                                  )

     



mouseModuleIdentifier :: EventloopModuleIdentifier

mouseModuleIdentifier = "mouse"





instance FromJSON MouseIn where

    parseJSON vO@(Object v)

        = do

            mouseEvent <- parseJSON vO :: Parser MouseEvent

            mouseType  <- parseJSON vO :: Parser MouseType

            point      <- parseJSON vO :: Parser Point

            id         <- v .: "id"    :: Parser NumericId

            return $ Mouse mouseType id mouseEvent point

    

    

instance FromJSON MouseType where

    parseJSON (Object v)

        = do

            type' <- v .: "elementType" :: Parser String

            return $ case type' of "canvas" -> MouseCanvas

                                   "svg"    -> MouseSVG

    

instance FromJSON MouseEvent where

    parseJSON (Object v)

        =   do

                eventType <- v .: "mouseEventType" :: Parser String

                button <- parseJSON (Object v) :: Parser MouseButton

                return $ case eventType of "click"      -> Click button

                                           "dblclick"   -> DoubleClick button

                                           "mousedown"  -> MouseDown button

                                           "mouseup"    -> MouseUp button

                                           "mouseenter" -> MouseEnter

                                           "mouseleave" -> MouseLeave

                                           "mousemove"  -> MouseMove

   

instance FromJSON MouseButton where

    parseJSON (Object v)

        = do

            button <- v .: "button" :: Parser String

            return $ case button of "left"   -> MouseLeft

                                    "middle" -> MouseMiddle

                                    "right"  -> MouseRight



instance FromJSON Point where

    parseJSON (Object v)

        = do

            x <- v .: "x"

            y <- v .: "y"

            return $ Point (x, y)

    

    

mouseInitializer :: Initializer

mouseInitializer sharedConst sharedIO

    = do

        (clientSocket, clientConn, serverSock) <- setupWebsocketConnection iNADDR_ANY  mousePort

        safePrintLn (safePrintToken sharedConst) "Mouse connection succesfull"

        return (sharedConst, sharedIO, MouseConstants clientSocket clientConn serverSock, NoState)





mouseEventRetriever :: EventRetriever

mouseEventRetriever sharedConst sharedIOT ioConst ioStateT

    = do

        isConnected <- isConnected sock

        case isConnected of

            False -> return []

            True -> do

                messageM <- takeMessage safePrintToken_ sock conn

                case messageM of

                    Nothing        -> return []

                    (Just message) -> return [InMouse $ messageToMouseIn message]

    where

        sock = clientSocket ioConst

        conn = clientConnection ioConst

        safePrintToken_ = safePrintToken sharedConst





messageToMouseIn :: Message -> MouseIn

messageToMouseIn message = fromJust.decode $ BL.pack message





mouseEventSender :: EventSender

mouseEventSender sharedConst sharedIOT ioConst ioStateT Stop

    = do

        closeWebsocketConnection safePrintToken_ serverSock clientSock conn

    where

        serverSock = serverSocket ioConst

        clientSock = clientSocket ioConst

        conn = clientConnection ioConst

        safePrintToken_ = safePrintToken sharedConst





mouseTeardown :: Teardown

mouseTeardown sharedConst sharedIO ioConst ioState

    = do

        destroyWebsocketConnection serverSock clientSock

        return sharedIO

    where

        serverSock = serverSocket ioConst

        clientSock = clientSocket ioConst

        conn = clientConnection ioConst