module EventLoop.EventProcessor(eventloop, IOMessage, readRequest, sendResponse) where

import qualified Network.WebSockets as WS
import Control.Exception (handle, fromException, AsyncException(..), onException)
import qualified Data.Text as T
import Data.String (String)
import Data.Char (isLower, isDigit)
import Control.Monad (sequence)

import EventLoop.Json
import EventLoop.Config

import Debug.Trace

type IOMessage = JSONMessage

-- Start connection
eventloop :: (a -> IOMessage -> ([IOMessage], a)) -> a -> IO ()
eventloop eh beginState = WS.runServer ipadres (fromIntegral port) $ application eh beginState

application :: (a -> IOMessage -> ([IOMessage], a)) -> a -> WS.PendingConnection -> IO ()
application eh beginState pending = do
                        conn <- WS.acceptRequest pending
                        onException (doEvents eh beginState conn) (putStrLn "text1")
                        --handle (catchUserInterrupt conn) $ handle (catchDisconnect conn) $ doEvents eh beginState conn
                        return ()

-- Connection functions
catchDisconnect :: WS.Connection -> WS.ConnectionException -> IO ()
catchDisconnect conn e = case e of
                          WS.ConnectionClosed         -> putStrLn "Connection closed!"
                          WS.CloseRequest code reason -> putStrLn "test1"

-- User Interrupt
catchUserInterrupt :: WS.Connection -> AsyncException -> IO()
catchUserInterrupt conn e = case e of
                             UserInterrupt -> putStrLn "test2"
                             ThreadKilled  -> putStrLn "test3"

-- Event Loop
doEvents :: (a -> IOMessage -> ([IOMessage], a)) -> a -> WS.Connection -> IO ()
doEvents eh state conn = do
                    request <- readRequest conn
                    let
                        (resp, state') = eh state request 
                        sendActions = map (sendResponse conn)  resp
                    sequence sendActions
                    doEvents eh state' conn
                
readRequest :: WS.Connection -> IO IOMessage                
readRequest conn = do
                    msg <- WS.receiveData conn
                    let
                        string = T.unpack msg
                        request = stringToJsonObject string
                    return request
                    
sendResponse :: WS.Connection -> IOMessage -> IO ()
sendResponse conn response = do
                        let
                            string = show response
                            text = T.pack string
                        WS.sendTextData conn text