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 List
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 (List.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 :: List.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 :: List.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 :: List.List Message.Message,
    -- | Tick marks shown on the scrubber when watching a replay.
    forall frames. ContentWith frames -> List Mark
marks :: List.List Mark.Mark,
    -- | A list of @.upk@ files to load, like
    -- @..\\..\\TAGame\\CookedPCConsole\\Stadium_P.upk@.
    forall frames. ContentWith frames -> List Str
packages :: List.List Str.Str,
    -- | Objects in the stream. Used for the
    -- 'Rattletrap.Type.ClassAttributeMap.ClassAttributeMap'.
    forall frames. ContentWith frames -> List Str
objects :: List.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 :: List.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 :: List.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 :: List.List Cache.Cache,
    forall frames. ContentWith frames -> [Word8]
unknown :: [Word.Word8]
  }
  deriving (ContentWith frames -> ContentWith frames -> Bool
forall frames.
Eq frames =>
ContentWith frames -> ContentWith frames -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContentWith frames -> ContentWith frames -> Bool
$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
Eq, Int -> ContentWith frames -> ShowS
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
showList :: [ContentWith frames] -> ShowS
$cshowList :: forall frames. Show frames => [ContentWith frames] -> ShowS
show :: ContentWith frames -> String
$cshow :: forall frames. Show frames => ContentWith frames -> String
showsPrec :: Int -> ContentWith frames -> ShowS
$cshowsPrec :: forall frames. Show frames => Int -> ContentWith frames -> ShowS
Show)

instance (Json.FromJSON frames) => Json.FromJSON (ContentWith frames) where
  parseJSON :: Value -> Parser (ContentWith frames)
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"Content" forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    List Str
levels <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"levels"
    List Keyframe
keyframes <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"key_frames"
    U32
streamSize <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"stream_size"
    frames
frames <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"frames"
    List Message
messages <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"messages"
    List Mark
marks <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"marks"
    List Str
packages <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"packages"
    List Str
objects <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"objects"
    List Str
names <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"names"
    List ClassMapping
classMappings <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"class_mappings"
    List Cache
caches <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"caches"
    [Word8]
unknown <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"unknown"
    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
      [ forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"levels" forall a b. (a -> b) -> a -> b
$ forall frames. ContentWith frames -> List Str
levels ContentWith frames
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"key_frames" forall a b. (a -> b) -> a -> b
$ forall frames. ContentWith frames -> List Keyframe
keyframes ContentWith frames
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"stream_size" forall a b. (a -> b) -> a -> b
$ forall frames. ContentWith frames -> U32
streamSize ContentWith frames
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"frames" forall a b. (a -> b) -> a -> b
$ forall frames. ContentWith frames -> frames
frames ContentWith frames
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"messages" forall a b. (a -> b) -> a -> b
$ forall frames. ContentWith frames -> List Message
messages ContentWith frames
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"marks" forall a b. (a -> b) -> a -> b
$ forall frames. ContentWith frames -> List Mark
marks ContentWith frames
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"packages" forall a b. (a -> b) -> a -> b
$ forall frames. ContentWith frames -> List Str
packages ContentWith frames
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"objects" forall a b. (a -> b) -> a -> b
$ forall frames. ContentWith frames -> List Str
objects ContentWith frames
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"names" forall a b. (a -> b) -> a -> b
$ forall frames. ContentWith frames -> List Str
names ContentWith frames
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"class_mappings" forall a b. (a -> b) -> a -> b
$ forall frames. ContentWith frames -> List ClassMapping
classMappings ContentWith frames
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"caches" forall a b. (a -> b) -> a -> b
$ forall frames. ContentWith frames -> List Cache
caches ContentWith frames
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"unknown" forall a b. (a -> b) -> a -> b
$ 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" forall a b. (a -> b) -> a -> b
$
    [((Key, Value), Bool)] -> Value
Schema.object
      [ (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"levels" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json forall a b. (a -> b) -> a -> b
$ Schema -> Schema
List.schema Schema
Str.schema, Bool
True),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"key_frames" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json forall a b. (a -> b) -> a -> b
$ Schema -> Schema
List.schema Schema
Keyframe.schema, Bool
True),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"stream_size" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
U32.schema, Bool
True),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"frames" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.json Schema
s, Bool
True),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"messages" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json forall a b. (a -> b) -> a -> b
$ Schema -> Schema
List.schema Schema
Message.schema, Bool
True),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"marks" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json forall a b. (a -> b) -> a -> b
$ Schema -> Schema
List.schema Schema
Mark.schema, Bool
True),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"packages" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json forall a b. (a -> b) -> a -> b
$ Schema -> Schema
List.schema Schema
Str.schema, Bool
True),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"objects" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json forall a b. (a -> b) -> a -> b
$ Schema -> Schema
List.schema Schema
Str.schema, Bool
True),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"names" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json forall a b. (a -> b) -> a -> b
$ Schema -> Schema
List.schema Schema
Str.schema, Bool
True),
        ( forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"class_mappings" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json forall a b. (a -> b) -> a -> b
$
            Schema -> Schema
List.schema
              Schema
ClassMapping.schema,
          Bool
True
        ),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"caches" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json forall a b. (a -> b) -> a -> b
