53 lines
1.3 KiB
Haskell
53 lines
1.3 KiB
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
module Player (
|
|
Key(..)
|
|
, Name
|
|
, Session(..)
|
|
, Status(..)
|
|
, 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)
|
|
|
|
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
|
|
|
|
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}
|
|
|
|
openSession :: Connection -> Session
|
|
openSession connection = Session {
|
|
connection
|
|
, status = LoggedIn False
|
|
}
|