module Rattletrap.Type.Replay where

import qualified Rattletrap.ByteGet as ByteGet
import qualified Rattletrap.BytePut as BytePut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.Content as Content
import qualified Rattletrap.Type.Dictionary as Dictionary
import qualified Rattletrap.Type.Header as Header
import qualified Rattletrap.Type.I32 as I32
import qualified Rattletrap.Type.Property as Property
import qualified Rattletrap.Type.PropertyValue as PropertyValue
import qualified Rattletrap.Type.Section as Section
import qualified Rattletrap.Type.Str as Str
import qualified Rattletrap.Type.U32 as U32
import qualified Rattletrap.Type.Version as Version
import qualified Rattletrap.Utility.Json as Json
import qualified Rattletrap.Version as Version

type Replay
  = ReplayWith
      (Section.Section Header.Header)
      (Section.Section Content.Content)

-- | A Rocket League replay.
data ReplayWith header content = Replay
  { ReplayWith header content -> header
header :: header
  -- ^ This has most of the high-level metadata.
  , ReplayWith header content -> content
content :: content
  -- ^ This has most of the low-level game data.
  }
  deriving (ReplayWith header content -> ReplayWith header content -> Bool
(ReplayWith header content -> ReplayWith header content -> Bool)
-> (ReplayWith header content -> ReplayWith header content -> Bool)
-> Eq (ReplayWith header content)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall header content.
(Eq header, Eq content) =>
ReplayWith header content -> ReplayWith header content -> Bool
/= :: ReplayWith header content -> ReplayWith header content -> Bool
$c/= :: forall header content.
(Eq header, Eq content) =>
ReplayWith header content -> ReplayWith header content -> Bool
== :: ReplayWith header content -> ReplayWith header content -> Bool
$c== :: forall header content.
(Eq header, Eq content) =>
ReplayWith header content -> ReplayWith header content -> Bool
Eq, Int -> ReplayWith header content -> ShowS
[ReplayWith header content] -> ShowS
ReplayWith header content -> String
(Int -> ReplayWith header content -> ShowS)
-> (ReplayWith header content -> String)
-> ([ReplayWith header content] -> ShowS)
-> Show (ReplayWith header content)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall header content.
(Show header, Show content) =>
Int -> ReplayWith header content -> ShowS
forall header content.
(Show header, Show content) =>
[ReplayWith header content] -> ShowS
forall header content.
(Show header, Show content) =>
ReplayWith header content -> String
showList :: [ReplayWith header content] -> ShowS
$cshowList :: forall header content.
(Show header, Show content) =>
[ReplayWith header content] -> ShowS
show :: ReplayWith header content -> String
$cshow :: forall header content.
(Show header, Show content) =>
ReplayWith header content -> String
showsPrec :: Int -> ReplayWith header content -> ShowS
$cshowsPrec :: forall header content.
(Show header, Show content) =>
Int -> ReplayWith header content -> ShowS
Show)

instance (Json.FromJSON h, Json.FromJSON c) => Json.FromJSON (ReplayWith h c) where
  parseJSON :: Value -> Parser (ReplayWith h c)
parseJSON = String
-> (Object -> Parser (ReplayWith h c))
-> Value
-> Parser (ReplayWith h c)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"Replay" ((Object -> Parser (ReplayWith h c))
 -> Value -> Parser (ReplayWith h c))
-> (Object -> Parser (ReplayWith h c))
-> Value
-> Parser (ReplayWith h c)
forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    h
header <- Object -> String -> Parser h
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"header"
    c
content <- Object -> String -> Parser c
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"content"
    ReplayWith h c -> Parser (ReplayWith h c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Replay :: forall header content.
header -> content -> ReplayWith header content
Replay { h
header :: h
header :: h
header, c
content :: c
content :: c
content }

instance (Json.ToJSON h, Json.ToJSON c) => Json.ToJSON (ReplayWith h c) where
  toJSON :: ReplayWith h c -> Value
toJSON ReplayWith h c
x = [Pair] -> Value
Json.object
    [ String -> String -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"$schema" String
schemaUrl
    , String -> h -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"header" (h -> Pair) -> h -> Pair
forall a b. (a -> b) -> a -> b
$ ReplayWith h c -> h
forall header content. ReplayWith header content -> header
header ReplayWith h c
x
    , String -> c -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"content" (c -> Pair) -> c -> Pair
forall a b. (a -> b) -> a -> b
$ ReplayWith h c -> c
forall header content. ReplayWith header content -> content
content ReplayWith h c
x
    ]

schema :: Schema.Schema -> Schema.Schema -> Schema.Schema
schema :: Schema -> Schema -> Schema
schema Schema
h Schema
c = String -> Value -> Schema
Schema.named String
"replay" (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
"header" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
h, Bool
True)
  , (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"content" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
c, Bool
True)
  ]

