module Rattletrap.Type.Content where

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 Rattletrap.Utility.Bytes
import qualified Rattletrap.Utility.Json as Json

import qualified Control.Monad.Trans.State as State
import qualified Data.ByteString as Bytes
import qualified Data.ByteString.Lazy as LazyBytes
import qualified Data.Word as Word

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

-- | Contains low-level game data about a 'Rattletrap.Replay.Replay'.
data ContentWith frames = Content
  { ContentWith frames -> List Str
levels :: List.List Str.Str
  -- ^ This typically only has one element, like @stadium_oob_audio_map@.
  , ContentWith frames -> List KeyFrame
keyFrames :: List.List KeyFrame.KeyFrame
  -- ^ 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.
  , ContentWith frames -> U32
streamSize :: U32.U32
  -- ^ The size of the stream in bytes. This is only really necessary because
  -- the stream has some arbitrary amount of padding at the end.
  , ContentWith frames -> frames
frames :: frames
  -- ^ The actual game data. This is where all the interesting information is.
  , ContentWith frames -> List Message
messages :: List.List Message.Message
  -- ^ Debugging messages. In newer replays, this is always empty.
  , ContentWith frames -> List Mark
marks :: List.List Mark.Mark
  -- ^ Tick marks shown on the scrubber when watching a replay.
  , ContentWith frames -> List Str
packages :: List.List Str.Str
  -- ^ A list of @.upk@ files to load, like
  -- @..\\..\\TAGame\\CookedPCConsole\\Stadium_P.upk@.
  , ContentWith frames -> List Str
objects :: List.List Str.Str
  -- ^ Objects in the stream. Used for the
  -- 'Rattletrap.Type.ClassAttributeMap.ClassAttributeMap'.
  , ContentWith frames -> List Str
names :: List.List Str.Str
  -- ^ It's not clear what these are used for. This list is usually not empty,
  -- but appears unused otherwise.
  , ContentWith frames -> List ClassMapping
classMappings :: List.List ClassMapping.ClassMapping
  -- ^ A mapping between classes and their ID in the stream. Used for the
  -- 'Rattletrap.Type.ClassAttributeMap.ClassAttributeMap'.
  , ContentWith frames -> List Cache
caches :: List.List Cache.Cache
  -- ^ A list of classes along with their parent classes and attributes. Used
  -- for the 'Rattletrap.Type.ClassAttributeMap.ClassAttributeMap'.
  , 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
/= :: 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
[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
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 = 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 (f :: * -> *) a. Applicative f => a -> f a
pure Content :: forall frames.
List Str
-> List KeyFrame
-> U32
-> frames
-> List Message
-> List Mark
-> List Str
-> List Str
-> List Str
-> List ClassMapping
-> List Cache
-> [Word8]
-> ContentWith frames
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 = [Pair] -> Value
Json.object
    [ String -> List Str -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"levels" (List Str -> Pair) -> List Str -> Pair
forall a b. (a -> b) -> a -> b
$ ContentWith frames -> List Str
forall frames. ContentWith frames -> List Str
levels ContentWith frames
x
    , String -> List KeyFrame -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"key_frames" (List KeyFrame -> Pair) -> List KeyFrame -> Pair
forall a b. (a -> b) -> a -> b
$ ContentWith frames -> List KeyFrame
forall frames. ContentWith frames -> List KeyFrame
keyFrames ContentWith frames
x
    , String -> U32 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"stream_size" (U32 -> Pair) -> U32 -> Pair
forall a b. (a -> b) -> a -> b
$ ContentWith frames -> U32
forall frames. ContentWith frames -> U32
streamSize ContentWith frames
x
    , String -> frames -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"frames" (frames -> Pair) -> frames -> Pair
forall a b. (a -> b) -> a -> b
$ ContentWith frames -> frames
forall frames. ContentWith frames -> frames
frames ContentWith frames
x
    , String -> List Message -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"messages" (List Message -> Pair) -> List Message -> Pair
forall a b. (a -> b) -> a -> b
$ ContentWith frames -> List Message
forall frames. ContentWith frames -> List Message
messages ContentWith frames
x
    , String -> List Mark -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"marks" (List Mark -> Pair) -> List Mark -> Pair
forall a b. (a -> b) -> a -> b
$ ContentWith frames -> List Mark
forall frames. ContentWith frames -> List Mark
marks ContentWith frames
x
    , String -> List Str -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"packages" (List Str -> Pair) -> List Str -> Pair
forall a b. (a -> b) -> a -> b
$ ContentWith frames -> List Str
forall frames. ContentWith frames -> List Str
packages ContentWith frames
x
    , String -> List Str -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"objects" (List Str -> Pair) -> List Str -> Pair
forall a b. (a -> b) -> a -> b
$ ContentWith frames -> List Str
forall frames. ContentWith frames -> List Str
objects ContentWith frames
x
    , String -> List Str -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"names" (List Str -> Pair) -> List Str -> Pair
forall a b. (a -> b) -> a -> b
$ ContentWith frames -> List Str
forall frames. ContentWith frames -> List Str
names ContentWith frames
x
    , String -> List ClassMapping -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"class_mappings" (List ClassMapping -> Pair) -> List ClassMapping -> Pair
forall a b. (a -> b) -> a -> b
$ ContentWith frames -> List ClassMapping
forall frames. ContentWith frames -> List ClassMapping
classMappings ContentWith frames
x
    , String -> List Cache -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"caches" (List Cache -> Pair) -> List Cache -> Pair
forall a b. (a -> b) -> a -> b
$ ContentWith frames -> List Cache
forall frames. ContentWith frames -> List Cache
caches ContentWith frames
x
    , String -> [Word8] -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"unknown" ([Word8] -> Pair) -> [Word8] -> Pair
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
$ [(Pair, Bool)] -> Value
Schema.object
  [ (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"levels" (Value -> Pair) -> (Schema -> Value) -> Schema -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json (Schema -> Pair) -> Schema -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
List.schema Schema
Str.schema, Bool
True)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"key_frames" (Value -> Pair) -> (Schema -> Value) -> Schema -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json (Schema -> Pair) -> Schema -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
List.schema Schema
KeyFrame.schema, Bool
True)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"stream_size" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
U32.schema, Bool
True)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"frames" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.json Schema
s, Bool
True)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"messages" (Value -> Pair) -> (Schema -> Value) -> Schema -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json (Schema -> Pair) -> Schema -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
List.schema Schema
Message.schema, Bool
True)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"marks" (Value -> Pair) -> (Schema -> Value) -> Schema -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json (Schema -> Pair) -> Schema -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
List.schema Schema
Mark.schema, Bool
True)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"packages" (Value -> Pair) -> (Schema -> Value) -> Schema -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json (Schema -> Pair) -> Schema -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
List.schema Schema
Str.schema, Bool
True)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"objects" (Value -> Pair) -> (Schema -> Value) -> Schema -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json (Schema -> Pair) -> Schema -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
List.schema Schema
Str.schema, Bool
True)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"names" (Value -> Pair) -> (Schema -> Value) -> Schema -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json (Schema -> Pair) -> Schema -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
List.schema Schema
Str.schema, Bool
True)
  , ( String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"class_mappings" (Value -> Pair) -> (Schema -> Value) -> Schema -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json (Schema -> Pair) -> Schema -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
List.schema
      Schema
ClassMapping.schema
    , Bool
True
    )
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"caches" (Value -> Pair) -> (Schema -> Value) -> Schema -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json (Schema -> Pair) -> Schema -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
List.schema Schema
Cache.schema, Bool
True)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"unknown" (Value -> Pair) -> (Schema -> Value) -> Schema -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Value
Schema.json (Schema -> Pair) -> Schema -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
Schema.array Schema
U8.schema, Bool
True)
  ]

