module Rattletrap.Decode.Int8Vector
  ( decodeInt8VectorBits
  )
where

import Rattletrap.Decode.Common
import Rattletrap.Decode.Int8le
import Rattletrap.Type.Int8Vector
import Rattletrap.Type.Int8le

decodeInt8VectorBits :: DecodeBits Int8Vector
decodeInt8VectorBits :: DecodeBits Int8Vector
decodeInt8VectorBits =
  Maybe Int8le -> Maybe Int8le -> Maybe Int8le -> Int8Vector
Int8Vector (Maybe Int8le -> Maybe Int8le -> Maybe Int8le -> Int8Vector)
-> BitGet (Maybe Int8le)
-> BitGet (Maybe Int8le -> Maybe Int8le -> Int8Vector)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet (Maybe Int8le)
decodeFieldBits BitGet (Maybe Int8le -> Maybe Int8le -> Int8Vector)
-> BitGet (Maybe Int8le) -> BitGet (Maybe Int8le -> Int8Vector)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BitGet (Maybe Int8le)
decodeFieldBits BitGet (Maybe Int8le -> Int8Vector)
-> BitGet (Maybe Int8le) -> DecodeBits Int8Vector
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BitGet (Maybe Int8le)
decodeFieldBits

decodeFieldBits :: DecodeBits (Maybe Int8le)
decodeFieldBits :: BitGet (Maybe Int8le)
decodeFieldBits = do
  Bool
hasField <- BitGet Bool
getBool
  Bool -> BitGet Int8le -> BitGet (Maybe Int8le)
forall (m :: * -> *) (f :: * -> *) a.
(Applicative m, Alternative f) =>
Bool -> m a -> m (f a)
decodeWhen Bool
hasField BitGet Int8le
decodeInt8leBits