module Rattletrap.Type.RemoteId.Switch where

import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.U64 as U64
import qualified Rattletrap.Utility.Json as Json

data Switch = Switch
  { Switch -> U64
a :: U64.U64
  , Switch -> U64
b :: U64.U64
  , Switch -> U64
c :: U64.U64
  , Switch -> U64
d :: U64.U64
  }
  deriving (Switch -> Switch -> Bool
(Switch -> Switch -> Bool)
-> (Switch -> Switch -> Bool) -> Eq Switch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Switch -> Switch -> Bool
$c/= :: Switch -> Switch -> Bool
== :: Switch -> Switch -> Bool
$c== :: Switch -> Switch -> Bool
Eq, Int -> Switch -> ShowS
[Switch] -> ShowS
Switch -> String
(Int -> Switch -> ShowS)
-> (Switch -> String) -> ([Switch] -> ShowS) -> Show Switch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Switch] -> ShowS
$cshowList :: [Switch] -> ShowS
show :: Switch -> String
$cshow :: Switch -> String
showsPrec :: Int -> Switch -> ShowS
$cshowsPrec :: Int -> Switch -> ShowS
Show)

instance Json.FromJSON Switch where
  parseJSON :: Value -> Parser Switch
parseJSON Value
json = do
    (U64
a, U64
b, U64
c, U64
d) <- Value -> Parser (U64, U64, U64, U64)
forall a. FromJSON a => Value -> Parser a
Json.parseJSON Value
json
    Switch -> Parser Switch
forall (f :: * -> *) a. Applicative f => a -> f a
pure Switch :: U64 -> U64 -> U64 -> U64 -> Switch
Switch { U64
a :: U64
a :: U64
a, U64
b :: U64
b :: U64
b, U64
c :: U64
c :: U64
c, U64
d :: U64
d :: U64
d }

instance Json.ToJSON Switch where
  toJSON :: Switch -> Value
toJSON Switch
x = (U64, U64, U64, U64) -> Value
forall a. ToJSON a => a -> Value
Json.toJSON (Switch -> U64
a Switch
x, Switch -> U64
b Switch
x, Switch -> U64
c Switch
x, Switch -> U64
d Switch
x)

schema :: Schema.Schema
schema :: Schema
schema =
  String -> Value -> Schema
Schema.named String
"remote-id-switch" (Value -> Schema) -> (Value -> Value) -> Value -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Value
Schema.tuple ([Value] -> Value) -> (Value -> [Value]) -> Value -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Value -> [Value]
forall a. Int -> a -> [a]
replicate Int
4 (Value -> Schema) -> Value -> Schema
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref
    Schema
U64.schema

bitPut :: Switch -> BitPut.BitPut
bitPut :: Switch -> BitPut
bitPut Switch
x =
  U64 -> BitPut
U64.bitPut (Switch -> U64
a Switch
x) BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> U64 -> BitPut
U64.bitPut (Switch -> U64
b Switch
x) BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> U64 -> BitPut
U64.bitPut (Switch -> U64
c Switch
x) BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> U64 -> BitPut
U64.bitPut (Switch -> U64
d Switch
x)

bitGet :: BitGet.BitGet Switch
bitGet :: BitGet Switch
bitGet = String -> BitGet Switch -> BitGet Switch
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"Switch" (BitGet Switch -> BitGet Switch) -> BitGet Switch -> BitGet Switch
forall a b. (a -> b) -> a -> b
$ do
  U64
a <- BitGet U64
U64.bitGet
  U64
b <- BitGet U64
U64.bitGet
  U64
c <- BitGet U64
U64.bitGet
  U64
d <- BitGet U64
U64.bitGet
  Switch -> BitGet Switch
forall (f :: * -> *) a. Applicative f => a -> f a
pure Switch :: U64 -> U64 -> U64 -> U64 -> Switch
Switch { U64
a :: U64
a :: U64
a, U64
b :: U64
b :: U64
b, U64
c :: U64
c :: U64
c, U64
d :: U64
d :: U64
d }