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)
data ReplayWith header content = Replay
{
:: header,
forall header content. ReplayWith header content -> content
content :: content
}
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
$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
/= :: 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
$cshowsPrec :: forall header content.
(Show header, Show content) =>
Int -> ReplayWith header content -> ShowS
showsPrec :: Int -> ReplayWith header content -> ShowS
$cshow :: forall header content.
(Show header, Show content) =>
ReplayWith header content -> String
show :: ReplayWith header content -> String
$cshowList :: forall header content.
(Show header, Show content) =>
[ReplayWith header content] -> ShowS
showList :: [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 a. a -> Parser a
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
[ String -> String -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"$schema" String
schemaUrl,
String -> h -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"header" (h -> (Key, Value)) -> h -> (Key, Value)
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 -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"content" (c -> (Key, Value)) -> c -> (Key, Value)
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
$
[((Key, Value), Bool)] -> Value
Schema.object
[ (String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"header" (Value -> (Key, Value)) -> Value -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
h, Bool
True),
(String -> Value -> (Key, Value)
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"content" (Value -> (Key, Value)) -> Value -> (Key, Value)
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 = String -> ByteGet Replay -> ByteGet Replay
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"Replay" (ByteGet Replay -> ByteGet Replay)
-> ByteGet Replay -> ByteGet Replay
forall a b. (a -> b) -> a -> b
$ do
Section Header
header <- String -> ByteGet (Section Header) -> ByteGet (Section Header)
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"header" (ByteGet (Section Header) -> ByteGet (Section Header))
-> ByteGet (Section Header) -> ByteGet (Section Header)
forall a b. (a -> b) -> a -> b
$ do
Section ByteString
section <-
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
body <- ByteGet Header -> ByteString -> ByteGet Header
forall a. ByteGet a -> ByteString -> ByteGet a
ByteGet.embed ByteGet Header
Header.byteGet (ByteString -> ByteGet Header) -> ByteString -> ByteGet Header
forall a b. (a -> b) -> a -> b
$ Section ByteString -> ByteString
forall a. Section a -> a
Section.body Section ByteString
section
Section Header -> ByteGet (Section Header)
forall a. a -> Get ByteString Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Section ByteString
section {Section.body}
Section Content
content <- String -> ByteGet (Section Content) -> ByteGet (Section Content)
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"content" (ByteGet (Section Content) -> ByteGet (Section Content))
-> ByteGet (Section Content) -> ByteGet (Section Content)
forall a b. (a -> b) -> a -> b
$ do
Section ByteString
section <-
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
body <-
if Bool
fast
then Content -> Get ByteString Identity Content
forall a. a -> Get ByteString Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Content
Content.empty
else
Get ByteString Identity Content
-> ByteString -> Get ByteString Identity Content
forall a. ByteGet a -> ByteString -> ByteGet a
ByteGet.embed (Header -> Get ByteString Identity Content
getContent (Header -> Get ByteString Identity Content)
-> Header -> Get ByteString Identity Content
forall a b. (a -> b) -> a -> b
$ Section Header -> Header
forall a. Section a -> a
Section.body Section Header
header) (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
section
Section Content -> ByteGet (Section Content)
forall a. a -> Get ByteString Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Section ByteString
section {Section.body}
Replay -> ByteGet Replay
forall a. a -> Get ByteString Identity a
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 -> Get ByteString Identity Content
getContent Header
h =
Maybe Str
-> Version
-> Int
-> Word
-> Maybe Str
-> Get ByteString Identity 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 :: PropertyValue Property
value :: Property -> PropertyValue Property
Property.value} <-
Str -> Dictionary Property -> Maybe Property
forall a. Str -> Dictionary a -> Maybe a
Dictionary.lookup (String -> Str
Str.fromString String
"MatchType") (Dictionary Property -> Maybe Property)
-> Dictionary Property -> Maybe Property
forall a b. (a -> b) -> a -> b
$ Header -> Dictionary Property
Header.properties Header
header
case PropertyValue Property
value of
PropertyValue.Name Name
x -> Str -> Maybe Str
forall a. a -> Maybe a
Just (Str -> Maybe Str) -> Str -> Maybe Str
forall a b. (a -> b) -> a -> b
$ Name -> Str
Property.Name.toStr Name
x
PropertyValue Property
_ -> Maybe Str
forall a. Maybe a
Nothing
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 Int
numFrames)) ->
Int32 -> Int
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_ =
Word -> Word -> Word
forall a. Num a => a -> a -> a
subtract Word
1 (Word -> Word) -> Word -> Word
forall a b. (a -> b) -> a -> b
$
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 Int
maxChannels)) ->
Int32 -> Word
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 <-
Str -> Dictionary Property -> Maybe Property
forall a. Str -> Dictionary a -> Maybe a
Dictionary.lookup (String -> Str
Str.fromString String
"BuildVersion") (Dictionary Property -> Maybe Property)
-> Dictionary Property -> Maybe Property
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 -> Str -> Maybe Str
forall a. a -> Maybe a
Just (Str -> Maybe Str) -> Str -> Maybe Str
forall a b. (a -> b) -> a -> b
$ Str -> Str
Property.Str.toStr Str
x
PropertyValue Property
_ -> Maybe Str
forall a. Maybe a
Nothing