{-# 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