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
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
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 = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"Int8Vector" forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    Maybe I8
x <- forall value.
FromJSON value =>
Object -> String -> Parser (Maybe value)
Json.optional Object
object String
"x"
    Maybe I8
y <- forall value.
FromJSON value =>
Object -> String -> Parser (Maybe value)
Json.optional Object
object String
"y"
    Maybe I8
z <- forall value.
FromJSON value =>
Object -> String -> Parser (Maybe value)
Json.optional Object
object String
"z"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 =
    [(Key, Value)] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"x" forall a b. (a -> b) -> a -> b
$ Int8Vector -> Maybe I8
x Int8Vector
a, forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"y" forall a b. (a -> b) -> a -> b
$ Int8Vector -> Maybe I8
y Int8Vector
a, forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"z" 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" 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
"x" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json forall a b. (a -> b) -> a -> b
$ Schema -> Schema
Schema.maybe Schema
I8.schema, Bool
False),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"y" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json forall a b. (a -> b) -> a -> b
$ Schema -> Schema
Schema.maybe Schema
I8.schema, Bool
False),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"z" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json 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)
    forall a. Semigroup a => a -> a -> a
<> Maybe I8 -> BitPut
putInt8VectorField (Int8Vector -> Maybe I8
y Int8Vector
int8Vector)
    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 forall a. Semigroup a => a -> a -> a
<> I8 -> BitPut
I8.bitPut I8
field

bitGet :: BitGet.BitGet Int8Vector
bitGet :: BitGet Int8Vector
bitGet = forall a. String -> BitGet a -> BitGet a
BitGet.label String
"Int8Vector" forall a b. (a -> b) -> a -> b
$ do
  Maybe I8
x <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"x" BitGet (Maybe I8)
decodeFieldBits
  Maybe I8
y <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"y" BitGet (Maybe I8)
decodeFieldBits
  Maybe I8
z <- forall a. String -> BitGet a -> BitGet a
BitGet.label String
"z" BitGet (Maybe I8)
decodeFieldBits
  forall (f :: * -> *) a. Applicative f => a -> f a
pure 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
  forall (m :: * -> *) a. Applicative m => Bool -> m a -> m (Maybe a)
Monad.whenMaybe Bool
hasField BitGet I8
I8.bitGet