module Rattletrap.Type.Attribute.GameServer where

import qualified Data.Foldable as Foldable
import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.Attribute.QWord as QWord
import qualified Rattletrap.Type.Str as Str
import qualified Rattletrap.Utility.Json as Json

data GameServer
  = Old QWord.QWord
  | New Str.Str
  deriving (GameServer -> GameServer -> Bool
(GameServer -> GameServer -> Bool)
-> (GameServer -> GameServer -> Bool) -> Eq GameServer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GameServer -> GameServer -> Bool
== :: GameServer -> GameServer -> Bool
$c/= :: GameServer -> GameServer -> Bool
/= :: GameServer -> GameServer -> Bool
Eq, Int -> GameServer -> ShowS
[GameServer] -> ShowS
GameServer -> String
(Int -> GameServer -> ShowS)
-> (GameServer -> String)
-> ([GameServer] -> ShowS)
-> Show GameServer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GameServer -> ShowS
showsPrec :: Int -> GameServer -> ShowS
$cshow :: GameServer -> String
show :: GameServer -> String
$cshowList :: [GameServer] -> ShowS
showList :: [GameServer] -> ShowS
Show)

instance Json.FromJSON GameServer where
  parseJSON :: Value -> Parser GameServer
parseJSON = String
-> (Object -> Parser GameServer) -> Value -> Parser GameServer
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"GameServer" ((Object -> Parser GameServer) -> Value -> Parser GameServer)
-> (Object -> Parser GameServer) -> Value -> Parser GameServer
forall a b. (a -> b) -> a -> b
$ \Object
x ->
    [Parser GameServer] -> Parser GameServer
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
Foldable.asum
      [(QWord -> GameServer) -> Parser QWord -> Parser GameServer
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap QWord -> GameServer
Old (Parser QWord -> Parser GameServer)
-> Parser QWord -> Parser GameServer
forall a b. (a -> b) -> a -> b
$ Object -> String -> Parser QWord
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
x String
"old", (Str -> GameServer) -> Parser Str -> Parser GameServer
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Str -> GameServer
New (Parser Str -> Parser GameServer)
-> Parser Str -> Parser GameServer
forall a b. (a -> b) -> a -> b
$ Object -> String -> Parser Str
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
x String
"new"]

instance Json.ToJSON GameServer where
  toJSON :: GameServer -> Value
toJSON GameServer
x = case GameServer
x of
    Old QWord
y -> [(Key, Value)] -> Value
Json.object [String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"old" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ QWord -> Value
forall a. ToJSON a => a -> Value
Json.toJSON QWord
y]
    New Str
y -> [(Key, Value)] -> Value
Json.object [String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"new" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Str -> Value
forall a. ToJSON a => a -> Value
Json.toJSON Str
y]

schema :: Schema.Schema
schema :: Schema
schema =
  String -> Value -> Schema
Schema.named String
"attribute-game-server" (Value -> Schema) -> ([Value] -> Value) -> [Value] -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Value
Schema.oneOf ([Value] -> Schema) -> [Value] -> Schema
forall a b. (a -> b) -> a -> b
$
    ((String, Value) -> Value) -> [(String, Value)] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      (\(String
k, Value
v) -> [((Key, Value), Bool)] -> Value
Schema.object [(String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
k Value
v, Bool
True)])
      [(String
"old", Schema -> Value
Schema.ref Schema
QWord.schema), (String
"new", Schema -> Value
Schema.ref Schema
Str.schema)]

bitPut :: GameServer -> BitPut.BitPut
bitPut :: GameServer -> BitPut
bitPut GameServer
x = case GameServer
x of
  Old QWord
y -> QWord -> BitPut
QWord.bitPut QWord
y
  New Str
y -> Str -> BitPut
Str.bitPut Str
y

bitGet :: Maybe Str.Str -> BitGet.BitGet GameServer
bitGet :: Maybe Str -> BitGet GameServer
bitGet Maybe Str
buildVersion =
  String -> BitGet GameServer -> BitGet GameServer
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"GameServer" (BitGet GameServer -> BitGet GameServer)
-> BitGet GameServer -> BitGet GameServer
forall a b. (a -> b) -> a -> b
$
    if Maybe Str
buildVersion Maybe Str -> Maybe Str -> Bool
forall a. Ord a => a -> a -> Bool
>= Str -> Maybe Str
forall a. a -> Maybe a
Just (String -> Str
Str.fromString String
"221120.42953.406184")
      then String -> BitGet GameServer -> BitGet GameServer
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"New" (BitGet GameServer -> BitGet GameServer)
-> BitGet GameServer -> BitGet GameServer
forall a b. (a -> b) -> a -> b
$ (Str -> GameServer)
-> Get BitString Identity Str -> BitGet GameServer
forall a b.
(a -> b) -> Get BitString Identity a -> Get BitString Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Str -> GameServer
New Get BitString Identity Str
Str.bitGet
      else String -> BitGet GameServer -> BitGet GameServer
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"Old" (BitGet GameServer -> BitGet GameServer)
-> BitGet GameServer -> BitGet GameServer
forall a b. (a -> b) -> a -> b
$ (QWord -> GameServer)
-> Get BitString Identity QWord -> BitGet GameServer
forall a b.
(a -> b) -> Get BitString Identity a -> Get BitString Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap QWord -> GameServer
Old Get BitString Identity QWord
QWord.bitGet