some backend refactoring
continuous-integration/drone/push Build is failing
Details
continuous-integration/drone/push Build is failing
Details
This commit is contained in:
parent
8c82cd81bd
commit
2159e273fa
|
@ -29,12 +29,13 @@ library
|
|||
Lib
|
||||
RoomDataHandler
|
||||
State.ConnectedClientsState
|
||||
State.GenericTVarState
|
||||
State.RoomDataState
|
||||
State.RoomsState
|
||||
Types.AppTypes
|
||||
Types.ConnectionState
|
||||
Types.Participant
|
||||
Types.RoomData
|
||||
Types.RoomsState
|
||||
Types.User
|
||||
Types.UsersData
|
||||
Types.WebEnv
|
||||
|
|
|
@ -8,9 +8,9 @@ where
|
|||
import ClassyPrelude
|
||||
import Data.Aeson (encode)
|
||||
import Network.WebSockets qualified as WS
|
||||
import State.ConnectedClientsState (MonadConnectedClientsRead (getConnctedClients))
|
||||
import State.ConnectedClientsState (ConnectedClients, MonadConnectedClientsRead (getConnctedClients))
|
||||
import State.RoomDataState (MonadRoomDataStateRead (getRoomDataState))
|
||||
import Types.ConnectionState (Client (..), ConnectedClients)
|
||||
import Types.ConnectionState (Client (..))
|
||||
import Types.User (User, clientToUser)
|
||||
import Types.UsersData (UsersData (..))
|
||||
|
||||
|
|
|
@ -6,9 +6,9 @@ module Lib
|
|||
where
|
||||
|
||||
import ClassyPrelude
|
||||
import State.ConnectedClientsState (initConnectionsState)
|
||||
import State.RoomsState (initRoomsState)
|
||||
import Types.AppTypes
|
||||
import Types.ConnectionState (initConnectionsState)
|
||||
import Types.RoomsState (initRoomsState)
|
||||
import WebServer (runWebServer)
|
||||
import WebSocket.Server (runWebSocketServer)
|
||||
|
||||
|
|
|
@ -20,7 +20,7 @@ import State.RoomDataState
|
|||
( MonadRoomDataStateModify (setRoomDataState),
|
||||
MonadRoomDataStateRead,
|
||||
)
|
||||
import Types.RoomsState
|
||||
import State.RoomsState
|
||||
( roomStateDiffers,
|
||||
)
|
||||
import Types.WebEnv
|
||||
|
|
|
@ -1,6 +1,10 @@
|
|||
module State.ConnectedClientsState
|
||||
( MonadConnectedClientsModify (..),
|
||||
MonadConnectedClientsRead (..),
|
||||
ConnectedClients,
|
||||
ConnectedClientsState,
|
||||
HasConnectedClientState (..),
|
||||
initConnectionsState,
|
||||
addWSClientGeneric,
|
||||
updateWSClientGeneric,
|
||||
removeWSClientGeneric,
|
||||
|
@ -10,14 +14,24 @@ where
|
|||
|
||||
import ClassyPrelude
|
||||
import Data.UUID
|
||||
import Types.AppTypes
|
||||
import Types.ConnectionState
|
||||
|
||||
type ConnectedClientsState = TVar ConnectedClients
|
||||
|
||||
initConnectionsState :: IO ConnectedClientsState
|
||||
initConnectionsState = newTVarIO newConnectedClients
|
||||
|
||||
newConnectedClients :: ConnectedClients
|
||||
newConnectedClients = []
|
||||
|
||||
class Monad m => MonadConnectedClientsModify m where
|
||||
addWSClient :: Client -> m ()
|
||||
removeWSClient :: UUID -> m ()
|
||||
updateWSClient :: UUID -> (Client -> Client) -> m ()
|
||||
|
||||
class HasConnectedClientState a where
|
||||
getConnectedClientState :: a -> ConnectedClientsState
|
||||
|
||||
addWSClientGeneric ::
|
||||
( HasConnectedClientState env,
|
||||
MonadReader env m,
|
||||
|
|
|
@ -0,0 +1,11 @@
|
|||
module State.GenericTVarState (GenericTVarState, updateGenericTVarState, getGenericTVarState) where
|
||||
|
||||
import ClassyPrelude
|
||||
|
||||
type GenericTVarState a = TVar a
|
||||
|
||||
updateGenericTVarState :: (MonadIO m) => GenericTVarState a -> a -> m ()
|
||||
updateGenericTVarState tv a = atomically $ writeTVar tv a
|
||||
|
||||
getGenericTVarState :: (MonadIO m) => GenericTVarState a -> m a
|
||||
getGenericTVarState = readTVarIO
|
|
@ -1,4 +1,4 @@
|
|||
module Types.RoomsState
|
||||
module State.RoomsState
|
||||
( RoomsState,
|
||||
initRoomsState,
|
||||
HasRoomsState (..),
|
||||
|
@ -9,10 +9,11 @@ module Types.RoomsState
|
|||
where
|
||||
|
||||
import ClassyPrelude
|
||||
import State.GenericTVarState
|
||||
import State.RoomDataState (MonadRoomDataStateRead (getRoomDataState))
|
||||
import Types.RoomData (RoomsData)
|
||||
|
||||
type RoomsState = TVar RoomsData
|
||||
type RoomsState = GenericTVarState RoomsData
|
||||
|
||||
initRoomsState :: IO RoomsState
|
||||
initRoomsState = newTVarIO []
|
||||
|
@ -30,7 +31,7 @@ updateRoomState ::
|
|||
updateRoomState newData = do
|
||||
state <- getRoomsState <$> ask
|
||||
liftIO $ putStrLn "Upating room state"
|
||||
atomically $ writeTVar state newData
|
||||
updateGenericTVarState state newData
|
||||
liftIO $ putStrLn "Done Upating room state"
|
||||
|
||||
getRoomState ::
|
||||
|
@ -41,7 +42,7 @@ getRoomState ::
|
|||
m RoomsData
|
||||
getRoomState = do
|
||||
state <- getRoomsState <$> ask
|
||||
readTVarIO state
|
||||
getGenericTVarState state
|
||||
|
||||
roomStateDiffers ::
|
||||
( MonadRoomDataStateRead m
|
|
@ -1,10 +1,10 @@
|
|||
{-# LANGUAGE DerivingVia #-}
|
||||
|
||||
module Types.AppTypes (Env (..), App (..), getConnectedClientState, HasConnectedClientState, AppProfile (Prod, Dev)) where
|
||||
module Types.AppTypes (Env (..), App (..), getConnectedClientState, AppProfile (Prod, Dev)) where
|
||||
|
||||
import ClassyPrelude
|
||||
import Types.ConnectionState (ConnectedClientsState)
|
||||
import Types.RoomsState
|
||||
import State.ConnectedClientsState
|
||||
import State.RoomsState
|
||||
( HasRoomsState (getRoomsState),
|
||||
RoomsState,
|
||||
)
|
||||
|
@ -17,9 +17,6 @@ data Env = Env
|
|||
profile :: AppProfile
|
||||
}
|
||||
|
||||
class HasConnectedClientState a where
|
||||
getConnectedClientState :: a -> ConnectedClientsState
|
||||
|
||||
instance HasConnectedClientState Env where
|
||||
getConnectedClientState = connectedClientsState
|
||||
|
||||
|
|
|
@ -1,8 +1,6 @@
|
|||
module Types.ConnectionState
|
||||
( Client (..),
|
||||
ConnectedClientsState,
|
||||
ConnectedClients,
|
||||
initConnectionsState,
|
||||
)
|
||||
where
|
||||
|
||||
|
@ -17,12 +15,4 @@ data Client = Client
|
|||
joinedRoom :: Bool
|
||||
}
|
||||
|
||||
type ConnectedClientsState = TVar ConnectedClients
|
||||
|
||||
type ConnectedClients = [Client]
|
||||
|
||||
initConnectionsState :: IO ConnectedClientsState
|
||||
initConnectionsState = newTVarIO newConnectedClients
|
||||
|
||||
newConnectedClients :: ConnectedClients
|
||||
newConnectedClients = []
|
||||
|
|
|
@ -6,11 +6,11 @@ where
|
|||
|
||||
import ClassyPrelude
|
||||
import Network.Wai (Request, Response, ResponseReceived)
|
||||
import State.ConnectedClientsState (HasConnectedClientState (getConnectedClientState))
|
||||
import State.RoomsState (HasRoomsState (getRoomsState))
|
||||
import Types.AppTypes
|
||||
( Env (..),
|
||||
HasConnectedClientState (getConnectedClientState),
|
||||
)
|
||||
import Types.RoomsState (HasRoomsState (getRoomsState))
|
||||
|
||||
class HasWebEnv a where
|
||||
getRequest :: a -> Request
|
||||
|
|
|
@ -29,23 +29,22 @@ data WebSocketMessage = ClientInfoMessage SetClientInfo | JoinRoomMessage JoinRo
|
|||
instance FromJSON WebSocketMessage where
|
||||
parseJSON = genericParseJSON defaultOptions {sumEncoding = UntaggedValue}
|
||||
|
||||
data SetClientInfo = SetClientInfo
|
||||
{ displayName :: Text
|
||||
}
|
||||
data SetClientInfo where
|
||||
SetClientInfo :: {displayName :: Text} -> SetClientInfo
|
||||
deriving (Generic, Show)
|
||||
|
||||
instance FromJSON SetClientInfo
|
||||
|
||||
data JoinRoom = JoinRoom
|
||||
{ roomName :: Text
|
||||
}
|
||||
data JoinRoom where
|
||||
JoinRoom :: {roomName :: Text} -> JoinRoom
|
||||
deriving (Generic, Show)
|
||||
|
||||
instance FromJSON JoinRoom
|
||||
|
||||
data AllChatMessageIncoming = AllChatMessageIncoming
|
||||
{ content :: Text
|
||||
}
|
||||
data AllChatMessageIncoming where
|
||||
AllChatMessageIncoming ::
|
||||
{content :: Text} ->
|
||||
AllChatMessageIncoming
|
||||
deriving (Generic, Show)
|
||||
|
||||
instance FromJSON AllChatMessageIncoming
|
||||
|
|
|
@ -25,11 +25,11 @@ import State.RoomDataState
|
|||
( MonadRoomDataStateModify (..),
|
||||
MonadRoomDataStateRead (getRoomDataState),
|
||||
)
|
||||
import Types.AppTypes (Env (..))
|
||||
import Types.RoomsState
|
||||
import State.RoomsState
|
||||
( getRoomState,
|
||||
updateRoomState,
|
||||
)
|
||||
import Types.AppTypes (Env (..))
|
||||
import Types.WebEnv
|
||||
|
||||
newtype ExceptTApp e a = E {unExceptTApp :: IO (Either e a)}
|
||||
|
|
|
@ -17,7 +17,8 @@ import ClassyPrelude
|
|||
import Data.UUID
|
||||
import Network.WebSockets qualified as WS
|
||||
import State.ConnectedClientsState
|
||||
( MonadConnectedClientsModify (..),
|
||||
( HasConnectedClientState,
|
||||
MonadConnectedClientsModify (..),
|
||||
MonadConnectedClientsRead (..),
|
||||
addWSClientGeneric,
|
||||
getConnctedClientsGeneric,
|
||||
|
@ -25,8 +26,8 @@ import State.ConnectedClientsState
|
|||
updateWSClientGeneric,
|
||||
)
|
||||
import State.RoomDataState
|
||||
import State.RoomsState (HasRoomsState (..), getRoomState)
|
||||
import Types.AppTypes
|
||||
import Types.RoomsState (HasRoomsState (..), getRoomState)
|
||||
|
||||
data WSEnv = WSEnv
|
||||
{ appEnv :: Env,
|
||||
|
|
Loading…
Reference in New Issue