Clean up backend code
continuous-integration/drone/push Build is passing Details

This commit is contained in:
qvalentin 2023-08-01 10:21:12 +02:00
parent c77e006ce4
commit b8c7b4b954
3 changed files with 8 additions and 30 deletions

View File

@ -16,16 +16,12 @@ import Network.Wai
consumeRequestBodyStrict,
responseLBS,
)
import State.ConnectedClientsState (MonadConnectedClientsRead)
import State.RoomDataState
( MonadRoomDataStateModify (setRoomDataState),
MonadRoomDataStateRead,
)
import Types.AppTypes (HasConnectedClientState)
import Types.RoomsState
( HasRoomsState,
roomStateDiffers,
updateRoomState,
( roomStateDiffers,
)
import Types.WebEnv
( HasWebEnv (getRequest),

View File

@ -15,7 +15,7 @@ import Control.Monad.Except
import Network.HTTP.Types
import Network.Wai
import Network.Wai.Handler.Warp (run)
import Network.Wai.Middleware.RequestLogger (logStdoutDev)
import Network.Wai.Middleware.RequestLogger (logStdout)
import RoomDataHandler (roomDataHandler)
import State.ConnectedClientsState
( MonadConnectedClientsRead (..),
@ -27,9 +27,7 @@ import State.RoomDataState
)
import Types.AppTypes (Env (..))
import Types.RoomsState
( HasRoomsState (getRoomsState),
getRoomState,
roomStateDiffers,
( getRoomState,
updateRoomState,
)
import Types.WebEnv
@ -122,24 +120,6 @@ notFound = do
"404 - Not Found"
throwError response
-- notFound ::
-- ( MonadIO m,
-- HasWebEnv env,
-- MonadReader env m,
-- MonadError ResponseReceived m
-- ) =>
-- m ResponseReceived
-- notFound = do
-- respond' <- getRespond <$> ask
-- response <-
-- liftIO $
-- respond' $
-- responseLBS
-- status200
-- [("Content-Type", "text/plain")]
-- "200 - Success"
-- response
runWebApp ::
( MonadIO m,
MonadReader Env m
@ -165,6 +145,6 @@ runWebServer ::
) =>
m ()
runWebServer = do
putStrLn "http://localhost:8081/"
runWebApp >>= liftIO . (run 8081 . logStdoutDev)
putStrLn "Webserver up and running at http://localhost:8081/"
runWebApp >>= liftIO . (run 8081 . logStdout)
return ()

View File

@ -33,11 +33,11 @@ wsApp = do
broadcastUserData
withCleanUp $ forever $ do
handleWSAction
broadcastUserData
handleWSAction ::
( MonadWebSocketSession m,
MonadConnectedClientsModify m,
MonadRoomDataStateRead m,
MonadBroadcast m,
MonadAllChat m
) =>
@ -47,8 +47,10 @@ handleWSAction = do
case msg of
JoinRoomMessage _ -> do
joinRoom
broadcastUserData
ClientInfoMessage clientInfo -> do
updateClientName clientInfo
broadcastUserData
AllChatMessageIncomingMessage incomingMessage -> do
broadCastAllChatMessage incomingMessage