schemaUrl :: String
schemaUrl :: String
schemaUrl = [String] -> String
forall a. Monoid a => [a] -> a
mconcat
  [ String
"https://github.com/tfausak/rattletrap/releases/download/"
  , String
Version.string
  , String
"/rattletrap-"
  , String
Version.string
  , String
"-schema.json"
  ]

bytePut :: Replay -> BytePut.BytePut
bytePut :: Replay -> BytePut
bytePut Replay
x = (Header -> BytePut) -> Section Header -> BytePut
forall a. (a -> BytePut) -> Section a -> BytePut
Section.bytePut Header -> BytePut
Header.bytePut (Replay -> Section Header
forall header content. ReplayWith header content -> header
header Replay
x)
  BytePut -> BytePut -> BytePut
forall a. Semigroup a => a -> a -> a
<> (Content -> BytePut) -> Section Content -> BytePut
forall a. (a -> BytePut) -> Section a -> BytePut
Section.bytePut Content -> BytePut
Content.bytePut (Replay -> Section Content
forall header content. ReplayWith header content -> content
content Replay
x)

byteGet :: Bool -> Bool -> ByteGet.ByteGet Replay
byteGet :: Bool -> Bool -> ByteGet Replay
byteGet Bool
fast Bool
skip = do
  Section ByteString
hs <- Bool -> (U32 -> ByteGet ByteString) -> ByteGet (Section ByteString)
forall a. Bool -> (U32 -> ByteGet a) -> ByteGet (Section a)
Section.byteGet Bool
skip ((U32 -> ByteGet ByteString) -> ByteGet (Section ByteString))
-> (U32 -> ByteGet ByteString) -> ByteGet (Section ByteString)
forall a b. (a -> b) -> a -> b
$ Int -> ByteGet ByteString
ByteGet.byteString (Int -> ByteGet ByteString)
-> (U32 -> Int) -> U32 -> 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 -> Int) -> (U32 -> Word32) -> U32 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. U32 -> Word32
U32.toWord32
  Header
h <- (String -> Get ByteString Identity Header)
-> (Header -> Get ByteString Identity Header)
-> Either String Header
-> Get ByteString Identity Header
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get ByteString Identity Header
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Header -> Get ByteString Identity Header
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Header -> Get ByteString Identity Header)
-> (ByteString -> Either String Header)
-> ByteString
-> Get ByteString Identity Header
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Get ByteString Identity Header
-> ByteString -> Either String Header
forall a. ByteGet a -> ByteString -> Either String a
ByteGet.run Get ByteString Identity Header
Header.byteGet (ByteString -> Get ByteString Identity Header)
-> ByteString -> Get ByteString Identity Header
forall a b. (a -> b) -> a -> b
$ Section ByteString -> ByteString
forall a. Section a -> a
Section.body Section ByteString
hs
  Section ByteString
cs <- Bool -> (U32 -> ByteGet ByteString) -> ByteGet (Section ByteString)
forall a. Bool -> (U32 -> ByteGet a) -> ByteGet (Section a)
Section.byteGet Bool
skip ((U32 -> ByteGet ByteString) -> ByteGet (Section ByteString))
-> (U32 -> ByteGet ByteString) -> ByteGet (Section ByteString)
forall a b. (a -> b) -> a -> b
$ Int -> ByteGet ByteString
ByteGet.byteString (Int -> ByteGet ByteString)
-> (U32 -> Int) -> U32 -> 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 -> Int) -> (U32 -> Word32) -> U32 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. U32 -> Word32
U32.toWord32
  Content
c <- if Bool
fast
    then Content -> Get ByteString Identity Content
forall (f :: * -> *) a. Applicative f => a -> f a
pure Content
Content.empty
    else (String -> Get ByteString Identity Content)
