71 lines
1.8 KiB
Haskell
71 lines
1.8 KiB
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
{-# LANGUAGE TypeSynonymInstances #-}
|
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
{-# LANGUAGE TypeOperators #-}
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
module Player (
|
|
Login(..)
|
|
, Name(..)
|
|
, Status(..)
|
|
, T(..)
|
|
, new
|
|
) where
|
|
|
|
import Data.Monoid ((<>))
|
|
import Data.Text (Text)
|
|
import Data.Aeson (FromJSON(..), ToJSON(..), (.=), Value(..), genericToEncoding, object, pairs)
|
|
import qualified JSON (defaultOptions, singleLCField)
|
|
import qualified Data (RW(..))
|
|
import Network.WebSockets (Connection)
|
|
import GHC.Generics
|
|
|
|
newtype Name = Name Text deriving (Eq, Ord, Generic)
|
|
data Login = Anonymous | Login Name
|
|
|
|
data Status =
|
|
LoggedIn Bool
|
|
| Answering Name
|
|
| Waiting Name
|
|
deriving (Generic)
|
|
|
|
data T = T {
|
|
connection :: Connection
|
|
, login :: Login
|
|
, status :: Status
|
|
}
|
|
|
|
instance Data.RW Login T where
|
|
update f player@(T {login}) = player {login = f login}
|
|
|
|
instance Data.RW Status T where
|
|
update f player@(T {status}) = player {status = f status}
|
|
|
|
instance ToJSON Name where
|
|
toEncoding = genericToEncoding JSON.defaultOptions
|
|
instance FromJSON Name
|
|
|
|
instance ToJSON Login where
|
|
toJSON Anonymous = toJSON Null
|
|
toJSON (Login name) = toJSON name
|
|
toEncoding Anonymous = toEncoding Null
|
|
toEncoding (Login name) = toEncoding name
|
|
|
|
instance FromJSON Login where
|
|
parseJSON Null = return Anonymous
|
|
parseJSON s = Login <$> parseJSON s
|
|
|
|
instance ToJSON Status where
|
|
toEncoding = genericToEncoding JSON.singleLCField
|
|
|
|
instance ToJSON T where
|
|
toJSON (T {login, status}) = object ["login" .= login, "status" .= status]
|
|
toEncoding (T {login, status}) = pairs (
|
|
"login" .= login <> "status" .= status
|
|
)
|
|
|
|
new :: Connection -> T
|
|
new connection = T {connection, login = Anonymous, status = LoggedIn False}
|