{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
module Octane.Type.Replay
( Replay(..)
, fromOptimizedReplay
, toOptimizedReplay
) where
import Data.Aeson ((.=))
import Data.Function ((&))
import qualified Control.DeepSeq as DeepSeq
import qualified Data.Aeson as Aeson
import qualified Data.Binary as Binary
import qualified Data.Default.Class as Default
import qualified Data.Map.Strict as Map
import qualified Data.OverloadedRecords.TH as OverloadedRecords
import qualified Data.Set as Set
import qualified Data.Text as StrictText
import qualified Data.Version as Version
import qualified GHC.Generics as Generics
import qualified Octane.Type.CacheItem as CacheItem
import qualified Octane.Type.CacheProperty as CacheProperty
import qualified Octane.Type.ClassItem as ClassItem
import qualified Octane.Type.Dictionary as Dictionary
import qualified Octane.Type.Frame as Frame
import qualified Octane.Type.KeyFrame as KeyFrame
import qualified Octane.Type.List as List
import qualified Octane.Type.Mark as Mark
import qualified Octane.Type.Message as Message
import qualified Octane.Type.OptimizedReplay as OptimizedReplay
import qualified Octane.Type.Property as Property
import qualified Octane.Type.Text as Text
import qualified Octane.Type.Word32 as Word32
data Replay = Replay
{ replayVersion :: Version.Version
, replayMetadata :: Map.Map StrictText.Text Property.Property
, replayLevels :: [StrictText.Text]
, replayMessages :: Map.Map StrictText.Text StrictText.Text
, replayTickMarks :: Map.Map StrictText.Text StrictText.Text
, replayPackages :: [StrictText.Text]
, replayFrames :: [Frame.Frame]
} deriving (Eq, Generics.Generic, Show)
$(OverloadedRecords.overloadedRecord Default.def ''Replay)
instance Binary.Binary Replay where
get = do
optimizedReplay <- Binary.get
fromOptimizedReplay optimizedReplay
put replay = do
optimizedReplay <- toOptimizedReplay replay
Binary.put optimizedReplay
instance DeepSeq.NFData Replay
instance Aeson.ToJSON Replay where
toJSON replay =
Aeson.object
[ "Version" .= #version replay
, "Metadata" .= #metadata replay
, "Levels" .= #levels replay
, "Messages" .= #messages replay
, "TickMarks" .= #tickMarks replay
, "Packages" .= #packages replay
, "Frames" .= #frames replay
]
-- | Converts an 'OptimizedReplay.OptimizedReplay' into a 'Replay'.
-- Operates in a 'Monad' so that it can 'fail' somewhat gracefully.
fromOptimizedReplay
:: (Monad m)
=> OptimizedReplay.OptimizedReplay -> m Replay
fromOptimizedReplay optimizedReplay = do
pure
Replay
{ replayVersion =
[#version1 optimizedReplay, #version2 optimizedReplay] &
map Word32.fromWord32 &
Version.makeVersion
, replayMetadata =
optimizedReplay & #properties & #unpack & Map.mapKeys #unpack
, replayLevels = optimizedReplay & #levels & #unpack & map #unpack
, replayMessages =
optimizedReplay & #messages & #unpack &
map
(\message -> do
let key = message & #frame & #unpack & show & StrictText.pack
let value = message & #content & #unpack
(key, value)) &
Map.fromList
, replayTickMarks =
optimizedReplay & #marks & #unpack &
map
(\mark -> do
let key = mark & #frame & #unpack & show & StrictText.pack
let value = mark & #label & #unpack
(key, value)) &
Map.fromList
, replayPackages = optimizedReplay & #packages & #unpack & map #unpack
, replayFrames = optimizedReplay & #frames
}
-- | Converts a 'Replay' into an 'OptimizedReplay.OptimizedReplay'.
-- Operates in a 'Monad' so that it can 'fail' somewhat gracefully.
toOptimizedReplay
:: (Monad m)
=> Replay -> m OptimizedReplay.OptimizedReplay
toOptimizedReplay replay = do
let [version1, version2] =
replay & #version & Version.versionBranch & map Word32.toWord32
-- Key frames aren't important for replays. Mark the first frame as a key
-- frame and the rest as regular frames.
let frames =
replay & #frames & zip [0 :: Int ..] &
map (\(index, frame) -> frame {Frame.frameIsKeyFrame = index == 0})
let objectNames = frames & concatMap #replications & map #objectName
let classNames = frames & concatMap #replications & map #className
let propertyNames =
frames & concatMap #replications & map #properties & concatMap Map.keys
let objects =
[objectNames, classNames, propertyNames] & concat & Set.fromList &
Set.toAscList &
map Text.Text &
List.List
let objectsToPosition = objects & #unpack & flip zip [0 ..] & Map.fromList
classes <-
frames & concatMap #replications & map #className & Set.fromList &
Set.toAscList &
map Text.Text &
mapM
(\className ->
case Map.lookup className objectsToPosition of
Nothing ->
fail
("class " ++ show className ++ " not found in list of objects")
Just position -> pure (ClassItem.ClassItem className position)) &
fmap List.List
let numClasses = classes & #unpack & length & fromIntegral
classesToProperties <-
frames & concatMap #replications &
concatMap
(\replication ->
zip
(replication & #className & repeat)
(replication & #properties & Map.keys & map Text.Text)) &
zip [numClasses ..] &
mapM
(\(streamId, (className, propertyName)) -> do
case Map.lookup propertyName objectsToPosition of
Nothing ->
fail
("property " ++
show propertyName ++ " not found in list of objects")
Just propertyId ->
pure (className, [CacheProperty.CacheProperty propertyId streamId])) &
fmap (Map.fromListWith (++))
let cache =
classes & #unpack & zip [0 ..] &
map
(\(index, classItem) -> do
let classId = #streamId classItem
let parentCacheId = index
let cacheId = index
let properties =
classesToProperties &
Map.findWithDefault [] (classItem & #name & #unpack) &
List.List
CacheItem.CacheItem classId parentCacheId cacheId properties) &
List.List
pure
OptimizedReplay.OptimizedReplay
{ OptimizedReplay.optimizedReplayVersion1 = version1
, OptimizedReplay.optimizedReplayVersion2 = version2
, OptimizedReplay.optimizedReplayLabel = "TAGame.Replay_Soccar_TA"
, OptimizedReplay.optimizedReplayProperties =
replay & #metadata & Map.mapKeys Text.Text & Dictionary.Dictionary
, OptimizedReplay.optimizedReplayLevels =
replay & #levels & map Text.Text & List.List
, OptimizedReplay.optimizedReplayKeyFrames =
frames & filter #isKeyFrame &
map
(\frame ->
KeyFrame.KeyFrame
(#time frame)
(frame & #number & Word32.toWord32)
0) &
List.List
, OptimizedReplay.optimizedReplayFrames = frames
, OptimizedReplay.optimizedReplayMessages =
replay & #messages & Map.toList &
map
(\(key, value) -> do
let frame = key & StrictText.unpack & read & Word32.Word32
let content = value & Text.Text
Message.Message frame "" content) &
List.List
, OptimizedReplay.optimizedReplayMarks =
replay & #tickMarks & Map.toList &
map
(\(key, value) -> do
let label = value & Text.Text
let frame = key & StrictText.unpack & read & Word32.Word32
Mark.Mark label frame) &
List.List
, OptimizedReplay.optimizedReplayPackages =
replay & #packages & map Text.Text & List.List
, OptimizedReplay.optimizedReplayObjects = objects
, OptimizedReplay.optimizedReplayNames = List.List [] -- TODO
, OptimizedReplay.optimizedReplayClasses = classes
, OptimizedReplay.optimizedReplayCache = cache
}