server/src/Session.hs

{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Session (
      Status(..)
    , T(..)
    , Update
    , open
  ) where

import Network.WebSockets (Connection)
import Hanafuda.KoiKoi (GameID, PlayerID)
import qualified Data (RW(..))

data Status =
    LoggedIn Bool
  | Answering PlayerID
  | Waiting PlayerID
  | Playing GameID
  deriving (Show)

data T = T {
      connection :: Connection
    , status :: Status
  }
type Update = T -> T

instance Data.RW Status T where
  get = status
  set status session = session {status}

open :: Connection -> T
open connection = T {
      connection
    , status = LoggedIn False
  }