module Rattletrap.Type.Attribute.Reservation where

import qualified Data.Word as Word
import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.Attribute.UniqueId as UniqueId
import qualified Rattletrap.Type.CompressedWord as CompressedWord
import qualified Rattletrap.Type.Str as Str
import qualified Rattletrap.Type.U8 as U8
import qualified Rattletrap.Type.Version as Version
import qualified Rattletrap.Utility.Json as Json
import qualified Rattletrap.Utility.Monad as Monad

data Reservation = Reservation
  { Reservation -> CompressedWord
number :: CompressedWord.CompressedWord
  , Reservation -> UniqueId
uniqueId :: UniqueId.UniqueId
  , Reservation -> Maybe Str
name :: Maybe Str.Str
  , Reservation -> Bool
unknown1 :: Bool
  , Reservation -> Bool
unknown2 :: Bool
  , Reservation -> Maybe Word8
unknown3 :: Maybe Word.Word8
  }
  deriving (Reservation -> Reservation -> Bool
(Reservation -> Reservation -> Bool)
-> (Reservation -> Reservation -> Bool) -> Eq Reservation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Reservation -> Reservation -> Bool
$c/= :: Reservation -> Reservation -> Bool
== :: Reservation -> Reservation -> Bool
$c== :: Reservation -> Reservation -> Bool
Eq, Int -> Reservation -> ShowS
[Reservation] -> ShowS
Reservation -> String
(Int -> Reservation -> ShowS)
-> (Reservation -> String)
-> ([Reservation] -> ShowS)
-> Show Reservation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Reservation] -> ShowS
$cshowList :: [Reservation] -> ShowS
show :: Reservation -> String
$cshow :: Reservation -> String
showsPrec :: Int -> Reservation -> ShowS
$cshowsPrec :: Int -> Reservation -> ShowS
Show)

instance Json.FromJSON Reservation where
  parseJSON :: Value -> Parser Reservation
parseJSON = String
-> (Object -> Parser Reservation) -> Value -> Parser Reservation
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"Reservation" ((Object -> Parser Reservation) -> Value -> Parser Reservation)
-> (Object -> Parser Reservation) -> Value -> Parser Reservation
forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    CompressedWord
number <- Object -> String -> Parser CompressedWord
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"number"
    UniqueId
uniqueId <- Object -> String -> Parser UniqueId
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"unique_id"
    Maybe Str
name <- Object -> String -> Parser (Maybe Str)
forall value.
FromJSON value =>
Object -> String -> Parser (Maybe value)
Json.optional Object
object String
"name"
    Bool
unknown1 <- Object -> String -> Parser Bool
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"unknown1"
    Bool
unknown2 <- Object -> String -> Parser Bool
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"unknown2"
    Maybe Word8
unknown3 <- Object -> String -> Parser (Maybe Word8)
forall value.
FromJSON value =>
Object -> String -> Parser (Maybe value)
Json.optional Object
object String
"unknown3"
    Reservation -> Parser Reservation
forall (f :: * -> *) a. Applicative f => a -> f a
pure Reservation :: CompressedWord
-> UniqueId
-> Maybe Str
-> Bool
-> Bool
-> Maybe Word8
-> Reservation
Reservation { CompressedWord
number :: CompressedWord
number :: CompressedWord
number, UniqueId
uniqueId :: UniqueId
uniqueId :: UniqueId
uniqueId, Maybe Str
name :: Maybe Str
name :: Maybe Str
name, Bool
unknown1 :: Bool
unknown1 :: Bool
unknown1, Bool
unknown2 :: Bool
unknown2 :: Bool
unknown2, Maybe Word8
unknown3 :: Maybe Word8
unknown3 :: Maybe Word8
unknown3 }

instance Json.ToJSON Reservation where
  toJSON :: Reservation -> Value
toJSON Reservation
x = [Pair] -> Value
Json.object
    [ String -> CompressedWord -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"number" (CompressedWord -> Pair) -> CompressedWord -> Pair
forall a b. (a -> b) -> a -> b
$ Reservation -> CompressedWord
number Reservation
x
    , String -> UniqueId -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"unique_id" (UniqueId -> Pair) -> UniqueId -> Pair
forall a b. (a -> b) -> a -> b
$ Reservation -> UniqueId
uniqueId Reservation
x
    , String -> Maybe Str -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"name" (Maybe Str -> Pair) -> Maybe Str -> Pair
forall a b. (a -> b) -> a -> b
$ Reservation -> Maybe Str
name Reservation
x
    , String -> Bool -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"unknown1" (Bool -> Pair) -> Bool -> Pair
forall a b. (a -> b) -> a -> b
$ Reservation -> Bool
unknown1 Reservation
x
    , String -> Bool -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"unknown2" (Bool -> Pair) -> Bool -> Pair
forall a b. (a -> b) -> a -> b
$ Reservation -> Bool
unknown2 Reservation
x
    , String -> Maybe Word8 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"unknown3" (Maybe Word8 -> Pair) -> Maybe Word8 -> Pair
forall a b. (a -> b) -> a -> b
$ Reservation -> Maybe Word8
unknown3 Reservation
x
    ]

