Keyboard.hs

 {-# LANGUAGE OverloadedStrings #-}
module Eventloop.Module.Websocket.Keyboard.Keyboard
    ( setupKeyboardModuleConfiguration
    , keyboardModuleIdentifier
    , keyboardInitializer
    , keyboardEventRetriever
    , keyboardTeardown
    ) where

import Data.Aeson
import Data.Maybe
import Control.Applicative
import Control.Concurrent.SafePrint
import qualified Data.ByteString.Lazy.Char8 as BL

import Eventloop.Types.Common
import Eventloop.Types.Events
import Eventloop.Types.System
import Eventloop.Module.Websocket.Keyboard.Types
import Eventloop.Utility.Config
import qualified Eventloop.Utility.BufferedWebsockets as WS


setupKeyboardModuleConfiguration :: EventloopSetupModuleConfiguration
setupKeyboardModuleConfiguration = ( EventloopSetupModuleConfiguration 
                                        keyboardModuleIdentifier
                                        (Just keyboardInitializer)
                                        (Just keyboardEventRetriever)
                                        Nothing
                                        Nothing
                                        Nothing
                                        (Just keyboardTeardown)
                                      )

                                      
keyboardModuleIdentifier :: EventloopModuleIdentifier
keyboardModuleIdentifier = "keyboard"

                  
instance FromJSON Keyboard where
    parseJSON (Object v) = Key <$> v .: "key"

    
keyboardInitializer :: Initializer
keyboardInitializer sharedIO
    = do
        (recvBuffer, clientSocket, clientConn, serverSock, bufferedReaderThread) <- WS.setupWebsocketConnection ipAddress  keyboardPort
        safePrintLn (safePrintToken sharedIO) "Keyboard connection successfull"
        return (sharedIO, KeyboardState recvBuffer clientSocket clientConn serverSock bufferedReaderThread)

                            
keyboardEventRetriever :: EventRetriever
keyboardEventRetriever sharedIO keyboardState = do
                                                    messages <- WS.takeMessages (receiveBuffer keyboardState)
                                                    return (sharedIO, keyboardState, map ((.) InKeyboard messageToKeyboardIn) messages)
                                        

messageToKeyboardIn :: WS.Message -> Keyboard
messageToKeyboardIn message = fromJust.decode $ BL.pack message


keyboardTeardown :: Teardown
keyboardTeardown sharedIO ks
    = do
        WS.closeWebsocketConnection (serverSocket ks) (clientSocket ks) (clientConnection ks) (bufferedReaderThread ks)
        return sharedIO