module Rattletrap.Encode.PartyLeaderAttribute
  ( putPartyLeaderAttribute
  )
where

import Rattletrap.Encode.RemoteId
import Rattletrap.Encode.Word8le
import Rattletrap.Type.PartyLeaderAttribute

import qualified Data.Binary.Bits.Put as BinaryBits

putPartyLeaderAttribute :: PartyLeaderAttribute -> BinaryBits.BitPut ()
putPartyLeaderAttribute :: PartyLeaderAttribute -> BitPut ()
putPartyLeaderAttribute PartyLeaderAttribute
partyLeaderAttribute = do
  Word8le -> BitPut ()
putWord8Bits (PartyLeaderAttribute -> Word8le
partyLeaderAttributeSystemId PartyLeaderAttribute
partyLeaderAttribute)
  case PartyLeaderAttribute -> Maybe (RemoteId, Word8le)
partyLeaderAttributeId PartyLeaderAttribute
partyLeaderAttribute of
    Maybe (RemoteId, Word8le)
Nothing -> () -> BitPut ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just (RemoteId
remoteId, Word8le
localId) -> do
      RemoteId -> BitPut ()
putRemoteId RemoteId
remoteId
      Word8le -> BitPut ()
putWord8Bits Word8le
localId