schema :: Schema.Schema
schema :: Schema
schema = String -> Value -> Schema
Schema.named String
"attribute-reservation" (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
"number" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
CompressedWord.schema, Bool
True)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"unique_id" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
UniqueId.schema, Bool
True)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"name" (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
Schema.maybe Schema
Str.schema, Bool
False)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"unknown1" (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
"unknown2" (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
"unknown3" (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
Schema.maybe Schema
Schema.integer, Bool
False)
  ]

bitPut :: Reservation -> BitPut.BitPut
bitPut :: Reservation -> BitPut
bitPut Reservation
reservationAttribute =
  CompressedWord -> BitPut
CompressedWord.bitPut (Reservation -> CompressedWord
number Reservation
reservationAttribute)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> UniqueId -> BitPut
UniqueId.bitPut (Reservation -> UniqueId
uniqueId Reservation
reservationAttribute)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> (Str -> BitPut) -> Maybe Str -> BitPut
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Str -> BitPut
Str.bitPut (Reservation -> Maybe Str
name Reservation
reservationAttribute)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> Bool -> BitPut
BitPut.bool (Reservation -> Bool
unknown1 Reservation
reservationAttribute)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> Bool -> BitPut
BitPut.bool (Reservation -> Bool
unknown2 Reservation
reservationAttribute)
    BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> (Word8 -> BitPut) -> Maybe Word8 -> BitPut
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Int -> Word8 -> BitPut
forall a. Bits a => Int -> a -> BitPut
BitPut.bits Int
6) (Reservation -> Maybe Word8
unknown3 Reservation
reservationAttribute)

bitGet :: Version.Version -> BitGet.BitGet Reservation
bitGet :: Version -> BitGet Reservation
bitGet Version
version = String -> BitGet Reservation -> BitGet Reservation
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"Reservation" (BitGet Reservation -> BitGet Reservation)
-> BitGet Reservation -> BitGet Reservation
forall a b. (a -> b) -> a -> b
$ do
  CompressedWord
number <- String -> BitGet CompressedWord -> BitGet CompressedWord
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"number" (BitGet CompressedWord -> BitGet CompressedWord)
-> BitGet CompressedWord -> BitGet CompressedWord
forall a b. (a -> b) -> a -> b
$ Word -> BitGet CompressedWord
CompressedWord.bitGet Word
7
  UniqueId
uniqueId <- String -> BitGet UniqueId -> BitGet UniqueId
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"uniqueId" (BitGet UniqueId -> BitGet UniqueId)
-> BitGet UniqueId -> BitGet UniqueId
forall a b. (a -> b) -> a -> b
$ Version -> BitGet UniqueId
UniqueId.bitGet Version
version
  Maybe Str
name <- String -> BitGet (Maybe Str) -> BitGet (Maybe Str)
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"name" (BitGet (Maybe Str) -> BitGet (Maybe Str))
-> BitGet (Maybe Str) -> BitGet (Maybe Str)
forall a b. (a -> b) -> a -> b
$ Bool -> Get BitString Identity Str -> BitGet (Maybe Str)
forall (m :: * -> *) a. Applicative m => Bool -> m a -> m (Maybe a)
Monad.whenMaybe
    (UniqueId -> U8
UniqueId.systemId UniqueId
uniqueId U8 -> U8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8 -> U8
U8.fromWord8 Word8
0)
    Get BitString Identity Str
Str.bitGet
  Bool
unknown1 <- String -> BitGet Bool -> BitGet Bool
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"unknown1" BitGet Bool
BitGet.bool
  Bool
unknown2 <- String -> BitGet Bool -> BitGet Bool
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"unknown2" BitGet Bool
BitGet.bool
  Maybe Word8
unknown3 <-
    String -> BitGet (Maybe Word8) -> BitGet (Maybe Word8)
forall a. String -> BitGet a -> BitGet a
BitGet.label String
"unknown3"
    (BitGet (Maybe Word8) -> BitGet (Maybe Word8))
-> (Get BitString Identity Word8 -> BitGet (Maybe Word8))
-> Get BitString Identity Word8
-> BitGet (Maybe Word8)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Get BitString Identity Word8 -> BitGet (Maybe Word8)
forall (m :: * -> *) a. Applicative m => Bool -> m a -> m (Maybe a)
Monad.whenMaybe (Int -> Int -> Int -> Version -> Bool
Version.atLeast Int
868 Int
12 Int
0 Version
version)
    (Get BitString Identity Word8 -> BitGet (Maybe Word8))
-> Get BitString Identity Word8 -> BitGet (Maybe Word8)
forall a b. (a -> b) -> a -> b
$ Int -> Get BitString Identity Word8
forall a. Bits a => Int -> BitGet a
BitGet.bits Int
6
  Reservation -> BitGet Reservation
forall (f :: * -> *) a. Applicative f => a -> f a
pure Reservation :: CompressedWord
-> UniqueId
-> Maybe Str
-> Bool
-> Bool
-> Maybe Word8
-> Reservation
Reservation { CompressedWord
number :: CompressedWord
number :: CompressedWord
number, UniqueId
uniqueId :: UniqueId
uniqueId :: UniqueId
uniqueId, Maybe Str
name :: Maybe Str
name :: Maybe Str
name, Bool
unknown1 :: Bool
unknown1 :: Bool
unknown1, Bool
unknown2 :: Bool
unknown2 :: Bool
unknown2, Maybe Word8
unknown3 :: Maybe Word8
unknown3 :: Maybe Word8
unknown3 }