module Rattletrap.Decode.ReservationAttribute
  ( decodeReservationAttributeBits
  )
where

import Rattletrap.Decode.Common
import Rattletrap.Decode.CompressedWord
import Rattletrap.Decode.Str
import Rattletrap.Decode.UniqueIdAttribute
import Rattletrap.Type.ReservationAttribute
import Rattletrap.Type.UniqueIdAttribute
import Rattletrap.Type.Word8le

decodeReservationAttributeBits
  :: (Int, Int, Int) -> DecodeBits ReservationAttribute
decodeReservationAttributeBits :: (Int, Int, Int) -> DecodeBits ReservationAttribute
decodeReservationAttributeBits (Int, Int, Int)
version = do
  CompressedWord
number <- Word -> DecodeBits CompressedWord
decodeCompressedWordBits Word
7
  UniqueIdAttribute
uniqueId <- (Int, Int, Int) -> DecodeBits UniqueIdAttribute
decodeUniqueIdAttributeBits (Int, Int, Int)
version
  CompressedWord
-> UniqueIdAttribute
-> Maybe Str
-> Bool
-> Bool
-> Maybe Word8
-> ReservationAttribute
ReservationAttribute CompressedWord
number UniqueIdAttribute
uniqueId
    (Maybe Str -> Bool -> Bool -> Maybe Word8 -> ReservationAttribute)
-> BitGet (Maybe Str)
-> BitGet (Bool -> Bool -> Maybe Word8 -> ReservationAttribute)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> BitGet Str -> BitGet (Maybe Str)
forall (m :: * -> *) (f :: * -> *) a.
(Applicative m, Alternative f) =>
Bool -> m a -> m (f a)
decodeWhen
          (UniqueIdAttribute -> Word8le
uniqueIdAttributeSystemId UniqueIdAttribute
uniqueId Word8le -> Word8le -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8 -> Word8le
Word8le Word8
0)
          BitGet Str
decodeStrBits
    BitGet (Bool -> Bool -> Maybe Word8 -> ReservationAttribute)
-> BitGet Bool
-> BitGet (Bool -> Maybe Word8 -> ReservationAttribute)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BitGet Bool
getBool
    BitGet (Bool -> Maybe Word8 -> ReservationAttribute)
-> BitGet Bool -> BitGet (Maybe Word8 -> ReservationAttribute)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BitGet Bool
getBool
    BitGet (Maybe Word8 -> ReservationAttribute)
-> BitGet (Maybe Word8) -> DecodeBits ReservationAttribute
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> BitGet Word8 -> BitGet (Maybe Word8)
forall (m :: * -> *) (f :: * -> *) a.
(Applicative m, Alternative f) =>
Bool -> m a -> m (f a)
decodeWhen ((Int, Int, Int)
version (Int, Int, Int) -> (Int, Int, Int) -> Bool
forall a. Ord a => a -> a -> Bool
>= (Int
868, Int
12, Int
0)) (Int -> BitGet Word8
getWord8Bits Int
6)