module Eventloop.Utility.BufferedWebsockets
    ( module Eventloop.Utility.Websockets
    , module Eventloop.Utility.BufferedWebsockets
    ) where

    

import qualified Data.Text as T
import qualified Network.Socket as S
import Network.WebSockets hiding (Message)
import Control.Concurrent.MVar
import Control.Concurrent
    
import Eventloop.Utility.Websockets hiding ( ReceiveBuffer
                                           , setupWebsocketConnection
                                           , spawnReader
                                           , readIntoBuffer
                                           , hasMessage
                                           , takeMessage
                                           )

type BufferedReceiveBuffer = MVar [Message]

setupWebsocketConnection :: Host -> Port -> IO (BufferedReceiveBuffer, Connection, S.Socket)
setupWebsocketConnection host port = S.withSocketsDo $ do
                                                        serverSocket <- createBindListenServerSocket host port
                                                        clientConnection <- acceptFirstConnection serverSocket
                                                        recvBuffer <- newMVar []
                                                        spawnReader recvBuffer clientConnection
                                                        return (recvBuffer, clientConnection, serverSocket)

                                                        
spawnReader :: BufferedReceiveBuffer -> Connection -> IO ThreadId
spawnReader recvBuffer conn = do
                                forkIO (readIntoBuffer recvBuffer conn)
                                --Spawn reader but with function that catches closeRequest exception and closes the connection
                                                        
                                                        
readIntoBuffer :: BufferedReceiveBuffer -> Connection -> IO ()
readIntoBuffer recvBuffer conn = do
                                    textMessage <- receiveData conn
                                    let
                                        message = T.unpack textMessage
                                    messages <- takeMVar recvBuffer
                                    putMVar recvBuffer (messages ++ [message])
                                    readIntoBuffer recvBuffer conn
                                    
                                    
hasMessages :: BufferedReceiveBuffer -> IO Bool
hasMessages recvBuffer = do
                            messages <- readMVar recvBuffer
                            return ((length messages) > 0)
                            
takeMessages :: BufferedReceiveBuffer -> IO [Message]
takeMessages recvBuffer = do
                            messages <- takeMVar recvBuffer
                            putMVar recvBuffer []
                            return messages