Start with haskell backend

backend/src/Lib.hs

@@ -1,7 +1,14 @@
 module Lib
-    ( someFunc
-    ) where
+  ( runBothServers,
+  )
+where
 
-someFunc :: IO ()
-someFunc = putS
+import ClassyPrelude
+import WebServer (runWebServer)
+import WebSocket (initMVarState, runWebSocketServer)
 
+runBothServers :: IO ()
+runBothServers = do
+  mVarState <- initMVarState
+  _ <- concurrently (runWebSocketServer mVarState) (runWebServer mVarState)
+  return ()

backend/src/WebServer.hs

@@ -0,0 +1,24 @@
+module WebServer (runWebServer) where
+
+import ClassyPrelude
+import Network.HTTP.Types
+import Network.Wai
+import Network.Wai.Handler.Warp (run)
+import WebSocket (ServerState, broadcast)
+
+app :: MVar ServerState -> Application
+app state _ respond = do
+  putStrLn "I've done some IO here"
+  currentState <- takeMVar state
+  broadcast "dsa" currentState
+  putMVar state currentState
+  respond $
+    responseLBS
+      status200
+      [("Content-Type", "text/plain")]
+      "Hello, Web!"
+
+runWebServer :: MVar ServerState -> IO ()
+runWebServer state = do
+  putStrLn $ "http://localhost:8080/"
+  run 8080 $ app state

backend/src/WebSocket.hs

@@ -0,0 +1,52 @@
+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')