module Rattletrap.Type.Attribute.WeldedInfo where

import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.F32 as F32
import qualified Rattletrap.Type.I32 as I32
import qualified Rattletrap.Type.Int8Vector as Int8Vector
import qualified Rattletrap.Type.Vector as Vector
import qualified Rattletrap.Type.Version as Version
import qualified Rattletrap.Utility.Json as Json

data WeldedInfo = WeldedInfo
  { WeldedInfo -> Bool
active :: Bool,
    WeldedInfo -> I32
actorId :: I32.I32,
    WeldedInfo -> Vector
offset :: Vector.Vector,
    WeldedInfo -> F32
mass :: F32.F32,
    WeldedInfo -> Int8Vector
rotation :: Int8Vector.Int8Vector
  }
  deriving (WeldedInfo -> WeldedInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WeldedInfo -> WeldedInfo -> Bool
$c/= :: WeldedInfo -> WeldedInfo -> Bool
== :: WeldedInfo -> WeldedInfo -> Bool
$c== :: WeldedInfo -> WeldedInfo -> Bool
Eq, Int -> WeldedInfo -> ShowS
[WeldedInfo] -> ShowS
WeldedInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WeldedInfo] -> ShowS
$cshowList :: [WeldedInfo] -> ShowS
show :: WeldedInfo -> String
$cshow :: WeldedInfo -> String
showsPrec :: Int -> WeldedInfo -> ShowS
$cshowsPrec :: Int -> WeldedInfo -> ShowS
Show)

instance Json.FromJSON WeldedInfo where
  parseJSON :: Value -> Parser WeldedInfo
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"WeldedInfo" forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    Bool
active <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"active"
    I32
actorId <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"actor_id"
    Vector
offset <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"offset"
    F32
mass <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"mass"
    Int8Vector
rotation <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"rotation"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure WeldedInfo {Bool
active :: Bool
active :: Bool
active, I32
actorId :: I32
actorId :: I32
actorId, Vector
offset :: Vector
offset :: Vector
offset, F32
mass :: F32
mass :: F32
mass, Int8Vector
rotation :: Int8Vector
rotation :: Int8Vector
rotation}

instance Json.ToJSON WeldedInfo where
  toJSON :: WeldedInfo -> Value
toJSON WeldedInfo
x =
    [(Key, Value)] -> Value
Json.object
      [ forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"active" forall a b. (a -> b) -> a -> b
$ WeldedInfo -> Bool
active WeldedInfo
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"actor_id" forall a b. (a -> b) -> a -> b
$ WeldedInfo -> I32
actorId WeldedInfo
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"offset" forall a b. (a -> b) -> a -> b
$ WeldedInfo -> Vector
offset WeldedInfo
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"mass" forall a b. (a -> b) -> a -> b
$ WeldedInfo -> F32
mass WeldedInfo
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"rotation" forall a b. (a -> b) -> a -> b
$ WeldedInfo -> Int8Vector
rotation WeldedInfo
x
      ]

schema :: Schema.Schema
schema :: Schema
schema =
  String -> Value -> Schema
Schema.named String
"attribute-welded-info" forall a b. (a -> b) -> a -> b
$
    [((Key, Value), Bool)] -> Value
Schema.object
      [ (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"active" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Schema.boolean, Bool
True),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"actor_id" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
I32.schema, Bool
True),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"offset" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Vector.schema, Bool
True),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"mass" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
F32.schema, Bool
True),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"rotation" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Int8Vector.schema, Bool
True)
      ]

bitPut :: WeldedInfo -> BitPut.BitPut
bitPut :: WeldedInfo -> BitPut
bitPut WeldedInfo
weldedInfoAttribute =
  Bool -> BitPut
BitPut.bool (WeldedInfo -> Bool
active WeldedInfo
weldedInfoAttribute)
    forall a. Semigroup a => a -> a -> a
<> I32 -> BitPut
I32.bitPut (WeldedInfo -> I32
actorId WeldedInfo
weldedInfoAttribute)
    forall a. Semigroup a => a -> a -> a
<> Vector -> BitPut
Vector.bitPut (WeldedInfo -> Vector
offset WeldedInfo
weldedInfoAttribute)
    forall a. Semigroup a => a -> a -> a
<> F32 -> BitPut
F32.bitPut (WeldedInfo -> F32
mass WeldedInfo
weldedInfoAttribute)
    forall a. Semigroup a => a -> a -> a
<> Int8Vector -> BitPut
Int8Vector.bitPut (WeldedInfo -> Int8Vector
rotation WeldedInfo
weldedInfoAttribute)

bitGet :: Version.Version -> BitGet.BitGet WeldedInfo
bitGet :: Version -> BitGet WeldedInfo
bitGet Version
version = forall a. String -> BitGet a -> BitGet a
BitGet.label String
"WeldedInfo" forall a b. (a -> b) -> a -> b
$ do
  Bool
active <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"active" BitGet Bool
BitGet.bool
  I32
actorId <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"actorId" BitGet I32
I32.bitGet
  Vector
offset <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"offset" forall a b. (a -> b) -> a -> b
$ Version -> BitGet Vector
Vector.bitGet Version
version
  F32
mass <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"mass" BitGet F32
F32.bitGet
  Int8Vector
rotation <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"rotation" BitGet Int8Vector
Int8Vector.bitGet
  forall (f :: * -> *) a. Applicative f => a -> f a
pure WeldedInfo {Bool
active :: Bool
active :: Bool
active, I32
actorId :: I32
actorId :: I32
actorId, Vector
offset :: Vector
offset :: Vector
offset, F32
mass :: F32
mass :: F32
mass, Int8Vector
rotation :: Int8Vector
rotation :: Int8Vector
rotation}