{-# LANGUAGE TemplateHaskell #-}

module Rattletrap.Type.Replay
  ( FullReplay
  , Replay(..)
  )
where

import Rattletrap.Type.Common
import Rattletrap.Type.Content
import Rattletrap.Type.Header
import Rattletrap.Type.Section

type FullReplay = Replay Content

-- | A Rocket League replay.
data Replay content = Replay
  { Replay content -> Section Header
replayHeader :: Section Header
  -- ^ This has most of the high-level metadata.
  , Replay content -> Section content
replayContent :: Section content
  -- ^ This has most of the low-level game data.
  } deriving (Replay content -> Replay content -> Bool
(Replay content -> Replay content -> Bool)
-> (Replay content -> Replay content -> Bool)
-> Eq (Replay content)
forall content.
Eq content =>
Replay content -> Replay content -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Replay content -> Replay content -> Bool
$c/= :: forall content.
Eq content =>
Replay content -> Replay content -> Bool
== :: Replay content -> Replay content -> Bool
$c== :: forall content.
Eq content =>
Replay content -> Replay content -> Bool
Eq, Eq (Replay content)
Eq (Replay content)
-> (Replay content -> Replay content -> Ordering)
-> (Replay content -> Replay content -> Bool)
-> (Replay content -> Replay content -> Bool)
-> (Replay content -> Replay content -> Bool)
-> (Replay content -> Replay content -> Bool)
-> (Replay content -> Replay content -> Replay content)
-> (Replay content -> Replay content -> Replay content)
-> Ord (Replay content)
Replay content -> Replay content -> Bool
Replay content -> Replay content -> Ordering
Replay content -> Replay content -> Replay content
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall content. Ord content => Eq (Replay content)
forall content.
Ord content =>
Replay content -> Replay content -> Bool
forall content.
Ord content =>
Replay content -> Replay content -> Ordering
forall content.
Ord content =>
Replay content -> Replay content -> Replay content
min :: Replay content -> Replay content -> Replay content
$cmin :: forall content.
Ord content =>
Replay content -> Replay content -> Replay content
max :: Replay content -> Replay content -> Replay content
$cmax :: forall content.
Ord content =>
Replay content -> Replay content -> Replay content
>= :: Replay content -> Replay content -> Bool
$c>= :: forall content.
Ord content =>
Replay content -> Replay content -> Bool
> :: Replay content -> Replay content -> Bool
$c> :: forall content.
Ord content =>
Replay content -> Replay content -> Bool
<= :: Replay content -> Replay content -> Bool
$c<= :: forall content.
Ord content =>
Replay content -> Replay content -> Bool
< :: Replay content -> Replay content -> Bool
$c< :: forall content.
Ord content =>
Replay content -> Replay content -> Bool
compare :: Replay content -> Replay content -> Ordering
$ccompare :: forall content.
Ord content =>
Replay content -> Replay content -> Ordering
$cp1Ord :: forall content. Ord content => Eq (Replay content)
Ord, Int -> Replay content -> ShowS
[Replay content] -> ShowS
Replay content -> String
(Int -> Replay content -> ShowS)
-> (Replay content -> String)
-> ([Replay content] -> ShowS)
-> Show (Replay content)
forall content. Show content => Int -> Replay content -> ShowS
forall content. Show content => [Replay content] -> ShowS
forall content. Show content => Replay content -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Replay content] -> ShowS
$cshowList :: forall content. Show content => [Replay content] -> ShowS
show :: Replay content -> String
$cshow :: forall content. Show content => Replay content -> String
showsPrec :: Int -> Replay content -> ShowS
$cshowsPrec :: forall content. Show content => Int -> Replay content -> ShowS
Show)

$(deriveJson ''Replay)