module Rattletrap.Decode.CustomDemolishAttribute
  ( decodeCustomDemolishAttributeBits
  )
where

import Rattletrap.Decode.Common
import Rattletrap.Decode.DemolishAttribute
import Rattletrap.Decode.Int32le
import Rattletrap.Type.CustomDemolishAttribute

decodeCustomDemolishAttributeBits :: (Int, Int, Int) -> DecodeBits CustomDemolishAttribute
decodeCustomDemolishAttributeBits :: (Int, Int, Int) -> DecodeBits CustomDemolishAttribute
decodeCustomDemolishAttributeBits (Int, Int, Int)
version =
  Bool -> Int32le -> DemolishAttribute -> CustomDemolishAttribute
CustomDemolishAttribute
    (Bool -> Int32le -> DemolishAttribute -> CustomDemolishAttribute)
-> BitGet Bool
-> BitGet (Int32le -> DemolishAttribute -> CustomDemolishAttribute)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet Bool
getBool
    BitGet (Int32le -> DemolishAttribute -> CustomDemolishAttribute)
-> BitGet Int32le
-> BitGet (DemolishAttribute -> CustomDemolishAttribute)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BitGet Int32le
decodeInt32leBits
    BitGet (DemolishAttribute -> CustomDemolishAttribute)
-> BitGet DemolishAttribute -> DecodeBits CustomDemolishAttribute
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int, Int, Int) -> BitGet DemolishAttribute
decodeDemolishAttributeBits (Int, Int, Int)
version