module Rattletrap.Encode.Section
  ( putSection
  )
where

import Rattletrap.Encode.Word32le
import Rattletrap.Type.Section
import Rattletrap.Type.Word32le
import Rattletrap.Utility.Crc

import qualified Data.Binary as Binary
import qualified Data.Binary.Put as Binary
import qualified Data.ByteString as Bytes
import qualified Data.ByteString.Lazy as LazyBytes

-- | Given a way to put the 'sectionBody', puts a section. This will also put
-- the size and CRC.
--
-- @
-- let bytes = 'Data.Binary.Put.runPut' ('putSection' 'Rattletrap.Content.putContent' content)
-- @
putSection :: (a -> Binary.Put) -> Section a -> Binary.Put
putSection :: (a -> Put) -> Section a -> Put
putSection a -> Put
putBody Section a
section = do
  let
    rawBody :: ByteString
rawBody =
      ByteString -> ByteString
LazyBytes.toStrict (Put -> ByteString
Binary.runPut (a -> Put
putBody (Section a -> a
forall a. Section a -> a
sectionBody Section a
section)))
  let size :: Int
size = ByteString -> Int
Bytes.length ByteString
rawBody
  let crc :: Word32
crc = ByteString -> Word32
getCrc32 ByteString
rawBody
  Word32le -> Put
putWord32 (Word32 -> Word32le
Word32le (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size))
  Word32le -> Put
putWord32 (Word32 -> Word32le
Word32le Word32
crc)
  ByteString -> Put
Binary.putByteString ByteString
rawBody