module Rattletrap.Type.Content where

import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Lazy as LazyByteString
import qualified Data.Word as Word
import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.ByteGet as ByteGet
import qualified Rattletrap.BytePut as BytePut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.Cache as Cache
import qualified Rattletrap.Type.ClassAttributeMap as ClassAttributeMap
import qualified Rattletrap.Type.ClassMapping as ClassMapping
import qualified Rattletrap.Type.Frame as Frame
import qualified Rattletrap.Type.Keyframe as Keyframe
import qualified Rattletrap.Type.List as RList
import qualified Rattletrap.Type.Mark as Mark
import qualified Rattletrap.Type.Message as Message
import qualified Rattletrap.Type.Str as Str
import qualified Rattletrap.Type.U32 as U32
import qualified Rattletrap.Type.U8 as U8
import qualified Rattletrap.Type.Version as Version
import qualified Rattletrap.Utility.Bytes as Bytes
import qualified Rattletrap.Utility.Json as Json

type Content = ContentWith (RList.List Frame.Frame)

-- | Contains low-level game data about a 'Rattletrap.Replay.Replay'.
data ContentWith frames = Content
  { -- | This typically only has one element, like @stadium_oob_audio_map@.
    forall frames. ContentWith frames -> List Str
levels :: RList.List Str.Str,
    -- | A list of which frames are key frames. Although they aren't necessary
    -- for replay, key frames are frames that replicate every actor. They
    -- typically happen once every 10 seconds.
    forall frames. ContentWith frames -> List Keyframe
keyframes :: RList.List Keyframe.Keyframe,
    -- | The size of the stream in bytes. This is only really necessary because
    -- the stream has some arbitrary amount of padding at the end.
    forall frames. ContentWith frames -> U32
streamSize :: U32.U32,
    -- | The actual game data. This is where all the interesting information is.
    forall frames. ContentWith frames -> frames
frames :: frames,
    -- | Debugging messages. In newer replays, this is always empty.
    forall frames. ContentWith frames -> List Message
messages :: RList.List Message.Message,
    -- | Tick marks shown on the scrubber when watching a replay.
    forall frames. ContentWith frames -> List Mark
marks :: RList.List Mark.Mark,
    -- | A list of @.upk@ files to load, like
    -- @..\\..\\TAGame\\CookedPCConsole\\Stadium_P.upk@.
    forall frames. ContentWith frames -> List Str
packages :: RList.List Str.Str,
    -- | Objects in the stream. Used for the
    -- 'Rattletrap.Type.ClassAttributeMap.ClassAttributeMap'.
    forall frames. ContentWith frames -> List Str
objects :: RList.List Str.Str,
    -- | It's not clear what these are used for. This list is usually not empty,
    -- but appears unused otherwise.
    forall frames. ContentWith frames -> List Str
names :: RList.List Str.Str,
    -- | A mapping between classes and their ID in the stream. Used for the
    -- 'Rattletrap.Type.ClassAttributeMap.ClassAttributeMap'.
    forall frames. ContentWith frames -> List ClassMapping
classMappings :: RList.List ClassMapping.ClassMapping,
    -- | A list of classes along with their parent classes and attributes. Used
    -- for the 'Rattletrap.Type.ClassAttributeMap.ClassAttributeMap'.
    forall frames. ContentWith frames -> List Cache
caches :: RList.List Cache.Cache,
    forall frames. ContentWith frames -> [Word8]
unknown :: [Word.Word8]
  }
  deriving (ContentWith frames -> ContentWith frames -> Bool
(ContentWith frames -> ContentWith frames -> Bool)
-> (ContentWith frames -> ContentWith frames -> Bool)
-> Eq (ContentWith frames)
forall frames.
Eq frames =>
ContentWith frames -> ContentWith frames -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall frames.
Eq frames =>
ContentWith frames -> ContentWith frames -> Bool
== :: ContentWith frames -> ContentWith frames -> Bool
$c/= :: forall frames.
Eq frames =>
ContentWith frames -> ContentWith frames -> Bool
/= :: ContentWith frames -> ContentWith frames -> Bool
Eq, Int -> ContentWith frames -> ShowS
[ContentWith frames] -> ShowS
ContentWith frames -> String
(Int -> ContentWith frames -> ShowS)
-> (ContentWith frames -> String)
-> ([ContentWith frames] -> ShowS)
-> Show (ContentWith frames)
forall frames. Show frames => Int -> ContentWith frames -> ShowS
forall frames. Show frames => [ContentWith frames] -> ShowS
forall frames. Show frames => ContentWith frames -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall frames. Show frames => Int -> ContentWith frames -> ShowS
showsPrec :: Int -> ContentWith frames -> ShowS
$cshow :: forall frames. Show frames => ContentWith frames -> String
show :: ContentWith frames -> String
$cshowList :: forall frames. Show frames => [ContentWith frames] -> ShowS
showList :: [ContentWith frames] -> ShowS
Show)

