{-# LANGUAGE TemplateHaskell #-}

module Rattletrap.Type.Section
  ( Section(..)
  , toSection
  )
where

import Rattletrap.Type.Common
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

-- | A section is a large piece of a 'Rattletrap.Replay.Replay'. It has a
-- 32-bit size (in bytes), a 32-bit CRC (see "Rattletrap.Utility.Crc"), and then a
-- bunch of data (the body). This interface is provided so that you don't have
-- to think about the size and CRC.
data Section a = Section
  { Section a -> Word32le
sectionSize :: Word32le
  -- ^ read only
  , Section a -> Word32le
sectionCrc :: Word32le
  -- ^ read only
  , Section a -> a
sectionBody :: a
  -- ^ The actual content in the section.
  } deriving (Section a -> Section a -> Bool
(Section a -> Section a -> Bool)
-> (Section a -> Section a -> Bool) -> Eq (Section a)
forall a. Eq a => Section a -> Section a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Section a -> Section a -> Bool
$c/= :: forall a. Eq a => Section a -> Section a -> Bool
== :: Section a -> Section a -> Bool
$c== :: forall a. Eq a => Section a -> Section a -> Bool
Eq, Eq (Section a)
Eq (Section a)
-> (Section a -> Section a -> Ordering)
-> (Section a -> Section a -> Bool)
-> (Section a -> Section a -> Bool)
-> (Section a -> Section a -> Bool)
-> (Section a -> Section a -> Bool)
-> (Section a -> Section a -> Section a)
-> (Section a -> Section a -> Section a)
-> Ord (Section a)
Section a -> Section a -> Bool
Section a -> Section a -> Ordering
Section a -> Section a -> Section a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Section a)
forall a. Ord a => Section a -> Section a -> Bool
forall a. Ord a => Section a -> Section a -> Ordering
forall a. Ord a => Section a -> Section a -> Section a
min :: Section a -> Section a -> Section a
$cmin :: forall a. Ord a => Section a -> Section a -> Section a
max :: Section a -> Section a -> Section a
$cmax :: forall a. Ord a => Section a -> Section a -> Section a
>= :: Section a -> Section a -> Bool
$c>= :: forall a. Ord a => Section a -> Section a -> Bool
> :: Section a -> Section a -> Bool
$c> :: forall a. Ord a => Section a -> Section a -> Bool
<= :: Section a -> Section a -> Bool
$c<= :: forall a. Ord a => Section a -> Section a -> Bool
< :: Section a -> Section a -> Bool
$c< :: forall a. Ord a => Section a -> Section a -> Bool
compare :: Section a -> Section a -> Ordering
$ccompare :: forall a. Ord a => Section a -> Section a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Section a)
Ord, Int -> Section a -> ShowS
[Section a] -> ShowS
Section a -> String
(Int -> Section a -> ShowS)
-> (Section a -> String)
-> ([Section a] -> ShowS)
-> Show (Section a)
forall a. Show a => Int -> Section a -> ShowS
forall a. Show a => [Section a] -> ShowS
forall a. Show a => Section a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Section a] -> ShowS
$cshowList :: forall a. Show a => [Section a] -> ShowS
show :: Section a -> String
$cshow :: forall a. Show a => Section a -> String
showsPrec :: Int -> Section a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Section a -> ShowS
Show)

$(deriveJson ''Section)

toSection :: (a -> Binary.Put) -> a -> Section a
toSection :: (a -> Put) -> a -> Section a
toSection a -> Put
encode a
body =
  let bytes :: ByteString
bytes = ByteString -> ByteString
LazyBytes.toStrict (ByteString -> ByteString)
-> (Put -> ByteString) -> Put -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
Binary.runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ a -> Put
encode a
body
  in
    Section :: forall a. Word32le -> Word32le -> a -> Section a
Section
      { sectionSize :: Word32le
sectionSize = Word32 -> Word32le
Word32le (Word32 -> Word32le) -> (Int -> Word32) -> Int -> Word32le
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32le) -> Int -> Word32le
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
Bytes.length ByteString
bytes
      , sectionCrc :: Word32le
sectionCrc = Word32 -> Word32le
Word32le (Word32 -> Word32le) -> Word32 -> Word32le
forall a b. (a -> b) -> a -> b
$ ByteString -> Word32
getCrc32 ByteString
bytes
      , sectionBody :: a
sectionBody = a
body
      }