module Rattletrap.Type.Attribute.ClubColors where

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

data ClubColors = ClubColors
  { ClubColors -> Bool
blueFlag :: Bool
  , ClubColors -> U8
blueColor :: U8.U8
  , ClubColors -> Bool
orangeFlag :: Bool
  , ClubColors -> U8
orangeColor :: U8.U8
  }
  deriving (ClubColors -> ClubColors -> Bool
(ClubColors -> ClubColors -> Bool)
-> (ClubColors -> ClubColors -> Bool) -> Eq ClubColors
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClubColors -> ClubColors -> Bool
$c/= :: ClubColors -> ClubColors -> Bool
== :: ClubColors -> ClubColors -> Bool
$c== :: ClubColors -> ClubColors -> Bool
Eq, Int -> ClubColors -> ShowS
[ClubColors] -> ShowS
ClubColors -> String
(Int -> ClubColors -> ShowS)
-> (ClubColors -> String)
-> ([ClubColors] -> ShowS)
-> Show ClubColors
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClubColors] -> ShowS
$cshowList :: [ClubColors] -> ShowS
show :: ClubColors -> String
$cshow :: ClubColors -> String
showsPrec :: Int -> ClubColors -> ShowS
$cshowsPrec :: Int -> ClubColors -> ShowS
Show)

instance Json.FromJSON ClubColors where
  parseJSON :: Value -> Parser ClubColors
parseJSON = String
-> (Object -> Parser ClubColors) -> Value -> Parser ClubColors
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"ClubColors" ((Object -> Parser ClubColors) -> Value -> Parser ClubColors)
-> (Object -> Parser ClubColors) -> Value -> Parser ClubColors
forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    Bool
blueFlag <- Object -> String -> Parser Bool
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"blue_flag"
    U8
blueColor <- Object -> String -> Parser U8
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"blue_color"
    Bool
orangeFlag <- Object -> String -> Parser Bool
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"orange_flag"
    U8
orangeColor <- Object -> String -> Parser U8
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"orange_color"
    ClubColors -> Parser ClubColors
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClubColors :: Bool -> U8 -> Bool -> U8 -> ClubColors
ClubColors { Bool
blueFlag :: Bool
blueFlag :: Bool
blueFlag, U8
blueColor :: U8
blueColor :: U8
blueColor, Bool
orangeFlag :: Bool
orangeFlag :: Bool
orangeFlag, U8
orangeColor :: U8
orangeColor :: U8
orangeColor }

instance Json.ToJSON ClubColors where
  toJSON :: ClubColors -> Value
toJSON ClubColors
x = [Pair] -> Value
Json.object
    [ String -> Bool -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"blue_flag" (Bool -> Pair) -> Bool -> Pair
forall a b. (a -> b) -> a -> b
$ ClubColors -> Bool
blueFlag ClubColors
x
    , String -> U8 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"blue_color" (U8 -> Pair) -> U8 -> Pair
forall a b. (a -> b) -> a -> b
$ ClubColors -> U8
blueColor ClubColors
x
    , String -> Bool -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"orange_flag" (Bool -> Pair) -> Bool -> Pair
forall a b. (a -> b) -> a -> b
$ ClubColors -> Bool
orangeFlag ClubColors
x
    , String -> U8 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"orange_color" (U8 -> Pair) -> U8 -> Pair
forall a b. (a -> b) -> a -> b
$ ClubColors -> U8
orangeColor ClubColors
x
    ]

schema :: Schema.Schema
schema :: Schema
schema = String -> Value -> Schema
Schema.named String
"attribute-club-colors" (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
"blue_flag" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Schema.boolean, Bool
True)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"blue_color" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
U8.schema, Bool
True)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"orange_flag" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Schema.boolean, Bool
True)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"orange_color" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
U8.schema, Bool
True)
  ]

bitPut :: ClubColors -> BitPut.BitPut
bitPut :: ClubColors -> BitPut
bitPut ClubColors
clubColorsAttribute =
  Bool -> BitPut
BitPut.bool (ClubColors -> Bool
blueFlag ClubColors
clubColorsAttribute)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> U8 -> BitPut
U8.bitPut (ClubColors -> U8
blueColor ClubColors
clubColorsAttribute)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> Bool -> BitPut
BitPut.bool (ClubColors -> Bool
orangeFlag ClubColors
clubColorsAttribute)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> U8 -> BitPut
U8.bitPut (ClubColors -> U8
orangeColor ClubColors
clubColorsAttribute)

bitGet :: BitGet.BitGet ClubColors
bitGet :: BitGet ClubColors
bitGet = do
  Bool
blueFlag <- BitGet Bool
BitGet.bool
  U8
blueColor <- BitGet U8
U8.bitGet
  Bool
orangeFlag <- BitGet Bool
BitGet.bool
  U8
orangeColor <- BitGet U8
U8.bitGet
  ClubColors -> BitGet ClubColors
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClubColors :: Bool -> U8 -> Bool -> U8 -> ClubColors
ClubColors { Bool
blueFlag :: Bool
blueFlag :: Bool
blueFlag, U8
blueColor :: U8
blueColor :: U8
blueColor, Bool
orangeFlag :: Bool
orangeFlag :: Bool
orangeFlag, U8
orangeColor :: U8
orangeColor :: U8
orangeColor }