module Rattletrap.Decode.PickupAttributeNew
  ( decodePickupAttributeNewBits
  )
where

import Rattletrap.Decode.Common
import Rattletrap.Decode.Word8le
import Rattletrap.Decode.Word32le
import Rattletrap.Type.PickupAttributeNew

decodePickupAttributeNewBits :: DecodeBits PickupAttributeNew
decodePickupAttributeNewBits :: DecodeBits PickupAttributeNew
decodePickupAttributeNewBits = do
  Bool
instigator <- BitGet Bool
getBool
  Maybe Word32le -> Word8le -> PickupAttributeNew
PickupAttributeNew
    (Maybe Word32le -> Word8le -> PickupAttributeNew)
-> BitGet (Maybe Word32le)
-> BitGet (Word8le -> PickupAttributeNew)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> BitGet Word32le -> BitGet (Maybe Word32le)
forall (m :: * -> *) (f :: * -> *) a.
(Applicative m, Alternative f) =>
Bool -> m a -> m (f a)
decodeWhen Bool
instigator BitGet Word32le
decodeWord32leBits
    BitGet (Word8le -> PickupAttributeNew)
-> BitGet Word8le -> DecodeBits PickupAttributeNew
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BitGet Word8le
decodeWord8leBits