module Rattletrap.Type.Attribute.PrivateMatchSettings where

import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.Str as Str
import qualified Rattletrap.Type.U32 as U32
import qualified Rattletrap.Utility.Json as Json

data PrivateMatchSettings = PrivateMatchSettings
  { PrivateMatchSettings -> Str
mutators :: Str.Str,
    PrivateMatchSettings -> U32
joinableBy :: U32.U32,
    PrivateMatchSettings -> U32
maxPlayers :: U32.U32,
    PrivateMatchSettings -> Str
gameName :: Str.Str,
    PrivateMatchSettings -> Str
password :: Str.Str,
    PrivateMatchSettings -> Bool
flag :: Bool
  }
  deriving (PrivateMatchSettings -> PrivateMatchSettings -> Bool
(PrivateMatchSettings -> PrivateMatchSettings -> Bool)
-> (PrivateMatchSettings -> PrivateMatchSettings -> Bool)
-> Eq PrivateMatchSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PrivateMatchSettings -> PrivateMatchSettings -> Bool
== :: PrivateMatchSettings -> PrivateMatchSettings -> Bool
$c/= :: PrivateMatchSettings -> PrivateMatchSettings -> Bool
/= :: PrivateMatchSettings -> PrivateMatchSettings -> Bool
Eq, Int -> PrivateMatchSettings -> ShowS
[PrivateMatchSettings] -> ShowS
PrivateMatchSettings -> String
(Int -> PrivateMatchSettings -> ShowS)
-> (PrivateMatchSettings -> String)
-> ([PrivateMatchSettings] -> ShowS)
-> Show PrivateMatchSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PrivateMatchSettings -> ShowS
showsPrec :: Int -> PrivateMatchSettings -> ShowS
$cshow :: PrivateMatchSettings -> String
show :: PrivateMatchSettings -> String
$cshowList :: [PrivateMatchSettings] -> ShowS
showList :: [PrivateMatchSettings] -> ShowS
Show)

instance Json.FromJSON PrivateMatchSettings where
  parseJSON :: Value -> Parser PrivateMatchSettings
parseJSON = String
-> (Object -> Parser PrivateMatchSettings)
-> Value
-> Parser PrivateMatchSettings
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"PrivateMatchSettings" ((Object -> Parser PrivateMatchSettings)
 -> Value -> Parser PrivateMatchSettings)
-> (Object -> Parser PrivateMatchSettings)
-> Value
-> Parser PrivateMatchSettings
forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    mutators <- Object -> String -> Parser Str
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"mutators"
    joinableBy <- Json.required object "joinable_by"
    maxPlayers <- Json.required object "max_players"
    gameName <- Json.required object "game_name"
    password <- Json.required object "password"
    flag <- Json.required object "flag"
    pure
      PrivateMatchSettings
        { mutators,
          joinableBy,
          maxPlayers,
          gameName,
          password,
          flag
        }

instance Json.ToJSON PrivateMatchSettings where
  toJSON :: PrivateMatchSettings -> Value
toJSON PrivateMatchSettings
x =
    [(Key, Value)] -> Value
Json.object
      [ String -> Str -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"mutators" (Str -> (Key, Value)) -> Str -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ PrivateMatchSettings -> Str
mutators PrivateMatchSettings
x,
        String -> U32 -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"joinable_by" (U32 -> (Key, Value)) -> U32 -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ PrivateMatchSettings -> U32
joinableBy PrivateMatchSettings
x,
        String -> U32 -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"max_players" (U32 -> (Key, Value)) -> U32 -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ PrivateMatchSettings -> U32
maxPlayers PrivateMatchSettings
x,
        String -> Str -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"game_name" (Str -> (Key, Value)) -> Str -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ PrivateMatchSettings -> Str
gameName PrivateMatchSettings
x,
        String -> Str -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"password" (Str -> (Key, Value)) -> Str -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ PrivateMatchSettings -> Str
password PrivateMatchSettings
x,
        String -> Bool -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"flag" (Bool -> (Key, Value)) -> Bool -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ PrivateMatchSettings -> Bool
flag PrivateMatchSettings
x
      ]

schema :: Schema.Schema
schema :: Schema
schema =
  String -> Value -> Schema
Schema.named String
"attribute-private-match-settings" (Value -> Schema) -> Value -> Schema
forall a b. (a -> b) -> a -> b
$
    [((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
"mutators" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Str.schema, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"joinable_by" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
U32.schema, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"max_players" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
U32.schema, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"game_name" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Str.schema, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"password" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Str.schema, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"flag" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Schema.boolean, Bool
True)
      ]

bitPut :: PrivateMatchSettings -> BitPut.BitPut
bitPut :: PrivateMatchSettings -> BitPut
bitPut PrivateMatchSettings
privateMatchSettingsAttribute =
  Str -> BitPut
Str.bitPut (PrivateMatchSettings -> Str
mutators PrivateMatchSettings
privateMatchSettingsAttribute)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> U32 -> BitPut
U32.bitPut (PrivateMatchSettings -> U32
joinableBy PrivateMatchSettings
privateMatchSettingsAttribute)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> U32 -> BitPut
U32.bitPut (PrivateMatchSettings -> U32
maxPlayers PrivateMatchSettings
privateMatchSettingsAttribute)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> Str -> BitPut
Str.bitPut (PrivateMatchSettings -> Str
gameName PrivateMatchSettings
privateMatchSettingsAttribute)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> Str -> BitPut
Str.bitPut (PrivateMatchSettings -> Str
password PrivateMatchSettings
privateMatchSettingsAttribute)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> Bool -> BitPut
BitPut.bool (PrivateMatchSettings -> Bool
flag PrivateMatchSettings
privateMatchSettingsAttribute)

bitGet :: BitGet.BitGet PrivateMatchSettings
bitGet :: BitGet PrivateMatchSettings
bitGet = String
-> BitGet PrivateMatchSettings -> BitGet PrivateMatchSettings
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"PrivateMatchSettings" (BitGet PrivateMatchSettings -> BitGet PrivateMatchSettings)
-> BitGet PrivateMatchSettings -> BitGet PrivateMatchSettings
forall a b. (a -> b) -> a -> b
$ do
  mutators <- String -> BitGet Str -> BitGet Str
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"mutators" BitGet Str
Str.bitGet
  joinableBy <- BitGet.label "joinableBy" U32.bitGet
  maxPlayers <- BitGet.label "maxPlayers" U32.bitGet
  gameName <- BitGet.label "gameName" Str.bitGet
  password <- BitGet.label "password" Str.bitGet
  flag <- BitGet.label "flag" BitGet.bool
  pure
    PrivateMatchSettings
      { mutators,
        joinableBy,
        maxPlayers,
        gameName,
        password,
        flag
      }