empty :: Content
empty :: Content
empty = Content :: forall frames.
List Str
-> List KeyFrame
-> U32
-> frames
-> List Message
-> List Mark
-> List Str
-> List Str
-> List Str
-> List ClassMapping
-> List Cache
-> [Word8]
-> ContentWith frames
Content
  { levels :: List Str
levels = List Str
forall a. List a
List.empty
  , keyFrames :: List KeyFrame
keyFrames = List KeyFrame
forall a. List a
List.empty
  , streamSize :: U32
streamSize = Word32 -> U32
U32.fromWord32 Word32
0
  , frames :: List Frame
frames = List Frame
forall a. List a
List.empty
  , messages :: List Message
messages = List Message
forall a. List a
List.empty
  , marks :: List Mark
marks = List Mark
forall a. List a
List.empty
  , packages :: List Str
packages = List Str
forall a. List a
List.empty
  , objects :: List Str
objects = List Str
forall a. List a
List.empty
  , names :: List Str
names = List Str
forall a. List a
List.empty
  , classMappings :: List ClassMapping
classMappings = List ClassMapping
forall a. List a
List.empty
  , caches :: List Cache
caches = List Cache
forall a. List a
List.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
List.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
List.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
List.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
List.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
List.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
List.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
List.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
List.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
List.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 (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
Bytes.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
    (ByteString -> ByteString
reverseBytes (Word32 -> ByteString -> ByteString
forall a. Integral a => a -> ByteString -> ByteString
padBytes (U32 -> Word32
U32.toWord32 U32
streamSize_) ByteString
stream))

byteGet
  :: Version.Version
  -- ^ Version numbers, usually from 'Rattletrap.Header.getVersion'.
  -> Int
  -- ^ The number of frames in the stream, usually from
  -- 'Rattletrap.Header.getNumFrames'.
  -> Word
  -- ^ The maximum number of channels in the stream, usually from
  -- 'Rattletrap.Header.getMaxChannels'.
  -> ByteGet.ByteGet Content
byteGet :: Version -> Int -> Word -> ByteGet Content
byteGet Version
version Int
numFrames Word
maxChannels = do
  (List Str
levels_, List KeyFrame
keyFrames_, U32
streamSize_) <-
    (,,)
    (List Str
 -> List KeyFrame -> U32 -> (List Str, List KeyFrame, U32))
-> Get ByteString Identity (List Str)
-> Get
     ByteString
     Identity
     (List KeyFrame -> U32 -> (List Str, List KeyFrame, U32))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteGet Str -> Get ByteString Identity (List Str)
forall a. ByteGet a -> ByteGet (List a)
List.byteGet ByteGet Str
Str.byteGet
    Get
  ByteString
  Identity
  (List KeyFrame -> U32 -> (List Str, List KeyFrame, U32))
-> Get ByteString Identity (List KeyFrame)
-> Get ByteString Identity (U32 -> (List Str, List KeyFrame, U32))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteGet KeyFrame -> Get ByteString Identity (List KeyFrame)
forall a. ByteGet a -> ByteGet (List a)
List.byteGet ByteGet KeyFrame
KeyFrame.byteGet
    Get ByteString Identity (U32 -> (List Str, List KeyFrame, U32))
-> Get ByteString Identity U32
-> Get ByteString Identity (List Str, List KeyFrame, U32)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ByteString Identity U32
U32.byteGet
  (ByteString
stream, List Message
messages_, List Mark
marks_, List Str
packages_, List Str
objects_, List Str
names_, List ClassMapping
classMappings_, List Cache
caches_) <-
    (,,,,,,,)
    (ByteString
 -> List Message
 -> List Mark
 -> List Str
 -> List Str
 -> List Str
 -> List ClassMapping
 -> List Cache
 -> (ByteString, List Message, List Mark, List Str, List Str,
     List Str, List ClassMapping, List Cache))
-> Get ByteString Identity ByteString
-> Get
     ByteString
     Identity
     (List Message
      -> List Mark
      -> List Str
      -> List Str
      -> List Str
      -> List ClassMapping
      -> List Cache
      -> (ByteString, List Message, List Mark, List Str, List Str,
          List Str, List ClassMapping, List Cache))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString Identity ByteString
ByteGet.byteString (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (U32 -> Word32
U32.toWord32 U32
streamSize_))
    Get
  ByteString
  Identity
  (List Message
   -> List Mark
   -> List Str
   -> List Str
   -> List Str
   -> List ClassMapping
   -> List Cache
   -> (ByteString, List Message, List Mark, List Str, List Str,
       List Str, List ClassMapping, List Cache))
-> Get ByteString Identity (List Message)
-> Get
     ByteString
     Identity
     (List Mark
      -> List Str
      -> List Str
      -> List Str
      -> List ClassMapping
      -> List Cache
      -> (ByteString, List Message, List Mark, List Str, List Str,
          List Str, List ClassMapping, List Cache))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteGet Message -> Get ByteString Identity (List Message)
forall a. ByteGet a -> ByteGet (List a)
List.byteGet ByteGet Message
Message.byteGet
    Get
  ByteString
  Identity
  (List Mark
   -> List Str
   -> List Str
   -> List Str
   -> List ClassMapping
   -> List Cache
   -> (ByteString, List Message, List Mark, List Str, List Str,
       List Str, List ClassMapping, List Cache))
-> Get ByteString Identity (List Mark)
-> Get
     ByteString
     Identity
     (List Str
      -> List Str
      -> List Str
      -> List ClassMapping
      -> List Cache
      -> (ByteString, List Message, List Mark, List Str, List Str,
          List Str, List ClassMapping, List Cache))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteGet Mark -> Get ByteString Identity (List Mark)
forall a. ByteGet a -> ByteGet (List a)
List.byteGet ByteGet Mark
Mark.byteGet
    Get
  ByteString
  Identity
  (List Str
   -> List Str
   -> List Str
   -> List ClassMapping
   -> List Cache
   -> (ByteString, List Message, List Mark, List Str, List Str,
       List Str, List ClassMapping, List Cache))
-> Get ByteString Identity (List Str)
-> Get
     ByteString
     Identity
     (List Str
      -> List Str
      -> List ClassMapping
      -> List Cache
      -> (ByteString, List Message, List Mark, List Str, List Str,
          List Str, List ClassMapping, List Cache))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteGet Str -> Get ByteString Identity (List Str)
forall a. ByteGet a -> ByteGet (List a)
List.byteGet ByteGet Str
Str.byteGet
    Get
  ByteString
  Identity
  (List Str
   -> List Str
   -> List ClassMapping
   -> List Cache
   -> (ByteString, List Message, List Mark, List Str, List Str,
       List Str, List ClassMapping, List Cache))
-> Get ByteString Identity (List Str)
-> Get
     ByteString
     Identity
     (List Str
      -> List ClassMapping
      -> List Cache
      -> (ByteString, List Message, List Mark, List Str, List Str,
          List Str, List ClassMapping, List Cache))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteGet Str -> Get ByteString Identity (List Str)
forall a. ByteGet a -> ByteGet (List a)
List.byteGet ByteGet Str
Str.byteGet
    Get
  ByteString
  Identity
  (List Str
   -> List ClassMapping
   -> List Cache
   -> (ByteString, List Message, List Mark, List Str, List Str,
       List Str, List ClassMapping, List Cache))
-> Get ByteString Identity (List Str)
-> Get
     ByteString
     Identity
     (List ClassMapping
      -> List Cache
      -> (ByteString, List Message, List Mark, List Str, List Str,
          List Str, List ClassMapping, List Cache))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteGet Str -> Get ByteString Identity (List Str)
forall a. ByteGet a -> ByteGet (List a)
List.byteGet ByteGet Str
Str.byteGet
    Get
  ByteString
  Identity
  (List ClassMapping
   -> List Cache
   -> (ByteString, List Message, List Mark, List Str, List Str,
       List Str, List ClassMapping, List Cache))
-> Get ByteString Identity (List ClassMapping)
-> Get
     ByteString
     Identity
     (List Cache
      -> (ByteString, List Message, List Mark, List Str, List Str,
          List Str, List ClassMapping, List Cache))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteGet ClassMapping -> Get ByteString Identity (List ClassMapping)
forall a. ByteGet a -> ByteGet (List a)
List.byteGet ByteGet ClassMapping
ClassMapping.byteGet
    Get
  ByteString
  Identity
  (List Cache
   -> (ByteString, List Message, List Mark, List Str, List Str,
       List Str, List ClassMapping, List Cache))
-> Get ByteString Identity (List Cache)
-> Get
     ByteString
     Identity
     (ByteString, List Message, List Mark, List Str, List Str, List Str,
      List ClassMapping, List Cache)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteGet Cache -> Get ByteString Identity (List Cache)
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_
    bitGet :: BitGet (List Frame)
bitGet = StateT (Map CompressedWord U32) BitGet (List Frame)
-> Map CompressedWord U32 -> BitGet (List Frame)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
State.evalStateT
      (Version
-> Int
-> Word
-> ClassAttributeMap
-> StateT (Map CompressedWord U32) BitGet (List Frame)
Frame.decodeFramesBits Version
version Int
numFrames Word
maxChannels ClassAttributeMap
classAttributeMap)
      Map CompressedWord U32
forall a. Monoid a => a
mempty
  List Frame
frames_ <-
    (String -> Get ByteString Identity (List Frame))
-> (List Frame -> Get ByteString Identity (List Frame))
-> Either String (List Frame)
-> Get ByteString Identity (List Frame)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get ByteString Identity (List Frame)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail List Frame -> Get ByteString Identity (List Frame)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (List Frame)
 -> Get ByteString Identity (List Frame))
-> (ByteString -> Either String (List Frame))
-> ByteString
-> Get ByteString Identity (List Frame)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Get ByteString Identity (List Frame)
-> ByteString -> Either String (List Frame)
forall a. ByteGet a -> ByteString -> Either String a
ByteGet.run (BitGet (List Frame) -> Get ByteString Identity (List Frame)
forall a. BitGet a -> ByteGet a
BitGet.toByteGet BitGet (List Frame)
bitGet) (ByteString -> Get ByteString Identity (List Frame))
-> ByteString -> Get ByteString Identity (List Frame)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
reverseBytes
      ByteString
stream
  List Str
-> List KeyFrame
-> U32
-> List Frame
-> List Message
-> List Mark
-> List Str
-> List Str
-> List Str
-> List ClassMapping
-> List Cache
-> [Word8]
-> Content
forall frames.
List Str
-> List KeyFrame
-> U32
-> frames
-> List Message
-> List Mark
-> List Str
-> List Str
-> List Str
-> List ClassMapping
-> List Cache
-> [Word8]
-> ContentWith frames
Content
      List Str
levels_
      List KeyFrame
keyFrames_
      U32
streamSize_
      List Frame
frames_
      List Message
messages_
      List Mark
marks_
      List Str
packages_
      List Str
objects_
      List Str
names_
      List ClassMapping
classMappings_
      List Cache
caches_
    ([Word8] -> Content)
-> (ByteString -> [Word8]) -> ByteString -> Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
LazyBytes.unpack
    (ByteString -> Content)
-> Get ByteString Identity ByteString -> ByteGet Content
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString Identity ByteString
ByteGet.remaining