diff --git a/hanafuda-webapp.cabal b/hanafuda-webapp.cabal index b22adf0..e23e969 100644 --- a/hanafuda-webapp.cabal +++ b/hanafuda-webapp.cabal @@ -26,7 +26,7 @@ executable hanafudapi , Config , Messaging , Game - , Data + , RW , Server , Session -- other-extensions: diff --git a/src/Automaton.hs b/src/Automaton.hs index b6c18d0..9280932 100644 --- a/src/Automaton.hs +++ b/src/Automaton.hs @@ -4,7 +4,7 @@ module Automaton ( ) where import Control.Monad.Reader (asks) -import qualified Data (RW(..)) +import qualified RW (RW(..)) import Data.Map (Map, (!?)) import qualified Game (new, play) 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 Session.LoggedIn True -> do 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.relay invitation $ Messaging.sendTo [to]) setSessionStatus (Session.Waiting to) @@ -58,7 +58,7 @@ receive (Session.Answering to) message@(Message.Answer {Message.accept}) = do else do Messaging.broadcast $ Messaging.update {Message.alone = [for, to]} 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 _ -> sendError "They're not waiting for your answer" @@ -77,7 +77,7 @@ receive (Session.Playing gameID) played@(Message.Play {}) = do Messaging.notifyPlayers newGame logs 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 Nothing -> do playerID <- asks App.playerID @@ -93,7 +93,7 @@ sendError = Messaging.send . Message.Error setSessionStatus :: Session.Status -> App.T () setSessionStatus newStatus = do 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 loop :: App.T () diff --git a/src/Data.hs b/src/RW.hs similarity index 93% rename from src/Data.hs rename to src/RW.hs index 9e1e13a..5519911 100644 --- a/src/Data.hs +++ b/src/RW.hs @@ -1,5 +1,5 @@ {-# LANGUAGE MultiParamTypeClasses #-} -module Data ( +module RW ( RW(..) ) where diff --git a/src/Server.hs b/src/Server.hs index e9b979a..82b5755 100644 --- a/src/Server.hs +++ b/src/Server.hs @@ -23,7 +23,7 @@ import qualified Data.Set as Set (delete, empty, insert) import Data.Text (Text) import Hanafuda.KoiKoi (Game, GameID, PlayerID) import Hanafuda.Message (PlayerStatus(..), Room) -import qualified Data (RW(..)) +import qualified RW (RW(..)) import qualified Session (Status(..), T(..), Update) type Names = Set Text @@ -37,19 +37,19 @@ data T = T { , games :: Games } -instance Data.RW Names T where +instance RW.RW Names T where get = names set names server = server {names} -instance Data.RW Players T where +instance RW.RW Players T where get = players set players server = server {players} -instance Data.RW Sessions T where +instance RW.RW Sessions T where get = sessions set sessions server = server {sessions} -instance Data.RW Games T where +instance RW.RW Games T where get = games set games server = server {games} @@ -72,31 +72,31 @@ new = T { , 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 = - let playerID = maybe (toEnum 0) (\(n, _) -> succ n) $ lookupMax $ (Data.get server :: Map a b) in - (Data.update (insert playerID x) server, playerID) + let playerID = maybe (toEnum 0) (\(n, _) -> succ n) $ lookupMax $ (RW.get server :: Map a b) in + (RW.update (insert playerID x) server, playerID) -get :: forall a b. (Ord a, Data.RW (Map a b) T) => a -> T -> b -get playerID server = (Data.get server :: Map a b) ! playerID +get :: forall a b. (Ord a, RW.RW (Map a b) T) => a -> T -> b +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 = - 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 = - Data.update (delete playerID :: Sessions -> Sessions) . logOut playerID + RW.update (delete playerID :: Sessions -> Sessions) . logOut playerID endGame :: GameID -> T -> T endGame playerID = - Data.update (delete playerID :: Games -> Games) + RW.update (delete playerID :: Games -> Games) logIn :: Text -> PlayerID -> T -> Either String T logIn name playerID server = - Data.update (Set.insert name) . - Data.update (insert playerID name) . - update playerID (Data.set $ Session.LoggedIn True :: Session.Update) <$> + RW.update (Set.insert name) . + RW.update (insert playerID name) . + update playerID (RW.set $ Session.LoggedIn True :: Session.Update) <$> if name `member` names server then Left "This name is already registered" else Right server @@ -106,7 +106,7 @@ logOut playerID server = maybe server (\playerName -> - Data.update (delete playerID :: Players -> Players) $ - update playerID (Data.set $ Session.LoggedIn False :: Session.Update) $ - Data.update (Set.delete playerName :: Names -> Names) server) + RW.update (delete playerID :: Players -> Players) $ + update playerID (RW.set $ Session.LoggedIn False :: Session.Update) $ + RW.update (Set.delete playerName :: Names -> Names) server) (players server !? playerID) diff --git a/src/Session.hs b/src/Session.hs index 8937543..7d61b60 100644 --- a/src/Session.hs +++ b/src/Session.hs @@ -9,7 +9,7 @@ module Session ( import Network.WebSockets (Connection) import Hanafuda.KoiKoi (GameID, PlayerID) -import qualified Data (RW(..)) +import qualified RW (RW(..)) data Status = LoggedIn Bool @@ -24,7 +24,7 @@ data T = T { } type Update = T -> T -instance Data.RW Status T where +instance RW.RW Status T where get = status set status session = session {status}