73 lines
1.7 KiB
Haskell
73 lines
1.7 KiB
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
module Player (
|
|
Key(..)
|
|
, Name
|
|
, Session(..)
|
|
, Status(..)
|
|
, T(..)
|
|
, new
|
|
, openSession
|
|
) where
|
|
|
|
import Data.Text (Text, pack)
|
|
import Data.Aeson (FromJSON(..), ToJSON(..), ToJSONKey(..), genericToEncoding)
|
|
import Data.Aeson.Types (toJSONKeyText)
|
|
import qualified JSON (defaultOptions)
|
|
import qualified Data (RW(..))
|
|
import Network.WebSockets (Connection)
|
|
import GHC.Generics
|
|
|
|
newtype Key = Key Int deriving (Eq, Ord, Read, Show, Generic)
|
|
newtype Name = Name Text deriving (Eq, Ord, Generic)
|
|
|
|
data T = T {
|
|
key :: Key
|
|
, name :: Name
|
|
}
|
|
deriving (Generic)
|
|
|
|
instance Data.RW Key T where
|
|
update f player@(T {key}) = player {key = f key}
|
|
|
|
instance Data.RW Name T where
|
|
update f player@(T {name}) = player {name = f name}
|
|
|
|
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
|
|
|
|
instance ToJSON T where
|
|
toEncoding = genericToEncoding JSON.defaultOptions
|
|
|
|
data Status =
|
|
LoggedIn Bool
|
|
| Answering Key
|
|
| Waiting Key
|
|
deriving (Generic)
|
|
|
|
data Session = Session {
|
|
connection :: Connection
|
|
, status :: Status
|
|
}
|
|
|
|
instance Data.RW Status Session where
|
|
update f session@(Session {status}) = session {status = f status}
|
|
|
|
new :: Key -> Name -> T
|
|
new key name = T {key, name}
|
|
|
|
openSession :: Connection -> Session
|
|
openSession connection = Session {
|
|
connection
|
|
, status = LoggedIn False
|
|
}
|