instance (Json.FromJSON frames) => Json.FromJSON (ContentWith frames) where
  parseJSON :: Value -> Parser (ContentWith frames)
parseJSON = String
-> (Object -> Parser (ContentWith frames))
-> Value
-> Parser (ContentWith frames)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"Content" ((Object -> Parser (ContentWith frames))
 -> Value -> Parser (ContentWith frames))
-> (Object -> Parser (ContentWith frames))
-> Value
-> Parser (ContentWith frames)
forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    List Str
levels <- Object -> String -> Parser (List Str)
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"levels"
    List Keyframe
keyframes <- Object -> String -> Parser (List Keyframe)
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"key_frames"
    U32
streamSize <- Object -> String -> Parser U32
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"stream_size"
    frames
frames <- Object -> String -> Parser frames
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"frames"
    List Message
messages <- Object -> String -> Parser (List Message)
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"messages"
    List Mark
marks <- Object -> String -> Parser (List Mark)
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"marks"
    List Str
packages <- Object -> String -> Parser (List Str)
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"packages"
    List Str
objects <- Object -> String -> Parser (List Str)
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"objects"
    List Str
names <- Object -> String -> Parser (List Str)
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"names"
    List ClassMapping
classMappings <- Object -> String -> Parser (List ClassMapping)
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"class_mappings"
    List Cache
caches <- Object -> String -> Parser (List Cache)
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"caches"
    [Word8]
unknown <- Object -> String -> Parser [Word8]
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"unknown"
    ContentWith frames -> Parser (ContentWith frames)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      Content
        { List Str
levels :: List Str
levels :: List Str
levels,
          List Keyframe
keyframes :: List Keyframe
keyframes :: List Keyframe
keyframes,
          U32
streamSize :: U32
streamSize :: U32
streamSize,
          frames
frames :: frames
frames :: frames
frames,
          List Message
messages :: List Message
messages :: List Message
messages,
          List Mark
marks :: List Mark
marks :: List Mark
marks,
          List Str
packages :: List Str
packages :: List Str
packages,
          List Str
objects :: List Str
objects :: List Str
objects,
          List Str
names :: List Str
names :: List Str
names,
          List ClassMapping
classMappings :: List ClassMapping
classMappings :: List ClassMapping
classMappings,
          List Cache
caches :: List Cache
caches :: List Cache
caches,
          [Word8]
unknown :: [Word8]
unknown :: [Word8]
unknown
        }

instance (Json.ToJSON frames) => Json.ToJSON (ContentWith frames) where
  toJSON :: ContentWith frames -> Value
toJSON ContentWith frames
x =
    [(Key, Value)] -> Value
