module Rattletrap.Decode.LoadoutsOnlineAttribute
  ( decodeLoadoutsOnlineAttributeBits
  )
where

import Rattletrap.Decode.Common
import Rattletrap.Decode.LoadoutOnlineAttribute
import Rattletrap.Type.LoadoutsOnlineAttribute
import Rattletrap.Type.Str
import Rattletrap.Type.Word32le

import qualified Data.Map as Map

decodeLoadoutsOnlineAttributeBits
  :: (Int, Int, Int)
  -> Map.Map Word32le Str
  -> DecodeBits LoadoutsOnlineAttribute
decodeLoadoutsOnlineAttributeBits :: (Int, Int, Int)
-> Map Word32le Str -> DecodeBits LoadoutsOnlineAttribute
decodeLoadoutsOnlineAttributeBits (Int, Int, Int)
version Map Word32le Str
objectMap =
  LoadoutOnlineAttribute
-> LoadoutOnlineAttribute
-> Bool
-> Bool
-> LoadoutsOnlineAttribute
LoadoutsOnlineAttribute
    (LoadoutOnlineAttribute
 -> LoadoutOnlineAttribute
 -> Bool
 -> Bool
 -> LoadoutsOnlineAttribute)
-> BitGet LoadoutOnlineAttribute
-> BitGet
     (LoadoutOnlineAttribute -> Bool -> Bool -> LoadoutsOnlineAttribute)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int, Int)
-> Map Word32le Str -> BitGet LoadoutOnlineAttribute
decodeLoadoutOnlineAttributeBits (Int, Int, Int)
version Map Word32le Str
objectMap
    BitGet
  (LoadoutOnlineAttribute -> Bool -> Bool -> LoadoutsOnlineAttribute)
-> BitGet LoadoutOnlineAttribute
-> BitGet (Bool -> Bool -> LoadoutsOnlineAttribute)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int, Int, Int)
-> Map Word32le Str -> BitGet LoadoutOnlineAttribute
decodeLoadoutOnlineAttributeBits (Int, Int, Int)
version Map Word32le Str
objectMap
    BitGet (Bool -> Bool -> LoadoutsOnlineAttribute)
-> BitGet Bool -> BitGet (Bool -> LoadoutsOnlineAttribute)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BitGet Bool
getBool
    BitGet (Bool -> LoadoutsOnlineAttribute)
-> BitGet Bool -> DecodeBits LoadoutsOnlineAttribute
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BitGet Bool
getBool