Get rid of modules rendered obsolete by recent refactoring
This commit is contained in:
parent
3e7c0a88f1
commit
5c9e0c9061
4 changed files with 6 additions and 63 deletions
|
@ -26,9 +26,7 @@ executable hanafudapi
|
||||||
, Config
|
, Config
|
||||||
, Messaging
|
, Messaging
|
||||||
, Game
|
, Game
|
||||||
, JSON
|
|
||||||
, Data
|
, Data
|
||||||
, Player
|
|
||||||
, Server
|
, Server
|
||||||
, Session
|
, Session
|
||||||
-- other-extensions:
|
-- other-extensions:
|
||||||
|
|
27
src/JSON.hs
27
src/JSON.hs
|
@ -1,27 +0,0 @@
|
||||||
module JSON (
|
|
||||||
defaultOptions
|
|
||||||
, distinct
|
|
||||||
, singleLCField
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Data.Char (toLower)
|
|
||||||
import Data.Aeson (
|
|
||||||
Options(..)
|
|
||||||
, SumEncoding(..)
|
|
||||||
, defaultOptions
|
|
||||||
)
|
|
||||||
|
|
||||||
first :: (a -> a) -> [a] -> [a]
|
|
||||||
first _ [] = []
|
|
||||||
first f (x:xs) = f x:xs
|
|
||||||
|
|
||||||
singleLCField :: Options
|
|
||||||
singleLCField = defaultOptions {
|
|
||||||
constructorTagModifier = (toLower `first`)
|
|
||||||
, sumEncoding = ObjectWithSingleField
|
|
||||||
}
|
|
||||||
|
|
||||||
distinct :: Options
|
|
||||||
distinct = defaultOptions {
|
|
||||||
sumEncoding = UntaggedValue
|
|
||||||
}
|
|
|
@ -1,27 +0,0 @@
|
||||||
{-# LANGUAGE NamedFieldPuns #-}
|
|
||||||
{-# LANGUAGE DeriveGeneric #-}
|
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
||||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
|
||||||
module Player (
|
|
||||||
T(..)
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Data.Text (Text)
|
|
||||||
import GHC.Generics
|
|
||||||
|
|
||||||
data T = T {
|
|
||||||
name :: Text
|
|
||||||
} deriving (Eq, Ord, Generic)
|
|
||||||
|
|
||||||
{-
|
|
||||||
instance FromJSON Key
|
|
||||||
instance ToJSON Key where
|
|
||||||
toEncoding = genericToEncoding JSON.defaultOptions
|
|
||||||
|
|
||||||
instance ToJSONKey Key where
|
|
||||||
toJSONKey = toJSONKeyText (pack . \(Key n) -> show n)
|
|
||||||
|
|
||||||
instance FromJSON Name
|
|
||||||
instance ToJSON Name where
|
|
||||||
toEncoding = genericToEncoding JSON.defaultOptions
|
|
||||||
-}
|
|
|
@ -24,11 +24,10 @@ 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 Data (RW(..))
|
||||||
import qualified Player (T(..))
|
|
||||||
import qualified Session (Status(..), T(..), Update)
|
import qualified Session (Status(..), T(..), Update)
|
||||||
|
|
||||||
type Names = Set Text
|
type Names = Set Text
|
||||||
type Players = Map PlayerID Player.T
|
type Players = Map PlayerID Text
|
||||||
type Sessions = Map PlayerID Session.T
|
type Sessions = Map PlayerID Session.T
|
||||||
type Games = Map GameID Game
|
type Games = Map GameID Game
|
||||||
data T = T {
|
data T = T {
|
||||||
|
@ -54,8 +53,8 @@ instance Data.RW Games T where
|
||||||
get = games
|
get = games
|
||||||
set games server = server {games}
|
set games server = server {games}
|
||||||
|
|
||||||
export :: Sessions -> PlayerID -> Player.T -> PlayerStatus
|
export :: Sessions -> PlayerID -> Text -> PlayerStatus
|
||||||
export sessions playerID player = PlayerStatus (Player.name player, alone)
|
export sessions playerID playerName = PlayerStatus (playerName, alone)
|
||||||
where
|
where
|
||||||
alone =
|
alone =
|
||||||
case Session.status (sessions ! playerID) of
|
case Session.status (sessions ! playerID) of
|
||||||
|
@ -96,7 +95,7 @@ endGame playerID =
|
||||||
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) .
|
Data.update (Set.insert name) .
|
||||||
Data.update (insert playerID $ Player.T {Player.name}) .
|
Data.update (insert playerID name) .
|
||||||
update playerID (Data.set $ Session.LoggedIn True :: Session.Update) <$>
|
update playerID (Data.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"
|
||||||
|
@ -106,8 +105,8 @@ logOut :: PlayerID -> T -> T
|
||||||
logOut playerID server =
|
logOut playerID server =
|
||||||
maybe
|
maybe
|
||||||
server
|
server
|
||||||
(\player ->
|
(\playerName ->
|
||||||
Data.update (delete playerID :: Players -> Players) $
|
Data.update (delete playerID :: Players -> Players) $
|
||||||
update playerID (Data.set $ Session.LoggedIn False :: Session.Update) $
|
update playerID (Data.set $ Session.LoggedIn False :: Session.Update) $
|
||||||
Data.update (Set.delete $ Player.name player :: Names -> Names) server)
|
Data.update (Set.delete playerName :: Names -> Names) server)
|
||||||
(players server !? playerID)
|
(players server !? playerID)
|
||||||
|
|
Loading…
Reference in a new issue