Json.object
      [ String -> List Str -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"levels" (List Str -> (Key, Value)) -> List Str -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ ContentWith frames -> List Str
forall frames. ContentWith frames -> List Str
levels ContentWith frames
x,
        String -> List Keyframe -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"key_frames" (List Keyframe -> (Key, Value)) -> List Keyframe -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ ContentWith frames -> List Keyframe
forall frames. ContentWith frames -> List Keyframe
keyframes ContentWith frames
x,
        String -> U32 -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"stream_size" (U32 -> (Key, Value)) -> U32 -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ ContentWith frames -> U32
forall frames. ContentWith frames -> U32
streamSize ContentWith frames
x,
        String -> frames -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"frames" (frames -> (Key, Value)) -> frames -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ ContentWith frames -> frames
forall frames. ContentWith frames -> frames
frames ContentWith frames
x,
        String -> List Message -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"messages" (List Message -> (Key, Value)) -> List Message -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ ContentWith frames -> List Message
forall frames. ContentWith frames -> List Message
messages ContentWith frames
x,
        String -> List Mark -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"marks" (List Mark -> (Key, Value)) -> List Mark -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ ContentWith frames -> List Mark
forall frames. ContentWith frames -> List Mark
marks ContentWith frames
x,
        String -> List Str -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"packages" (List Str -> (Key, Value)) -> List Str -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ ContentWith frames -> List Str
forall frames. ContentWith frames -> List Str
packages ContentWith frames
x,
        String -> List Str -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"objects" (List Str -> (Key, Value)) -> List Str -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ ContentWith frames -> List Str
forall frames. ContentWith frames -> List Str
objects ContentWith frames
x,
        String -> List Str -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"names" (List Str -> (Key, Value)) -> List Str -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ ContentWith frames -> List Str
forall frames. ContentWith frames -> List Str
names ContentWith frames
x,
        String -> List ClassMapping -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"class_mappings" (List ClassMapping -> (Key, Value))
-> List ClassMapping -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ ContentWith frames -> List ClassMapping
forall frames. ContentWith frames -> List ClassMapping
classMappings ContentWith frames
x,
        String -> List Cache -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"caches" (List Cache -> (Key, Value)) -> List Cache -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ ContentWith frames -> List Cache
forall frames. ContentWith frames -> List Cache
caches ContentWith frames
x,
        String -> [Word8] -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"unknown" ([Word8] -> (Key, Value)) -> [Word8] -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ ContentWith frames -> [Word8]
forall frames. ContentWith frames -> [Word8]
unknown ContentWith frames
x
      ]

schema :: Schema.Schema -> Schema.Schema
schema :: Schema -> Schema
schema Schema
s =
  String -> Value -> Schema
Schema.named String
"content" (Value -> Schema) -> Value -> Schema
forall a b. (a -> b) -> a -> b
$
    [((Key, Value), Bool)] -> Value
