Rename poorly named module Data to RW
This commit is contained in:
parent
e9205b67c7
commit
0778c4a675
5 changed files with 29 additions and 29 deletions
|
@ -26,7 +26,7 @@ executable hanafudapi
|
||||||
, Config
|
, Config
|
||||||
, Messaging
|
, Messaging
|
||||||
, Game
|
, Game
|
||||||
, Data
|
, RW
|
||||||
, Server
|
, Server
|
||||||
, Session
|
, Session
|
||||||
-- other-extensions:
|
-- other-extensions:
|
||||||
|
|
|
@ -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 ()
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
module Data (
|
module RW (
|
||||||
RW(..)
|
RW(..)
|
||||||
) where
|
) where
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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}
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue