module Rattletrap.Type.Cache where

import qualified Rattletrap.ByteGet as ByteGet
import qualified Rattletrap.BytePut as BytePut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.AttributeMapping as AttributeMapping
import qualified Rattletrap.Type.List as List
import qualified Rattletrap.Type.U32 as U32
import qualified Rattletrap.Utility.Json as Json

data Cache = Cache
  { Cache -> U32
classId :: U32.U32,
    Cache -> U32
parentCacheId :: U32.U32,
    Cache -> U32
cacheId :: U32.U32,
    Cache -> List AttributeMapping
attributeMappings :: List.List AttributeMapping.AttributeMapping
  }
  deriving (Cache -> Cache -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cache -> Cache -> Bool
$c/= :: Cache -> Cache -> Bool
== :: Cache -> Cache -> Bool
$c== :: Cache -> Cache -> Bool
Eq, Int -> Cache -> ShowS
[Cache] -> ShowS
Cache -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cache] -> ShowS
$cshowList :: [Cache] -> ShowS
show :: Cache -> String
$cshow :: Cache -> String
showsPrec :: Int -> Cache -> ShowS
$cshowsPrec :: Int -> Cache -> ShowS
Show)

instance Json.FromJSON Cache where
  parseJSON :: Value -> Parser Cache
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"Cache" forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    U32
classId <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"class_id"
    U32
parentCacheId <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"parent_cache_id"
    U32
cacheId <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"cache_id"
    List AttributeMapping
attributeMappings <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"attribute_mappings"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Cache {U32
classId :: U32
classId :: U32
classId, U32
parentCacheId :: U32
parentCacheId :: U32
parentCacheId, U32
cacheId :: U32
cacheId :: U32
cacheId, List AttributeMapping
attributeMappings :: List AttributeMapping
attributeMappings :: List AttributeMapping
attributeMappings}

instance Json.ToJSON Cache where
  toJSON :: Cache -> Value
toJSON Cache
x =
    [(Key, Value)] -> Value
Json.object
      [ forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"class_id" forall a b. (a -> b) -> a -> b
$ Cache -> U32
classId Cache
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"parent_cache_id" forall a b. (a -> b) -> a -> b
$ Cache -> U32
parentCacheId Cache
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"cache_id" forall a b. (a -> b) -> a -> b
$ Cache -> U32
cacheId Cache
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"attribute_mappings" forall a b. (a -> b) -> a -> b
$ Cache -> List AttributeMapping
attributeMappings Cache
x
      ]

schema :: Schema.Schema
schema :: Schema
schema =
  String -> Value -> Schema
Schema.named String
"cache" 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
"class_id" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
U32.schema, Bool
True),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"parent_cache_id" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
U32.schema, Bool
True),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"cache_id" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
U32.schema, Bool
True),
        ( forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"attribute_mappings" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json forall a b. (a -> b) -> a -> b
$
            Schema -> Schema
List.schema
              Schema
AttributeMapping.schema,
          Bool
True
        )
      ]

bytePut :: Cache -> BytePut.BytePut
bytePut :: Cache -> BytePut
bytePut Cache
x =
  U32 -> BytePut
U32.bytePut (Cache -> U32
classId Cache
x)
    forall a. Semigroup a => a -> a -> a
<> U32 -> BytePut
U32.bytePut (Cache -> U32
parentCacheId Cache
x)
    forall a. Semigroup a => a -> a -> a
<> U32 -> BytePut
U32.bytePut (Cache -> U32
cacheId Cache
x)
    forall a. Semigroup a => a -> a -> a
<> forall a. (a -> BytePut) -> List a -> BytePut
List.bytePut AttributeMapping -> BytePut
AttributeMapping.bytePut (Cache -> List AttributeMapping
attributeMappings Cache
x)

byteGet :: ByteGet.ByteGet Cache
byteGet :: ByteGet Cache
byteGet = forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"Cache" forall a b. (a -> b) -> a -> b
$ do
  U32
classId <- forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"classId" ByteGet U32
U32.byteGet
  U32
parentCacheId <- forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"parentCacheId" ByteGet U32
U32.byteGet
  U32
cacheId <- forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"cacheId" ByteGet U32
U32.byteGet
  List AttributeMapping
attributeMappings <-
    forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"attributeMappings" forall a b. (a -> b) -> a -> b
$
      forall a. ByteGet a -> ByteGet (List a)
List.byteGet ByteGet AttributeMapping
AttributeMapping.byteGet
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Cache {U32
classId :: U32
classId :: U32
classId, U32
parentCacheId :: U32
parentCacheId :: U32
parentCacheId, U32
cacheId :: U32
cacheId :: U32
cacheId, List AttributeMapping
attributeMappings :: List AttributeMapping
attributeMappings :: List AttributeMapping
attributeMappings}