module Rattletrap.Decode.WeldedInfoAttribute
  ( decodeWeldedInfoAttributeBits
  )
where

import Rattletrap.Decode.Common
import Rattletrap.Decode.Float32le
import Rattletrap.Decode.Int32le
import Rattletrap.Decode.Int8Vector
import Rattletrap.Decode.Vector
import Rattletrap.Type.WeldedInfoAttribute

decodeWeldedInfoAttributeBits
  :: (Int, Int, Int) -> DecodeBits WeldedInfoAttribute
decodeWeldedInfoAttributeBits :: (Int, Int, Int) -> DecodeBits WeldedInfoAttribute
decodeWeldedInfoAttributeBits (Int, Int, Int)
version =
  Bool
-> Int32le
-> Vector
-> Float32le
-> Int8Vector
-> WeldedInfoAttribute
WeldedInfoAttribute
    (Bool
 -> Int32le
 -> Vector
 -> Float32le
 -> Int8Vector
 -> WeldedInfoAttribute)
-> BitGet Bool
-> BitGet
     (Int32le
      -> Vector -> Float32le -> Int8Vector -> WeldedInfoAttribute)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet Bool
getBool
    BitGet
  (Int32le
   -> Vector -> Float32le -> Int8Vector -> WeldedInfoAttribute)
-> BitGet Int32le
-> BitGet
     (Vector -> Float32le -> Int8Vector -> WeldedInfoAttribute)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BitGet Int32le
decodeInt32leBits
    BitGet (Vector -> Float32le -> Int8Vector -> WeldedInfoAttribute)
-> BitGet Vector
-> BitGet (Float32le -> Int8Vector -> WeldedInfoAttribute)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int, Int, Int) -> BitGet Vector
decodeVectorBits (Int, Int, Int)
version
    BitGet (Float32le -> Int8Vector -> WeldedInfoAttribute)
-> BitGet Float32le -> BitGet (Int8Vector -> WeldedInfoAttribute)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BitGet Float32le
decodeFloat32leBits
    BitGet (Int8Vector -> WeldedInfoAttribute)
-> BitGet Int8Vector -> DecodeBits WeldedInfoAttribute
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BitGet Int8Vector
decodeInt8VectorBits