module WebSocket (broadcast, initMVarState, runWebSocketServer, ServerState, Client) where

import ClassyPrelude
import Network.WebSockets qualified as WS

type Client = (Text, WS.Connection)

type ServerState = [Client]

addClient :: Client -> ServerState -> ServerState
addClient client clients = client : clients

removeClient :: Client -> ServerState -> ServerState
removeClient client = filter ((/= fst client) . fst)

newServerState :: ServerState
newServerState = []

broadcast :: Text -> ServerState -> IO ()
broadcast message clients = do
  putStrLn message
  forM_ clients $ \(_, conn) -> WS.sendTextData conn message

initMVarState :: IO (MVar ServerState)
initMVarState = newMVar newServerState

runWebSocketServer :: MVar ServerState -> IO ()
runWebSocketServer state = do
  WS.runServer "127.0.0.1" 9160 $ webSocketApplication state

webSocketApplication :: MVar ServerState -> WS.ServerApp
webSocketApplication state pending = do
  putStrLn "pending request"
  conn <- WS.acceptRequest pending
  WS.withPingThread conn 30 (return ()) $ do
    msg <- WS.receiveData conn
    putStrLn msg
    let client = ("hall", conn)
    flip finally (disconnect client) $ do
      modifyMVar_ state $ \s -> do
        let s' = addClient client s
        return s'
      forever $ do
        currentMsg <- WS.receiveData conn
        putStrLn currentMsg
  where
    disconnect client = do
      putStrLn "disconnect"
      modifyMVar state $ \s ->
        let s' = removeClient client s
         in return
              (s', s')