Schema.object
      [ (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"levels" (Value -> (Key, Value))
-> (Schema -> Value) -> Schema -> (Key, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json (Schema -> (Key, Value)) -> Schema -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
RList.schema Schema
Str.schema, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"key_frames" (Value -> (Key, Value))
-> (Schema -> Value) -> Schema -> (Key, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json (Schema -> (Key, Value)) -> Schema -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
RList.schema Schema
Keyframe.schema, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"stream_size" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
U32.schema, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"frames" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.json Schema
s, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"messages" (Value -> (Key, Value))
-> (Schema -> Value) -> Schema -> (Key, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json (Schema -> (Key, Value)) -> Schema -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
RList.schema Schema
Message.schema, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"marks" (Value -> (Key, Value))
-> (Schema -> Value) -> Schema -> (Key, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json (Schema -> (Key, Value)) -> Schema -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
RList.schema Schema
Mark.schema, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"packages" (Value -> (Key, Value))
-> (Schema -> Value) -> Schema -> (Key, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json (Schema -> (Key, Value)) -> Schema -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
RList.schema Schema
Str.schema, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"objects" (Value -> (Key, Value))
-> (Schema -> Value) -> Schema -> (Key, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json (Schema -> (Key, Value)) -> Schema -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
RList.schema Schema
Str.schema, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"names" (Value -> (Key, Value))
-> (Schema -> Value) -> Schema -> (Key, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json (Schema -> (Key, Value)) -> Schema -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
RList.schema Schema
Str.schema, Bool
True),
        ( String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"class_mappings" (Value -> (Key, Value))
-> (Schema -> Value) -> Schema -> (Key, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json (Schema -> (Key, Value)) -> Schema -> (Key, Value)
forall a b. (a -> b) -> a -> b
$
            Schema -> Schema
RList.schema
              Schema
ClassMapping.schema,
          Bool
True
        ),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"caches" (Value -> (Key, Value))
-> (Schema -> Value) -> Schema -> (Key, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json (Schema -> (Key, Value)) -> Schema -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
RList.schema Schema
Cache.schema, Bool
True),
        (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"unknown" (Value -> (Key, Value))
-> (Schema -> Value) -> Schema -> (Key, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json (Schema -> (Key, Value)) -> Schema -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
Schema.array Schema
U8.schema, Bool
True)
      ]

empty :: Content
empty :: Content
empty =
  Content
    { levels :: List Str
levels = List Str
forall a. List a
RList.empty,
      keyframes :: List Keyframe
keyframes = List Keyframe
forall a. List a
RList.empty,
      streamSize :: U32
streamSize = Word32 -> U32
U32.fromWord32 Word32
0,
      frames :: List Frame
frames = List Frame
forall a. List a
RList.empty,
      messages :: List Message
messages = List Message
forall a. List a
RList.empty,
      marks :: List Mark
marks = List Mark
forall a. List a
RList.empty,
      packages :: List Str
packages = List Str
forall a. List a
RList.empty,
      objects :: List Str
objects = List Str
forall a. List a
RList.empty,
      names :: List Str
names = List Str
forall a. List a
RList.empty,
      classMappings :: List ClassMapping
classMappings = List ClassMapping
forall a. List a
RList.empty,
      caches :: List Cache
caches = List Cache
forall a. List a
RList.empty,
      unknown :: [Word8]
unknown = []
    }

bytePut :: Content -> BytePut.BytePut
bytePut :: Content -> BytePut
bytePut Content
x =
  (Str -> BytePut) -> List Str -> BytePut
forall a. (a -> BytePut) -> List a -> BytePut
RList.bytePut Str -> BytePut
Str.bytePut (Content -> List Str
forall frames. ContentWith frames -> List Str
levels Content
x)
    BytePut -> BytePut -> BytePut
forall a. Semigroup a => a -> a -> a
<> (Keyframe -> BytePut) -> List Keyframe -> BytePut
forall a. (a -> BytePut) -> List a -> BytePut
RList.bytePut Keyframe -> BytePut
Keyframe.bytePut (Content -> List Keyframe
forall frames. ContentWith frames -> List Keyframe
keyframes Content
x)
    BytePut -> BytePut -> BytePut
forall a. Semigroup a => a -> a -> a
<> Content -> BytePut
putFrames Content
x
    BytePut -> BytePut -> BytePut
forall a. Semigroup a => a -> a -> a
<> (Message -> BytePut) -> List Message -> BytePut
forall a. (a -> BytePut) -> List a -> BytePut
RList.bytePut Message -> BytePut
Message.bytePut (Content -> List Message
forall frames. ContentWith frames -> List Message
messages Content
x)
    BytePut -> BytePut -> BytePut
forall a. Semigroup a => a -> a -> a
<> (Mark -> BytePut) -> List Mark -> BytePut
forall a. (a -> BytePut) -> List a -> BytePut
RList.bytePut Mark -> BytePut
Mark.bytePut (Content -> List Mark
forall frames. ContentWith frames -> List Mark
marks Content
x)
    BytePut -> BytePut -> BytePut
forall a. Semigroup a => a -> a -> a
<> (Str -> BytePut) -> List Str -> BytePut
forall a. (a -> BytePut) -> List a -> BytePut
RList.bytePut Str -> BytePut
Str.bytePut (Content -> List Str
forall frames. ContentWith frames -> List Str
packages Content
x)
    BytePut -> BytePut -> BytePut
forall a. Semigroup a => a -> a -> a
<> (Str -> BytePut) -> List Str -> BytePut
forall a. (a -> BytePut) -> List a -> BytePut
RList.bytePut Str -> BytePut
Str.bytePut (Content -> List Str
forall frames. ContentWith frames -> List Str
objects Content
x)
    BytePut -> BytePut -> BytePut
forall a. Semigroup a => a -> a -> a
<> (Str -> BytePut) -> List Str -> BytePut
forall a. (a -> BytePut) -> List a -> BytePut
RList.bytePut Str -> BytePut
Str.bytePut (Content -> List Str
forall frames. ContentWith frames -> List Str
names Content
x)
    BytePut -> BytePut -> BytePut
forall a. Semigroup a => a -> a -> a
<> (ClassMapping -> BytePut) -> List ClassMapping -> BytePut
forall a. (a -> BytePut) -> List a -> BytePut
RList.bytePut ClassMapping -> BytePut
ClassMapping.bytePut (Content -> List ClassMapping
forall frames. ContentWith frames -> List ClassMapping
classMappings Content
x)
    BytePut -> BytePut -> BytePut
forall a. Semigroup a => a -> a -> a
<> (Cache -> BytePut) -> List Cache -> BytePut
forall a. (a -> BytePut) -> List a -> BytePut
RList.bytePut Cache -> BytePut
Cache.bytePut (Content -> List Cache
forall frames. ContentWith frames -> List Cache
caches Content
x)
    BytePut -> BytePut -> BytePut
forall a. Semigroup a => a -> a -> a
<> (Word8 -> BytePut) -> [Word8] -> BytePut
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Word8 -> BytePut
BytePut.word8 (Content -> [Word8]
forall frames. ContentWith frames -> [Word8]
unknown Content
x)

putFrames :: Content -> BytePut.BytePut
putFrames :: Content -> BytePut
putFrames Content
x =
  let stream :: ByteString
stream =
        BytePut -> ByteString
BytePut.toByteString (BytePut -> ByteString)
-> (List Frame -> BytePut) -> List Frame -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BitPut -> BytePut
BitPut.toBytePut (BitPut -> BytePut)
-> (List Frame -> BitPut) -> List Frame -> BytePut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List Frame -> BitPut
Frame.putFrames (List Frame -> ByteString) -> List Frame -> ByteString
forall a b. (a -> b) -> a -> b
$ Content -> List Frame
forall frames. ContentWith frames -> frames
frames Content
x
      -- This is a little strange. When parsing a binary replay, the stream size
      -- is given before the stream itself. When generating the JSON, the stream
      -- size is included. That allows a bit-for-bit identical binary replay to
      -- be generated from the JSON. However if you modify the JSON before
      -- converting it back into binary, the stream size might be different.
      --
      -- If it was possible to know how much padding the stream required without
      -- carrying it along as extra data on the side, this logic could go away.
      -- Unforunately that isn't currently known. See this issue for details:
      -- <https://github.com/tfausak/rattletrap/issues/171>.
      expectedStreamSize :: U32
expectedStreamSize = Content -> U32
forall frames. ContentWith frames -> U32
streamSize Content
x
      actualStreamSize :: U32
actualStreamSize =
        Word32 -> U32
U32.fromWord32 (Word32 -> U32) -> (Int -> Word32) -> Int -> U32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> U32) -> Int -> U32
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
ByteString.length ByteString
stream
      streamSize_ :: U32
streamSize_ =
        Word32 -> U32
U32.fromWord32 (Word32 -> U32) -> Word32 -> U32
forall a b. (a -> b) -> a -> b
$
          Word32 -> Word32 -> Word32
forall a. Ord a => a -> a -> a
max (U32 -> Word32
U32.toWord32 U32
expectedStreamSize) (U32 -> Word32
U32.toWord32 U32
actualStreamSize)
   in U32 -> BytePut
U32.bytePut U32
streamSize_
        BytePut -> BytePut -> BytePut
forall a. Semigroup a => a -> a -> a
<> ByteString -> BytePut
BytePut.byteString (Word32 -> ByteString -> ByteString
forall a. Integral a => a -> ByteString -> ByteString
Bytes.padBytes (U32 -> Word32
U32.toWord32 U32
streamSize_) ByteString
stream)

byteGet ::
  Maybe Str.Str ->
  -- | Version numbers, usually from 'Rattletrap.Header.getVersion'.
  Version.Version ->
  -- | The number of frames in the stream, usually from
  -- 'Rattletrap.Header.getNumFrames'.
  Int ->
  -- | The maximum number of channels in the stream, usually from
  -- 'Rattletrap.Header.getMaxChannels'.
  Word ->
  -- | 'Rattletrap.Header.getBuildVersion'
  Maybe Str.Str ->
  ByteGet.ByteGet Content
byteGet :: Maybe Str -> Version -> Int -> Word -> Maybe Str -> ByteGet Content
byteGet Maybe Str
matchType Version
version Int
numFrames Word
maxChannels Maybe Str
buildVersion =
  String -> ByteGet Content -> ByteGet Content
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"Content" (ByteGet Content -> ByteGet Content)
-> ByteGet Content -> ByteGet Content
forall a b. (a -> b) -> a -> b
$ do
    List Str
levels <- String -> ByteGet (List Str) -> ByteGet (List Str)
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"levels" (ByteGet (List Str) -> ByteGet (List Str))
-> ByteGet (List Str) -> ByteGet (List Str)
forall a b. (a -> b) -> a -> b
$ ByteGet Str -> ByteGet (List Str)
forall a. ByteGet a -> ByteGet (List a)
RList.byteGet ByteGet Str
Str.byteGet
    List Keyframe
keyframes <- String -> ByteGet (List Keyframe) -> ByteGet (List Keyframe)
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"keyframes" (ByteGet (List Keyframe) -> ByteGet (List Keyframe))
-> ByteGet (List Keyframe) -> ByteGet (List Keyframe)
forall a b. (a -> b) -> a -> b
$ ByteGet Keyframe -> ByteGet (List Keyframe)
forall a. ByteGet a -> ByteGet (List a)
RList.byteGet ByteGet Keyframe
Keyframe.byteGet
    U32
streamSize <- String -> ByteGet U32 -> ByteGet U32
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"streamSize" ByteGet U32
U32.byteGet
    ByteString
stream <-
      String -> ByteGet ByteString -> ByteGet ByteString
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"stream" (ByteGet ByteString -> ByteGet ByteString)
-> (Word32 -> ByteGet ByteString) -> Word32 -> ByteGet ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteGet ByteString
ByteGet.byteString (Int -> ByteGet ByteString)
-> (Word32 -> Int) -> Word32 -> ByteGet ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> ByteGet ByteString) -> Word32 -> ByteGet ByteString
forall a b. (a -> b) -> a -> b
$
        U32 -> Word32
U32.toWord32
          U32
streamSize
    List Message
messages <- String -> ByteGet (List Message) -> ByteGet (List Message)
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"messages" (ByteGet (List Message) -> ByteGet (List Message))
-> ByteGet (List Message) -> ByteGet (List Message)
forall a b. (a -> b) -> a -> b
$ ByteGet Message -> ByteGet (List Message)
forall a. ByteGet a -> ByteGet (List a)
RList.byteGet ByteGet Message
Message.byteGet
    List Mark
marks <- String -> ByteGet (List Mark) -> ByteGet (List Mark)
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"marks" (ByteGet (List Mark) -> ByteGet (List Mark))
-> ByteGet (List Mark) -> ByteGet (List Mark)
forall a b. (a -> b) -> a -> b
$ ByteGet Mark -> ByteGet (List Mark)
forall a. ByteGet a -> ByteGet (List a)
RList.byteGet ByteGet Mark
Mark.byteGet
    List Str
packages <- String -> ByteGet (List Str) -> ByteGet (List Str)
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"packages" (ByteGet (List Str) -> ByteGet (List Str))
-> ByteGet (List Str) -> ByteGet (List Str)
forall a b. (a -> b) -> a -> b
$ ByteGet Str -> ByteGet (List Str)
forall a. ByteGet a -> ByteGet (List a)
RList.byteGet ByteGet Str
Str.byteGet
    List Str
objects <- String -> ByteGet (List Str) -> ByteGet (List Str)
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"objects" (ByteGet (List Str) -> ByteGet (List Str))
-> ByteGet (List Str) -> ByteGet (List Str)
forall a b. (a -> b) -> a -> b
$ ByteGet Str -> ByteGet (List Str)
forall a. ByteGet a -> ByteGet (List a)
RList.byteGet ByteGet Str
Str.byteGet
    List Str
names <- String -> ByteGet (List Str) -> ByteGet (List Str)
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"names" (ByteGet (List Str) -> ByteGet (List Str))
-> ByteGet (List Str) -> ByteGet (List Str)
forall a b. (a -> b) -> a -> b
$ ByteGet Str -> ByteGet (List Str)
forall a. ByteGet a -> ByteGet (List a)
RList.byteGet ByteGet Str
Str.byteGet
    List ClassMapping
classMappings <-
      String
-> ByteGet (List ClassMapping) -> ByteGet (List ClassMapping)
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"classMappings" (ByteGet (List ClassMapping) -> ByteGet (List ClassMapping))
-> ByteGet (List ClassMapping) -> ByteGet (List ClassMapping)
forall a b. (a -> b) -> a -> b
$
        ByteGet ClassMapping -> ByteGet (List ClassMapping)
forall a. ByteGet a -> ByteGet (List a)
RList.byteGet ByteGet ClassMapping
ClassMapping.byteGet
    List Cache
caches <- String -> ByteGet (List Cache) -> ByteGet (List Cache)
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"caches" (ByteGet (List Cache) -> ByteGet (List Cache))
-> ByteGet (List Cache) -> ByteGet (List Cache)
forall a b. (a -> b) -> a -> b
$ ByteGet Cache -> ByteGet (List Cache)
forall a. ByteGet a -> ByteGet (List a)
RList.byteGet ByteGet Cache
Cache.byteGet
    let classAttributeMap :: ClassAttributeMap
classAttributeMap =
          List Str
-> List ClassMapping -> List Cache -> List Str -> ClassAttributeMap
ClassAttributeMap.make List Str
objects List ClassMapping
classMappings List Cache
caches List Str
names
        getFrames :: ByteGet (List Frame)
getFrames =
          BitGet (List Frame) -> ByteGet (List Frame)
forall a. BitGet a -> ByteGet a
BitGet.toByteGet (BitGet (List Frame) -> ByteGet (List Frame))
-> BitGet (List Frame) -> ByteGet (List Frame)
forall a b. (a -> b) -> a -> b
$
            Maybe Str
-> Version
-> Maybe Str
-> Int
-> Word
-> ClassAttributeMap
-> BitGet (List Frame)
Frame.decodeFramesBits
              Maybe Str
matchType
              Version
version
              Maybe Str
buildVersion
              Int
numFrames
              Word
maxChannels
              ClassAttributeMap
classAttributeMap
    List Frame
frames <- String -> ByteGet (List Frame) -> ByteGet (List Frame)
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"frames" (ByteGet (List Frame) -> ByteGet (List Frame))
-> ByteGet (List Frame) -> ByteGet (List Frame)
forall a b. (a -> b) -> a -> b
$ ByteGet (List Frame) -> ByteString -> ByteGet (List Frame)
forall a. ByteGet a -> ByteString -> ByteGet a
ByteGet.embed ByteGet (List Frame)
getFrames ByteString
stream
    [Word8]
unknown <-
      String -> ByteGet [Word8] -> ByteGet [Word8]
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"unknown" (ByteGet [Word8] -> ByteGet [Word8])
-> ByteGet [Word8] -> ByteGet [Word8]
forall a b. (a -> b) -> a -> b
$
        (ByteString -> [Word8])
-> Get ByteString Identity ByteString -> ByteGet [Word8]
forall a b.
(a -> b) -> Get ByteString Identity a -> Get ByteString Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> [Word8]
LazyByteString.unpack Get ByteString Identity ByteString
ByteGet.remaining
    Content -> ByteGet Content
forall a. a -> Get ByteString Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      Content
        { List Str
levels :: List Str
levels :: List Str
levels,
          List Keyframe
keyframes :: List Keyframe
keyframes :: List Keyframe
keyframes,
          U32
streamSize :: U32
streamSize :: U32
streamSize,
          List Frame
frames :: List Frame
frames :: List Frame
frames,
          List Message
messages :: List Message
messages :: List Message
messages,
          List Mark
marks :: List Mark
marks :: List Mark
marks,
          List Str
packages :: List Str
packages :: List Str
packages,
          List Str
objects :: List Str
objects :: List Str
objects,
          List Str
names :: List Str
names :: List Str
names,
          List ClassMapping
classMappings :: List ClassMapping
classMappings :: List ClassMapping
classMappings,
          List Cache
caches :: List Cache
caches :: List Cache
caches,
          [Word8]
unknown :: [Word8]
unknown :: [Word8]
unknown
        }