2018-04-11 13:25:24 +02:00
|
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
|
|
|
module Session (
|
2019-10-28 08:19:14 +01:00
|
|
|
ID
|
2019-11-12 23:25:00 +01:00
|
|
|
, Status
|
2018-04-11 13:25:24 +02:00
|
|
|
, T(..)
|
2018-05-13 18:08:12 +02:00
|
|
|
, Update
|
2018-05-11 12:31:53 +02:00
|
|
|
, open
|
2019-11-12 23:25:00 +01:00
|
|
|
, setPlayer
|
2018-04-11 13:25:24 +02:00
|
|
|
) where
|
|
|
|
|
2019-11-12 23:25:00 +01:00
|
|
|
import Data.Text (Text)
|
2019-11-20 18:26:23 +01:00
|
|
|
import qualified Hanafuda.ID as Hanafuda (ID, IDType(..), Prefix(..))
|
2019-11-12 23:25:00 +01:00
|
|
|
import Hanafuda.KoiKoi (PlayerID)
|
2019-10-13 22:00:35 +02:00
|
|
|
import Network.WebSockets (Connection)
|
2019-11-12 23:25:00 +01:00
|
|
|
import qualified Player (T(..))
|
2018-05-11 12:31:53 +02:00
|
|
|
|
2019-11-12 23:25:00 +01:00
|
|
|
type ID = Hanafuda.ID T
|
2019-11-20 18:26:23 +01:00
|
|
|
instance Hanafuda.IDType T where
|
|
|
|
prefix = Hanafuda.Prefix "Session"
|
2019-11-12 23:25:00 +01:00
|
|
|
type Status = Maybe Player.T
|
2018-04-11 13:25:24 +02:00
|
|
|
data T = T {
|
2018-05-11 12:31:53 +02:00
|
|
|
connection :: Connection
|
2019-11-12 23:25:00 +01:00
|
|
|
, player :: Status
|
2018-04-11 13:25:24 +02:00
|
|
|
}
|
2018-05-13 18:08:12 +02:00
|
|
|
type Update = T -> T
|
2018-04-11 13:25:24 +02:00
|
|
|
|
2019-11-12 23:25:00 +01:00
|
|
|
setPlayer :: PlayerID -> Text -> Session.Update
|
|
|
|
setPlayer playerID name session = session {
|
|
|
|
player = Just $ Player.T {Player.playerID, Player.name}
|
|
|
|
}
|
2018-04-11 13:25:24 +02:00
|
|
|
|
2018-05-11 12:31:53 +02:00
|
|
|
open :: Connection -> T
|
|
|
|
open connection = T {
|
|
|
|
connection
|
2019-11-05 18:14:24 +01:00
|
|
|
, player = Nothing
|
2018-05-11 12:31:53 +02:00
|
|
|
}
|