Rename poorly named module Data to RW

This commit is contained in:
Tissevert 2019-10-13 21:52:28 +02:00
parent e9205b67c7
commit 0778c4a675
5 changed files with 29 additions and 29 deletions

View file

@ -26,7 +26,7 @@ executable hanafudapi
, Config , Config
, Messaging , Messaging
, Game , Game
, Data , RW
, Server , Server
, Session , Session
-- other-extensions: -- other-extensions:

View file

@ -4,7 +4,7 @@ module Automaton (
) where ) where
import Control.Monad.Reader (asks) import Control.Monad.Reader (asks)
import qualified Data (RW(..)) import qualified RW (RW(..))
import Data.Map (Map, (!?)) import Data.Map (Map, (!?))
import qualified Game (new, play) import qualified Game (new, play)
import qualified Hanafuda.KoiKoi as KoiKoi ( import qualified Hanafuda.KoiKoi as KoiKoi (
@ -36,7 +36,7 @@ receive (Session.LoggedIn True) invitation@(Message.Invitation {Message.to}) = d
case Session.status session of case Session.status session of
Session.LoggedIn True -> do Session.LoggedIn True -> do
from <- asks App.playerID from <- asks App.playerID
App.update_ (Server.update to (Data.set $ Session.Answering from :: Session.Update)) App.update_ (Server.update to (RW.set $ Session.Answering from :: Session.Update))
Messaging.broadcast $ Messaging.update {Message.paired = [from, to]} Messaging.broadcast $ Messaging.update {Message.paired = [from, to]}
(Messaging.relay invitation $ Messaging.sendTo [to]) (Messaging.relay invitation $ Messaging.sendTo [to])
setSessionStatus (Session.Waiting to) setSessionStatus (Session.Waiting to)
@ -58,7 +58,7 @@ receive (Session.Answering to) message@(Message.Answer {Message.accept}) = do
else do else do
Messaging.broadcast $ Messaging.update {Message.alone = [for, to]} Messaging.broadcast $ Messaging.update {Message.alone = [for, to]}
return $ Session.LoggedIn True return $ Session.LoggedIn True
App.update_ $ Server.update to (Data.set newStatus :: Session.Update) App.update_ $ Server.update to (RW.set newStatus :: Session.Update)
setSessionStatus newStatus setSessionStatus newStatus
_ -> sendError "They're not waiting for your answer" _ -> sendError "They're not waiting for your answer"
@ -77,7 +77,7 @@ receive (Session.Playing gameID) played@(Message.Play {}) = do
Messaging.notifyPlayers newGame logs Messaging.notifyPlayers newGame logs
receive (Session.Playing gameID) Message.Quit = do receive (Session.Playing gameID) Message.Quit = do
games <- (Data.get <$> App.server :: App.T (Map KoiKoi.GameID KoiKoi.Game)) games <- (RW.get <$> App.server :: App.T (Map KoiKoi.GameID KoiKoi.Game))
case games !? gameID of case games !? gameID of
Nothing -> do Nothing -> do
playerID <- asks App.playerID playerID <- asks App.playerID
@ -93,7 +93,7 @@ sendError = Messaging.send . Message.Error
setSessionStatus :: Session.Status -> App.T () setSessionStatus :: Session.Status -> App.T ()
setSessionStatus newStatus = do setSessionStatus newStatus = do
playerID <- asks App.playerID playerID <- asks App.playerID
App.update_ $ Server.update playerID $ (Data.set newStatus :: Session.Update) App.update_ $ Server.update playerID $ (RW.set newStatus :: Session.Update)
App.debug $ show newStatus App.debug $ show newStatus
loop :: App.T () loop :: App.T ()

View file

@ -1,5 +1,5 @@
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
module Data ( module RW (
RW(..) RW(..)
) where ) where

View file

@ -23,7 +23,7 @@ import qualified Data.Set as Set (delete, empty, insert)
import Data.Text (Text) import Data.Text (Text)
import Hanafuda.KoiKoi (Game, GameID, PlayerID) import Hanafuda.KoiKoi (Game, GameID, PlayerID)
import Hanafuda.Message (PlayerStatus(..), Room) import Hanafuda.Message (PlayerStatus(..), Room)
import qualified Data (RW(..)) import qualified RW (RW(..))
import qualified Session (Status(..), T(..), Update) import qualified Session (Status(..), T(..), Update)
type Names = Set Text type Names = Set Text
@ -37,19 +37,19 @@ data T = T {
, games :: Games , games :: Games
} }
instance Data.RW Names T where instance RW.RW Names T where
get = names get = names
set names server = server {names} set names server = server {names}
instance Data.RW Players T where instance RW.RW Players T where
get = players get = players
set players server = server {players} set players server = server {players}
instance Data.RW Sessions T where instance RW.RW Sessions T where
get = sessions get = sessions
set sessions server = server {sessions} set sessions server = server {sessions}
instance Data.RW Games T where instance RW.RW Games T where
get = games get = games
set games server = server {games} set games server = server {games}
@ -72,31 +72,31 @@ new = T {
, games = Map.empty , games = Map.empty
} }
register :: forall a b. (Enum a, Ord a, Data.RW (Map a b) T) => b -> T -> (T, a) register :: forall a b. (Enum a, Ord a, RW.RW (Map a b) T) => b -> T -> (T, a)
register x server = register x server =
let playerID = maybe (toEnum 0) (\(n, _) -> succ n) $ lookupMax $ (Data.get server :: Map a b) in let playerID = maybe (toEnum 0) (\(n, _) -> succ n) $ lookupMax $ (RW.get server :: Map a b) in
(Data.update (insert playerID x) server, playerID) (RW.update (insert playerID x) server, playerID)
get :: forall a b. (Ord a, Data.RW (Map a b) T) => a -> T -> b get :: forall a b. (Ord a, RW.RW (Map a b) T) => a -> T -> b
get playerID server = (Data.get server :: Map a b) ! playerID get playerID server = (RW.get server :: Map a b) ! playerID
update :: forall a b. (Ord a, Data.RW (Map a b) T) => a -> (b -> b) -> T -> T update :: forall a b. (Ord a, RW.RW (Map a b) T) => a -> (b -> b) -> T -> T
update playerID updator = update playerID updator =
Data.update (adjust updator playerID :: Map a b -> Map a b) RW.update (adjust updator playerID :: Map a b -> Map a b)
disconnect :: PlayerID -> T -> T disconnect :: PlayerID -> T -> T
disconnect playerID = disconnect playerID =
Data.update (delete playerID :: Sessions -> Sessions) . logOut playerID RW.update (delete playerID :: Sessions -> Sessions) . logOut playerID
endGame :: GameID -> T -> T endGame :: GameID -> T -> T
endGame playerID = endGame playerID =
Data.update (delete playerID :: Games -> Games) RW.update (delete playerID :: Games -> Games)
logIn :: Text -> PlayerID -> T -> Either String T logIn :: Text -> PlayerID -> T -> Either String T
logIn name playerID server = logIn name playerID server =
Data.update (Set.insert name) . RW.update (Set.insert name) .
Data.update (insert playerID name) . RW.update (insert playerID name) .
update playerID (Data.set $ Session.LoggedIn True :: Session.Update) <$> update playerID (RW.set $ Session.LoggedIn True :: Session.Update) <$>
if name `member` names server if name `member` names server
then Left "This name is already registered" then Left "This name is already registered"
else Right server else Right server
@ -106,7 +106,7 @@ logOut playerID server =
maybe maybe
server server
(\playerName -> (\playerName ->
Data.update (delete playerID :: Players -> Players) $ RW.update (delete playerID :: Players -> Players) $
update playerID (Data.set $ Session.LoggedIn False :: Session.Update) $ update playerID (RW.set $ Session.LoggedIn False :: Session.Update) $
Data.update (Set.delete playerName :: Names -> Names) server) RW.update (Set.delete playerName :: Names -> Names) server)
(players server !? playerID) (players server !? playerID)

View file

@ -9,7 +9,7 @@ module Session (
import Network.WebSockets (Connection) import Network.WebSockets (Connection)
import Hanafuda.KoiKoi (GameID, PlayerID) import Hanafuda.KoiKoi (GameID, PlayerID)
import qualified Data (RW(..)) import qualified RW (RW(..))
data Status = data Status =
LoggedIn Bool LoggedIn Bool
@ -24,7 +24,7 @@ data T = T {
} }
type Update = T -> T type Update = T -> T
instance Data.RW Status T where instance RW.RW Status T where
get = status get = status
set status session = session {status} set status session = session {status}