$ Schema -> Schema
List.schema Schema
Cache.schema, Bool
True),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"unknown" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json 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 = forall a. List a
List.empty,
      keyframes :: List Keyframe
keyframes = forall a. List a
List.empty,
      streamSize :: U32
streamSize = Word32 -> U32
U32.fromWord32 Word32
0,
      frames :: List Frame
frames = forall a. List a
List.empty,
      messages :: List Message
messages = forall a. List a
List.empty,
      marks :: List Mark
marks = forall a. List a
List.empty,
      packages :: List Str
packages = forall a. List a
List.empty,
      objects :: List Str
objects = forall a. List a
List.empty,
      names :: List Str
names = forall a. List a
List.empty,
      classMappings :: List ClassMapping
classMappings = forall a. List a
List.empty,
      caches :: List Cache
caches = forall a. List a
List.empty,
      unknown :: [Word8]
unknown = []
    }

bytePut :: Content -> BytePut.BytePut
bytePut :: Content -> BytePut
bytePut Content
x =
  forall a. (a -> BytePut) -> List a -> BytePut
List.bytePut Str -> BytePut
Str.bytePut (forall frames. ContentWith frames -> List Str
levels Content
x)
    forall a. Semigroup a => a -> a -> a
<> forall a. (a -> BytePut) -> List a -> BytePut
List.bytePut Keyframe -> BytePut
Keyframe.bytePut (forall frames. ContentWith frames -> List Keyframe
keyframes Content
x)
    forall a. Semigroup a => a -> a -> a
<> Content -> BytePut
putFrames Content
x
    forall a. Semigroup a => a -> a -> a
<> forall a. (a -> BytePut) -> List a -> BytePut
List.bytePut Message -> BytePut
Message.bytePut (forall frames. ContentWith frames -> List Message
messages Content
x)
    forall a. Semigroup a => a -> a -> a
<> forall a. (a -> BytePut) -> List a -> BytePut
List.bytePut Mark -> BytePut
Mark.bytePut (forall frames. ContentWith frames -> List Mark
marks Content
x)
    forall a. Semigroup a => a -> a -> a
<> forall a. (a -> BytePut) -> List a -> BytePut
List.bytePut Str -> BytePut
Str.bytePut (forall frames. ContentWith frames -> List Str
packages Content
x)
    forall a. Semigroup a => a -> a -> a
<> forall a. (a -> BytePut) -> List a -> BytePut
List.bytePut Str -> BytePut
Str.bytePut (forall frames. ContentWith frames -> List Str
objects Content
x)
    forall a. Semigroup a => a -> a -> a
<> forall a. (a -> BytePut) -> List a -> BytePut
List.bytePut Str -> BytePut
Str.bytePut (forall frames. ContentWith frames -> List Str
names Content
x)
    forall a. Semigroup a => a -> a -> a
