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
$c== :: Reservation -> Reservation -> Bool
== :: Reservation -> Reservation -> Bool
$c/= :: Reservation -> Reservation -> Bool
/= :: 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
$cshowsPrec :: Int -> Reservation -> ShowS
showsPrec :: Int -> Reservation -> ShowS
$cshow :: Reservation -> String
show :: Reservation -> String
$cshowList :: [Reservation] -> ShowS
showList :: [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
    number <- Object -> String -> Parser CompressedWord
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"number"
    uniqueId <- Json.required object "unique_id"
    name <- Json.optional object "name"
    unknown1 <- Json.required object "unknown1"
    unknown2 <- Json.required object "unknown2"
    unknown3 <- Json.optional object "unknown3"
    pure Reservation {number, uniqueId, name, unknown1, unknown2, unknown3}

instance Json.ToJSON Reservation where
  toJSON :: Reservation -> Value
toJSON Reservation
x =
    [(Key, Value)] -> Value
Json.object
      [ String -> CompressedWord -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"number" (CompressedWord -> (Key, Value)) -> CompressedWord -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Reservation -> CompressedWord
number Reservation
x,
        String -> UniqueId -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"unique_id" (UniqueId -> (Key, Value)) -> UniqueId -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Reservation -> UniqueId
uniqueId Reservation
x,
        String -> Maybe Str -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"name" (Maybe Str -> (Key, Value)) -> Maybe Str -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Reservation -> Maybe Str
name Reservation
x,
        String -> Bool -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"unknown1" (Bool -> (Key, Value)) -> Bool -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Reservation -> Bool
unknown1 Reservation
x,
        String -> Bool -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"unknown2" (Bool -> (Key, Value)) -> Bool -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Reservation -> Bool
unknown2 Reservation
x,
        String -> Maybe Word8 -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"unknown3" (Maybe Word8 -> (Key, Value)) -> Maybe Word8 -> (Key, Value)
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
$
    [((Key, Value), Bool)] -> Value
Schema.object
      [ (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"number" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
CompressedWord.schema, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"unique_id" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
UniqueId.schema, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"name" (Value -> (Key, Value))
-> (Schema -> Value) -> Schema -> (Key, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json (Schema -> (Key, Value)) -> Schema -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
Schema.maybe Schema
Str.schema, Bool
False),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"unknown1" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Schema.boolean, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"unknown2" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
Schema.boolean, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"unknown3" (Value -> (Key, Value))
-> (Schema -> Value) -> Schema -> (Key, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json (Schema -> (Key, Value)) -> Schema -> (Key, Value)
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 m a. Monoid m => (a -> m) -> Maybe a -> m
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 m a. Monoid m => (a -> m) -> Maybe a -> m
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
  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 <- BitGet.label "uniqueId" $ UniqueId.bitGet version
  name <-
    BitGet.label "name" $
      Monad.whenMaybe
        (UniqueId.systemId uniqueId /= U8.fromWord8 0)
        Str.bitGet
  unknown1 <- BitGet.label "unknown1" BitGet.bool
  unknown2 <- BitGet.label "unknown2" BitGet.bool
  unknown3 <-
    BitGet.label "unknown3"
      . Monad.whenMaybe (Version.atLeast 868 12 0 version)
      $ BitGet.bits 6
  pure Reservation {number, uniqueId, name, unknown1, unknown2, unknown3}