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.Property.Int as Property.Int
import qualified Rattletrap.Type.Property.Name as Property.Name
import qualified Rattletrap.Type.Property.Str as Property.Str
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.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
  { -- | This has most of the high-level metadata.
    forall header content. ReplayWith header content -> header
header :: header,
    -- | This has most of the low-level game data.
    forall header content. ReplayWith header content -> content
content :: content
  }
  deriving (ReplayWith header content -> ReplayWith header content -> Bool
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
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 = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"Replay" forall a b. (a -> b) -> a -> b
$ \Object
object -> do
    h
header <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"header"
    c
content <- forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"content"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 =
    [(Key, Value)] -> Value
Json.object
      [ forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"$schema" String
schemaUrl,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"header" forall a b. (a -> b) -> a -> b
$ forall header content. ReplayWith header content -> header
header ReplayWith h c
x,
        forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"content" forall a b. (a -> b) -> a -> b
$ 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" 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
"header" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
h, Bool
True),
        (forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"content" forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
c, Bool
True)
      ]

schemaUrl :: String
schemaUrl :: String
schemaUrl =
  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 =
  forall a. (a -> BytePut) -> Section a -> BytePut
Section.bytePut Header -> BytePut
Header.bytePut (forall header content. ReplayWith header content -> header
header Replay
x)
    forall a. Semigroup a => a -> a -> a
<> forall a. (a -> BytePut) -> Section a -> BytePut
Section.bytePut Content -> BytePut
Content.bytePut (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 = forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"Replay" forall a b. (a -> b) -> a -> b
$ do
  Section Header
header <- forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"header" forall a b. (a -> b) -> a -> b
$ do
    Section ByteString
section <-
      forall a. Bool -> (U32 -> ByteGet a) -> ByteGet (Section a)
Section.byteGet Bool
skip forall a b. (a -> b) -> a -> b
$ Int -> ByteGet ByteString
ByteGet.byteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. U32 -> Word32
U32.toWord32
    Header
body <- forall a. ByteGet a -> ByteString -> ByteGet a
ByteGet.embed ByteGet Header
Header.byteGet forall a b. (a -> b) -> a -> b
$ forall a. Section a -> a
Section.body Section ByteString
section
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Section ByteString
section {Header
body :: Header
body :: Header
Section.body}
  Section Content
content <- forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"content" forall a b. (a -> b) -> a -> b
$ do
    Section ByteString
section <-
      forall a. Bool -> (U32 -> ByteGet a) -> ByteGet (Section a)
Section.byteGet Bool
skip forall a b. (a -> b) -> a -> b
$ Int -> ByteGet ByteString
ByteGet.byteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. U32 -> Word32
U32.toWord32
    Content
body <-
      if Bool
fast
        then forall (f :: * -> *) a. Applicative f => a -> f a
pure Content
Content.empty
        else
          forall a. ByteGet a -> ByteString -> ByteGet a
ByteGet.embed (Header -> ByteGet Content
getContent forall a b. (a -> b) -> a -> b
$ forall a. Section a -> a
Section.body Section Header
header) forall a b. (a -> b) -> a -> b
$
            forall a. Section a -> a
Section.body Section ByteString
section
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Section ByteString
section {Content
body :: Content
body :: Content
Section.body}
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Replay {Section Header
header :: Section Header
header :: Section Header
header, Section Content
content :: Section Content
content :: Section Content
content}

getContent :: Header.Header -> ByteGet.ByteGet Content.Content
getContent :: Header -> ByteGet Content
getContent Header
h =
  Maybe Str -> Version -> Int -> Word -> Maybe Str -> ByteGet Content
Content.byteGet
    (Header -> Maybe Str
getMatchType Header
h)
    (Header -> Version
Header.version Header
h)
    (Header -> Int
getNumFrames Header
h)
    (Header -> Word
getMaxChannels Header
h)
    (Header -> Maybe Str
getBuildVersion Header
h)

getMatchType :: Header.Header -> Maybe Str.Str
getMatchType :: Header -> Maybe Str
getMatchType Header
header = do
  Property.Property {PropertyValue Property
value :: Property -> PropertyValue Property
value :: PropertyValue Property
Property.value} <-
    forall a. Str -> Dictionary a -> Maybe a
Dictionary.lookup (String -> Str
Str.fromString String
"MatchType") forall a b. (a -> b) -> a -> b
$ Header -> Dictionary Property
Header.properties Header
header
  case PropertyValue Property
value of
    PropertyValue.Name Name
x -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Name -> Str
Property.Name.toStr Name
x
    PropertyValue Property
_ -> forall a. Maybe a
Nothing

getNumFrames :: Header.Header -> Int
getNumFrames :: Header -> Int
getNumFrames Header
header_ =
  case 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 Int
numFrames)) ->
      forall a b. (Integral a, Num b) => a -> b
fromIntegral (I32 -> Int32
I32.toInt32 (Int -> I32
Property.Int.toI32 Int
numFrames))
    Maybe Property
_ -> Int
0

getMaxChannels :: Header.Header -> Word
getMaxChannels :: Header -> Word
getMaxChannels Header
header_ =
  forall a. Num a => a -> a -> a
subtract Word
1 forall a b. (a -> b) -> a -> b
$
    case 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 Int
maxChannels)) ->
        forall a b. (Integral a, Num b) => a -> b
fromIntegral (I32 -> Int32
I32.toInt32 (Int -> I32
Property.Int.toI32 Int
maxChannels))
      Maybe Property
_ -> Word
1023

getBuildVersion :: Header.Header -> Maybe Str.Str
getBuildVersion :: Header -> Maybe Str
getBuildVersion Header
header = do
  Property
property <-
    forall a. Str -> Dictionary a -> Maybe a
Dictionary.lookup (String -> Str
Str.fromString String
"BuildVersion") forall a b. (a -> b) -> a -> b
$
      Header -> Dictionary Property
Header.properties Header
header
  case Property -> PropertyValue Property
Property.value Property
property of
    PropertyValue.Str Str
x -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Str -> Str
Property.Str.toStr Str
x
    PropertyValue Property
_ -> forall a. Maybe a
Nothing