{-# 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}