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
(Cache -> Cache -> Bool) -> (Cache -> Cache -> Bool) -> Eq Cache
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
(Int -> Cache -> ShowS)
-> (Cache -> String) -> ([Cache] -> ShowS) -> Show Cache
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 = String -> (Object -> Parser Cache) -> Value -> Parser Cache
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"Cache" ((Object -> Parser Cache) -> Value -> Parser Cache)
-> (Object -> Parser Cache) -> Value -> Parser Cache
forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    U32
classId <- Object -> String -> Parser U32
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"class_id"
    U32
parentCacheId <- Object -> String -> Parser U32
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"parent_cache_id"
    U32
cacheId <- Object -> String -> Parser U32
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"cache_id"
    List AttributeMapping
attributeMappings <- Object -> String -> Parser (List AttributeMapping)
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"attribute_mappings"
    Cache -> Parser Cache
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cache :: U32 -> U32 -> U32 -> List AttributeMapping -> Cache
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 = [Pair] -> Value
Json.object
    [ String -> U32 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"class_id" (U32 -> Pair) -> U32 -> Pair
forall a b. (a -> b) -> a -> b
$ Cache -> U32
classId Cache
x
    , String -> U32 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"parent_cache_id" (U32 -> Pair) -> U32 -> Pair
forall a b. (a -> b) -> a -> b
$ Cache -> U32
parentCacheId Cache
x
    , String -> U32 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"cache_id" (U32 -> Pair) -> U32 -> Pair
forall a b. (a -> b) -> a -> b
$ Cache -> U32
cacheId Cache
x
    , String -> List AttributeMapping -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"attribute_mappings" (List AttributeMapping -> Pair) -> List AttributeMapping -> Pair
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" (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
"class_id" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
U32.schema, Bool
True)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"parent_cache_id" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
U32.schema, Bool
True)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"cache_id" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
U32.schema, Bool
True)
  , ( String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"attribute_mappings" (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
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)
    BytePut -> BytePut -> BytePut
forall a. Semigroup a => a -> a -> a
<> U32 -> BytePut
U32.bytePut (Cache -> U32
parentCacheId Cache
x)
    BytePut -> BytePut -> BytePut
forall a. Semigroup a => a -> a -> a
<> U32 -> BytePut
U32.bytePut (Cache -> U32
cacheId Cache
x)
    BytePut -> BytePut -> BytePut
forall a. Semigroup a => a -> a -> a
<> (AttributeMapping -> BytePut) -> List AttributeMapping -> BytePut
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 = String -> ByteGet Cache -> ByteGet Cache
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"Cache" (ByteGet Cache -> ByteGet Cache) -> ByteGet Cache -> ByteGet Cache
forall a b. (a -> b) -> a -> b
$ do
  U32
classId <- String -> ByteGet U32 -> ByteGet U32
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"classId" ByteGet U32
U32.byteGet
  U32
parentCacheId <- String -> ByteGet U32 -> ByteGet U32
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"parentCacheId" ByteGet U32
U32.byteGet
  U32
cacheId <- String -> ByteGet U32 -> ByteGet U32
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"cacheId" ByteGet U32
U32.byteGet
  List AttributeMapping
attributeMappings <- String
-> ByteGet (List AttributeMapping)
-> ByteGet (List AttributeMapping)
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"attributeMappings"
    (ByteGet (List AttributeMapping)
 -> ByteGet (List AttributeMapping))
-> ByteGet (List AttributeMapping)
-> ByteGet (List AttributeMapping)
forall a b. (a -> b) -> a -> b
$ ByteGet AttributeMapping -> ByteGet (List AttributeMapping)
forall a. ByteGet a -> ByteGet (List a)
List.byteGet ByteGet AttributeMapping
AttributeMapping.byteGet
  Cache -> ByteGet Cache
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cache :: U32 -> U32 -> U32 -> List AttributeMapping -> Cache
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 }