-> (Content -> Get ByteString Identity Content)
-> Either String Content
-> Get ByteString Identity Content
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get ByteString Identity Content
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Content -> Get ByteString Identity Content
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Content -> Get ByteString Identity Content)
-> (ByteString -> Either String Content)
-> ByteString
-> Get ByteString Identity Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Get ByteString Identity Content
-> ByteString -> Either String Content
forall a. ByteGet a -> ByteString -> Either String a
ByteGet.run (Header -> Get ByteString Identity Content
getContent Header
h) (ByteString -> Get ByteString Identity Content)
-> ByteString -> Get ByteString Identity Content
forall a b. (a -> b) -> a -> b
$ Section ByteString -> ByteString
forall a. Section a -> a
Section.body Section ByteString
cs
  Replay -> ByteGet Replay
forall (f :: * -> *) a. Applicative f => a -> f a
pure Replay :: forall header content.
header -> content -> ReplayWith header content
Replay
    { header :: Section Header
header = Section ByteString
hs { body :: Header
Section.body = Header
h }
    , content :: Section Content
content = Section ByteString
cs { body :: Content
Section.body = Content
c }
    }

getContent :: Header.Header -> ByteGet.ByteGet Content.Content
getContent :: Header -> Get ByteString Identity Content
getContent Header
h =
  Version -> Int -> Word -> Get ByteString Identity Content
Content.byteGet (Header -> Version
getVersion Header
h) (Header -> Int
getNumFrames Header
h) (Header -> Word
getMaxChannels Header
h)

getVersion :: Header.Header -> Version.Version
getVersion :: Header -> Version
getVersion Header
x = Version :: Int -> Int -> Int -> Version
Version.Version
  { major :: Int
Version.major = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> (U32 -> Word32) -> U32 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. U32 -> Word32
U32.toWord32 (U32 -> Int) -> U32 -> Int
forall a b. (a -> b) -> a -> b
$ Header -> U32
Header.engineVersion Header
x
  , minor :: Int
Version.minor = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> (U32 -> Word32) -> U32 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. U32 -> Word32
U32.toWord32 (U32 -> Int) -> U32 -> Int
forall a b. (a -> b) -> a -> b
$ Header -> U32
Header.licenseeVersion Header
x
  , patch :: Int
Version.patch = Header -> Int
getPatchVersion Header
x
  }

getPatchVersion :: Header.Header -> Int
getPatchVersion :: Header -> Int
getPatchVersion Header
header_ = case Header -> Maybe U32
Header.patchVersion Header
header_ of
  Just U32
version -> Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (U32 -> Word32
U32.toWord32 U32
version)
  Maybe U32
Nothing ->
    case
        Str -> Dictionary Property -> Maybe Property
forall a. Str -> Dictionary a -> Maybe a
Dictionary.lookup
          (String -> Str
Str.fromString String
"MatchType")
          (Header -> Dictionary Property
Header.properties Header
header_)
      of
      -- This is an ugly, ugly hack to handle replays from season 2 of RLCS.
      -- See `decodeSpawnedReplicationBits` and #85.
        Just Property.Property { value :: Property -> PropertyValue Property
Property.value = PropertyValue.Name Str
str }
          | Str -> String
Str.toString Str
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"Lan" -> -Int
1
        Maybe Property
_ -> Int
0

getNumFrames :: Header.Header -> Int
getNumFrames :: Header -> Int
getNumFrames Header
header_ =
  case
      Str -> Dictionary Property -> Maybe Property
forall a. Str -> Dictionary a -> Maybe a
Dictionary.lookup
        (String -> Str
Str.fromString String
"NumFrames")
        (Header -> Dictionary Property
Header.properties Header
header_)
    of
      Just (Property.Property Str
_ U64
_ (PropertyValue.Int I32
numFrames)) ->
        Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (I32 -> Int32
I32.toInt32 I32
numFrames)
      Maybe Property
_ -> Int
0

getMaxChannels :: Header.Header -> Word
getMaxChannels :: Header -> Word
getMaxChannels Header
header_ =
  case
      Str -> Dictionary Property -> Maybe Property
forall a. Str -> Dictionary a -> Maybe a
Dictionary.lookup
        (String -> Str
Str.fromString String
"MaxChannels")
        (Header -> Dictionary Property
Header.properties Header
header_)
    of
      Just (Property.Property Str
_ U64
_ (PropertyValue.Int I32
numFrames)) ->
        Int32 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (I32 -> Int32
I32.toInt32 I32
numFrames)
      Maybe Property
_ -> Word
1023