{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE OverloadedStrings #-}
module Hanafuda.Message (
  ) where

import Data.Char (toLower)
import Data.Aeson (
      FromJSON(..), Options(..), SumEncoding(..), ToJSON(..), ToJSONKey(..)
    , Value, (.=), defaultOptions, eitherDecode', encode, genericParseJSON
    , genericToEncoding, object, pairs
  )
import Data.Aeson.Types (toJSONKeyText)
import Data.Map (Map)
import Data.Text (Text)
import qualified Data.Text as Text (pack)
import GHC.Generics (Generic)
import qualified Hanafuda (Card(..))
import Hanafuda.Key (Key(..), getKey)
import Hanafuda.KoiKoi (PlayerKey)
import qualified Hanafuda.KoiKoi as KoiKoi (Action(..), Game(..), Move(..), Source(..))

deriving instance Generic PlayerKey
instance FromJSON PlayerKey
instance ToJSON PlayerKey where
  toEncoding = genericToEncoding defaultOptions
instance ToJSONKey PlayerKey where
  toJSONKey = toJSONKeyText (Text.pack . getKey)

first :: (a -> a) -> [a] -> [a]
first _ [] = []
first f (x:xs) = f x:xs

singleLCField :: Options
singleLCField = defaultOptions {
      constructorTagModifier = (toLower `first`)
    , sumEncoding = ObjectWithSingleField
  }

deriving instance Generic KoiKoi.Move
instance FromJSON KoiKoi.Move where
  parseJSON = genericParseJSON singleLCField
instance ToJSON KoiKoi.Move where
  toEncoding = genericToEncoding singleLCField

deriving instance Generic Hanafuda.Card
instance FromJSON Hanafuda.Card
instance ToJSON Hanafuda.Card where
  toEncoding = genericToEncoding defaultOptions

data FromClient =
    Answer {accept :: Bool}
  | Invitation {to :: PlayerKey}
  | LogIn {name :: Text}
  | LogOut
  | Play {move :: KoiKoi.Move}
  | Quit
  | Ping
  deriving (Generic)

instance FromJSON FromClient
instance ToJSON FromClient where
  toEncoding = genericToEncoding defaultOptions

newtype PlayerStatus = PlayerStatus (Text, Bool)

instance ToJSON PlayerStatus where
  toJSON (PlayerStatus (name, alone)) =
    object ["name" .= name, "alone" .= alone]
  toEncoding (PlayerStatus (name, alone)) =
    pairs ("name" .= name <> "alone" .= alone)

type Room = Map PlayerKey PlayerStatus

deriving instance Generic KoiKoi.Source
instance ToJSON KoiKoi.Source

deriving instance Generic KoiKoi.Action
instance ToJSON KoiKoi.Action

data T =
    Relay {from :: PlayerKey, message :: FromClient}
  | Welcome {room :: Room, key :: PlayerKey}
  | Update {alone :: [PlayerKey], paired :: [PlayerKey]}
  | Game {game :: Value, logs :: [KoiKoi.Action]}
  | Pong
  | Error {error :: String}
  deriving (Generic)

instance ToJSON T where
  toEncoding = genericToEncoding defaultOptions