<> forall a. (a -> BytePut) -> List a -> BytePut
List.bytePut ClassMapping -> BytePut
ClassMapping.bytePut (forall frames. ContentWith frames -> List ClassMapping
classMappings Content
x)
    forall a. Semigroup a => a -> a -> a
<> forall a. (a -> BytePut) -> List a -> BytePut
List.bytePut Cache -> BytePut
Cache.bytePut (forall frames. ContentWith frames -> List Cache
caches Content
x)
    forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Word8 -> BytePut
BytePut.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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. BitPut -> BytePut
BitPut.toBytePut forall b c a. (b -> c) -> (a -> b) -> a -> c
. List Frame -> BitPut
Frame.putFrames forall a b. (a -> b) -> a -> b
$ 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 = forall frames. ContentWith frames -> U32
streamSize Content
x
      actualStreamSize :: U32
actualStreamSize =
        Word32 -> U32
U32.fromWord32 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
ByteString.length ByteString
stream
      streamSize_ :: U32
streamSize_ =
        Word32 -> U32
U32.fromWord32 forall a b. (a -> b) -> a -> b
$
          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_
        forall a. Semigroup a => a -> a -> a
<> ByteString -> BytePut
BytePut.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 =
  forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"Content" forall a b. (a -> b) -> a -> b
$ do
    List Str
levels <- forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"levels" forall a b. (a -> b) -> a -> b
$ forall a. ByteGet a -> ByteGet (List a)
List.byteGet ByteGet Str
Str.byteGet
    List Keyframe
keyframes <- forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"keyframes" forall a b. (a -> b) -> a -> b
$ forall a. ByteGet a -> ByteGet (List a)
List.byteGet ByteGet Keyframe
Keyframe.byteGet
    U32
streamSize <- forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"streamSize" ByteGet U32
U32.byteGet
    ByteString
stream <-
      forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"stream" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Get ByteString Identity ByteString
ByteGet.byteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$
        U32 -> Word32
U32.toWord32
          U32
streamSize
    List Message
messages <- forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"messages" forall a b. (a -> b) -> a -> b
$ forall a. ByteGet a -> ByteGet (List a)
List.byteGet ByteGet Message
Message.byteGet
    List Mark
marks <- forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"marks" forall a b. (a -> b) -> a -> b
$ forall a. ByteGet a -> ByteGet (List a)
List.byteGet ByteGet Mark
Mark.byteGet
    List Str
packages <- forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"packages" forall a b. (a -> b) -> a -> b
$ forall a. ByteGet a -> ByteGet (List a)
List.byteGet ByteGet Str
Str.byteGet
    List Str
objects <- forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"objects" forall a b. (a -> b) -> a -> b
$ forall a. ByteGet a -> ByteGet (List a)
List.byteGet ByteGet Str
Str.byteGet
    List Str
names <- forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"names" forall a b. (a -> b) -> a -> b
$ forall a. ByteGet a -> ByteGet (List a)
List.byteGet ByteGet Str
Str.byteGet
    List ClassMapping
classMappings <-
      forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"classMappings" forall a b. (a -> b) -> a -> b
$
        forall a. ByteGet a -> ByteGet (List a)
List.byteGet ByteGet ClassMapping
ClassMapping.byteGet
    List Cache
caches <- forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"caches" forall a b. (a -> b) -> a -> b
$ forall a. ByteGet a -> ByteGet (List a)
List.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 =
          forall a. BitGet a -> ByteGet a
BitGet.toByteGet 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 <- forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"frames" forall a b. (a -> b) -> a -> b
$ forall a. ByteGet a -> ByteString -> ByteGet a
ByteGet.embed ByteGet (List Frame)
getFrames ByteString
stream
    [Word8]
unknown <-
      forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"unknown" forall a b. (a -> b) -> a -> b
$
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> [Word8]
LazyByteString.unpack ByteGet ByteString
ByteGet.remaining
    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
        }