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
|
||||
, Messaging
|
||||
, Game
|
||||
, JSON
|
||||
, Data
|
||||
, Player
|
||||
, Server
|
||||
, Session
|
||||
-- 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.Message (PlayerStatus(..), Room)
|
||||
import qualified Data (RW(..))
|
||||
import qualified Player (T(..))
|
||||
import qualified Session (Status(..), T(..), Update)
|
||||
|
||||
type Names = Set Text
|
||||
type Players = Map PlayerID Player.T
|
||||
type Players = Map PlayerID Text
|
||||
type Sessions = Map PlayerID Session.T
|
||||
type Games = Map GameID Game
|
||||
data T = T {
|
||||
|
@ -54,8 +53,8 @@ instance Data.RW Games T where
|
|||
get = games
|
||||
set games server = server {games}
|
||||
|
||||
export :: Sessions -> PlayerID -> Player.T -> PlayerStatus
|
||||
export sessions playerID player = PlayerStatus (Player.name player, alone)
|
||||
export :: Sessions -> PlayerID -> Text -> PlayerStatus
|
||||
export sessions playerID playerName = PlayerStatus (playerName, alone)
|
||||
where
|
||||
alone =
|
||||
case Session.status (sessions ! playerID) of
|
||||
|
@ -96,7 +95,7 @@ endGame playerID =
|
|||
logIn :: Text -> PlayerID -> T -> Either String T
|
||||
logIn name playerID server =
|
||||
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) <$>
|
||||
if name `member` names server
|
||||
then Left "This name is already registered"
|
||||
|
@ -106,8 +105,8 @@ logOut :: PlayerID -> T -> T
|
|||
logOut playerID server =
|
||||
maybe
|
||||
server
|
||||
(\player ->
|
||||
(\playerName ->
|
||||
Data.update (delete playerID :: Players -> Players) $
|
||||
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)
|
||||
|
|
Loading…
Reference in a new issue