module Rattletrap.Type.Attribute.Loadouts where

import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.Attribute.Loadout as Loadout
import qualified Rattletrap.Utility.Json as Json

data Loadouts = Loadouts
  { Loadouts -> Loadout
blue :: Loadout.Loadout,
    Loadouts -> Loadout
orange :: Loadout.Loadout
  }
  deriving (Loadouts -> Loadouts -> Bool
(Loadouts -> Loadouts -> Bool)
-> (Loadouts -> Loadouts -> Bool) -> Eq Loadouts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Loadouts -> Loadouts -> Bool
== :: Loadouts -> Loadouts -> Bool
$c/= :: Loadouts -> Loadouts -> Bool
/= :: Loadouts -> Loadouts -> Bool
Eq, Int -> Loadouts -> ShowS
[Loadouts] -> ShowS
Loadouts -> String
(Int -> Loadouts -> ShowS)
-> (Loadouts -> String) -> ([Loadouts] -> ShowS) -> Show Loadouts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Loadouts -> ShowS
showsPrec :: Int -> Loadouts -> ShowS
$cshow :: Loadouts -> String
show :: Loadouts -> String
$cshowList :: [Loadouts] -> ShowS
showList :: [Loadouts] -> ShowS
Show)

instance Json.FromJSON Loadouts where
  parseJSON :: Value -> Parser Loadouts
parseJSON = String -> (Object -> Parser Loadouts) -> Value -> Parser Loadouts
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"Loadouts" ((Object -> Parser Loadouts) -> Value -> Parser Loadouts)
-> (Object -> Parser Loadouts) -> Value -> Parser Loadouts
forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    Loadout
blue <- Object -> String -> Parser Loadout
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"blue"
    Loadout
orange <- Object -> String -> Parser Loadout
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"orange"
    Loadouts -> Parser Loadouts
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Loadouts {Loadout
blue :: Loadout
blue :: Loadout
blue, Loadout
orange :: Loadout
orange :: Loadout
orange}

instance Json.ToJSON Loadouts where
  toJSON :: Loadouts -> Value
toJSON Loadouts
x =
    [(Key, Value)] -> Value
Json.object [String -> Loadout -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"blue" (Loadout -> (Key, Value)) -> Loadout -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Loadouts -> Loadout
blue Loadouts
x, String -> Loadout -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"orange" (Loadout -> (Key, Value)) -> Loadout -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Loadouts -> Loadout
orange Loadouts
x]

schema :: Schema.Schema
schema :: Schema
schema =
  String -> Value -> Schema
Schema.named String
"attribute-loadouts" (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
"blue" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Loadout.schema, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"orange" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Loadout.schema, Bool
True)
      ]

bitPut :: Loadouts -> BitPut.BitPut
bitPut :: Loadouts -> BitPut
bitPut Loadouts
loadoutsAttribute =
  Loadout -> BitPut
Loadout.bitPut (Loadouts -> Loadout
blue Loadouts
loadoutsAttribute)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> Loadout -> BitPut
Loadout.bitPut (Loadouts -> Loadout
orange Loadouts
loadoutsAttribute)

bitGet :: BitGet.BitGet Loadouts
bitGet :: BitGet Loadouts
bitGet = String -> BitGet Loadouts -> BitGet Loadouts
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"Loadouts" (BitGet Loadouts -> BitGet Loadouts)
-> BitGet Loadouts -> BitGet Loadouts
forall a b. (a -> b) -> a -> b
$ do
  Loadout
blue <- String -> BitGet Loadout -> BitGet Loadout
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"blue" BitGet Loadout
Loadout.bitGet
  Loadout
orange <- String -> BitGet Loadout -> BitGet Loadout
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"orange" BitGet Loadout
Loadout.bitGet
  Loadouts -> BitGet Loadouts
forall a. a -> Get BitString Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Loadouts {Loadout
blue :: Loadout
blue :: Loadout
blue, Loadout
orange :: Loadout
orange :: Loadout
orange}