module Rattletrap.Type.Int8Vector where

import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.I8 as I8
import qualified Rattletrap.Utility.Json as Json
import qualified Rattletrap.Utility.Monad as Monad

data Int8Vector = Int8Vector
  { Int8Vector -> Maybe I8
x :: Maybe I8.I8
  , Int8Vector -> Maybe I8
y :: Maybe I8.I8
  , Int8Vector -> Maybe I8
z :: Maybe I8.I8
  }
  deriving (Int8Vector -> Int8Vector -> Bool
(Int8Vector -> Int8Vector -> Bool)
-> (Int8Vector -> Int8Vector -> Bool) -> Eq Int8Vector
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Int8Vector -> Int8Vector -> Bool
$c/= :: Int8Vector -> Int8Vector -> Bool
== :: Int8Vector -> Int8Vector -> Bool
$c== :: Int8Vector -> Int8Vector -> Bool
Eq, Int -> Int8Vector -> ShowS
[Int8Vector] -> ShowS
Int8Vector -> String
(Int -> Int8Vector -> ShowS)
-> (Int8Vector -> String)
-> ([Int8Vector] -> ShowS)
-> Show Int8Vector
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Int8Vector] -> ShowS
$cshowList :: [Int8Vector] -> ShowS
show :: Int8Vector -> String
$cshow :: Int8Vector -> String
showsPrec :: Int -> Int8Vector -> ShowS
$cshowsPrec :: Int -> Int8Vector -> ShowS
Show)

instance Json.FromJSON Int8Vector where
  parseJSON :: Value -> Parser Int8Vector
parseJSON = String
-> (Object -> Parser Int8Vector) -> Value -> Parser Int8Vector
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"Int8Vector" ((Object -> Parser Int8Vector) -> Value -> Parser Int8Vector)
-> (Object -> Parser Int8Vector) -> Value -> Parser Int8Vector
forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    Maybe I8
x <- Object -> String -> Parser (Maybe I8)
forall value.
FromJSON value =>
Object -> String -> Parser (Maybe value)
Json.optional Object
object String
"x"
    Maybe I8
y <- Object -> String -> Parser (Maybe I8)
forall value.
FromJSON value =>
Object -> String -> Parser (Maybe value)
Json.optional Object
object String
"y"
    Maybe I8
z <- Object -> String -> Parser (Maybe I8)
forall value.
FromJSON value =>
Object -> String -> Parser (Maybe value)
Json.optional Object
object String
"z"
    Int8Vector -> Parser Int8Vector
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int8Vector :: Maybe I8 -> Maybe I8 -> Maybe I8 -> Int8Vector
Int8Vector { Maybe I8
x :: Maybe I8
x :: Maybe I8
x, Maybe I8
y :: Maybe I8
y :: Maybe I8
y, Maybe I8
z :: Maybe I8
z :: Maybe I8
z }

instance Json.ToJSON Int8Vector where
  toJSON :: Int8Vector -> Value
toJSON Int8Vector
a =
    [Pair] -> Value
Json.object [String -> Maybe I8 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"x" (Maybe I8 -> Pair) -> Maybe I8 -> Pair
forall a b. (a -> b) -> a -> b
$ Int8Vector -> Maybe I8
x Int8Vector
a, String -> Maybe I8 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"y" (Maybe I8 -> Pair) -> Maybe I8 -> Pair
forall a b. (a -> b) -> a -> b
$ Int8Vector -> Maybe I8
y Int8Vector
a, String -> Maybe I8 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"z" (Maybe I8 -> Pair) -> Maybe I8 -> Pair
forall a b. (a -> b) -> a -> b
$ Int8Vector -> Maybe I8
z Int8Vector
a]

schema :: Schema.Schema
schema :: Schema
schema = String -> Value -> Schema
Schema.named String
"int8Vector" (Value -> Schema) -> Value -> Schema
forall a b. (a -> b) -> a -> b
$ [(Pair, Bool)] -> Value
Schema.object
  [ (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"x" (Value -> Pair) -> (Schema -> Value) -> Schema -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json (Schema -> Pair) -> Schema -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
Schema.maybe Schema
I8.schema, Bool
False)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"y" (Value -> Pair) -> (Schema -> Value) -> Schema -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json (Schema -> Pair) -> Schema -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
Schema.maybe Schema
I8.schema, Bool
False)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"z" (Value -> Pair) -> (Schema -> Value) -> Schema -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json (Schema -> Pair) -> Schema -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
Schema.maybe Schema
I8.schema, Bool
False)
  ]

bitPut :: Int8Vector -> BitPut.BitPut
bitPut :: Int8Vector -> BitPut
bitPut Int8Vector
int8Vector =
  Maybe I8 -> BitPut
putInt8VectorField (Int8Vector -> Maybe I8
x Int8Vector
int8Vector)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> Maybe I8 -> BitPut
putInt8VectorField (Int8Vector -> Maybe I8
y Int8Vector
int8Vector)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> Maybe I8 -> BitPut
putInt8VectorField (Int8Vector -> Maybe I8
z Int8Vector
int8Vector)

putInt8VectorField :: Maybe I8.I8 -> BitPut.BitPut
putInt8VectorField :: Maybe I8 -> BitPut
putInt8VectorField Maybe I8
maybeField = case Maybe I8
maybeField of
  Maybe I8
Nothing -> Bool -> BitPut
BitPut.bool Bool
False
  Just I8
field -> Bool -> BitPut
BitPut.bool Bool
True BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> I8 -> BitPut
I8.bitPut I8
field

bitGet :: BitGet.BitGet Int8Vector
bitGet :: BitGet Int8Vector
bitGet = String -> BitGet Int8Vector -> BitGet Int8Vector
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"Int8Vector" (BitGet Int8Vector -> BitGet Int8Vector)
-> BitGet Int8Vector -> BitGet Int8Vector
forall a b. (a -> b) -> a -> b
$ do
  Maybe I8
x <- String -> BitGet (Maybe I8) -> BitGet (Maybe I8)
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"x" BitGet (Maybe I8)
decodeFieldBits
  Maybe I8
y <- String -> BitGet (Maybe I8) -> BitGet (Maybe I8)
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"y" BitGet (Maybe I8)
decodeFieldBits
  Maybe I8
z <- String -> BitGet (Maybe I8) -> BitGet (Maybe I8)
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"z" BitGet (Maybe I8)
decodeFieldBits
  Int8Vector -> BitGet Int8Vector
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int8Vector :: Maybe I8 -> Maybe I8 -> Maybe I8 -> Int8Vector
Int8Vector { Maybe I8
x :: Maybe I8
x :: Maybe I8
x, Maybe I8
y :: Maybe I8
y :: Maybe I8
y, Maybe I8
z :: Maybe I8
z :: Maybe I8
z }

decodeFieldBits :: BitGet.BitGet (Maybe I8.I8)
decodeFieldBits :: BitGet (Maybe I8)
decodeFieldBits = do
  Bool
hasField <- BitGet Bool
BitGet.bool
  Bool -> Get BitString Identity I8 -> BitGet (Maybe I8)
forall (m :: * -> *) a. Applicative m => Bool -> m a -> m (Maybe a)
Monad.whenMaybe Bool
hasField Get BitString Identity I8
I8.bitGet