octane 0.14.0 → 0.15.0

raw patch · 54 files changed

+3036/−3099 lines, 54 filesdep −doctestdep ~aesondep ~basedep ~binarysetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies removed: doctest

Dependency ranges changed: aeson, base, binary, bytestring

API changes (from Hackage documentation)

Files

• Setup.hs +3/−2
• benchmark/Main.hs +4/−6
• benchmark/OctaneBench.hs +4/−5
• executable/Main.hs +58/−2
• library/Octane.hs +6/−6
• library/Octane/Data.hs +8/−46
• library/Octane/Main.hs +0/−77
• library/Octane/Type.hs +32/−32
• library/Octane/Type/Boolean.hs +18/−46
• library/Octane/Type/CacheItem.hs +15/−28
• library/Octane/Type/CacheProperty.hs +11/−19
• library/Octane/Type/ClassItem.hs +11/−19
• library/Octane/Type/CompressedWord.hs +39/−53
• library/Octane/Type/Dictionary.hs +40/−59
• library/Octane/Type/Float32.hs +20/−51
• library/Octane/Type/Frame.hs +57/−224
• library/Octane/Type/Initialization.hs +27/−24
• library/Octane/Type/Int32.hs +31/−58
• library/Octane/Type/Int8.hs +31/−61
• library/Octane/Type/KeyFrame.hs +13/−22
• library/Octane/Type/List.hs +25/−42
• library/Octane/Type/Mark.hs +10/−17
• library/Octane/Type/Message.hs +13/−21
• library/Octane/Type/OptimizedReplay.hs +65/−63
• library/Octane/Type/Property.hs +310/−164
• library/Octane/Type/RawReplay.hs +50/−53
• library/Octane/Type/RemoteId.hs +89/−163
• library/Octane/Type/Replay.hs +114/−134
• library/Octane/Type/ReplayWithFrames.hs +73/−70
• library/Octane/Type/ReplayWithoutFrames.hs +87/−90
• library/Octane/Type/Replication.hs +11/−10
• library/Octane/Type/State.hs +8/−7
• library/Octane/Type/Stream.hs +21/−29
• library/Octane/Type/Text.hs +64/−105
• library/Octane/Type/Value.hs +434/−97
• library/Octane/Type/Vector.hs +59/−62
• library/Octane/Type/Word16.hs +22/−44
• library/Octane/Type/Word32.hs +31/−68
• library/Octane/Type/Word64.hs +31/−68
• library/Octane/Type/Word8.hs +31/−67
• library/Octane/Utility.hs +8/−8
• library/Octane/Utility/CRC.hs +275/−87
• library/Octane/Utility/ClassPropertyMap.hs +140/−154
• library/Octane/Utility/Embed.hs +16/−34
• library/Octane/Utility/Endian.hs +12/−21
• library/Octane/Utility/Generator.hs +44/−50
• library/Octane/Utility/Optimizer.hs +96/−92
• library/Octane/Utility/Parser.hs +425/−388
• library/Octane/Version.hs +18/−0
• octane.cabal +10/−21
• package.yaml +7/−14
• test-suite/DocTest.hs +0/−7
• test-suite/Main.hs +5/−5
• test-suite/OctaneSpec.hs +4/−4

@@ -1,7 +1,8 @@-module Main (main) where+module Main+  ( main+  ) where  import qualified Distribution.Simple-  main :: IO () main = Distribution.Simple.defaultMain

@@ -1,14 +1,12 @@-module Main (main) where+module Main+  ( main+  ) where  import qualified Criterion.Main as Criterion import qualified OctaneBench - main :: IO () main = Criterion.defaultMain bench - bench :: [Criterion.Benchmark]-bench =-    [ OctaneBench.bench-    ]+bench = [OctaneBench.bench]

@@ -1,9 +1,8 @@-module OctaneBench (bench) where+module OctaneBench+  ( bench+  ) where  import qualified Criterion - bench :: Criterion.Benchmark-bench = Criterion.bgroup "Octane"-    [-    ]+bench = Criterion.bgroup "Octane" []

@@ -1,3 +1,59 @@-module Main (module Octane) where+module Main+  ( main+  ) where -import Octane (main)+import qualified Data.Aeson as Aeson+import qualified Data.Binary as Binary+import qualified Data.ByteString.Lazy as LazyBytes+import qualified Network.HTTP.Client as Client+import qualified Network.HTTP.Client.TLS as TLS+import qualified Octane.Type.Replay as Replay+import qualified Octane.Version as Version+import qualified System.Environment as Environment++main :: IO ()+main = do+  manager <- Client.newManager TLS.tlsManagerSettings+  TLS.setGlobalManager manager+  args <- Environment.getArgs+  case args of+    [] -> main0+    ["--version"] -> mainVersion+    [x] -> main1 x+    xs -> main2 xs++main0 :: IO ()+main0 = do+  LazyBytes.interact+    (\input -> do+       let replay = Binary.decode input+       Aeson.encode (replay :: Replay.Replay))++mainVersion :: IO ()+mainVersion = do+  putStrLn Version.versionString++main1 :: String -> IO ()+main1 x = do+  replay <- decode x+  let output = Aeson.encode replay+  LazyBytes.putStr output++main2 :: [String] -> IO ()+main2 xs = do+  replays <- mapM decode xs+  let output = Aeson.encode replays+  LazyBytes.putStr output++decode :: String -> IO Replay.Replay+decode x = do+  case Client.parseUrlThrow x of+    Nothing -> do+      let file = x+      Binary.decodeFile file+    Just request -> do+      manager <- TLS.getGlobalManager+      response <- Client.httpLbs request manager+      let input = Client.responseBody response+      let replay = Binary.decode input+      pure replay

@@ -1,11 +1,11 @@ module Octane-    ( module Octane.Data-    , module Octane.Main-    , module Octane.Type-    , module Octane.Utility-    ) where+  ( module Octane.Data+  , module Octane.Type+  , module Octane.Utility+  , module Octane.Version+  ) where  import Octane.Data-import Octane.Main import Octane.Type import Octane.Utility+import Octane.Version

@@ -9,66 +9,28 @@ import qualified Data.Text as StrictText import qualified Octane.Utility.Embed as Embed --- $setup--- >>> :set -XOverloadedStrings-- -- | A map from object names to their class names.------ >>> Map.lookup "Archetypes.Ball.Ball_Default" classes--- Just "TAGame.Ball_TA"------ Note that some object names have been normalized to make lookup easier.------ >>> Map.lookup "Neotokyo_p.TheWorld:PersistentLevel.InMapScoreboard_TA_0@" classes--- Nothing--- >>> Map.lookup "TheWorld:PersistentLevel.InMapScoreboard_TA" classes--- Just "TAGame.InMapScoreboard_TA" classes :: Map.Map StrictText.Text StrictText.Text-classes = Embed.decodeMap-    $(FileEmbed.embedFile "data/classes.json")-+classes = Embed.decodeMap $(FileEmbed.embedFile "data/classes.json")  -- | A set of classes that have an initial location vector.------ >>> Set.member "TAGame.Ball_TA" classesWithLocation--- True classesWithLocation :: Set.Set StrictText.Text-classesWithLocation = Embed.decodeSet-    $(FileEmbed.embedFile "data/classes-with-location.json")-+classesWithLocation =+  Embed.decodeSet $(FileEmbed.embedFile "data/classes-with-location.json")  -- | A set of classes that have an initial rotation vector.------ >>> Set.member "TAGame.Ball_TA" classesWithRotation--- True classesWithRotation :: Set.Set StrictText.Text-classesWithRotation = Embed.decodeSet-    $(FileEmbed.embedFile "data/classes-with-rotation.json")-+classesWithRotation =+  Embed.decodeSet $(FileEmbed.embedFile "data/classes-with-rotation.json")  -- | A one-to-one mapping between game mode IDs and their names.------ >>> Bimap.lookup 1 gameModes :: Maybe StrictText.Text--- Just "Hockey" gameModes :: Bimap.Bimap Int StrictText.Text-gameModes = Embed.decodeBimap-    $(FileEmbed.embedFile "data/game-modes.json")-+gameModes = Embed.decodeBimap $(FileEmbed.embedFile "data/game-modes.json")  -- | A one-to-one mapping between product IDs and their names.------ >>> Bimap.lookup 1 products :: Maybe StrictText.Text--- Just "Antenna_8Ball" products :: Bimap.Bimap Word StrictText.Text-products = Embed.decodeBimap-    $(FileEmbed.embedFile "data/products.json")-+products = Embed.decodeBimap $(FileEmbed.embedFile "data/products.json")  -- | A mapping between property names and their serialized type.------ >>> Map.lookup "Engine.Actor:bBlockActors" properties--- Just "boolean" properties :: Map.Map StrictText.Text StrictText.Text-properties = Embed.decodeMap-    $(FileEmbed.embedFile "data/properties.json")+properties = Embed.decodeMap $(FileEmbed.embedFile "data/properties.json")

@@ -1,77 +0,0 @@-module Octane.Main (main) where--import qualified Data.Aeson as Aeson-import qualified Data.Binary as Binary-import qualified Data.ByteString.Lazy as LazyBytes-import qualified Network.HTTP.Client as Client-import qualified Network.HTTP.Client.TLS as TLS-import qualified Octane.Type.Replay as Replay-import qualified System.Environment as Environment----- | Octane's command-line entrypoint. It has three modes:------ 1.  If no arguments are given, it will read from 'System.IO.stdin' and write---     to a JSON object to 'System.IO.stdout'.------     > octane < a.replay > replay.json------ 2.  If one argument is given, it will assume that argument is a path to a---     replay. Both local and remote (HTTP or HTTPS) paths are supported.---     Octane will read from the path and write a JSON object to---     'System.IO.stdout'.------     > octane a.replay > replay.json------     > octane https://media.rocketleaguereplays.com/uploads/replay_files/8D0940554D285C3F45109F85C79396A2.replay > replay.json------ 3.  If multiple arguments are given, it will assume that those arguments are---     paths to replays, read from them, and write a JSON array of objects to---     'System.IO.stdout'.------     > octane first.replay second.replay > replays.json-main :: IO ()-main = do-    manager <- Client.newManager TLS.tlsManagerSettings-    TLS.setGlobalManager manager--    args <- Environment.getArgs-    case args of-        [] -> main0-        [x] -> main1 x-        xs -> main2 xs---main0 :: IO ()-main0 = do-    LazyBytes.interact (\ input -> do-        let replay = Binary.decode input-        Aeson.encode (replay :: Replay.Replay))---main1 :: String -> IO ()-main1 x = do-    replay <- decode x-    let output = Aeson.encode replay-    LazyBytes.putStr output---main2 :: [String] -> IO ()-main2 xs = do-    replays <- mapM decode xs-    let output = Aeson.encode replays-    LazyBytes.putStr output---decode :: String -> IO Replay.Replay-decode x = do-    case Client.parseUrlThrow x of-        Nothing -> do-            let file = x-            Binary.decodeFile file-        Just request -> do-            manager <- TLS.getGlobalManager-            response <- Client.httpLbs request manager-            let input = Client.responseBody response-            let replay = Binary.decode input-            pure replay

@@ -1,36 +1,36 @@ module Octane.Type-    ( module Octane.Type.Boolean-    , module Octane.Type.CacheItem-    , module Octane.Type.CacheProperty-    , module Octane.Type.ClassItem-    , module Octane.Type.Dictionary-    , module Octane.Type.Float32-    , module Octane.Type.Frame-    , module Octane.Type.Initialization-    , module Octane.Type.Int32-    , module Octane.Type.Int8-    , module Octane.Type.KeyFrame-    , module Octane.Type.List-    , module Octane.Type.Mark-    , module Octane.Type.Message-    , module Octane.Type.OptimizedReplay-    , module Octane.Type.Property-    , module Octane.Type.RawReplay-    , module Octane.Type.RemoteId-    , module Octane.Type.Replay-    , module Octane.Type.ReplayWithFrames-    , module Octane.Type.ReplayWithoutFrames-    , module Octane.Type.Replication-    , module Octane.Type.State-    , module Octane.Type.Stream-    , module Octane.Type.Text-    , module Octane.Type.Value-    , module Octane.Type.Vector-    , module Octane.Type.Word16-    , module Octane.Type.Word32-    , module Octane.Type.Word64-    , module Octane.Type.Word8-    ) where+  ( module Octane.Type.Boolean+  , module Octane.Type.CacheItem+  , module Octane.Type.CacheProperty+  , module Octane.Type.ClassItem+  , module Octane.Type.Dictionary+  , module Octane.Type.Float32+  , module Octane.Type.Frame+  , module Octane.Type.Initialization+  , module Octane.Type.Int32+  , module Octane.Type.Int8+  , module Octane.Type.KeyFrame+  , module Octane.Type.List+  , module Octane.Type.Mark+  , module Octane.Type.Message+  , module Octane.Type.OptimizedReplay+  , module Octane.Type.Property+  , module Octane.Type.RawReplay+  , module Octane.Type.RemoteId+  , module Octane.Type.Replay+  , module Octane.Type.ReplayWithFrames+  , module Octane.Type.ReplayWithoutFrames+  , module Octane.Type.Replication+  , module Octane.Type.State+  , module Octane.Type.Stream+  , module Octane.Type.Text+  , module Octane.Type.Value+  , module Octane.Type.Vector+  , module Octane.Type.Word16+  , module Octane.Type.Word32+  , module Octane.Type.Word64+  , module Octane.Type.Word8+  ) where  import Octane.Type.Boolean import Octane.Type.CacheItem

@@ -7,7 +7,9 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -module Octane.Type.Boolean (Boolean(..)) where+module Octane.Type.Boolean+  ( Boolean(..)+  ) where  import Data.Function ((&)) @@ -21,63 +23,33 @@ import qualified Data.OverloadedRecords.TH as OverloadedRecords import qualified GHC.Generics as Generics --- $setup--- >>> import qualified Data.Binary.Get as Binary--- >>> import qualified Data.Binary.Put as Binary-- -- | A boolean value. newtype Boolean = Boolean-    { booleanUnpack :: Bool-    } deriving (Eq, Generics.Generic, Show)+  { booleanUnpack :: Bool+  } deriving (Eq, Generics.Generic, Show)  $(OverloadedRecords.overloadedRecord Default.def ''Boolean)  -- | Stored in the last bit of a byte. Decoding will fail if the byte is -- anything other than @0b00000000@ or @0b00000001@.------ >>> Binary.decode "\x01" :: Boolean--- Boolean {booleanUnpack = True}------ >>> Binary.encode (Boolean True)--- "\SOH" instance Binary.Binary Boolean where-    get = do-        value <- Binary.getWord8-        case value of-            0 -> pure (Boolean False)-            1 -> pure (Boolean True)-            _ -> fail ("Unexpected Boolean value " ++ show value)--    put boolean = boolean-        & #unpack-        & fromEnum-        & fromIntegral-        & Binary.putWord8+  get = do+    value <- Binary.getWord8+    case value of+      0 -> pure (Boolean False)+      1 -> pure (Boolean True)+      _ -> fail ("Unexpected Boolean value " ++ show value)+  put boolean = boolean & #unpack & fromEnum & fromIntegral & Binary.putWord8  -- | Stored as a bit.------ >>> Binary.runGet (BinaryBit.runBitGet (BinaryBit.getBits 0)) "\x80" :: Boolean--- Boolean {booleanUnpack = True}------ >>> Binary.runPut (BinaryBit.runBitPut (BinaryBit.putBits 0 (Boolean True)))--- "\128" instance BinaryBit.BinaryBit Boolean where-    getBits _ = do-        value <- BinaryBit.getBool-        value & Boolean & pure--    putBits _ boolean = boolean-        & #unpack-        & BinaryBit.putBool+  getBits _ = do+    value <- BinaryBit.getBool+    value & Boolean & pure+  putBits _ boolean = boolean & #unpack & BinaryBit.putBool -instance DeepSeq.NFData Boolean where+instance DeepSeq.NFData Boolean  -- | Encoded directly as a JSON boolean.------ >>> Aeson.encode (Boolean True)--- "true" instance Aeson.ToJSON Boolean where-    toJSON boolean = boolean-        & #unpack-        & Aeson.toJSON+  toJSON boolean = boolean & #unpack & Aeson.toJSON

@@ -8,7 +8,9 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -module Octane.Type.CacheItem (CacheItem(..)) where+module Octane.Type.CacheItem+  ( CacheItem(..)+  ) where  import Data.Function ((&)) @@ -21,42 +23,27 @@ import qualified Octane.Type.List as List import qualified Octane.Type.Word32 as Word32 --- $setup--- >>> :set -XOverloadedLists-- -- | An item in the class net cache map. data CacheItem = CacheItem-    { cacheItemClassId :: Word32.Word32+  { cacheItemClassId :: Word32.Word32     -- ^ The class ID.-    , cacheItemParentCacheId :: Word32.Word32+  , cacheItemParentCacheId :: Word32.Word32     -- ^ The cache ID of the parent class.-    , cacheItemCacheId :: Word32.Word32+  , cacheItemCacheId :: Word32.Word32     -- ^ The cache ID of the class.-    , cacheItemProperties :: List.List CacheProperty.CacheProperty+  , cacheItemProperties :: List.List CacheProperty.CacheProperty     -- ^ The properties that belong to this class.-    } deriving (Eq, Generics.Generic, Show)+  } deriving (Eq, Generics.Generic, Show)  $(OverloadedRecords.overloadedRecord Default.def ''CacheItem)  -- | Fields are stored one after the other in order.------ >>> Binary.decode "\x01\x00\x00\x00\x02\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00" :: CacheItem--- CacheItem {cacheItemClassId = 0x00000001, cacheItemParentCacheId = 0x00000002, cacheItemCacheId = 0x00000003, cacheItemProperties = fromList []}------ >>> Binary.encode (CacheItem 1 2 3 [])--- "\SOH\NUL\NUL\NUL\STX\NUL\NUL\NUL\ETX\NUL\NUL\NUL\NUL\NUL\NUL\NUL" instance Binary.Binary CacheItem where-    get = CacheItem-        <$> Binary.get-        <*> Binary.get-        <*> Binary.get-        <*> Binary.get--    put cacheItem = do-        cacheItem & #classId & Binary.put-        cacheItem & #parentCacheId & Binary.put-        cacheItem & #cacheId & Binary.put-        cacheItem & #properties & Binary.put+  get = CacheItem <$> Binary.get <*> Binary.get <*> Binary.get <*> Binary.get+  put cacheItem = do+    cacheItem & #classId & Binary.put+    cacheItem & #parentCacheId & Binary.put+    cacheItem & #cacheId & Binary.put+    cacheItem & #properties & Binary.put -instance DeepSeq.NFData CacheItem where+instance DeepSeq.NFData CacheItem

@@ -8,7 +8,9 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -module Octane.Type.CacheProperty (CacheProperty(..)) where+module Octane.Type.CacheProperty+  ( CacheProperty(..)+  ) where  import Data.Function ((&)) @@ -19,31 +21,21 @@ import qualified GHC.Generics as Generics import qualified Octane.Type.Word32 as Word32 - -- | A property on an item in the class net cache map. data CacheProperty = CacheProperty-    { cachePropertyObjectId :: Word32.Word32+  { cachePropertyObjectId :: Word32.Word32     -- ^ The object's ID.-    , cachePropertyStreamId :: Word32.Word32+  , cachePropertyStreamId :: Word32.Word32     -- ^ The object's ID in the network stream.-    } deriving (Eq, Generics.Generic, Show)+  } deriving (Eq, Generics.Generic, Show)  $(OverloadedRecords.overloadedRecord Default.def ''CacheProperty)  -- | Fields are stored one after the other in order.------ >>> Binary.decode "\x01\x00\x00\x00\x02\x00\x00\x00" :: CacheProperty--- CacheProperty {cachePropertyObjectId = 0x00000001, cachePropertyStreamId = 0x00000002}------ >>> Binary.encode (CacheProperty 1 2)--- "\SOH\NUL\NUL\NUL\STX\NUL\NUL\NUL" instance Binary.Binary CacheProperty where-    get = CacheProperty-        <$> Binary.get-        <*> Binary.get--    put cacheProperty = do-        cacheProperty & #objectId & Binary.put-        cacheProperty & #streamId & Binary.put+  get = CacheProperty <$> Binary.get <*> Binary.get+  put cacheProperty = do+    cacheProperty & #objectId & Binary.put+    cacheProperty & #streamId & Binary.put -instance DeepSeq.NFData CacheProperty where+instance DeepSeq.NFData CacheProperty

@@ -8,7 +8,9 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -module Octane.Type.ClassItem (ClassItem(..)) where+module Octane.Type.ClassItem+  ( ClassItem(..)+  ) where  import Data.Function ((&)) @@ -20,32 +22,22 @@ import qualified Octane.Type.Text as Text import qualified Octane.Type.Word32 as Word32 - -- | A class (like @Core.Object@) and it's associated ID in the net stream -- (like @0@). data ClassItem = ClassItem-    { classItemName :: Text.Text+  { classItemName :: Text.Text     -- ^ The class's name.-    , classItemStreamId :: Word32.Word32+  , classItemStreamId :: Word32.Word32     -- ^ The class's ID in the network stream.-    } deriving (Eq, Generics.Generic, Show)+  } deriving (Eq, Generics.Generic, Show)  $(OverloadedRecords.overloadedRecord Default.def ''ClassItem)  -- | Fields are stored one after the other in order.------ >>> Binary.decode "\x02\x00\x00\x00\x4b\x00\x01\x00\x00\x00" :: ClassItem--- ClassItem {classItemName = "K", classItemStreamId = 0x00000001}------ >>> Binary.encode (ClassItem "K" 1)--- "\STX\NUL\NUL\NULK\NUL\SOH\NUL\NUL\NUL" instance Binary.Binary ClassItem where-    get = ClassItem-        <$> Binary.get-        <*> Binary.get--    put classItem = do-        classItem & #name & Binary.put-        classItem & #streamId & Binary.put+  get = ClassItem <$> Binary.get <*> Binary.get+  put classItem = do+    classItem & #name & Binary.put+    classItem & #streamId & Binary.put -instance DeepSeq.NFData ClassItem where+instance DeepSeq.NFData ClassItem

@@ -11,9 +11,9 @@ {-# LANGUAGE TypeFamilies #-}  module Octane.Type.CompressedWord-    ( CompressedWord(..)-    , fromCompressedWord-    ) where+  ( CompressedWord(..)+  , fromCompressedWord+  ) where  import Data.Aeson ((.=)) import Data.Function ((&))@@ -29,78 +29,64 @@ import qualified GHC.Generics as Generics import qualified Octane.Type.Boolean as Boolean --- $setup--- >>> import qualified Data.Binary.Get as Binary--- >>> import qualified Data.Binary.Put as Binary-- -- | A compressed, unsigned integer. When serialized, the least significant bit -- is first. Bits are serialized until the next bit would be greater than the -- limit, or the number of bits necessary to reach the limit has been reached, -- whichever comes first. data CompressedWord = CompressedWord-    { compressedWordLimit :: Word-    , compressedWordValue :: Word-    } deriving (Eq, Generics.Generic, Show)+  { compressedWordLimit :: Word+  , compressedWordValue :: Word+  } deriving (Eq, Generics.Generic, Show)  $(OverloadedRecords.overloadedRecord Default.def ''CompressedWord)  -- | Abuses the first argument to 'BinaryBit.getBits' as the maximum value.------ >>> Binary.runGet (BinaryBit.runBitGet (BinaryBit.getBits 4)) "\x7f" :: CompressedWord--- CompressedWord {compressedWordLimit = 4, compressedWordValue = 2}------ >>> Binary.runPut (BinaryBit.runBitPut (BinaryBit.putBits 0 (CompressedWord 4 2)))--- "\128" instance BinaryBit.BinaryBit CompressedWord where-    getBits n = do-        let limit = fromIntegral n-        value <- getStep limit (bitSize limit) 0 0-        pure (CompressedWord limit value)--    putBits _ compressedWord = do-        let limit = fromIntegral (#limit compressedWord)-        let value = fromIntegral (#value compressedWord)-        let maxBits = bitSize limit-        let upper = (2 ^ (maxBits - 1)) - 1-        let lower = limit - upper-        let numBits = if lower > value || value > upper-                then maxBits-                else maxBits - 1-        BinaryBit.putWord64be numBits value+  getBits n = do+    let limit = fromIntegral n+    value <- getStep limit (bitSize limit) 0 0+    pure (CompressedWord limit value)+  putBits _ compressedWord = do+    let limit = fromIntegral (#limit compressedWord)+    let value = fromIntegral (#value compressedWord)+    let maxBits = bitSize limit+    let upper = (2 ^ (maxBits - 1)) - 1+    let lower = limit - upper+    let numBits =+          if lower > value || value > upper+            then maxBits+            else maxBits - 1+    BinaryBit.putWord64be numBits value -instance DeepSeq.NFData CompressedWord where+instance DeepSeq.NFData CompressedWord  -- | Encoded as an object.------ >>> Aeson.encode (CompressedWord 2 1)--- "{\"Value\":1,\"Limit\":2}" instance Aeson.ToJSON CompressedWord where-    toJSON compressedWord = Aeson.object-        [ "Limit" .= #limit compressedWord-        , "Value" .= #value compressedWord-        ]-+  toJSON compressedWord =+    Aeson.object+      ["Limit" .= #limit compressedWord, "Value" .= #value compressedWord]  -- | Converts a 'CompressedWord' into any integral value. This is a lossy -- conversion because it discards the compressed word's maximum value.------ >>> fromCompressedWord (CompressedWord 2 1) :: Int--- 1-fromCompressedWord :: (Integral a) => CompressedWord -> a+fromCompressedWord+  :: (Integral a)+  => CompressedWord -> a fromCompressedWord compressedWord = compressedWord & #value & fromIntegral --bitSize :: (Integral a, Integral b) => a -> b+bitSize+  :: (Integral a, Integral b)+  => a -> b bitSize x = x & fromIntegral & logBase (2 :: Double) & ceiling - getStep :: Word -> Word -> Word -> Word -> BinaryBit.BitGet Word getStep limit maxBits position value = do-    let x = Bits.shiftL 1 (fromIntegral position)-    if position < maxBits && value + x <= limit+  let x = Bits.shiftL 1 (fromIntegral position)+  if position < maxBits && value + x <= limit     then do-        (bit :: Boolean.Boolean) <- BinaryBit.getBits 0-        let newValue = if #unpack bit then value + x else value-        getStep limit maxBits (position + 1) newValue+      (bit :: Boolean.Boolean) <- BinaryBit.getBits 0+      let newValue =+            if #unpack bit+              then value + x+              else value+      getStep limit maxBits (position + 1) newValue     else pure value

@@ -8,7 +8,9 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -module Octane.Type.Dictionary (Dictionary(..)) where+module Octane.Type.Dictionary+  ( Dictionary(..)+  ) where  import Data.Function ((&)) @@ -22,86 +24,65 @@ import qualified GHC.Generics as Generics import qualified Octane.Type.Text as Text --- $setup--- >>> import GHC.Exts--- >>> import Octane.Type.Word8-- -- | A mapping between text and arbitrary values. newtype Dictionary a = Dictionary-    { dictionaryUnpack :: (Map.Map Text.Text a)-    } deriving (Eq, Generics.Generic)+  { dictionaryUnpack :: (Map.Map Text.Text a)+  } deriving (Eq, Generics.Generic)  $(OverloadedRecords.overloadedRecord Default.def ''Dictionary)  -- | Elements are stored with the key first, then the value. The dictionary -- ends when a key is @"None"@.------ >>> Binary.decode "\x02\x00\x00\x00k\x00\x01\x05\x00\x00\x00None\x00" :: Dictionary Word8--- fromList [("k",0x01)]------ >>> Binary.encode ([("k", 1)] :: Dictionary Word8)--- "\STX\NUL\NUL\NULk\NUL\SOH\ENQ\NUL\NUL\NULNone\NUL"-instance (Binary.Binary a) => Binary.Binary (Dictionary a) where-    get = do-        element <- getElement-        if Map.null element-        then element & Dictionary & pure-        else do-            Dictionary elements <- Binary.get-            elements & Map.union element & Dictionary & pure--    put dictionary = do-        dictionary & #unpack & Map.assocs & mapM_ putElement-        noneKey & Binary.put+instance (Binary.Binary a) =>+         Binary.Binary (Dictionary a) where+  get = do+    element <- getElement+    if Map.null element+      then element & Dictionary & pure+      else do+        Dictionary elements <- Binary.get+        elements & Map.union element & Dictionary & pure+  put dictionary = do+    dictionary & #unpack & Map.assocs & mapM_ putElement+    noneKey & Binary.put  -- | Allows creating 'Dictionary' values with 'Exts.fromList'. Also allows -- 'Dictionary' literals with the @OverloadedLists@ extension.------ >>> [("one", 1)] :: Dictionary Int--- fromList [("one",1)] instance Exts.IsList (Dictionary a) where-    type Item (Dictionary a) = (Text.Text, a)--    fromList items = Dictionary (Map.fromList items)--    toList dictionary = Map.toList (#unpack dictionary)+  type Item (Dictionary a) = (Text.Text, a)+  fromList items = Dictionary (Map.fromList items)+  toList dictionary = Map.toList (#unpack dictionary) -instance (DeepSeq.NFData a) => DeepSeq.NFData (Dictionary a) where+instance (DeepSeq.NFData a) =>+         DeepSeq.NFData (Dictionary a)  -- | Shown as @fromList [("key","value")]@.------ >>> show ([("one", 1)] :: Dictionary Int)--- "fromList [(\"one\",1)]"-instance (Show a) => Show (Dictionary a) where-    show dictionary = show (#unpack dictionary)+instance (Show a) =>+         Show (Dictionary a) where+  show dictionary = show (#unpack dictionary)  -- | Encoded directly as a JSON object.------ >>> Aeson.encode ([("one", 1)] :: Dictionary Int)--- "{\"one\":1}"-instance (Aeson.ToJSON a) => Aeson.ToJSON (Dictionary a) where-    toJSON dictionary = dictionary-        & #unpack-        & Map.mapKeys #unpack-        & Aeson.toJSON-+instance (Aeson.ToJSON a) =>+         Aeson.ToJSON (Dictionary a) where+  toJSON dictionary = dictionary & #unpack & Map.mapKeys #unpack & Aeson.toJSON -getElement :: (Binary.Binary a) => Binary.Get (Map.Map Text.Text a)+getElement+  :: (Binary.Binary a)+  => Binary.Get (Map.Map Text.Text a) getElement = do-    key <- Binary.get-    if key == noneKey+  key <- Binary.get+  if key == noneKey     then pure Map.empty     else do-        value <- Binary.get-        value & Map.singleton key & pure-+      value <- Binary.get+      value & Map.singleton key & pure -putElement :: (Binary.Binary a) => (Text.Text, a) -> Binary.Put+putElement+  :: (Binary.Binary a)+  => (Text.Text, a) -> Binary.Put putElement (key, value) = do-    Binary.put key-    Binary.put value-+  Binary.put key+  Binary.put value  noneKey :: Text.Text noneKey = "None"

@@ -8,7 +8,9 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -module Octane.Type.Float32 (Float32(..)) where+module Octane.Type.Float32+  ( Float32(..)+  ) where  import Data.Function ((&)) @@ -27,71 +29,38 @@ import qualified GHC.Generics as Generics import qualified Octane.Utility.Endian as Endian --- $setup--- >>> import qualified Data.Binary.Get as Binary--- >>> import qualified Data.Binary.Put as Binary-- -- | A 32-bit float. newtype Float32 = Float32-    { float32Unpack :: Float-    } deriving (Eq, Fractional, Generics.Generic, Num, Ord)+  { float32Unpack :: Float+  } deriving (Eq, Fractional, Generics.Generic, Num, Ord)  $(OverloadedRecords.overloadedRecord Default.def ''Float32)  -- | Little-endian.------ >>> Binary.decode "\x9a\x99\x99\x3f" :: Float32--- 1.2------ >>> Binary.encode (1.2 :: Float32)--- "\154\153\153?" instance Binary.Binary Float32 where-    get = do-        value <- IEEE754.getFloat32le-        value & Float32 & pure--    put float32 = float32-        & #unpack-        & IEEE754.putFloat32le+  get = do+    value <- IEEE754.getFloat32le+    value & Float32 & pure+  put float32 = float32 & #unpack & IEEE754.putFloat32le  -- | Little-endian with the bits in each byte reversed.------ >>> Binary.runGet (BinaryBit.runBitGet (BinaryBit.getBits 0)) "\x59\x99\x99\xfc" :: Float32--- 1.2------ >>> Binary.runPut (BinaryBit.runBitPut (BinaryBit.putBits 0 (1.2 :: Float32)))--- "Y\153\153\252" instance BinaryBit.BinaryBit Float32 where-    getBits _ = do-        bytes <- BinaryBit.getByteString 4-        bytes-            & LazyBytes.fromStrict-            & Endian.reverseBitsInLazyBytes-            & Binary.runGet Binary.get-            & pure--    putBits _ float32 = float32-        & Binary.put-        & Binary.runPut-        & Endian.reverseBitsInLazyBytes-        & LazyBytes.toStrict-        & BinaryBit.putByteString+  getBits _ = do+    bytes <- BinaryBit.getByteString 4+    bytes & LazyBytes.fromStrict & Endian.reverseBitsInLazyBytes &+      Binary.runGet Binary.get &+      pure+  putBits _ float32 =+    float32 & Binary.put & Binary.runPut & Endian.reverseBitsInLazyBytes &+    LazyBytes.toStrict &+    BinaryBit.putByteString  instance DeepSeq.NFData Float32  -- | Shown as @12.34@.------ >>> show (1.2 :: Float32)--- "1.2" instance Show Float32 where-    show float32 = show (#unpack float32)+  show float32 = show (#unpack float32)  -- | Encoded directly as a JSON number.------ Aeson.encode (1.2 :: Float32)--- "1.2" instance Aeson.ToJSON Float32 where-    toJSON float32 = float32-        & #unpack-        & Aeson.toJSON+  toJSON float32 = float32 & #unpack & Aeson.toJSON

@@ -9,272 +9,105 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -module Octane.Type.Frame (Frame(..)) where+module Octane.Type.Frame+  ( Frame(..)+  ) where  import Data.Aeson ((.=)) import Data.Function ((&))-import Data.Monoid ((<>))  import qualified Control.DeepSeq as DeepSeq import qualified Data.Aeson as Aeson-import qualified Data.Bimap as Bimap import qualified Data.Default.Class as Default import qualified Data.Map.Strict as Map import qualified Data.OverloadedRecords.TH as OverloadedRecords import qualified Data.Text as StrictText import qualified GHC.Generics as Generics-import qualified Octane.Data as Data import qualified Octane.Type.Float32 as Float32 import qualified Octane.Type.Replication as Replication import qualified Octane.Type.State as State-import qualified Octane.Type.Value as Value-import qualified Octane.Type.Word32 as Word32-import qualified Octane.Type.Word8 as Word8 - -- | A frame in the network stream. This holds all the interesting game data. -- -- This cannot be an instance of 'Data.Binary.Bits.BinaryBit' because it -- requires out-of-band information (the class property map) to decode. data Frame = Frame-    { frameNumber :: Word+  { frameNumber :: Word     -- ^ This frame's number in the network stream. Starts at 0.-    , frameIsKeyFrame :: Bool+  , frameIsKeyFrame :: Bool     -- ^ Is this frame a key frame?-    , frameTime :: Float32.Float32+  , frameTime :: Float32.Float32     -- ^ The since the start of the match that this frame occurred.-    , frameDelta :: Float32.Float32+  , frameDelta :: Float32.Float32     -- ^ The time between the last frame and this one.-    , frameReplications :: [Replication.Replication]+  , frameReplications :: [Replication.Replication]     -- ^ A list of all the replications in this frame.-    } deriving (Eq, Generics.Generic, Show)+  } deriving (Eq, Generics.Generic, Show)  $(OverloadedRecords.overloadedRecord Default.def ''Frame) -instance DeepSeq.NFData Frame where+instance DeepSeq.NFData Frame  instance Aeson.ToJSON Frame where-    toJSON frame = Aeson.object-        [ "Number" .= #number frame-        , "IsKeyFrame" .= #isKeyFrame frame-        , "Time" .= #time frame-        , "Delta" .= #delta frame-        , "Spawned" .= (frame & #replications & getSpawned)-        , "Updated" .= (frame & #replications & getUpdated)-        , "Destroyed" .= (frame & #replications & getDestroyed)-        ]-+  toJSON frame =+    Aeson.object+      [ "Number" .= #number frame+      , "IsKeyFrame" .= #isKeyFrame frame+      , "Time" .= #time frame+      , "Delta" .= #delta frame+      , "Spawned" .= (frame & #replications & getSpawned)+      , "Updated" .= (frame & #replications & getUpdated)+      , "Destroyed" .= (frame & #replications & getDestroyed)+      ] -newtype Spawned = Spawned [Replication.Replication]+newtype Spawned =+  Spawned [Replication.Replication]  instance Aeson.ToJSON Spawned where-    toJSON (Spawned xs) = xs-        & map (\ x -> do-            let k = x & #actorId & #value & show & StrictText.pack-            let v = Aeson.object-                    [ "Name" .= #objectName x-                    , "Class" .= #className x-                    , "Position" .= (x & #initialization & fmap #location)-                    , "Rotation" .= (x & #initialization & fmap #rotation)-                    ]-            (k, v))-        & Map.fromList-        & Aeson.toJSON+  toJSON (Spawned xs) =+    xs &+    map+      (\x -> do+         let k = x & #actorId & #value & show & StrictText.pack+         let v =+               Aeson.object+                 [ "Name" .= #objectName x+                 , "Class" .= #className x+                 , "Position" .= (x & #initialization & fmap #location)+                 , "Rotation" .= (x & #initialization & fmap #rotation)+                 ]+         (k, v)) &+    Map.fromList &+    Aeson.toJSON  getSpawned :: [Replication.Replication] -> Spawned-getSpawned xs = xs-    & filter (\ x -> x-        & #state-        & (== State.SOpening))-    & Spawned-+getSpawned xs = xs & filter (\x -> x & #state & (== State.SOpening)) & Spawned -newtype Updated = Updated [Replication.Replication]+newtype Updated =+  Updated [Replication.Replication]  instance Aeson.ToJSON Updated where-    toJSON (Updated xs) = xs-        & map (\ x -> do-            let k = x-                    & #actorId-                    & #value-                    & show-                    & StrictText.pack-            let v = x-                    & #properties-                    & Map.map (\ value -> Aeson.object-                        [ "Type" .= getType value-                        , "Value" .= getValue value-                        ])-            (k, v))-        & Map.fromList-        & Aeson.toJSON-+  toJSON (Updated xs) =+    xs &+    map+      (\x -> do+         let k = x & #actorId & #value & show & StrictText.pack+         let v = x & #properties+         (k, v)) &+    Map.fromList &+    Aeson.toJSON  getUpdated :: [Replication.Replication] -> Updated-getUpdated xs = xs-    & filter (\ x -> x-        & #state-        & (== State.SExisting))-    & filter (\ x -> x-        & #properties-        & null-        & not)-    & Updated-+getUpdated xs =+  xs & filter (\x -> x & #state & (== State.SExisting)) &+  filter (\x -> x & #properties & null & not) &+  Updated -newtype Destroyed = Destroyed [Replication.Replication]+newtype Destroyed =+  Destroyed [Replication.Replication]  instance Aeson.ToJSON Destroyed where-    toJSON (Destroyed xs) = xs-        & map #actorId-        & map #value-        & Aeson.toJSON+  toJSON (Destroyed xs) = xs & map #actorId & map #value & Aeson.toJSON  getDestroyed :: [Replication.Replication] -> Destroyed-getDestroyed xs = xs-    & filter (\ x -> x-        & #state-        & (== State.SClosing))-    & Destroyed---getType :: Value.Value -> StrictText.Text-getType value = case value of-    Value.VBoolean _ -> "Boolean"-    Value.VByte _ -> "Byte"-    Value.VCamSettings _ _ _ _ _ _ -> "CameraSettings"-    Value.VDemolish _ _ _ _ _ _ -> "Demolition"-    Value.VEnum _ _ -> "Enum"-    Value.VExplosion _ _ _ -> "Explosion"-    Value.VFlaggedInt _ _ -> "FlaggedInt"-    Value.VFloat _ -> "Float"-    Value.VGameMode _ -> "GameMode"-    Value.VInt _ -> "Int"-    Value.VLoadout _ _ _ _ _ _ _ _ _ -> "Loadout"-    Value.VLoadoutOnline _ -> "OnlineLoadout"-    Value.VLocation _ -> "Position"-    Value.VMusicStinger _ _ _ -> "MusicStinger"-    Value.VPickup _ _ _ -> "Pickup"-    Value.VPrivateMatchSettings _ _ _ _ _ _ -> "PrivateMatchSettings"-    Value.VQWord _ -> "QWord"-    Value.VRelativeRotation _ -> "RelativeRotation"-    Value.VReservation _ _ _ _ _ _ _ -> "Reservation"-    Value.VRigidBodyState _ _ _ _ _ -> "RigidBodyState"-    Value.VString _ -> "String"-    Value.VTeamPaint _ _ _ _ _ -> "Paint"-    Value.VUniqueId _ _ _ -> "UniqueId"---getValue :: Value.Value -> Aeson.Value-getValue value = case value of-    Value.VBoolean x -> Aeson.toJSON x-    Value.VByte x -> Aeson.toJSON x-    Value.VCamSettings fov height angle distance stiffness swivelSpeed -> Aeson.object-        [ ("FOV", Aeson.toJSON fov)-        , ("Height", Aeson.toJSON height)-        , ("Angle", Aeson.toJSON angle)-        , ("Distance", Aeson.toJSON distance)-        , ("Stiffness", Aeson.toJSON stiffness)-        , ("SwivelSpeed", Aeson.toJSON swivelSpeed)-        ]-    Value.VDemolish a b c d e f -> Aeson.toJSON (a, b, c, d, e, f)-    Value.VEnum x y -> Aeson.toJSON (x, y)-    Value.VExplosion a b c -> Aeson.toJSON (a, b, c)-    Value.VFlaggedInt x y -> Aeson.toJSON (x, y)-    Value.VFloat x -> Aeson.toJSON x-    Value.VGameMode gameMode -> Aeson.object-        [ ("Id", Aeson.toJSON gameMode)-        , ("Name", gameMode & getGameMode & Aeson.toJSON)-        ]-    Value.VInt x -> Aeson.toJSON x-    Value.VLoadout version body decal wheels rocketTrail antenna topper x y -> Aeson.object-        [ ("Version", Aeson.toJSON version)-        , ("Body", Aeson.object-            [ ("Id", Aeson.toJSON body)-            , ("Name", body & getProduct & Aeson.toJSON)-            ])-        , ("Decal", Aeson.object-            [ ("Id", Aeson.toJSON decal)-            , ("Name", decal & getProduct & Aeson.toJSON)-            ])-        , ("Wheels", Aeson.object-            [ ("Id", Aeson.toJSON wheels)-            , ("Name", wheels & getProduct & Aeson.toJSON)-            ])-        , ("RocketTrail", Aeson.object-            [ ("Id", Aeson.toJSON rocketTrail)-            , ("Name", rocketTrail & getProduct & Aeson.toJSON)-            ])-        , ("Antenna", Aeson.object-            [ ("Id", Aeson.toJSON antenna)-            , ("Name", antenna & getProduct & Aeson.toJSON)-            ])-        , ("Topper", Aeson.object-            [ ("Id", Aeson.toJSON topper)-            , ("Name", topper & getProduct & Aeson.toJSON)-            ])-        , ("Unknown1", Aeson.toJSON x)-        , ("Unknown2", Aeson.toJSON y)-        ]-    Value.VLoadoutOnline a -> Aeson.toJSON a-    Value.VLocation x -> Aeson.toJSON x-    Value.VMusicStinger a b c -> Aeson.toJSON (a, b, c)-    Value.VPickup a b c -> Aeson.toJSON (a, b, c)-    Value.VPrivateMatchSettings mutators joinableBy maxPlayers name password x -> Aeson.object-        [ ("Mutators", Aeson.toJSON mutators)-        , ("JoinableBy", Aeson.toJSON joinableBy)-        , ("MaxPlayers", Aeson.toJSON maxPlayers)-        , ("Name", Aeson.toJSON name)-        , ("Password", Aeson.toJSON password)-        , ("Unknown", Aeson.toJSON x)-        ]-    Value.VQWord x -> Aeson.toJSON x-    Value.VRelativeRotation x -> Aeson.toJSON x-    Value.VReservation num systemId remoteId localId name x y -> Aeson.object-        [ ("Number", Aeson.toJSON num)-        , ("SystemId", Aeson.toJSON systemId)-        , ("RemoteId", Aeson.toJSON remoteId)-        , ("LocalId", Aeson.toJSON localId)-        , ("Name", Aeson.toJSON name)-        , ("Unknown1", Aeson.toJSON x)-        , ("Unknown2", Aeson.toJSON y)-        ]-    Value.VRigidBodyState sleeping position rotation linear angular -> Aeson.object-        [ ("Sleeping", Aeson.toJSON sleeping)-        , ("Position", Aeson.toJSON position)-        , ("Rotation", Aeson.toJSON rotation)-        , ("LinearVelocity", Aeson.toJSON linear)-        , ("AngularVelocity", Aeson.toJSON angular)-        ]-    Value.VString x -> Aeson.toJSON x-    Value.VTeamPaint team color1 color2 finish1 finish2 -> Aeson.object-        [ ("Team", Aeson.toJSON team)-        , ("PrimaryColor", Aeson.toJSON color1)-        , ("AccentColor", Aeson.toJSON color2)-        , ("PrimaryFinish", Aeson.object-            [ ("Id", Aeson.toJSON finish1)-            , ("Name", finish1 & getProduct & Aeson.toJSON)-            ])-        , ("AccentFinish", Aeson.object-            [ ("Id", Aeson.toJSON finish2)-            , ("Name", finish2 & getProduct & Aeson.toJSON)-            ])-        ]-    Value.VUniqueId systemId remoteId localId -> Aeson.object-        [ ("System", case systemId of-            0 -> "Local"-            1 -> "Steam"-            2 -> "PlayStation"-            4 -> "Xbox"-            _ -> Aeson.String ("Unknown system " <> StrictText.pack (show systemId)))-        , ("Remote", Aeson.toJSON remoteId)-        , ("Local", Aeson.toJSON localId)-        ]---getGameMode :: Word8.Word8 -> Maybe StrictText.Text-getGameMode x = Bimap.lookup (Word8.fromWord8 x) Data.gameModes---getProduct :: Word32.Word32 -> Maybe StrictText.Text-getProduct x = Bimap.lookup (Word32.fromWord32 x) Data.products+getDestroyed xs = xs & filter (\x -> x & #state & (== State.SClosing)) & Destroyed

@@ -9,10 +9,10 @@ {-# LANGUAGE TypeFamilies #-}  module Octane.Type.Initialization-    ( Initialization(..)-    , getInitialization-    , putInitialization-    ) where+  ( Initialization(..)+  , getInitialization+  , putInitialization+  ) where  import qualified Control.DeepSeq as DeepSeq import qualified Data.Binary.Bits.Get as BinaryBit@@ -26,42 +26,45 @@ import qualified Octane.Type.Int8 as Int8 import qualified Octane.Type.Vector as Vector - -- | Information about a new instance of a class. -- -- This cannot be an instance of 'Data.Binary.Bits.BinaryBit' because it -- requires out-of-band information (the class name) to decode. data Initialization = Initialization-    { initializationLocation :: Maybe (Vector.Vector Int)+  { initializationLocation :: Maybe (Vector.Vector Int)     -- ^ The instance's initial position.-    , initializationRotation :: Maybe (Vector.Vector Int8.Int8)+  , initializationRotation :: Maybe (Vector.Vector Int8.Int8)     -- ^ The instance's initial rotation.-    } deriving (Eq, Generics.Generic, Show)+  } deriving (Eq, Generics.Generic, Show)  $(OverloadedRecords.overloadedRecord Default.def ''Initialization) -instance DeepSeq.NFData Initialization where-+instance DeepSeq.NFData Initialization  -- | Gets the 'Initialization' for a given class. getInitialization :: StrictText.Text -> BinaryBit.BitGet Initialization getInitialization className = do-    location <- if Set.member className Data.classesWithLocation-        then fmap Just Vector.getIntVector-        else pure Nothing-    rotation <- if Set.member className Data.classesWithRotation-        then fmap Just Vector.getInt8Vector-        else pure Nothing-    pure Initialization { initializationLocation = location, initializationRotation = rotation }-+  location <-+    if Set.member className Data.classesWithLocation+      then fmap Just Vector.getIntVector+      else pure Nothing+  rotation <-+    if Set.member className Data.classesWithRotation+      then fmap Just Vector.getInt8Vector+      else pure Nothing+  pure+    Initialization+    { initializationLocation = location+    , initializationRotation = rotation+    }  -- | Puts the 'Initialization'. Note that unlike 'getInitialization', this does -- not require the class name. putInitialization :: Initialization -> BinaryBit.BitPut () putInitialization initialization = do-    case #location initialization of-        Nothing -> pure ()-        Just x -> Vector.putIntVector x-    case #rotation initialization of-        Nothing -> pure ()-        Just x -> Vector.putInt8Vector x+  case #location initialization of+    Nothing -> pure ()+    Just x -> Vector.putIntVector x+  case #rotation initialization of+    Nothing -> pure ()+    Just x -> Vector.putInt8Vector x

@@ -8,7 +8,11 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -module Octane.Type.Int32 (Int32(..), fromInt32, toInt32) where+module Octane.Type.Int32+  ( Int32(..)+  , fromInt32+  , toInt32+  ) where  import Data.Function ((&)) @@ -27,83 +31,52 @@ import qualified GHC.Generics as Generics import qualified Octane.Utility.Endian as Endian - -- | A 32-bit signed integer. newtype Int32 = Int32-    { int32Unpack :: Int.Int32-    } deriving (Eq, Generics.Generic, Num, Ord)+  { int32Unpack :: Int.Int32+  } deriving (Eq, Generics.Generic, Num, Ord)  $(OverloadedRecords.overloadedRecord Default.def ''Int32)  -- | Little-endian.------ >>> Binary.decode "\x01\x00\x00\x00" :: Int32--- 1------ >>> Binary.encode (1 :: Int32)--- "\SOH\NUL\NUL\NUL" instance Binary.Binary Int32 where-    get = do-        value <- Binary.getInt32le-        pure (Int32 value)--    put int32 = do-        let value = #unpack int32-        Binary.putInt32le value+  get = do+    value <- Binary.getInt32le+    pure (Int32 value)+  put int32 = do+    let value = #unpack int32+    Binary.putInt32le value  -- | Little-endian with the bits in each byte reversed.------ >>> Binary.runGet (BinaryBit.runBitGet (BinaryBit.getBits 0)) "\x80\x00\x00\x00" :: Int32--- 1------ >>> Binary.runPut (BinaryBit.runBitPut (BinaryBit.putBits 0 (1 :: Int32)))--- "\128\NUL\NUL\NUL" instance BinaryBit.BinaryBit Int32 where-    getBits _ = do-        bytes <- BinaryBit.getByteString 4-        bytes-            & LazyBytes.fromStrict-            & Endian.reverseBitsInLazyBytes-            & Binary.runGet Binary.get-            & pure--    putBits _ int32 = int32-        & Binary.put-        & Binary.runPut-        & Endian.reverseBitsInLazyBytes-        & LazyBytes.toStrict-        & BinaryBit.putByteString+  getBits _ = do+    bytes <- BinaryBit.getByteString 4+    bytes & LazyBytes.fromStrict & Endian.reverseBitsInLazyBytes &+      Binary.runGet Binary.get &+      pure+  putBits _ int32 =+    int32 & Binary.put & Binary.runPut & Endian.reverseBitsInLazyBytes &+    LazyBytes.toStrict &+    BinaryBit.putByteString -instance DeepSeq.NFData Int32 where+instance DeepSeq.NFData Int32  -- | Shown as @1234@.------ >>> show (1 :: Int32)--- "1" instance Show Int32 where-    show int32 = show (#unpack int32)+  show int32 = show (#unpack int32)  -- | Encoded as a JSON number directly.------ >>> Aeson.encode (1 :: Int32)--- "1" instance Aeson.ToJSON Int32 where-    toJSON int32 = int32-        & #unpack-        & Aeson.toJSON-+  toJSON int32 = int32 & #unpack & Aeson.toJSON  -- | Converts a 'Int32' into any 'Integral' value.------ >>> fromInt32 1 :: Int.Int32--- 1-fromInt32 :: (Integral a) => Int32 -> a+fromInt32+  :: (Integral a)+  => Int32 -> a fromInt32 int32 = fromIntegral (#unpack int32) - -- | Converts any 'Integral' value into a 'Int32'.------ >>> toInt32 (1 :: Int.Int32)--- 1-toInt32 :: (Integral a) => a -> Int32+toInt32+  :: (Integral a)+  => a -> Int32 toInt32 value = Int32 (fromIntegral value)

@@ -8,7 +8,11 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -module Octane.Type.Int8 (Int8(..), fromInt8, toInt8) where+module Octane.Type.Int8+  ( Int8(..)+  , fromInt8+  , toInt8+  ) where  import Data.Function ((&)) @@ -27,85 +31,51 @@ import qualified GHC.Generics as Generics import qualified Octane.Utility.Endian as Endian --- $setup--- >>> import qualified Data.Binary.Get as Binary--- >>> import qualified Data.Binary.Put as Binary-- -- | A 8-bit signed integer. newtype Int8 = Int8-    { int8Unpack :: Int.Int8-    } deriving (Eq, Generics.Generic, Num, Ord)+  { int8Unpack :: Int.Int8+  } deriving (Eq, Generics.Generic, Num, Ord)  $(OverloadedRecords.overloadedRecord Default.def ''Int8) --- | >>> Binary.decode "\x01" :: Int8--- 1------ >>> Binary.encode (1 :: Int8)--- "\SOH" instance Binary.Binary Int8 where-    get = do-        value <- Binary.getInt8-        pure (Int8 value)--    put int8 = do-        let value = #unpack int8-        Binary.putInt8 value+  get = do+    value <- Binary.getInt8+    pure (Int8 value)+  put int8 = do+    let value = #unpack int8+    Binary.putInt8 value  -- | Stored with the bits reversed.------ >>> Binary.runGet (BinaryBit.runBitGet (BinaryBit.getBits 0)) "\x80" :: Int8--- 1------ >>> Binary.runPut (BinaryBit.runBitPut (BinaryBit.putBits 0 (1 :: Int8)))--- "\128" instance BinaryBit.BinaryBit Int8 where-    getBits _ = do-        bytes <- BinaryBit.getByteString 1-        bytes-            & LazyBytes.fromStrict-            & Endian.reverseBitsInLazyBytes-            & Binary.runGet Binary.get-            & pure--    putBits _ int8 = int8-        & Binary.put-        & Binary.runPut-        & Endian.reverseBitsInLazyBytes-        & LazyBytes.toStrict-        & BinaryBit.putByteString+  getBits _ = do+    bytes <- BinaryBit.getByteString 1+    bytes & LazyBytes.fromStrict & Endian.reverseBitsInLazyBytes &+      Binary.runGet Binary.get &+      pure+  putBits _ int8 =+    int8 & Binary.put & Binary.runPut & Endian.reverseBitsInLazyBytes &+    LazyBytes.toStrict &+    BinaryBit.putByteString -instance DeepSeq.NFData Int8 where+instance DeepSeq.NFData Int8  -- | Shown as @1234@.------ >>> show (1 :: Int8)--- "1" instance Show Int8 where-    show int8 = show (#unpack int8)+  show int8 = show (#unpack int8)  -- | Encoded directly as a JSON number.------ >>> Aeson.encode (1 :: Int8)--- "1" instance Aeson.ToJSON Int8 where-    toJSON int8 = int8-        & #unpack-        & Aeson.toJSON-+  toJSON int8 = int8 & #unpack & Aeson.toJSON  -- | Converts a 'Int8' into any 'Integral' value.------ >>> fromInt8 1 :: Int.Int8--- 1-fromInt8 :: (Integral a) => Int8 -> a+fromInt8+  :: (Integral a)+  => Int8 -> a fromInt8 int8 = fromIntegral (#unpack int8) - -- | Converts any 'Integral' value into a 'Int8'.------ >>> toInt8 (1 :: Int.Int8)--- 1-toInt8 :: (Integral a) => a -> Int8+toInt8+  :: (Integral a)+  => a -> Int8 toInt8 value = Int8 (fromIntegral value)

@@ -8,7 +8,9 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -module Octane.Type.KeyFrame (KeyFrame(..)) where+module Octane.Type.KeyFrame+  ( KeyFrame(..)+  ) where  import Data.Function ((&)) @@ -20,35 +22,24 @@ import qualified Octane.Type.Float32 as Float32 import qualified Octane.Type.Word32 as Word32 - -- | A key frame. data KeyFrame = KeyFrame-    { keyFrameTime :: Float32.Float32+  { keyFrameTime :: Float32.Float32     -- ^ When this key frame occurred.-    , keyFrameFrame :: Word32.Word32+  , keyFrameFrame :: Word32.Word32     -- ^ Which frame this key frame corresponds to.-    , keyFramePosition :: Word32.Word32+  , keyFramePosition :: Word32.Word32     -- ^ The bit position of the start of this key frame in the network stream.-    } deriving (Eq, Generics.Generic, Show)+  } deriving (Eq, Generics.Generic, Show)  $(OverloadedRecords.overloadedRecord Default.def ''KeyFrame)  -- | Stored with the fields one after the other in order.------ >>> Binary.decode "\x00\x00\x00\x00\x01\x00\x00\x00\x02\x00\x00\x00" :: KeyFrame--- KeyFrame {keyFrameTime = 0.0, keyFrameFrame = 0x00000001, keyFramePosition = 0x00000002}------ >>> Binary.encode (KeyFrame 0 1 2)--- "\NUL\NUL\NUL\NUL\SOH\NUL\NUL\NUL\STX\NUL\NUL\NUL" instance Binary.Binary KeyFrame where-    get = KeyFrame-        <$> Binary.get-        <*> Binary.get-        <*> Binary.get--    put keyFrame = do-        keyFrame & #time & Binary.put-        keyFrame & #frame & Binary.put-        keyFrame & #position & Binary.put+  get = KeyFrame <$> Binary.get <*> Binary.get <*> Binary.get+  put keyFrame = do+    keyFrame & #time & Binary.put+    keyFrame & #frame & Binary.put+    keyFrame & #position & Binary.put -instance DeepSeq.NFData KeyFrame where+instance DeepSeq.NFData KeyFrame

@@ -7,7 +7,9 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -module Octane.Type.List (List(..)) where+module Octane.Type.List+  ( List(..)+  ) where  import Data.Function ((&)) @@ -21,58 +23,39 @@ import qualified GHC.Generics as Generics import qualified Octane.Type.Word32 as Word32 --- $setup--- >>> import Octane.Type.Int8-- -- | A list of values. newtype List a = List-    { listUnpack :: [a]-    } deriving (Eq, Generics.Generic, Ord)+  { listUnpack :: [a]+  } deriving (Eq, Generics.Generic, Ord)  $(OverloadedRecords.overloadedRecord Default.def ''List)  -- | Prefixed with the number of elements in the list.------ >>> Binary.decode "\x01\x00\x00\x00\x02" :: List Int8--- fromList [2]------ >>> Binary.encode ([2] :: List Int8)--- "\SOH\NUL\NUL\NUL\STX"-instance (Binary.Binary a) => Binary.Binary (List a) where-    get = do-        size <- Binary.get-        elements <- Monad.replicateM (Word32.fromWord32 size) Binary.get-        elements & List & pure--    put list = do-        list & #unpack & length & fromIntegral & Word32.Word32 & Binary.put-        list & #unpack & mapM_ Binary.put+instance (Binary.Binary a) =>+         Binary.Binary (List a) where+  get = do+    size <- Binary.get+    elements <- Monad.replicateM (Word32.fromWord32 size) Binary.get+    elements & List & pure+  put list = do+    list & #unpack & length & fromIntegral & Word32.Word32 & Binary.put+    list & #unpack & mapM_ Binary.put  -- | Allows creating 'List' values with 'Exts.fromList'. Also allows 'List' -- literals with the @OverloadedLists@ extension.------ >>> [2] :: List Int--- fromList [2] instance Exts.IsList (List a) where-    type Item (List a) = a--    fromList items = List items--    toList list = #unpack list+  type Item (List a) = a+  fromList items = List items+  toList list = #unpack list -instance (DeepSeq.NFData a) => DeepSeq.NFData (List a) where+instance (DeepSeq.NFData a) =>+         DeepSeq.NFData (List a) --- | >>> show ([2] :: List Int)--- "fromList [2]"-instance (Show a) => Show (List a) where-    show list = "fromList " ++ show (#unpack list)+instance (Show a) =>+         Show (List a) where+  show list = "fromList " ++ show (#unpack list)  -- | Encoded as a JSON array directly.------ >>> Aeson.encode ([2] :: List Int)--- "[2]"-instance (Aeson.ToJSON a) => Aeson.ToJSON (List a) where-    toJSON list = list-        & #unpack-        & Aeson.toJSON+instance (Aeson.ToJSON a) =>+         Aeson.ToJSON (List a) where+  toJSON list = list & #unpack & Aeson.toJSON

@@ -8,7 +8,9 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -module Octane.Type.Mark (Mark(..)) where+module Octane.Type.Mark+  ( Mark(..)+  ) where  import Data.Function ((&)) @@ -22,29 +24,20 @@  -- | A tick mark on the replay. Both goals and saves make tick marks. data Mark = Mark-    { markLabel :: Text.Text+  { markLabel :: Text.Text     -- ^ The description of the tick mark. Typically something like     -- @"Team0Goal"@ or @"Team1Save"@ or @"User"@.-    , markFrame :: Word32.Word32+  , markFrame :: Word32.Word32     -- ^ Which frame this tick mark corresponds to.-    } deriving (Eq, Generics.Generic, Show)+  } deriving (Eq, Generics.Generic, Show)  $(OverloadedRecords.overloadedRecord Default.def ''Mark)  -- | Fields are stored one after the other in order.------ >>> Binary.decode "\x02\x00\x00\x00\x4b\x00\x01\x00\x00\x00" :: Mark--- Mark {markLabel = "K", markFrame = 0x00000001}------ >>> Binary.encode (Mark "K" 1)--- "\STX\NUL\NUL\NULK\NUL\SOH\NUL\NUL\NUL" instance Binary.Binary Mark where-    get = Mark-        <$> Binary.get-        <*> Binary.get--    put mark = do-        mark & #label & Binary.put-        mark & #frame & Binary.put+  get = Mark <$> Binary.get <*> Binary.get+  put mark = do+    mark & #label & Binary.put+    mark & #frame & Binary.put  instance DeepSeq.NFData Mark

@@ -8,7 +8,9 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -module Octane.Type.Message (Message(..)) where+module Octane.Type.Message+  ( Message(..)+  ) where  import Data.Function ((&)) @@ -22,32 +24,22 @@  -- | A debugging message. Replays do not have any of these anymore. data Message = Message-    { messageFrame :: Word32.Word32+  { messageFrame :: Word32.Word32     -- ^ The frame this message corresponds to.-    , messageName :: Text.Text+  , messageName :: Text.Text     -- ^ The primary player name.-    , messageContent :: Text.Text+  , messageContent :: Text.Text     -- ^ The actual content of the message.-    } deriving (Eq, Generics.Generic, Show)+  } deriving (Eq, Generics.Generic, Show)  $(OverloadedRecords.overloadedRecord Default.def ''Message)  -- | Fields stored in order, one after the other.------ >>> Binary.decode "\x01\x00\x00\x00\x02\x00\x00\x00\x41\x00\x02\x00\x00\x00\x42\x00" :: Message--- Message {messageFrame = 0x00000001, messageName = "A", messageContent = "B"}------ >>> Binary.encode (Message 1 "A" "B")--- "\SOH\NUL\NUL\NUL\STX\NUL\NUL\NULA\NUL\STX\NUL\NUL\NULB\NUL" instance Binary.Binary Message where-    get = Message-        <$> Binary.get-        <*> Binary.get-        <*> Binary.get--    put message = do-        message & #frame & Binary.put-        message & #name & Binary.put-        message & #content & Binary.put+  get = Message <$> Binary.get <*> Binary.get <*> Binary.get+  put message = do+    message & #frame & Binary.put+    message & #name & Binary.put+    message & #content & Binary.put -instance DeepSeq.NFData Message where+instance DeepSeq.NFData Message

@@ -10,10 +10,10 @@ {-# LANGUAGE TypeFamilies #-}  module Octane.Type.OptimizedReplay-    ( OptimizedReplay(..)-    , fromReplayWithFrames-    , toReplayWithFrames-    ) where+  ( OptimizedReplay(..)+  , fromReplayWithFrames+  , toReplayWithFrames+  ) where  import Data.Function ((&)) @@ -36,80 +36,82 @@ import qualified Octane.Type.Word32 as Word32 import qualified Octane.Utility.Optimizer as Optimizer - -- | A fully-processed replay with optimized frames. That means any unnecessary -- replications have been removed. -- -- See 'Octane.Type.Replay.Replay'. data OptimizedReplay = OptimizedReplay-    { optimizedReplayVersion1 :: Word32.Word32-    , optimizedReplayVersion2 :: Word32.Word32-    , optimizedReplayLabel :: Text.Text-    , optimizedReplayProperties :: Dictionary.Dictionary Property.Property-    , optimizedReplayLevels :: List.List Text.Text-    , optimizedReplayKeyFrames :: List.List KeyFrame.KeyFrame-    , optimizedReplayFrames :: [Frame.Frame]-    , optimizedReplayMessages :: List.List Message.Message-    , optimizedReplayMarks :: List.List Mark.Mark-    , optimizedReplayPackages :: List.List Text.Text-    , optimizedReplayObjects :: List.List Text.Text-    , optimizedReplayNames :: List.List Text.Text-    , optimizedReplayClasses :: List.List ClassItem.ClassItem-    , optimizedReplayCache :: List.List CacheItem.CacheItem-    } deriving (Eq, Generics.Generic, Show)+  { optimizedReplayVersion1 :: Word32.Word32+  , optimizedReplayVersion2 :: Word32.Word32+  , optimizedReplayLabel :: Text.Text+  , optimizedReplayProperties :: Dictionary.Dictionary Property.Property+  , optimizedReplayLevels :: List.List Text.Text+  , optimizedReplayKeyFrames :: List.List KeyFrame.KeyFrame+  , optimizedReplayFrames :: [Frame.Frame]+  , optimizedReplayMessages :: List.List Message.Message+  , optimizedReplayMarks :: List.List Mark.Mark+  , optimizedReplayPackages :: List.List Text.Text+  , optimizedReplayObjects :: List.List Text.Text+  , optimizedReplayNames :: List.List Text.Text+  , optimizedReplayClasses :: List.List ClassItem.ClassItem+  , optimizedReplayCache :: List.List CacheItem.CacheItem+  } deriving (Eq, Generics.Generic, Show)  $(OverloadedRecords.overloadedRecord Default.def ''OptimizedReplay)  instance Binary.Binary OptimizedReplay where-    get = do-        replayWithFrames <- Binary.get-        fromReplayWithFrames replayWithFrames--    put replay = do-        replayWithFrames <- toReplayWithFrames replay-        Binary.put replayWithFrames--instance DeepSeq.NFData OptimizedReplay where+  get = do+    replayWithFrames <- Binary.get+    fromReplayWithFrames replayWithFrames+  put replay = do+    replayWithFrames <- toReplayWithFrames replay+    Binary.put replayWithFrames +instance DeepSeq.NFData OptimizedReplay  -- | Converts a 'ReplayWithFrames.ReplayWithFrames' into an 'OptimizedReplay'. -- Operates in a 'Monad' so that it can 'fail' somewhat gracefully.-fromReplayWithFrames :: (Monad m) => ReplayWithFrames.ReplayWithFrames -> m OptimizedReplay+fromReplayWithFrames+  :: (Monad m)+  => ReplayWithFrames.ReplayWithFrames -> m OptimizedReplay fromReplayWithFrames replayWithFrames = do-    let frames = replayWithFrames & #frames & Optimizer.optimizeFrames-    pure (OptimizedReplay-        (#version1 replayWithFrames)-        (#version2 replayWithFrames)-        (#label replayWithFrames)-        (#properties replayWithFrames)-        (#levels replayWithFrames)-        (#keyFrames replayWithFrames)-        frames-        (#messages replayWithFrames)-        (#marks replayWithFrames)-        (#packages replayWithFrames)-        (#objects replayWithFrames)-        (#names replayWithFrames)-        (#classes replayWithFrames)-        (#cache replayWithFrames))-+  let frames = replayWithFrames & #frames & Optimizer.optimizeFrames+  pure+    (OptimizedReplay+       (#version1 replayWithFrames)+       (#version2 replayWithFrames)+       (#label replayWithFrames)+       (#properties replayWithFrames)+       (#levels replayWithFrames)+       (#keyFrames replayWithFrames)+       frames+       (#messages replayWithFrames)+       (#marks replayWithFrames)+       (#packages replayWithFrames)+       (#objects replayWithFrames)+       (#names replayWithFrames)+       (#classes replayWithFrames)+       (#cache replayWithFrames))  -- | Converts an 'OptimizedReplay' into a 'ReplayWithFrames.ReplayWithFrames'. -- Operates in a 'Monad' so that it can 'fail' somewhat gracefully.-toReplayWithFrames :: (Monad m) => OptimizedReplay -> m ReplayWithFrames.ReplayWithFrames+toReplayWithFrames+  :: (Monad m)+  => OptimizedReplay -> m ReplayWithFrames.ReplayWithFrames toReplayWithFrames optimizedReplay = do-    pure (ReplayWithFrames.ReplayWithFrames-        (#version1 optimizedReplay)-        (#version2 optimizedReplay)-        (#label optimizedReplay)-        (#properties optimizedReplay)-        (#levels optimizedReplay)-        (#keyFrames optimizedReplay)-        (#frames optimizedReplay)-        (#messages optimizedReplay)-        (#marks optimizedReplay)-        (#packages optimizedReplay)-        (#objects optimizedReplay)-        (#names optimizedReplay)-        (#classes optimizedReplay)-        (#cache optimizedReplay))+  pure+    (ReplayWithFrames.ReplayWithFrames+       (#version1 optimizedReplay)+       (#version2 optimizedReplay)+       (#label optimizedReplay)+       (#properties optimizedReplay)+       (#levels optimizedReplay)+       (#keyFrames optimizedReplay)+       (#frames optimizedReplay)+       (#messages optimizedReplay)+       (#marks optimizedReplay)+       (#packages optimizedReplay)+       (#objects optimizedReplay)+       (#names optimizedReplay)+       (#classes optimizedReplay)+       (#cache optimizedReplay))

@@ -1,9 +1,25 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StrictData #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-} -module Octane.Type.Property (Property(..)) where+module Octane.Type.Property+  ( Property(..)+  , ArrayProperty(..)+  , BoolProperty(..)+  , ByteProperty(..)+  , FloatProperty(..)+  , IntProperty(..)+  , NameProperty(..)+  , QWordProperty(..)+  , StrProperty(..)+  ) where  import Data.Aeson ((.=)) import Data.Function ((&))@@ -11,6 +27,8 @@ 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.OverloadedRecords.TH as OverloadedRecords import qualified GHC.Generics as Generics import qualified Octane.Type.Boolean as Boolean import qualified Octane.Type.Dictionary as Dictionary@@ -20,211 +38,339 @@ import qualified Octane.Type.Text as Text import qualified Octane.Type.Word64 as Word64 +data ArrayProperty = ArrayProperty+  { arrayPropertySize :: Word64.Word64+  , arrayPropertyContent :: List.List (Dictionary.Dictionary Property)+  } deriving (Eq, Generics.Generic, Show) --- TODO: Split these into individual data types like RemoteId.--- | A metadata property. All properties have a size, but only some actually--- use it. The value stored in the property can be an array, a boolean, and--- so on.-data Property-    = ArrayProperty-        Word64.Word64-        (List.List (Dictionary.Dictionary Property))-    | BoolProperty-        Word64.Word64-        Boolean.Boolean-    | ByteProperty-        Word64.Word64-        (Text.Text, Text.Text)-    | FloatProperty-        Word64.Word64-        Float32.Float32-    | IntProperty-        Word64.Word64-        Int32.Int32-    | NameProperty-        Word64.Word64-        Text.Text-    | QWordProperty-        Word64.Word64-        Word64.Word64-    | StrProperty-        Word64.Word64-        Text.Text-    deriving (Eq, Generics.Generic, Show)+instance Binary.Binary ArrayProperty where+  get = do+    size <- Binary.get+    content <- Binary.get+    pure (ArrayProperty size content)+  put array = do+    array & #size & Binary.put+    array & #content & Binary.put --- | Stored with the size first, then the value.-instance Binary.Binary Property where-    get = do-        kind <- Binary.get-        case kind of-            _ | kind == arrayProperty -> do-                size <- Binary.get-                value <- Binary.get-                value & ArrayProperty size & pure+instance DeepSeq.NFData ArrayProperty -            _ | kind == boolProperty -> do-                size <- Binary.get-                value <- Binary.get-                value & BoolProperty size & pure+instance Aeson.ToJSON ArrayProperty where+  toJSON array =+    Aeson.object+      [ "Type" .= ("Array" :: Text.Text)+      , "Size" .= #size array+      , "Value" .= #content array+      ] -            _ | kind == byteProperty -> do-                size <- Binary.get-                key <- Binary.get-                if key == "OnlinePlatform_Steam"-                    then ("OnlinePlatform", key) & ByteProperty size & pure-                    else do-                        value <- Binary.get-                        (key, value) & ByteProperty size & pure+data BoolProperty = BoolProperty+  { boolPropertySize :: Word64.Word64+  , boolPropertyContent :: Boolean.Boolean+  } deriving (Eq, Generics.Generic, Show) -            _ | kind == floatProperty -> do-                size <- Binary.get-                value <- case #unpack size of-                    4 -> Binary.get-                    x -> fail ("unknown FloatProperty size " ++ show x)-                value & FloatProperty size & pure+instance Binary.Binary BoolProperty where+  get = do+    size <- Binary.get+    content <- Binary.get+    pure (BoolProperty size content)+  put bool = do+    bool & #size & Binary.put+    bool & #content & Binary.put -            _ | kind == intProperty -> do-                size <- Binary.get-                value <- case #unpack size of-                    4 -> Binary.get-                    x -> fail ("unknown IntProperty size " ++ show x)-                value & IntProperty size & pure+instance DeepSeq.NFData BoolProperty -            _ | kind == nameProperty -> do-                size <- Binary.get-                value <- Binary.get-                value & NameProperty size & pure+instance Aeson.ToJSON BoolProperty where+  toJSON bool =+    Aeson.object+      [ "Type" .= ("Bool" :: Text.Text)+      , "Size" .= #size bool+      , "Value" .= #content bool+      ] -            _ | kind == qWordProperty -> do-                size <- Binary.get-                value <- case #unpack size of-                    8 -> Binary.get-                    x -> fail ("unknown QWordProperty size " ++ show x)-                value & QWordProperty size & pure+data ByteProperty = ByteProperty+  { bytePropertySize :: Word64.Word64+  , bytePropertyKey :: Text.Text+  , bytePropertyValue :: Text.Text+  } deriving (Eq, Generics.Generic, Show) -            _ | kind == strProperty -> do-                size <- Binary.get-                value <- Binary.get-                value & StrProperty size & pure+instance Binary.Binary ByteProperty where+  get = do+    size <- Binary.get+    key <- Binary.get+    if key == "OnlinePlatform_Steam"+      then do+        pure (ByteProperty size "OnlinePlatform" key)+      else do+        value <- Binary.get+        pure (ByteProperty size key value)+  put byte = do+    byte & #size & Binary.put+    byte & #key & Binary.put+    byte & #value & Binary.put -            _ -> fail ("unknown property type " ++ show (#unpack kind))+instance DeepSeq.NFData ByteProperty -    put property =-        case property of-            ArrayProperty size value -> do-                Binary.put arrayProperty-                Binary.put size-                Binary.put value+instance Aeson.ToJSON ByteProperty where+  toJSON byte =+    Aeson.object+      [ "Type" .= ("Byte" :: Text.Text)+      , "Size" .= #size byte+      , "Value" .= (#key byte, #value byte)+      ] -            BoolProperty size value -> do-                Binary.put boolProperty-                Binary.put size-                Binary.put value+data FloatProperty = FloatProperty+  { floatPropertySize :: Word64.Word64+  , floatPropertyContent :: Float32.Float32+  } deriving (Eq, Generics.Generic, Show) -            ByteProperty size (key, value) -> do-                Binary.put byteProperty-                Binary.put size-                Binary.put key-                Binary.put value+instance Binary.Binary FloatProperty where+  get = do+    size <- Binary.get+    content <-+      case #unpack size of+        4 -> Binary.get+        x -> fail ("unknown FloatProperty size " ++ show x)+    pure (FloatProperty size content)+  put float = do+    float & #size & Binary.put+    float & #content & Binary.put -            FloatProperty size value -> do-                Binary.put floatProperty-                Binary.put size-                Binary.put value+instance DeepSeq.NFData FloatProperty -            IntProperty size value -> do-                Binary.put intProperty-                Binary.put size-                Binary.put value+instance Aeson.ToJSON FloatProperty where+  toJSON float =+    Aeson.object+      [ "Type" .= ("Float" :: Text.Text)+      , "Size" .= #size float+      , "Value" .= #content float+      ] -            NameProperty size value -> do-                Binary.put nameProperty-                Binary.put size-                Binary.put value+data IntProperty = IntProperty+  { intPropertySize :: Word64.Word64+  , intPropertyContent :: Int32.Int32+  } deriving (Eq, Generics.Generic, Show) -            QWordProperty size value -> do-                Binary.put qWordProperty-                Binary.put size-                Binary.put value+instance Binary.Binary IntProperty where+  get = do+    size <- Binary.get+    content <-+      case #unpack size of+        4 -> Binary.get+        x -> fail ("unknown IntProperty size " ++ show x)+    pure (IntProperty size content)+  put int = do+    int & #size & Binary.put+    int & #content & Binary.put -            StrProperty size value -> do-                Binary.put strProperty-                Binary.put size-                Binary.put value+instance DeepSeq.NFData IntProperty -instance DeepSeq.NFData Property where+instance Aeson.ToJSON IntProperty where+  toJSON int =+    Aeson.object+      [ "Type" .= ("Int" :: Text.Text)+      , "Size" .= #size int+      , "Value" .= #content int+      ] -instance Aeson.ToJSON Property where-    toJSON property = case property of-        ArrayProperty size x -> Aeson.object-            [ "Type" .= ("Array" :: Text.Text)-            , "Size" .= size-            , "Value" .= x-            ]-        BoolProperty size x -> Aeson.object-            [ "Type" .= ("Bool" :: Text.Text)-            , "Size" .= size-            , "Value" .= x-            ]-        ByteProperty size x -> Aeson.object-            [ "Type" .= ("Byte" :: Text.Text)-            , "Size" .= size-            , "Value" .= x-            ]-        FloatProperty size x -> Aeson.object-            [ "Type" .= ("Float" :: Text.Text)-            , "Size" .= size-            , "Value" .= x-            ]-        IntProperty size x -> Aeson.object-            [ "Type" .= ("Int" :: Text.Text)-            , "Size" .= size-            , "Value" .= x-            ]-        NameProperty size x -> Aeson.object-            [ "Type" .= ("Name" :: Text.Text)-            , "Size" .= size-            , "Value" .= x-            ]-        QWordProperty size x -> Aeson.object-            [ "Type" .= ("QWord" :: Text.Text)-            , "Size" .= size-            , "Value" .= x-            ]-        StrProperty size x -> Aeson.object-            [ "Type" .= ("Str" :: Text.Text)-            , "Size" .= size-            , "Value" .= x-            ]+data NameProperty = NameProperty+  { namePropertySize :: Word64.Word64+  , namePropertyContent :: Text.Text+  } deriving (Eq, Generics.Generic, Show) +instance Binary.Binary NameProperty where+  get = do+    size <- Binary.get+    content <- Binary.get+    pure (NameProperty size content)+  put name = do+    name & #size & Binary.put+    name & #content & Binary.put +instance DeepSeq.NFData NameProperty++instance Aeson.ToJSON NameProperty where+  toJSON name =+    Aeson.object+      [ "Type" .= ("Name" :: Text.Text)+      , "Size" .= #size name+      , "Value" .= #content name+      ]++data QWordProperty = QWordProperty+  { qWordPropertySize :: Word64.Word64+  , qWordPropertyContent :: Word64.Word64+  } deriving (Eq, Generics.Generic, Show)++instance Binary.Binary QWordProperty where+  get = do+    size <- Binary.get+    content <-+      case #unpack size of+        8 -> Binary.get+        x -> fail ("unknown QWordProperty size " ++ show x)+    pure (QWordProperty size content)+  put qWord = do+    qWord & #size & Binary.put+    qWord & #content & Binary.put++instance DeepSeq.NFData QWordProperty++instance Aeson.ToJSON QWordProperty where+  toJSON qWord =+    Aeson.object+      [ "Type" .= ("QWord" :: Text.Text)+      , "Size" .= #size qWord+      , "Value" .= #content qWord+      ]++data StrProperty = StrProperty+  { strPropertySize :: Word64.Word64+  , strPropertyContent :: Text.Text+  } deriving (Eq, Generics.Generic, Show)++instance Binary.Binary StrProperty where+  get = do+    size <- Binary.get+    content <- Binary.get+    pure (StrProperty size content)+  put str = do+    str & #size & Binary.put+    str & #content & Binary.put++instance DeepSeq.NFData StrProperty++instance Aeson.ToJSON StrProperty where+  toJSON str =+    Aeson.object+      [ "Type" .= ("Str" :: Text.Text)+      , "Size" .= #size str+      , "Value" .= #content str+      ]++-- | A metadata property. All properties have a size, but only some actually+-- use it. The value stored in the property can be an array, a boolean, and+-- so on.+data Property+  = PropertyArray ArrayProperty+  | PropertyBool BoolProperty+  | PropertyByte ByteProperty+  | PropertyFloat FloatProperty+  | PropertyInt IntProperty+  | PropertyName NameProperty+  | PropertyQWord QWordProperty+  | PropertyStr StrProperty+  deriving (Eq, Generics.Generic, Show)++$(OverloadedRecords.overloadedRecords+    Default.def+    [ ''ArrayProperty+    , ''BoolProperty+    , ''ByteProperty+    , ''FloatProperty+    , ''IntProperty+    , ''NameProperty+    , ''QWordProperty+    , ''StrProperty+    ])++-- | Stored with the size first, then the value.+instance Binary.Binary Property where+  get = do+    kind <- Binary.get+    case kind of+      _+        | kind == arrayProperty -> do+          array <- Binary.get+          pure (PropertyArray array)+      _+        | kind == boolProperty -> do+          bool <- Binary.get+          pure (PropertyBool bool)+      _+        | kind == byteProperty -> do+          byte <- Binary.get+          pure (PropertyByte byte)+      _+        | kind == floatProperty -> do+          float <- Binary.get+          pure (PropertyFloat float)+      _+        | kind == intProperty -> do+          int <- Binary.get+          pure (PropertyInt int)+      _+        | kind == nameProperty -> do+          name <- Binary.get+          pure (PropertyName name)+      _+        | kind == qWordProperty -> do+          qWord <- Binary.get+          pure (PropertyQWord qWord)+      _+        | kind == strProperty -> do+          str <- Binary.get+          pure (PropertyStr str)+      _ -> fail ("unknown property type " ++ show (#unpack kind))+  put property =+    case property of+      PropertyArray array -> do+        Binary.put arrayProperty+        Binary.put array+      PropertyBool bool -> do+        Binary.put boolProperty+        Binary.put bool+      PropertyByte byte -> do+        Binary.put byteProperty+        Binary.put byte+      PropertyFloat float -> do+        Binary.put floatProperty+        Binary.put float+      PropertyInt int -> do+        Binary.put intProperty+        Binary.put int+      PropertyName name -> do+        Binary.put nameProperty+        Binary.put name+      PropertyQWord qWord -> do+        Binary.put qWordProperty+        Binary.put qWord+      PropertyStr str -> do+        Binary.put strProperty+        Binary.put str++instance DeepSeq.NFData Property++instance Aeson.ToJSON Property where+  toJSON property =+    case property of+      PropertyArray array -> Aeson.toJSON array+      PropertyBool bool -> Aeson.toJSON bool+      PropertyByte byte -> Aeson.toJSON byte+      PropertyFloat float -> Aeson.toJSON float+      PropertyInt int -> Aeson.toJSON int+      PropertyName name -> Aeson.toJSON name+      PropertyQWord qWord -> Aeson.toJSON qWord+      PropertyStr str -> Aeson.toJSON str+ arrayProperty :: Text.Text arrayProperty = "ArrayProperty" - boolProperty :: Text.Text boolProperty = "BoolProperty" - byteProperty :: Text.Text byteProperty = "ByteProperty" - floatProperty :: Text.Text floatProperty = "FloatProperty" - intProperty :: Text.Text intProperty = "IntProperty" - nameProperty :: Text.Text nameProperty = "NameProperty" - qWordProperty :: Text.Text qWordProperty = "QWordProperty"-  strProperty :: Text.Text strProperty = "StrProperty"

@@ -8,7 +8,10 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -module Octane.Type.RawReplay (RawReplay(..), newRawReplay) where+module Octane.Type.RawReplay+  ( RawReplay(..)+  , newRawReplay+  ) where  import qualified Control.DeepSeq as DeepSeq import qualified Control.Monad as Monad@@ -23,86 +26,80 @@ import qualified Octane.Type.Word32 as Word32 import qualified Text.Printf as Printf - -- | A raw, unprocessed replay. Only enough parsing is done to make sure that -- the CRCs are valid. -- -- See 'Octane.Type.ReplayWithoutFrames.ReplayWithoutFrames'. data RawReplay = RawReplay-    { rawReplayHeaderSize :: Word32.Word32+  { rawReplayHeaderSize :: Word32.Word32     -- ^ The byte size of the first section.-    , rawReplayHeaderCRC :: Word32.Word32+  , rawReplayHeaderCRC :: Word32.Word32     -- ^ The CRC of the first section.-    , rawReplayHeader :: LazyBytes.ByteString+  , rawReplayHeader :: LazyBytes.ByteString     -- ^ The first section.-    , rawReplayContentSize :: Word32.Word32+  , rawReplayContentSize :: Word32.Word32     -- ^ The byte size of the second section.-    , rawReplayContentCRC :: Word32.Word32+  , rawReplayContentCRC :: Word32.Word32     -- ^ The CRC of the second section.-    , rawReplayContent :: LazyBytes.ByteString+  , rawReplayContent :: LazyBytes.ByteString     -- ^ The second section.-    , rawReplayFooter :: LazyBytes.ByteString+  , rawReplayFooter :: LazyBytes.ByteString     -- ^ Arbitrary data after the second section. In replays generated by     -- Rocket League, this is always empty. However it is not technically     -- invalid to put something here.-    } deriving (Eq, Generics.Generic, Show)+  } deriving (Eq, Generics.Generic, Show)  $(OverloadedRecords.overloadedRecord Default.def ''RawReplay)  -- | Decoding will fail if the CRCs don't match, but it is possible to encode -- invalid replays. That means @decode (encode rawReplay)@ can fail. instance Binary.Binary RawReplay where-    get = do-        headerSize <- Binary.get-        headerCRC <- Binary.get-        header <- Binary.getLazyByteString (Word32.fromWord32 headerSize)-        checkCRC headerCRC header--        contentSize <- Binary.get-        contentCRC <- Binary.get-        content <- Binary.getLazyByteString (Word32.fromWord32 contentSize)-        checkCRC contentCRC content--        footer <- Binary.getRemainingLazyByteString--        pure (RawReplay headerSize headerCRC header contentSize contentCRC content footer)--    put replay = do-        Binary.put (#headerSize replay)-        Binary.put (#headerCRC replay)-        Binary.putLazyByteString (#header replay)--        Binary.put (#contentSize replay)-        Binary.put (#contentCRC replay)-        Binary.putLazyByteString (#content replay)--        Binary.putLazyByteString (#footer replay)--instance DeepSeq.NFData RawReplay where+  get = do+    headerSize <- Binary.get+    headerCRC <- Binary.get+    header <- Binary.getLazyByteString (Word32.fromWord32 headerSize)+    checkCRC headerCRC header+    contentSize <- Binary.get+    contentCRC <- Binary.get+    content <- Binary.getLazyByteString (Word32.fromWord32 contentSize)+    checkCRC contentCRC content+    footer <- Binary.getRemainingLazyByteString+    pure+      (RawReplay headerSize headerCRC header contentSize contentCRC content footer)+  put replay = do+    Binary.put (#headerSize replay)+    Binary.put (#headerCRC replay)+    Binary.putLazyByteString (#header replay)+    Binary.put (#contentSize replay)+    Binary.put (#contentCRC replay)+    Binary.putLazyByteString (#content replay)+    Binary.putLazyByteString (#footer replay) +instance DeepSeq.NFData RawReplay  -- | Creates a new 'RawReplay'. You should prefer this over directly using the -- constructor so that the sizes and CRCs are set correctly. newRawReplay-    :: LazyBytes.ByteString -- ^ The header.-    -> LazyBytes.ByteString -- ^ The content.-    -> LazyBytes.ByteString -- ^ The footer.-    -> RawReplay+  :: LazyBytes.ByteString -- ^ The header.+  -> LazyBytes.ByteString -- ^ The content.+  -> LazyBytes.ByteString -- ^ The footer.+  -> RawReplay newRawReplay header content footer = do-    let headerSize = Word32.toWord32 (LazyBytes.length header)-    let headerCRC = Word32.Word32 (CRC.crc32 header)--    let contentSize = Word32.toWord32 (LazyBytes.length content)-    let contentCRC = Word32.Word32 (CRC.crc32 content)--    RawReplay headerSize headerCRC header contentSize contentCRC content footer-+  let headerSize = Word32.toWord32 (LazyBytes.length header)+  let headerCRC = Word32.Word32 (CRC.crc32 header)+  let contentSize = Word32.toWord32 (LazyBytes.length content)+  let contentCRC = Word32.Word32 (CRC.crc32 content)+  RawReplay headerSize headerCRC header contentSize contentCRC content footer -checkCRC :: (Monad m) => Word32.Word32 -> LazyBytes.ByteString -> m ()+checkCRC+  :: (Monad m)+  => Word32.Word32 -> LazyBytes.ByteString -> m () checkCRC (Word32.Word32 expected) bytes = do-    let actual = CRC.crc32 bytes-    Monad.when (actual /= expected) (do-        let message = Printf.printf+  let actual = CRC.crc32 bytes+  Monad.when+    (actual /= expected)+    (do let message =+              Printf.printf                 "CRC 0x%08x does not equal expected value 0x%08x"                 actual                 expected

@@ -10,12 +10,12 @@ {-# LANGUAGE TypeFamilies #-}  module Octane.Type.RemoteId-    ( RemoteId(..)-    , SteamId(..)-    , PlayStationId(..)-    , SplitscreenId(..)-    , XboxId(..)-    ) where+  ( RemoteId(..)+  , SteamId(..)+  , PlayStationId(..)+  , SplitscreenId(..)+  , XboxId(..)+  ) where  import Data.Aeson ((.=)) import Data.Function ((&))@@ -36,202 +36,128 @@ import qualified Octane.Utility.Endian as Endian import qualified Text.Printf as Printf --- $setup--- >>> import qualified Data.Binary.Get as Binary--- >>> import qualified Data.Binary.Put as Binary-- data PlayStationId = PlayStationId-    { playStationIdName :: Text.Text-    , playStationIdUnknown :: LazyBytes.ByteString-    } deriving (Eq, Generics.Generic, Show)--$(OverloadedRecords.overloadedRecord Default.def ''PlayStationId)+  { playStationIdName :: Text.Text+  , playStationIdUnknown :: LazyBytes.ByteString+  } deriving (Eq, Generics.Generic, Show)  -- | Each part is stored as exactly 16 bits.------ >>> Binary.runGet (BinaryBit.runBitGet (BinaryBit.getBits 0)) "\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80" :: PlayStationId--- PlayStationId {playStationIdName = "B", playStationIdUnknown = "\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\SOH"}------ >>> Binary.runPut (BinaryBit.runBitPut (BinaryBit.putBits 0 (PlayStationId "A" "\x01")))--- "\130\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\128" instance BinaryBit.BinaryBit PlayStationId where-    getBits _ = do-        nameBytes <- BinaryBit.getByteString 16-        let name = nameBytes-                & Endian.reverseBitsInStrictBytes-                & Encoding.decodeLatin1-                & StrictText.dropWhileEnd (== '\0')-                & Text.Text--        unknownBytes <- BinaryBit.getByteString 16-        let unknown = unknownBytes-                & Endian.reverseBitsInStrictBytes-                & LazyBytes.fromStrict--        pure (PlayStationId name unknown)--    putBits _ playStationId = do-        playStationId-            & #name-            & #unpack-            & StrictText.justifyLeft 16 '\x00'-            & StrictText.take 16-            & Text.encodeLatin1-            & Endian.reverseBitsInStrictBytes-            & BinaryBit.putByteString--        playStationId-            & #unknown-            & LazyBytes.toStrict-            & Endian.reverseBitsInStrictBytes-            & BinaryBit.putByteString+  getBits _ = do+    nameBytes <- BinaryBit.getByteString 16+    let name =+          nameBytes & Endian.reverseBitsInStrictBytes & Encoding.decodeLatin1 &+          StrictText.dropWhileEnd (== '\0') &+          Text.Text+    unknownBytes <- BinaryBit.getByteString 16+    let unknown = unknownBytes & Endian.reverseBitsInStrictBytes & LazyBytes.fromStrict+    pure (PlayStationId name unknown)+  putBits _ playStationId = do+    playStationId & #name & #unpack & StrictText.justifyLeft 16 '\x00' &+      StrictText.take 16 &+      Text.encodeLatin1 &+      Endian.reverseBitsInStrictBytes &+      BinaryBit.putByteString+    playStationId & #unknown & LazyBytes.toStrict & Endian.reverseBitsInStrictBytes &+      BinaryBit.putByteString -instance DeepSeq.NFData PlayStationId where+instance DeepSeq.NFData PlayStationId --- | >>> Aeson.encode (PlayStationId "A" "B")--- "{\"Unknown\":\"0x42\",\"Name\":\"A\"}" instance Aeson.ToJSON PlayStationId where-    toJSON playStationId = Aeson.object-        [ "Name" .= #name playStationId-        , "Unknown" .= (playStationId-            & #unknown-            & LazyBytes.unpack-            & concatMap (Printf.printf "%02x")-            & ("0x" ++)-            & StrictText.pack)-        ]-+  toJSON playStationId =+    Aeson.object+      [ "Name" .= #name playStationId+      , "Unknown" .=+        (playStationId & #unknown & LazyBytes.unpack &+         concatMap (Printf.printf "%02x") &+         ("0x" ++) &+         StrictText.pack)+      ]  newtype SplitscreenId = SplitscreenId-    { splitscreenIdUnpack :: Maybe Int-    } deriving (Eq, Generics.Generic, Show)--$(OverloadedRecords.overloadedRecord Default.def ''SplitscreenId)+  { splitscreenIdUnpack :: Maybe Int+  } deriving (Eq, Generics.Generic, Show)  -- | Stored as a bare byte string.------ >>> Binary.runGet (BinaryBit.runBitGet (BinaryBit.getBits 0)) "\x00\x00\x00" :: SplitscreenId--- SplitscreenId {splitscreenIdUnpack = Just 0}------ >>> Binary.runPut (BinaryBit.runBitPut (BinaryBit.putBits 0 (SplitscreenId (Just 0))))--- "\NUL\NUL\NUL" instance BinaryBit.BinaryBit SplitscreenId where-    getBits _ = do-        bytes <- BinaryBit.getByteString 3-        case bytes of-            "\x00\x00\x00" -> do-                pure (SplitscreenId (Just 0))-            _ -> do-                fail ("Unexpected SplitscreenId value " ++ show bytes)--    putBits _ _splitscreenId = do-        BinaryBit.putByteString "\x00\x00\x00"+  getBits _ = do+    bytes <- BinaryBit.getByteString 3+    case bytes of+      "\x00\x00\x00" -> do+        pure (SplitscreenId (Just 0))+      _ -> do+        fail ("Unexpected SplitscreenId value " ++ show bytes)+  putBits _ _splitscreenId = do+    BinaryBit.putByteString "\x00\x00\x00" -instance DeepSeq.NFData SplitscreenId where+instance DeepSeq.NFData SplitscreenId  -- | Encoded as an optional number.------ >>> Aeson.encode (SplitscreenId Nothing)--- "null"------ >>> Aeson.encode (SplitscreenId (Just 0))--- "0" instance Aeson.ToJSON SplitscreenId where-    toJSON splitscreenId = splitscreenId & #unpack & Aeson.toJSON-+  toJSON splitscreenId = splitscreenId & #unpack & Aeson.toJSON  newtype SteamId = SteamId-    { steamIdUnpack :: Word64.Word64-    } deriving (Eq, Generics.Generic, Show)--$(OverloadedRecords.overloadedRecord Default.def ''SteamId)+  { steamIdUnpack :: Word64.Word64+  } deriving (Eq, Generics.Generic, Show)  -- | Stored as a plain 'Word64.Word64'.------ >>> Binary.runGet (BinaryBit.runBitGet (BinaryBit.getBits 0)) "\x80\x00\x00\x00\x00\x00\x00\x00" :: SteamId--- SteamId {steamIdUnpack = 0x0000000000000001}------ >>> Binary.runPut (BinaryBit.runBitPut (BinaryBit.putBits 0 (SteamId 1)))--- "\128\NUL\NUL\NUL\NUL\NUL\NUL\NUL" instance BinaryBit.BinaryBit SteamId where-    getBits _ = do-        steamId <- BinaryBit.getBits 0-        pure (SteamId steamId)--    putBits _ steamId = steamId & #unpack & BinaryBit.putBits 0+  getBits _ = do+    steamId <- BinaryBit.getBits 0+    pure (SteamId steamId)+  putBits _ steamId = steamId & #unpack & BinaryBit.putBits 0 -instance DeepSeq.NFData SteamId where+instance DeepSeq.NFData SteamId  -- | Encoded directly as a number.------ >>> Aeson.encode (SteamId 1)--- "1" instance Aeson.ToJSON SteamId where-    toJSON steamId = steamId & #unpack & Aeson.toJSON-+  toJSON steamId = steamId & #unpack & Aeson.toJSON  newtype XboxId = XboxId-    { xboxIdUnpack :: Word64.Word64-    } deriving (Eq, Generics.Generic, Show)--$(OverloadedRecords.overloadedRecord Default.def ''XboxId)+  { xboxIdUnpack :: Word64.Word64+  } deriving (Eq, Generics.Generic, Show)  -- | Stored as a plain 'Word64.Word64'.------ >>> Binary.runGet (BinaryBit.runBitGet (BinaryBit.getBits 0)) "\x80\x00\x00\x00\x00\x00\x00\x00" :: XboxId--- XboxId {xboxIdUnpack = 0x0000000000000001}------ >>> Binary.runPut (BinaryBit.runBitPut (BinaryBit.putBits 0 (XboxId 1)))--- "\128\NUL\NUL\NUL\NUL\NUL\NUL\NUL" instance BinaryBit.BinaryBit XboxId where-    getBits _ = do-        xboxId <- BinaryBit.getBits 0-        pure (XboxId xboxId)--    putBits _ xboxId = xboxId & #unpack & BinaryBit.putBits 0-+  getBits _ = do+    xboxId <- BinaryBit.getBits 0+    pure (XboxId xboxId)+  putBits _ xboxId = xboxId & #unpack & BinaryBit.putBits 0 -instance DeepSeq.NFData XboxId where+instance DeepSeq.NFData XboxId  -- | Encoded directly as a number.------ >>> Aeson.encode (XboxId 1)--- "1" instance Aeson.ToJSON XboxId where-    toJSON xboxId = xboxId & #unpack & Aeson.toJSON-+  toJSON xboxId = xboxId & #unpack & Aeson.toJSON  -- | A player's canonical remote ID. This is the best way to uniquely identify -- players data RemoteId-    = RemotePlayStationId PlayStationId-    | RemoteSplitscreenId SplitscreenId-    | RemoteSteamId SteamId-    | RemoteXboxId XboxId-    deriving (Eq, Generics.Generic, Show)+  = RemotePlayStationId PlayStationId+  | RemoteSplitscreenId SplitscreenId+  | RemoteSteamId SteamId+  | RemoteXboxId XboxId+  deriving (Eq, Generics.Generic, Show) -instance DeepSeq.NFData RemoteId where+$(OverloadedRecords.overloadedRecords+    Default.def+    [''PlayStationId, ''SplitscreenId, ''SteamId, ''XboxId]) +instance DeepSeq.NFData RemoteId+ -- | Encodes the remote ID as an object with "Type" and "Value" keys.------ >>> Aeson.encode (RemoteSteamId (SteamId 1))--- "{\"Value\":1,\"Type\":\"Steam\"}" instance Aeson.ToJSON RemoteId where-    toJSON remoteId = case remoteId of-        RemotePlayStationId x -> Aeson.object-            [ "Type" .= ("PlayStation" :: Text.Text)-            , "Value" .= Aeson.toJSON x-            ]-        RemoteSplitscreenId x -> Aeson.object-            [ "Type" .= ("Splitscreen" :: Text.Text)-            , "Value" .= Aeson.toJSON x-            ]-        RemoteSteamId x -> Aeson.object-            [ "Type" .= ("Steam" :: Text.Text)-            , "Value" .= Aeson.toJSON x-            ]-        RemoteXboxId x -> Aeson.object-            [ "Type" .= ("Xbox" :: Text.Text)-            , "Value" .= Aeson.toJSON x-            ]+  toJSON remoteId =+    case remoteId of+      RemotePlayStationId x ->+        Aeson.object+          ["Type" .= ("PlayStation" :: Text.Text), "Value" .= Aeson.toJSON x]+      RemoteSplitscreenId x ->+        Aeson.object+          ["Type" .= ("Splitscreen" :: Text.Text), "Value" .= Aeson.toJSON x]+      RemoteSteamId x ->+        Aeson.object+          ["Type" .= ("Steam" :: Text.Text), "Value" .= Aeson.toJSON x]+      RemoteXboxId x ->+        Aeson.object+          ["Type" .= ("Xbox" :: Text.Text), "Value" .= Aeson.toJSON x]

@@ -10,10 +10,10 @@ {-# LANGUAGE TypeFamilies #-}  module Octane.Type.Replay-    ( Replay(..)-    , fromOptimizedReplay-    , toOptimizedReplay-    ) where+  ( Replay(..)+  , fromOptimizedReplay+  , toOptimizedReplay+  ) where  import Data.Aeson ((.=)) import Data.Function ((&))@@ -38,13 +38,12 @@ import qualified Octane.Type.Text as Text import qualified Octane.Type.Word32 as Word32 - -- | A fully-processed, optimized replay. This is the nicest format for humans -- to work with. It can be converted all the way back down to a -- 'Octane.Type.RawReplay.RawReplay' for serialization. data Replay = Replay-    { replayVersion :: Version.Version-    , replayMetadata :: Map.Map StrictText.Text Property.Property+  { replayVersion :: Version.Version+  , replayMetadata :: Map.Map StrictText.Text Property.Property     -- ^ High-level metadata about the replay. Only one key is actually     -- required to be able to view the replay in Rocket League:     --@@ -84,145 +83,126 @@     --   team. This value is not validated, so you can put absurd values like     --   @99@. To get an "unfair" team size like 1v4, you must set the     --   @"bUnfairBots"@ 'Property.BoolProperty' to @True@.-    , 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)+  , 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+  get = do+    optimizedReplay <- Binary.get+    fromOptimizedReplay optimizedReplay+  put replay = do+    optimizedReplay <- toOptimizedReplay replay+    Binary.put optimizedReplay -instance DeepSeq.NFData Replay where+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-        ]-+  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+  :: (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-        }-+  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+  :: (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 })--    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 = List.List [] -- TODO-        -- TODO: This list is usually empty. Also the parser doesn't use it at-        -- all. Is it safe for it to always be empty?-        , OptimizedReplay.optimizedReplayNames = List.List []-        , OptimizedReplay.optimizedReplayClasses = List.List [] -- TODO-        , OptimizedReplay.optimizedReplayCache = List.List [] -- TODO-        }+  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+              })+  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 = List.List [] -- TODO+    , OptimizedReplay.optimizedReplayNames = List.List [] -- TODO+    , OptimizedReplay.optimizedReplayClasses = List.List [] -- TODO+    , OptimizedReplay.optimizedReplayCache = List.List [] -- TODO+    }

@@ -9,10 +9,10 @@ {-# LANGUAGE TypeFamilies #-}  module Octane.Type.ReplayWithFrames-    ( ReplayWithFrames(..)-    , fromReplayWithoutFrames-    , toReplayWithoutFrames-    ) where+  ( ReplayWithFrames(..)+  , fromReplayWithoutFrames+  , toReplayWithoutFrames+  ) where  import qualified Control.DeepSeq as DeepSeq import qualified Data.Binary as Binary@@ -28,91 +28,94 @@ import qualified Octane.Type.Mark as Mark import qualified Octane.Type.Message as Message import qualified Octane.Type.Property as Property-import qualified Octane.Type.ReplayWithoutFrames as ReplayWithoutFrames+import qualified Octane.Type.ReplayWithoutFrames as Replay import qualified Octane.Type.Text as Text import qualified Octane.Type.Word32 as Word32 import qualified Octane.Utility.Generator as Generator import qualified Octane.Utility.Parser as Parser - -- | A fully-processed replay. This has all of the frames from the network -- stream as well as all of the metadata. -- -- See 'Octane.Type.OptimizedReplay.OptimizedReplay'. data ReplayWithFrames = ReplayWithFrames-    { replayWithFramesVersion1 :: Word32.Word32-    , replayWithFramesVersion2 :: Word32.Word32-    , replayWithFramesLabel :: Text.Text-    , replayWithFramesProperties :: Dictionary.Dictionary Property.Property-    , replayWithFramesLevels :: List.List Text.Text-    , replayWithFramesKeyFrames :: List.List KeyFrame.KeyFrame-    , replayWithFramesFrames :: [Frame.Frame]-    , replayWithFramesMessages :: List.List Message.Message-    , replayWithFramesMarks :: List.List Mark.Mark-    , replayWithFramesPackages :: List.List Text.Text-    , replayWithFramesObjects :: List.List Text.Text-    , replayWithFramesNames :: List.List Text.Text-    , replayWithFramesClasses :: List.List ClassItem.ClassItem-    , replayWithFramesCache :: List.List CacheItem.CacheItem-    } deriving (Eq, Generics.Generic, Show)+  { replayWithFramesVersion1 :: Word32.Word32+  , replayWithFramesVersion2 :: Word32.Word32+  , replayWithFramesLabel :: Text.Text+  , replayWithFramesProperties :: Dictionary.Dictionary Property.Property+  , replayWithFramesLevels :: List.List Text.Text+  , replayWithFramesKeyFrames :: List.List KeyFrame.KeyFrame+  , replayWithFramesFrames :: [Frame.Frame]+  , replayWithFramesMessages :: List.List Message.Message+  , replayWithFramesMarks :: List.List Mark.Mark+  , replayWithFramesPackages :: List.List Text.Text+  , replayWithFramesObjects :: List.List Text.Text+  , replayWithFramesNames :: List.List Text.Text+  , replayWithFramesClasses :: List.List ClassItem.ClassItem+  , replayWithFramesCache :: List.List CacheItem.CacheItem+  } deriving (Eq, Generics.Generic, Show)  $(OverloadedRecords.overloadedRecord Default.def ''ReplayWithFrames)  instance Binary.Binary ReplayWithFrames where-    get = do-        replayWithoutFrames <- Binary.get-        fromReplayWithoutFrames replayWithoutFrames--    put replay = do-        replayWithoutFrames <- toReplayWithoutFrames replay-        Binary.put replayWithoutFrames--instance DeepSeq.NFData ReplayWithFrames where+  get = do+    replayWithoutFrames <- Binary.get+    fromReplayWithoutFrames replayWithoutFrames+  put replay = do+    replayWithoutFrames <- toReplayWithoutFrames replay+    Binary.put replayWithoutFrames +instance DeepSeq.NFData ReplayWithFrames  -- | Converts a 'ReplayWithoutFrames.ReplayWithoutFrames' into a 'ReplayWithFrames'. -- Operates in a 'Monad' so that it can 'fail' somewhat gracefully.-fromReplayWithoutFrames :: (Monad m) => ReplayWithoutFrames.ReplayWithoutFrames -> m ReplayWithFrames+fromReplayWithoutFrames+  :: (Monad m)+  => Replay.ReplayWithoutFrames -> m ReplayWithFrames fromReplayWithoutFrames replayWithoutFrames = do-    pure (ReplayWithFrames-        (#version1 replayWithoutFrames)-        (#version2 replayWithoutFrames)-        (#label replayWithoutFrames)-        (#properties replayWithoutFrames)-        (#levels replayWithoutFrames)-        (#keyFrames replayWithoutFrames)-        (Parser.parseStream replayWithoutFrames)-        (#messages replayWithoutFrames)-        (#marks replayWithoutFrames)-        (#packages replayWithoutFrames)-        (#objects replayWithoutFrames)-        (#names replayWithoutFrames)-        (#classes replayWithoutFrames)-        (#cache replayWithoutFrames))-+  pure+    (ReplayWithFrames+       (#version1 replayWithoutFrames)+       (#version2 replayWithoutFrames)+       (#label replayWithoutFrames)+       (#properties replayWithoutFrames)+       (#levels replayWithoutFrames)+       (#keyFrames replayWithoutFrames)+       (Parser.parseStream replayWithoutFrames)+       (#messages replayWithoutFrames)+       (#marks replayWithoutFrames)+       (#packages replayWithoutFrames)+       (#objects replayWithoutFrames)+       (#names replayWithoutFrames)+       (#classes replayWithoutFrames)+       (#cache replayWithoutFrames)) --- | Converts a 'ReplayWithFrames' into a 'ReplayWithoutFrames.ReplayWithoutFrames'.+-- | Converts a 'ReplayWithFrames' into a 'Replay.ReplayWithoutFrames'. -- Operates in a 'Monad' so that it can 'fail' somewhat gracefully.-toReplayWithoutFrames :: (Monad m) => ReplayWithFrames -> m ReplayWithoutFrames.ReplayWithoutFrames+toReplayWithoutFrames+  :: (Monad m)+  => ReplayWithFrames -> m Replay.ReplayWithoutFrames toReplayWithoutFrames replayWithFrames = do-    let stream = Generator.generateStream-            (#frames replayWithFrames)-            (#objects replayWithFrames)-            (#names replayWithFrames)-            (#classes replayWithFrames)-            (#cache replayWithFrames)-    pure (ReplayWithoutFrames.ReplayWithoutFrames-        (#version1 replayWithFrames)-        (#version2 replayWithFrames)-        (#label replayWithFrames)-        (#properties replayWithFrames)-        (#levels replayWithFrames)-        (#keyFrames replayWithFrames)-        stream-        (#messages replayWithFrames)-        (#marks replayWithFrames)-        (#packages replayWithFrames)-        (#objects replayWithFrames)-        (#names replayWithFrames)-        (#classes replayWithFrames)-        (#cache replayWithFrames))+  let stream =+        Generator.generateStream+          (#frames replayWithFrames)+          (#objects replayWithFrames)+          (#names replayWithFrames)+          (#classes replayWithFrames)+          (#cache replayWithFrames)+  pure+    (Replay.ReplayWithoutFrames+       (#version1 replayWithFrames)+       (#version2 replayWithFrames)+       (#label replayWithFrames)+       (#properties replayWithFrames)+       (#levels replayWithFrames)+       (#keyFrames replayWithFrames)+       stream+       (#messages replayWithFrames)+       (#marks replayWithFrames)+       (#packages replayWithFrames)+       (#objects replayWithFrames)+       (#names replayWithFrames)+       (#classes replayWithFrames)+       (#cache replayWithFrames))

@@ -9,10 +9,10 @@ {-# LANGUAGE TypeFamilies #-}  module Octane.Type.ReplayWithoutFrames-    ( ReplayWithoutFrames(..)-    , fromRawReplay-    , toRawReplay-    ) where+  ( ReplayWithoutFrames(..)+  , fromRawReplay+  , toRawReplay+  ) where  import qualified Control.DeepSeq as DeepSeq import qualified Data.Binary as Binary@@ -35,107 +35,104 @@ import qualified Octane.Type.Text as Text import qualified Octane.Type.Word32 as Word32 - -- | A partially-processed replay. This has parsed all of the high-level -- metadata, but it has not parsed any of the network stream. -- -- See 'Octane.Type.ReplayWithFrames.ReplayWithFrames'. data ReplayWithoutFrames = ReplayWithoutFrames-    { replayWithoutFramesVersion1 :: Word32.Word32-    , replayWithoutFramesVersion2 :: Word32.Word32-    , replayWithoutFramesLabel :: Text.Text-    , replayWithoutFramesProperties :: Dictionary.Dictionary Property.Property-    , replayWithoutFramesLevels :: List.List Text.Text-    , replayWithoutFramesKeyFrames :: List.List KeyFrame.KeyFrame-    , replayWithoutFramesStream :: Stream.Stream-    , replayWithoutFramesMessages :: List.List Message.Message-    , replayWithoutFramesMarks :: List.List Mark.Mark-    , replayWithoutFramesPackages :: List.List Text.Text-    , replayWithoutFramesObjects :: List.List Text.Text-    , replayWithoutFramesNames :: List.List Text.Text-    , replayWithoutFramesClasses :: List.List ClassItem.ClassItem-    , replayWithoutFramesCache :: List.List CacheItem.CacheItem-    } deriving (Eq, Generics.Generic, Show)+  { replayWithoutFramesVersion1 :: Word32.Word32+  , replayWithoutFramesVersion2 :: Word32.Word32+  , replayWithoutFramesLabel :: Text.Text+  , replayWithoutFramesProperties :: Dictionary.Dictionary Property.Property+  , replayWithoutFramesLevels :: List.List Text.Text+  , replayWithoutFramesKeyFrames :: List.List KeyFrame.KeyFrame+  , replayWithoutFramesStream :: Stream.Stream+  , replayWithoutFramesMessages :: List.List Message.Message+  , replayWithoutFramesMarks :: List.List Mark.Mark+  , replayWithoutFramesPackages :: List.List Text.Text+  , replayWithoutFramesObjects :: List.List Text.Text+  , replayWithoutFramesNames :: List.List Text.Text+  , replayWithoutFramesClasses :: List.List ClassItem.ClassItem+  , replayWithoutFramesCache :: List.List CacheItem.CacheItem+  } deriving (Eq, Generics.Generic, Show)  $(OverloadedRecords.overloadedRecord Default.def ''ReplayWithoutFrames)  instance Binary.Binary ReplayWithoutFrames where-    get = do-        rawReplay <- Binary.get-        fromRawReplay rawReplay--    put replayWithoutFrames = do-        rawReplay <- toRawReplay replayWithoutFrames-        Binary.put rawReplay--instance DeepSeq.NFData ReplayWithoutFrames where+  get = do+    rawReplay <- Binary.get+    fromRawReplay rawReplay+  put replayWithoutFrames = do+    rawReplay <- toRawReplay replayWithoutFrames+    Binary.put rawReplay +instance DeepSeq.NFData ReplayWithoutFrames  -- | Converts a 'RawReplay.RawReplay' into a 'ReplayWithoutFrames'. -- Operates in a 'Monad' so that it can 'fail' somewhat gracefully.-fromRawReplay :: (Monad m) => RawReplay.RawReplay -> m ReplayWithoutFrames+fromRawReplay+  :: (Monad m)+  => RawReplay.RawReplay -> m ReplayWithoutFrames fromRawReplay rawReplay = do-    let header = #header rawReplay-    let content = #content rawReplay--    let get = do-            version1 <- Binary.get-            version2 <- Binary.get-            label <- Binary.get-            properties <- Binary.get-            levels <- Binary.get-            keyFrames <- Binary.get-            stream <- Binary.get-            messages <- Binary.get-            marks <- Binary.get-            packages <- Binary.get-            objects <- Binary.get-            names <- Binary.get-            classes <- Binary.get-            cache <- Binary.get--            pure (ReplayWithoutFrames-                version1-                version2-                label-                properties-                levels-                keyFrames-                stream-                messages-                marks-                packages-                objects-                names-                classes-                cache)-    let bytes = LazyBytes.append header content--    pure (Binary.runGet get bytes)-+  let header = #header rawReplay+  let content = #content rawReplay+  let get = do+        version1 <- Binary.get+        version2 <- Binary.get+        label <- Binary.get+        properties <- Binary.get+        levels <- Binary.get+        keyFrames <- Binary.get+        stream <- Binary.get+        messages <- Binary.get+        marks <- Binary.get+        packages <- Binary.get+        objects <- Binary.get+        names <- Binary.get+        classes <- Binary.get+        cache <- Binary.get+        pure+          (ReplayWithoutFrames+             version1+             version2+             label+             properties+             levels+             keyFrames+             stream+             messages+             marks+             packages+             objects+             names+             classes+             cache)+  let bytes = LazyBytes.append header content+  pure (Binary.runGet get bytes)  -- | Converts a 'ReplayWithoutFrames' into a 'RawReplay.RawReplay'. -- Operates in a 'Monad' so that it can 'fail' somewhat gracefully.-toRawReplay :: (Monad m) => ReplayWithoutFrames -> m RawReplay.RawReplay+toRawReplay+  :: (Monad m)+  => ReplayWithoutFrames -> m RawReplay.RawReplay toRawReplay replay = do-    let header = Binary.runPut (do-            Binary.put (#version1 replay)-            Binary.put (#version2 replay)-            Binary.put (#label replay)-            Binary.put (#properties replay))--    let content = Binary.runPut (do-            Binary.put (#levels replay)-            Binary.put (#keyFrames replay)-            Binary.put (#stream replay)-            Binary.put (#messages replay)-            Binary.put (#marks replay)-            Binary.put (#packages replay)-            Binary.put (#objects replay)-            Binary.put (#names replay)-            Binary.put (#classes replay)-            Binary.put (#cache replay))--    let footer = LazyBytes.empty--    pure (RawReplay.newRawReplay header content footer)+  let header =+        Binary.runPut+          (do Binary.put (#version1 replay)+              Binary.put (#version2 replay)+              Binary.put (#label replay)+              Binary.put (#properties replay))+  let content =+        Binary.runPut+          (do Binary.put (#levels replay)+              Binary.put (#keyFrames replay)+              Binary.put (#stream replay)+              Binary.put (#messages replay)+              Binary.put (#marks replay)+              Binary.put (#packages replay)+              Binary.put (#objects replay)+              Binary.put (#names replay)+              Binary.put (#classes replay)+              Binary.put (#cache replay))+  let footer = LazyBytes.empty+  pure (RawReplay.newRawReplay header content footer)

@@ -7,7 +7,9 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -module Octane.Type.Replication (Replication(..)) where+module Octane.Type.Replication+  ( Replication(..)+  ) where  import qualified Control.DeepSeq as DeepSeq import qualified Data.Default.Class as Default@@ -20,27 +22,26 @@ import qualified Octane.Type.State as State import qualified Octane.Type.Value as Value - -- | A replicated actor in a frame. -- -- This cannot be an instance of 'Data.Binary.Bits.BinaryBit' because it -- requires out-of-band information (the class property map) to decode. data Replication = Replication-    { replicationActorId :: CompressedWord.CompressedWord+  { replicationActorId :: CompressedWord.CompressedWord     -- ^ The actor's ID.-    , replicationObjectName :: StrictText.Text+  , replicationObjectName :: StrictText.Text     -- ^ The name of the actor's object.-    , replicationClassName :: StrictText.Text+  , replicationClassName :: StrictText.Text     -- ^ The name of the actor's class.-    , replicationState :: State.State+  , replicationState :: State.State     -- ^ Which state this actor's replication is in.-    , replicationInitialization :: Maybe Initialization.Initialization+  , replicationInitialization :: Maybe Initialization.Initialization     -- ^ The optional initialization information for this actor. These only     -- exist for new actors.-    , replicationProperties :: Map.Map StrictText.Text Value.Value+  , replicationProperties :: Map.Map StrictText.Text Value.Value     -- ^ The property updates associated with this actor's replication.-    } deriving (Eq, Generics.Generic, Show)+  } deriving (Eq, Generics.Generic, Show)  $(OverloadedRecords.overloadedRecord Default.def ''Replication) -instance DeepSeq.NFData Replication where+instance DeepSeq.NFData Replication

@@ -1,19 +1,20 @@ {-# LANGUAGE DeriveGeneric #-} -module Octane.Type.State (State(..)) where+module Octane.Type.State+  ( State(..)+  ) where  import qualified Control.DeepSeq as DeepSeq import qualified GHC.Generics as Generics - -- | The state of an actor in a replication. data State-    = SOpening+  = SOpening     -- ^ This is a new actor that we have not seen before.-    | SExisting+  | SExisting     -- ^ We have seen this actor before.-    | SClosing+  | SClosing     -- ^ This actor is going away.-    deriving (Eq, Generics.Generic, Show)+  deriving (Eq, Generics.Generic, Show) -instance DeepSeq.NFData State where+instance DeepSeq.NFData State

@@ -7,7 +7,9 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -module Octane.Type.Stream (Stream(..)) where+module Octane.Type.Stream+  ( Stream(..)+  ) where  import Data.Function ((&)) @@ -23,43 +25,33 @@ import qualified Octane.Utility.Endian as Endian import qualified Text.Printf as Printf - -- | A stream of bits. newtype Stream = Stream-    { streamUnpack :: LazyBytes.ByteString-    } deriving (Eq, Generics.Generic)+  { streamUnpack :: LazyBytes.ByteString+  } deriving (Eq, Generics.Generic)  $(OverloadedRecords.overloadedRecord Default.def ''Stream)  -- | Prefixed by a length in bytes. Each byte is reversed such that -- @0b01234567@ is actually @0b76543210@.------ >>> Binary.decode "\x01\x00\x00\x00\x0f" :: Stream--- Stream {unpack = "1 byte"}------ >>> Binary.encode (Stream "\xf0")--- "\SOH\NUL\NUL\NUL\SI" instance Binary.Binary Stream where-    get = do-        size <- Binary.get-        content <- size & Word32.fromWord32 & Binary.getLazyByteString-        content & Endian.reverseBitsInLazyBytes & Stream & pure-    put stream = do-        let content = #unpack stream-        content & LazyBytes.length & Word32.toWord32 & Binary.put-        content & Endian.reverseBitsInLazyBytes & Binary.putLazyByteString+  get = do+    size <- Binary.get+    content <- size & Word32.fromWord32 & Binary.getLazyByteString+    content & Endian.reverseBitsInLazyBytes & Stream & pure+  put stream = do+    let content = #unpack stream+    content & LazyBytes.length & Word32.toWord32 & Binary.put+    content & Endian.reverseBitsInLazyBytes & Binary.putLazyByteString -instance DeepSeq.NFData Stream where+instance DeepSeq.NFData Stream  -- | Doesn't show the actual bytes to avoid dumping tons of text.------ >>> show (Stream "\x00")--- "Stream {unpack = \"1 byte\"}"------ >>> show (Stream "\x00\x00")--- "Stream {unpack = \"2 bytes\"}" instance Show Stream where-    show stream = do-        let size = stream & #unpack & LazyBytes.length-        let s = if size == 1 then "" else "s"-        Printf.printf "Stream {unpack = \"%d byte%s\"}" size s+  show stream = do+    let size = stream & #unpack & LazyBytes.length+    let s =+          if size == 1+            then ""+            else "s"+    Printf.printf "Stream {unpack = \"%d byte%s\"}" size s

@@ -8,7 +8,10 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -module Octane.Type.Text (Text(..), encodeLatin1) where+module Octane.Type.Text+  ( Text(..)+  , encodeLatin1+  ) where  import Data.Function ((&)) @@ -31,141 +34,97 @@ import qualified Octane.Type.Int32 as Int32 import qualified Octane.Utility.Endian as Endian --- $setup--- >>> import qualified Data.Binary.Get as Binary--- >>> import qualified Data.Binary.Put as Binary-- -- | A thin wrapper around 'StrictText.Text'. newtype Text = Text-    { textUnpack :: StrictText.Text-    } deriving (Eq, Generics.Generic, Ord)+  { textUnpack :: StrictText.Text+  } deriving (Eq, Generics.Generic, Ord)  $(OverloadedRecords.overloadedRecord Default.def ''Text)  -- | Text is both length-prefixed and null-terminated.------ >>> Binary.decode "\x02\x00\x00\x00\x4b\x00" :: Text--- "K"------ >>> Binary.encode ("K" :: Text)--- "\STX\NUL\NUL\NULK\NUL" instance Binary.Binary Text where-    get = getText-        Binary.get-        Binary.getByteString-        id--    put text = putText-        Binary.put-        Binary.putByteString-        id-        text+  get = getText Binary.get Binary.getByteString id+  put text = putText Binary.put Binary.putByteString id text  -- | Both length-prefixed and null-terminated. The bits in each byte are -- reversed.------ >>> Binary.runGet (BinaryBit.runBitGet (BinaryBit.getBits 0)) "\x40\x00\x00\x00\xd2\x00" :: Text--- "K"------ >>> Binary.runPut (BinaryBit.runBitPut (BinaryBit.putBits 0 ("K" :: Text)))--- "@\NUL\NUL\NUL\210\NUL" instance BinaryBit.BinaryBit Text where-    getBits _ = getText-        (BinaryBit.getBits 32)-        BinaryBit.getByteString-        Endian.reverseBitsInStrictBytes--    putBits _ text = putText-        (BinaryBit.putBits 32)-        BinaryBit.putByteString-        Endian.reverseBitsInStrictBytes-        text+  getBits _ = getText (BinaryBit.getBits 32) BinaryBit.getByteString Endian.reverseBitsInStrictBytes+  putBits _ text =+    putText+      (BinaryBit.putBits 32)+      BinaryBit.putByteString+      Endian.reverseBitsInStrictBytes+      text  -- | Allows you to write 'Text' as string literals with @OverloadedStrings@. -- Also allows using the 'String.fromString' helper function.------ >>> "K" :: Text--- "K" instance String.IsString Text where-    fromString string = Text (StrictText.pack string)+  fromString string = Text (StrictText.pack string) -instance DeepSeq.NFData Text where+instance DeepSeq.NFData Text  -- | Shown as a string literal, like @"this"@.------ >>> show ("K" :: Text)--- "\"K\"" instance Show Text where-    show text = show (#unpack text)+  show text = show (#unpack text)  -- | Encoded directly as a JSON string.------ >>> Aeson.encode ("K" :: Text)--- "\"K\"" instance Aeson.ToJSON Text where-    toJSON text = text-        & #unpack-        & Aeson.toJSON-+  toJSON text = text & #unpack & Aeson.toJSON  getText-    :: (Monad m)-    => (m Int32.Int32)-    -> (Int -> m StrictBytes.ByteString)-    -> (StrictBytes.ByteString -> StrictBytes.ByteString)-    -> m Text+  :: (Monad m)+  => (m Int32.Int32)+  -> (Int -> m StrictBytes.ByteString)+  -> (StrictBytes.ByteString -> StrictBytes.ByteString)+  -> m Text getText getInt getBytes convertBytes = do-    (Int32.Int32 rawSize) <- getInt-    (size, decode) <--        -- In some tiny percentage of replays, this nonsensical string size-        -- shows up. As far as I can tell the next 3 bytes are always null. And-        -- the actual string is "None", which is 5 bytes including the null-        -- terminator.-        ---        -- These annoying replays come from around 2015-10-25 to 2015-11-01.-        if rawSize == 0x05000000-        then do-            bytes <- getBytes 3-            if StrictBytes.all (== '\0') bytes-                then pure (5, Encoding.decodeLatin1)-                else fail ("Unexpected Text bytes " ++ show bytes ++ " after size " ++ show rawSize)-        else if rawSize < 0-        then pure (-2 * fromIntegral rawSize, Encoding.decodeUtf16LE)-        else pure (fromIntegral rawSize, Encoding.decodeLatin1)-    bytes <- getBytes size-    let rawText = bytes & convertBytes & decode-    case StrictText.splitAt (StrictText.length rawText - 1) rawText of-        (text, "") -> text & Text & pure-        (text, "\0") -> text & Text & pure-        _ -> fail ("Unexpected Text value " ++ show rawText)-+  (Int32.Int32 rawSize) <- getInt+  (size, decode)+  -- In some tiny percentage of replays, this nonsensical string size+  -- shows up. As far as I can tell the next 3 bytes are always null. And+  -- the actual string is "None", which is 5 bytes including the null+  -- terminator.+  --+  -- These annoying replays come from around 2015-10-25 to 2015-11-01.+     <-+    if rawSize == 0x05000000+      then do+        bytes <- getBytes 3+        if StrictBytes.all (== '\0') bytes+          then pure (5, Encoding.decodeLatin1)+          else fail+                 ("Unexpected Text bytes " +++                  show bytes ++ " after size " ++ show rawSize)+      else if rawSize < 0+             then pure (-2 * fromIntegral rawSize, Encoding.decodeUtf16LE)+             else pure (fromIntegral rawSize, Encoding.decodeLatin1)+  bytes <- getBytes size+  let rawText = bytes & convertBytes & decode+  case StrictText.splitAt (StrictText.length rawText - 1) rawText of+    (text, "") -> text & Text & pure+    (text, "\0") -> text & Text & pure+    _ -> fail ("Unexpected Text value " ++ show rawText)  putText-    :: (Monad m)-    => (Int32.Int32 -> m ())-    -> (StrictBytes.ByteString -> m ())-    -> (StrictBytes.ByteString -> StrictBytes.ByteString)-    -> Text-    -> m ()+  :: (Monad m)+  => (Int32.Int32 -> m ())+  -> (StrictBytes.ByteString -> m ())+  -> (StrictBytes.ByteString -> StrictBytes.ByteString)+  -> Text+  -> m () putText putInt putBytes convertBytes text = do-    let fullText = text & #unpack & flip StrictText.snoc '\NUL'-    let size = fullText & StrictText.length & fromIntegral-    if StrictText.all Char.isLatin1 fullText+  let fullText = text & #unpack & flip StrictText.snoc '\NUL'+  let size = fullText & StrictText.length & fromIntegral+  if StrictText.all Char.isLatin1 fullText     then do-        size & Int32.Int32 & putInt-        fullText & encodeLatin1 & convertBytes & putBytes+      size & Int32.Int32 & putInt+      fullText & encodeLatin1 & convertBytes & putBytes     else do-        size & negate & Int32.Int32 & putInt-        fullText & Encoding.encodeUtf16LE & convertBytes & putBytes-+      size & negate & Int32.Int32 & putInt+      fullText & Encoding.encodeUtf16LE & convertBytes & putBytes  -- | Encodes text as Latin-1. Note that this isn't really safe if the text has -- characters that can't be encoded in Latin-1.------ >>> encodeLatin1 "A"--- "A" encodeLatin1 :: StrictText.Text -> StrictBytes.ByteString-encodeLatin1 text = text-    & StrictText.unpack-    & StrictBytes.pack+encodeLatin1 text = text & StrictText.unpack & StrictBytes.pack

@@ -1,10 +1,51 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StrictData #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-} -module Octane.Type.Value (Value(..)) where+module Octane.Type.Value+  ( Value(..)+  , BooleanValue(..)+  , ByteValue(..)+  , CamSettingsValue(..)+  , DemolishValue(..)+  , EnumValue(..)+  , ExplosionValue(..)+  , FlaggedIntValue(..)+  , FloatValue(..)+  , GameModeValue(..)+  , IntValue(..)+  , LoadoutValue(..)+  , LoadoutOnlineValue(..)+  , LocationValue(..)+  , MusicStingerValue(..)+  , PickupValue(..)+  , PrivateMatchSettingsValue(..)+  , QWordValue(..)+  , RelativeRotationValue(..)+  , ReservationValue(..)+  , RigidBodyStateValue(..)+  , StringValue(..)+  , TeamPaintValue(..)+  , UniqueIdValue(..)+  ) where +import Data.Aeson ((.=))+ import qualified Control.DeepSeq as DeepSeq+import qualified Data.Aeson as Aeson+import qualified Data.Bimap as Bimap+import qualified Data.Default.Class as Default+import qualified Data.OverloadedRecords.TH as OverloadedRecords+import qualified Data.Text as StrictText import qualified GHC.Generics as Generics+import qualified Octane.Data as Data import qualified Octane.Type.Boolean as Boolean import qualified Octane.Type.CompressedWord as CompressedWord import qualified Octane.Type.Float32 as Float32@@ -17,103 +58,399 @@ import qualified Octane.Type.Word64 as Word64 import qualified Octane.Type.Word8 as Word8 +newtype BooleanValue = BooleanValue+  { booleanValueUnpack :: Boolean.Boolean+  } deriving (Eq, Generics.Generic, Show) --- TODO: Split these into individual data types like RemoteId.+instance DeepSeq.NFData BooleanValue++newtype ByteValue = ByteValue+  { byteValueUnpack :: Word8.Word8+  } deriving (Eq, Generics.Generic, Show)++instance DeepSeq.NFData ByteValue++data CamSettingsValue = CamSettingsValue+  { camSettingsValueFov :: Float32.Float32+  , camSettingsValueHeight :: Float32.Float32+  , camSettingsValueAngle :: Float32.Float32+  , camSettingsValueDistance :: Float32.Float32+  , camSettingsValueStiffness :: Float32.Float32+  , camSettingsValueSwivelSpeed :: Float32.Float32+  } deriving (Eq, Generics.Generic, Show)++instance DeepSeq.NFData CamSettingsValue++data DemolishValue = DemolishValue+  { demolishValueAttackerFlag :: Boolean.Boolean+  , demolishValueAttackerActorId :: Word32.Word32+  , demolishValueVictimFlag :: Boolean.Boolean+  , demolishValueVictimActorId :: Word32.Word32+  , demolishValueAttackerVelocity :: Vector.Vector Int+  , demolishValueVictimVelocity :: Vector.Vector Int+  } deriving (Eq, Generics.Generic, Show)++instance DeepSeq.NFData DemolishValue++data EnumValue = EnumValue+  { enumValueValue :: Word16.Word16+  , enumValueFlag :: Boolean.Boolean+  } deriving (Eq, Generics.Generic, Show)++instance DeepSeq.NFData EnumValue++data ExplosionValue = ExplosionValue+  { explosionValueActorless :: Boolean.Boolean+  , explosionValueActorId :: Maybe Int32.Int32+  , explosionValuePosition :: Vector.Vector Int+  } deriving (Eq, Generics.Generic, Show)++instance DeepSeq.NFData ExplosionValue++data FlaggedIntValue = FlaggedIntValue+  { flaggedIntValueFlag :: Boolean.Boolean+  , flaggedIntValueInt :: Int32.Int32+  } deriving (Eq, Generics.Generic, Show)++instance DeepSeq.NFData FlaggedIntValue++newtype FloatValue = FloatValue+  { floatValueUnpack :: Float32.Float32+  } deriving (Eq, Generics.Generic, Show)++instance DeepSeq.NFData FloatValue++newtype GameModeValue = GameModeValue+  { gameModeValueUnpack :: Word8.Word8+  } deriving (Eq, Generics.Generic, Show)++instance DeepSeq.NFData GameModeValue++newtype IntValue = IntValue+  { intValueUnpack :: Int32.Int32+  } deriving (Eq, Generics.Generic, Show)++instance DeepSeq.NFData IntValue++data LoadoutValue = LoadoutValue+  { loadoutValueVersion :: Word8.Word8+  , loadoutValueBody :: Word32.Word32+  , loadoutValueDecal :: Word32.Word32+  , loadoutValueWheels :: Word32.Word32+  , loadoutValueRocketTrail :: Word32.Word32+  , loadoutValueAntenna :: Word32.Word32+  , loadoutValueTopper :: Word32.Word32+  , loadoutValueUnknown1 :: Word32.Word32+  , loadoutValueUnknown2 :: Maybe Word32.Word32+  } deriving (Eq, Generics.Generic, Show)++instance DeepSeq.NFData LoadoutValue++newtype LoadoutOnlineValue = LoadoutOnlineValue+  { loadoutOnlineValueUnpack :: [[(Word32.Word32, CompressedWord.CompressedWord)]]+  } deriving (Eq, Generics.Generic, Show)++instance DeepSeq.NFData LoadoutOnlineValue++newtype LocationValue = LocationValue+  { locationValueUnpack :: Vector.Vector Int+  } deriving (Eq, Generics.Generic, Show)++instance DeepSeq.NFData LocationValue++data MusicStingerValue = MusicStingerValue+  { musicStingerValueFlag :: Boolean.Boolean+  , musicStingerValueCue :: Word32.Word32+  , musicStingerValueTrigger :: Word8.Word8+  } deriving (Eq, Generics.Generic, Show)++instance DeepSeq.NFData MusicStingerValue++data PickupValue = PickupValue+  { pickupValueHasInstigator :: Boolean.Boolean+  , pickupValueInstigatorId :: Maybe Word32.Word32+  , pickupValuePickedUp :: Boolean.Boolean+  } deriving (Eq, Generics.Generic, Show)++instance DeepSeq.NFData PickupValue++data PrivateMatchSettingsValue = PrivateMatchSettingsValue+  { privateMatchSettingsValueMutators :: Text.Text+  , privateMatchSettingsValueJoinableBy :: Word32.Word32+  , privateMatchSettingsValueMaxPlayers :: Word32.Word32+  , privateMatchSettingsValueGameName :: Text.Text+  , privateMatchSettingsValuePassword :: Text.Text+  , privateMatchSettingsValueFlag :: Boolean.Boolean+  } deriving (Eq, Generics.Generic, Show)++instance DeepSeq.NFData PrivateMatchSettingsValue++newtype QWordValue = QWordValue+  { qWordValueUnpack :: Word64.Word64+  } deriving (Eq, Generics.Generic, Show)++instance DeepSeq.NFData QWordValue++newtype RelativeRotationValue = RelativeRotationValue+  { relativeRotationValueUnpack :: Vector.Vector Float+  } deriving (Eq, Generics.Generic, Show)++instance DeepSeq.NFData RelativeRotationValue++data ReservationValue = ReservationValue+  { reservationValueNumber :: CompressedWord.CompressedWord+  , reservationValueSystemId :: Word8.Word8+  , reservationValueRemoteId :: RemoteId.RemoteId+  , reservationValueLocalId :: Maybe Word8.Word8+  , reservationValuePlayerName :: Maybe Text.Text+  , reservationValueUnknown1 :: Boolean.Boolean+  , reservationValueUnknown2 :: Boolean.Boolean+  } deriving (Eq, Generics.Generic, Show)++instance DeepSeq.NFData ReservationValue++data RigidBodyStateValue = RigidBodyStateValue+  { rigidBodyStateValueSleeping :: Boolean.Boolean+  , rigidBodyStateValuePosition :: Vector.Vector Int+  , rigidBodyStateValueRotation :: Vector.Vector Float+  , rigidBodyStateValueLinearVelocity :: Maybe (Vector.Vector Int)+  , rigidBodyStateValueAngularVelocity :: Maybe (Vector.Vector Int)+  } deriving (Eq, Generics.Generic, Show)++instance DeepSeq.NFData RigidBodyStateValue++newtype StringValue = StringValue+  { stringValueUnpack :: Text.Text+  } deriving (Eq, Generics.Generic, Show)++instance DeepSeq.NFData StringValue++data TeamPaintValue = TeamPaintValue+  { teamPaintValueTeam :: Word8.Word8+  , teamPaintValuePrimaryColor :: Word8.Word8+  , teamPaintValueAccentColor :: Word8.Word8+  , teamPaintValuePrimaryFinish :: Word32.Word32+  , teamPaintValueAccentFinish :: Word32.Word32+  } deriving (Eq, Generics.Generic, Show)++instance DeepSeq.NFData TeamPaintValue++data UniqueIdValue = UniqueIdValue+  { uniqueIdValueSystemId :: Word8.Word8+  , uniqueIdValueRemoteId :: RemoteId.RemoteId+  , uniqueIdValueLocalId :: Maybe Word8.Word8+  } deriving (Eq, Generics.Generic, Show)++instance DeepSeq.NFData UniqueIdValue+ -- | A replicated property's value. data Value-    = VBoolean-        Boolean.Boolean-    | VByte-        Word8.Word8-    | VCamSettings-        Float32.Float32-        Float32.Float32-        Float32.Float32-        Float32.Float32-        Float32.Float32-        Float32.Float32-    | VDemolish-        Boolean.Boolean-        Word32.Word32-        Boolean.Boolean-        Word32.Word32-        (Vector.Vector Int)-        (Vector.Vector Int)-    | VEnum-        Word16.Word16-        Boolean.Boolean-    | VExplosion-        Boolean.Boolean-        (Maybe Int32.Int32)-        (Vector.Vector Int)-    | VFlaggedInt-        Boolean.Boolean-        Int32.Int32-    | VFloat-        Float32.Float32-    | VGameMode-        Word8.Word8-    | VInt-        Int32.Int32-    | VLoadout-        Word8.Word8-        Word32.Word32-        Word32.Word32-        Word32.Word32-        Word32.Word32-        Word32.Word32-        Word32.Word32-        Word32.Word32-        (Maybe Word32.Word32)-    | VLoadoutOnline-        [[(Word32.Word32, CompressedWord.CompressedWord)]]-    | VLocation-        (Vector.Vector Int)-    | VMusicStinger-        Boolean.Boolean-        Word32.Word32-        Word8.Word8-    | VPickup-        Boolean.Boolean-        (Maybe Word32.Word32)-        Boolean.Boolean-    | VPrivateMatchSettings-        Text.Text-        Word32.Word32-        Word32.Word32-        Text.Text-        Text.Text-        Boolean.Boolean-    | VQWord-        Word64.Word64-    | VRelativeRotation-        (Vector.Vector Float)-    | VReservation-        CompressedWord.CompressedWord-        Word8.Word8-        RemoteId.RemoteId-        (Maybe Word8.Word8)-        (Maybe Text.Text)-        Boolean.Boolean-        Boolean.Boolean-    | VRigidBodyState-        Boolean.Boolean-        (Vector.Vector Int)-        (Vector.Vector Float)-        (Maybe (Vector.Vector Int))-        (Maybe (Vector.Vector Int))-    | VString-        Text.Text-    | VTeamPaint-        Word8.Word8-        Word8.Word8-        Word8.Word8-        Word32.Word32-        Word32.Word32-    | VUniqueId-        Word8.Word8-        RemoteId.RemoteId-        (Maybe Word8.Word8)-    deriving (Eq, Generics.Generic, Show)+  = ValueBoolean BooleanValue+  | ValueByte ByteValue+  | ValueCamSettings CamSettingsValue+  | ValueDemolish DemolishValue+  | ValueEnum EnumValue+  | ValueExplosion ExplosionValue+  | ValueFlaggedInt FlaggedIntValue+  | ValueFloat FloatValue+  | ValueGameMode GameModeValue+  | ValueInt IntValue+  | ValueLoadout LoadoutValue+  | ValueLoadoutOnline LoadoutOnlineValue+  | ValueLocation LocationValue+  | ValueMusicStinger MusicStingerValue+  | ValuePickup PickupValue+  | ValuePrivateMatchSettings PrivateMatchSettingsValue+  | ValueQWord QWordValue+  | ValueRelativeRotation RelativeRotationValue+  | ValueReservation ReservationValue+  | ValueRigidBodyState RigidBodyStateValue+  | ValueString StringValue+  | ValueTeamPaint TeamPaintValue+  | ValueUniqueId UniqueIdValue+  deriving (Eq, Generics.Generic, Show) -instance DeepSeq.NFData Value where+$(OverloadedRecords.overloadedRecords+    Default.def+    [ ''BooleanValue+    , ''ByteValue+    , ''CamSettingsValue+    , ''DemolishValue+    , ''EnumValue+    , ''ExplosionValue+    , ''FlaggedIntValue+    , ''FloatValue+    , ''GameModeValue+    , ''IntValue+    , ''LoadoutValue+    , ''LoadoutOnlineValue+    , ''LocationValue+    , ''MusicStingerValue+    , ''PickupValue+    , ''PrivateMatchSettingsValue+    , ''QWordValue+    , ''RelativeRotationValue+    , ''ReservationValue+    , ''RigidBodyStateValue+    , ''StringValue+    , ''TeamPaintValue+    , ''UniqueIdValue+    ])++instance DeepSeq.NFData Value++instance Aeson.ToJSON Value where+  toJSON value =+    Aeson.object ["Type" .= typeName value, "Value" .= jsonValue value]++typeName :: Value -> StrictText.Text+typeName value =+  case value of+    ValueBoolean _ -> "Boolean"+    ValueByte _ -> "Byte"+    ValueCamSettings _ -> "CameraSettings"+    ValueDemolish _ -> "Demolition"+    ValueEnum _ -> "Enum"+    ValueExplosion _ -> "Explosion"+    ValueFlaggedInt _ -> "FlaggedInt"+    ValueFloat _ -> "Float"+    ValueGameMode _ -> "GameMode"+    ValueInt _ -> "Int"+    ValueLoadout _ -> "Loadout"+    ValueLoadoutOnline _ -> "OnlineLoadout"+    ValueLocation _ -> "Position"+    ValueMusicStinger _ -> "MusicStinger"+    ValuePickup _ -> "Pickup"+    ValuePrivateMatchSettings _ -> "PrivateMatchSettings"+    ValueQWord _ -> "QWord"+    ValueRelativeRotation _ -> "RelativeRotation"+    ValueReservation _ -> "Reservation"+    ValueRigidBodyState _ -> "RigidBodyState"+    ValueString _ -> "String"+    ValueTeamPaint _ -> "Paint"+    ValueUniqueId _ -> "UniqueId"++jsonValue :: Value -> Aeson.Value+jsonValue value =+  case value of+    ValueBoolean x -> Aeson.toJSON (#unpack x)+    ValueByte x -> Aeson.toJSON (#unpack x)+    ValueCamSettings x ->+      Aeson.object+        [ "FOV" .= #fov x+        , "Height" .= #height x+        , "Angle" .= #angle x+        , "Distance" .= #distance x+        , "Stiffness" .= #stiffness x+        , "SwivelSpeed" .= #swivelSpeed x+        ]+    ValueDemolish x ->+      Aeson.object+        [ "AttackerFlag" .= #attackerFlag x+        , "AttackerActorId" .= #attackerActorId x+        , "VictimFlag" .= #victimFlag x+        , "VictimActorId" .= #victimActorId x+        , "AttackerVelocity" .= #attackerVelocity x+        , "VictimVelocity" .= #victimVelocity x+        ]+    ValueEnum x -> Aeson.object ["Value" .= #value x, "Flag" .= #flag x]+    ValueExplosion x ->+      Aeson.object+        [ "Actorless" .= #actorless x+        , "ActorId" .= #actorId x+        , "Position" .= #position x+        ]+    ValueFlaggedInt x -> Aeson.object ["Flag" .= #flag x, "Int" .= #int x]+    ValueFloat x -> Aeson.toJSON (#unpack x)+    ValueGameMode x ->+      Aeson.object ["Id" .= #unpack x, "Name" .= getGameMode (#unpack x)]+    ValueInt x -> Aeson.toJSON (#unpack x)+    ValueLoadout x ->+      Aeson.object+        [ "Version" .= #version x+        , "Body" .=+          Aeson.object ["Id" .= #body x, "Name" .= getProduct (#body x)]+        , "Decal" .=+          Aeson.object ["Id" .= #decal x, "Name" .= getProduct (#decal x)]+        , "Wheels" .=+          Aeson.object ["Id" .= #wheels x, "Name" .= getProduct (#wheels x)]+        , "RocketTrail" .=+          Aeson.object+            ["Id" .= #rocketTrail x, "Name" .= getProduct (#rocketTrail x)]+        , "Antenna" .=+          Aeson.object ["Id" .= #antenna x, "Name" .= getProduct (#antenna x)]+        , "Topper" .=+          Aeson.object ["Id" .= #topper x, "Name" .= getProduct (#topper x)]+        , "Unknown1" .= #unknown1 x+        , "Unknown2" .= #unknown2 x+        ]+    ValueLoadoutOnline x -> Aeson.toJSON (#unpack x)+    ValueLocation x -> Aeson.toJSON (#unpack x)+    ValueMusicStinger x ->+      Aeson.object ["Flag" .= #flag x, "Cue" .= #cue x, "Trigger" .= #trigger x]+    ValuePickup x ->+      Aeson.object+        [ "HasInstigator" .= #hasInstigator x+        , "InstigatorId" .= #instigatorId x+        , "PickedUp" .= #pickedUp x+        ]+    ValuePrivateMatchSettings x ->+      Aeson.object+        [ "Mutators" .= #mutators x+        , "JoinableBy" .= #joinableBy x+        , "MaxPlayers" .= #maxPlayers x+        , "Name" .= #gameName x+        , "Password" .= #password x+        , "Unknown" .= #flag x+        ]+    ValueQWord x -> Aeson.toJSON (#unpack x)+    ValueRelativeRotation x -> Aeson.toJSON (#unpack x)+    ValueReservation x ->+      Aeson.object+        [ "Number" .= #number x+        , "SystemId" .= #systemId x+        , "RemoteId" .= #remoteId x+        , "LocalId" .= #localId x+        , "Name" .= #playerName x+        , "Unknown1" .= #unknown1 x+        , "Unknown2" .= #unknown2 x+        ]+    ValueRigidBodyState x ->+      Aeson.object+        [ "Sleeping" .= #sleeping x+        , "Position" .= #position x+        , "Rotation" .= #rotation x+        , "LinearVelocity" .= #linearVelocity x+        , "AngularVelocity" .= #angularVelocity x+        ]+    ValueString x -> Aeson.toJSON (#unpack x)+    ValueTeamPaint x ->+      Aeson.object+        [ "Team" .= #team x+        , "PrimaryColor" .= #primaryColor x+        , "AccentColor" .= #accentColor x+        , "PrimaryFinish" .=+          Aeson.object+            ["Id" .= #primaryFinish x, "Name" .= getProduct (#primaryFinish x)]+        , "AccentFinish" .=+          Aeson.object+            ["Id" .= #accentFinish x, "Name" .= getProduct (#accentFinish x)]+        ]+    ValueUniqueId x ->+      Aeson.object+        [ "System" .=+          case #systemId x of+            0 -> "Local"+            1 -> "Steam"+            2 -> "PlayStation"+            4 -> "Xbox"+            y -> "Unknown system " ++ show y+        , "Remote" .= #remoteId x+        , "Local" .= #localId x+        ]++getGameMode :: Word8.Word8 -> Maybe StrictText.Text+getGameMode x = Bimap.lookup (Word8.fromWord8 x) Data.gameModes++getProduct :: Word32.Word32 -> Maybe StrictText.Text+getProduct x = Bimap.lookup (Word32.fromWord32 x) Data.products

@@ -10,13 +10,13 @@ {-# LANGUAGE TypeFamilies #-}  module Octane.Type.Vector-    ( Vector(..)-    , getFloatVector-    , getInt8Vector-    , getIntVector-    , putInt8Vector-    , putIntVector-    ) where+  ( Vector(..)+  , getFloatVector+  , getInt8Vector+  , getIntVector+  , putInt8Vector+  , putIntVector+  ) where  import qualified Control.DeepSeq as DeepSeq import qualified Data.Aeson as Aeson@@ -31,7 +31,6 @@ import qualified Octane.Type.CompressedWord as CompressedWord import qualified Octane.Type.Int8 as Int8 - -- | Three values packed together. Although the fields are called @x@, @y@, and -- @z@, that may not be what they actually represent. --@@ -39,90 +38,88 @@ -- always serialized the same way. Sometimes it is three values run together, -- but other times it has a flag for the presence of each value. data Vector a = Vector-    { vectorX :: a-    , vectorY :: a-    , vectorZ :: a-    } deriving (Eq, Generics.Generic, Show)+  { vectorX :: a+  , vectorY :: a+  , vectorZ :: a+  } deriving (Eq, Generics.Generic, Show)  $(OverloadedRecords.overloadedRecord Default.def ''Vector) -instance (DeepSeq.NFData a) => DeepSeq.NFData (Vector a) where+instance (DeepSeq.NFData a) =>+         DeepSeq.NFData (Vector a)  -- | Encoded as a JSON array with 3 elements. -- -- Aeson.encode (Vector 1 2 3 :: Vector Int) -- "[1,2,3]"-instance (Aeson.ToJSON a) => Aeson.ToJSON (Vector a) where-    toJSON vector = Aeson.toJSON [#x vector, #y vector, #z vector]-+instance (Aeson.ToJSON a) =>+         Aeson.ToJSON (Vector a) where+  toJSON vector = Aeson.toJSON [#x vector, #y vector, #z vector]  -- | Gets a 'Vector' full of 'Float's. getFloatVector :: BinaryBit.BitGet (Vector Float) getFloatVector = do-    let maxValue = 1-    let numBits = 16--    x <- getFloat maxValue numBits-    y <- getFloat maxValue numBits-    z <- getFloat maxValue numBits--    pure (Vector x y z)-+  let maxValue = 1+  let numBits = 16+  x <- getFloat maxValue numBits+  y <- getFloat maxValue numBits+  z <- getFloat maxValue numBits+  pure (Vector x y z)  getFloat :: Int -> Int -> BinaryBit.BitGet Float getFloat maxValue numBits = do-    let maxBitValue = (Bits.shiftL 1 (numBits - 1)) - 1-    let bias = Bits.shiftL 1 (numBits - 1)-    let serIntMax = Bits.shiftL 1 numBits-    delta <- fmap CompressedWord.fromCompressedWord (BinaryBit.getBits serIntMax)-    let unscaledValue = (delta :: Int) - bias-    if maxValue > maxBitValue+  let maxBitValue = (Bits.shiftL 1 (numBits - 1)) - 1+  let bias = Bits.shiftL 1 (numBits - 1)+  let serIntMax = Bits.shiftL 1 numBits+  delta <- fmap CompressedWord.fromCompressedWord (BinaryBit.getBits serIntMax)+  let unscaledValue = (delta :: Int) - bias+  if maxValue > maxBitValue     then do-        let invScale = fromIntegral maxValue / fromIntegral maxBitValue-        pure (fromIntegral unscaledValue * invScale)+      let invScale = fromIntegral maxValue / fromIntegral maxBitValue+      pure (fromIntegral unscaledValue * invScale)     else do-        let scale = fromIntegral maxBitValue / fromIntegral maxValue-        let invScale = 1.0 / scale-        pure (fromIntegral unscaledValue * invScale)-+      let scale = fromIntegral maxBitValue / fromIntegral maxValue+      let invScale = 1.0 / scale+      pure (fromIntegral unscaledValue * invScale)  -- | Gets a 'Vector' full of 'Int8's. getInt8Vector :: BinaryBit.BitGet (Vector Int8.Int8) getInt8Vector = do-    (hasX :: Boolean.Boolean) <- BinaryBit.getBits 0-    x <- if #unpack hasX then BinaryBit.getBits 0 else pure 0--    (hasY :: Boolean.Boolean) <- BinaryBit.getBits 0-    y <- if #unpack hasY then BinaryBit.getBits 0 else pure 0--    (hasZ :: Boolean.Boolean) <- BinaryBit.getBits 0-    z <- if #unpack hasZ then BinaryBit.getBits 0 else pure 0--    pure (Vector x y z)-+  (hasX :: Boolean.Boolean) <- BinaryBit.getBits 0+  x <-+    if #unpack hasX+      then BinaryBit.getBits 0+      else pure 0+  (hasY :: Boolean.Boolean) <- BinaryBit.getBits 0+  y <-+    if #unpack hasY+      then BinaryBit.getBits 0+      else pure 0+  (hasZ :: Boolean.Boolean) <- BinaryBit.getBits 0+  z <-+    if #unpack hasZ+      then BinaryBit.getBits 0+      else pure 0+  pure (Vector x y z)  -- | Gets a 'Vector' full of 'Int's. getIntVector :: BinaryBit.BitGet (Vector Int) getIntVector = do-    numBits <- fmap CompressedWord.fromCompressedWord (BinaryBit.getBits 19)-    let bias = Bits.shiftL 1 (numBits + 1)-    let maxBits = numBits + 2-    let maxValue = 2 ^ maxBits--    dx <- fmap CompressedWord.fromCompressedWord (BinaryBit.getBits maxValue)-    dy <- fmap CompressedWord.fromCompressedWord (BinaryBit.getBits maxValue)-    dz <- fmap CompressedWord.fromCompressedWord (BinaryBit.getBits maxValue)--    pure (Vector (dx - bias) (dy - bias) (dz - bias))-+  numBits <- fmap CompressedWord.fromCompressedWord (BinaryBit.getBits 19)+  let bias = Bits.shiftL 1 (numBits + 1)+  let maxBits = numBits + 2+  let maxValue = 2 ^ maxBits+  dx <- fmap CompressedWord.fromCompressedWord (BinaryBit.getBits maxValue)+  dy <- fmap CompressedWord.fromCompressedWord (BinaryBit.getBits maxValue)+  dz <- fmap CompressedWord.fromCompressedWord (BinaryBit.getBits maxValue)+  pure (Vector (dx - bias) (dy - bias) (dz - bias))  -- | Puts a 'Vector' full of 'Int8's. putInt8Vector :: Vector Int8.Int8 -> BinaryBit.BitPut () putInt8Vector _ = do-    pure () -- TODO-+  pure () -- TODO  -- | Puts a 'Vector' full of 'Int's. putIntVector :: Vector Int -> BinaryBit.BitPut () putIntVector _ = do-    pure () -- TODO+  pure () -- TODO

@@ -8,7 +8,11 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -module Octane.Type.Word16 (Word16(..), fromWord16, toWord16) where+module Octane.Type.Word16+  ( Word16(..)+  , fromWord16+  , toWord16+  ) where  import Data.Function ((&)) @@ -23,66 +27,40 @@ import qualified GHC.Generics as Generics import qualified Text.Printf as Printf - -- | A 16-bit unsigned integer. newtype Word16 = Word16-    { word16Unpack :: Word.Word16-    } deriving (Eq, Generics.Generic, Num, Ord)+  { word16Unpack :: Word.Word16+  } deriving (Eq, Generics.Generic, Num, Ord)  $(OverloadedRecords.overloadedRecord Default.def ''Word16)  -- | Little-endian.------ >>> Binary.decode "\x01\x00" :: Word16--- 0x0001------ >>> Binary.encode (1 :: Word16)--- "\SOH\NUL" instance Binary.Binary Word16 where-    get = do-        value <- Binary.getWord16le-        pure (Word16 value)--    put word16 = do-        let value = #unpack word16-        Binary.putWord16le value+  get = do+    value <- Binary.getWord16le+    pure (Word16 value)+  put word16 = do+    let value = #unpack word16+    Binary.putWord16le value -instance DeepSeq.NFData Word16 where+instance DeepSeq.NFData Word16  -- | Shown as @0x0102@.------ >>> show (1 :: Word16)--- "0x0001" instance Show Word16 where-    show word16 = Printf.printf "0x%04x" (#unpack word16)+  show word16 = Printf.printf "0x%04x" (#unpack word16)  -- | Encoded as a JSON number.------ >>> Aeson.encode (1 :: Word16)--- "1" instance Aeson.ToJSON Word16 where-    toJSON word16 = word16-        & #unpack-        & Aeson.toJSON-+  toJSON word16 = word16 & #unpack & Aeson.toJSON  -- | Converts a 'Word16' into any 'Integral' value.------ >>> fromWord16 0x0001 :: Word.Word16--- 1------ >>> fromWord16 0xffff :: Data.Int.Int16--- -1-fromWord16 :: (Integral a) => Word16 -> a+fromWord16+  :: (Integral a)+  => Word16 -> a fromWord16 word16 = fromIntegral (#unpack word16) - -- | Converts any 'Integral' value into a 'Word16'.------ >>> toWord16 (1 :: Word.Word16)--- 0x0001------ >>> toWord16 (-1 :: Data.Int.Int16)--- 0xffff-toWord16 :: (Integral a) => a -> Word16+toWord16+  :: (Integral a)+  => a -> Word16 toWord16 value = Word16 (fromIntegral value)

@@ -8,7 +8,11 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -module Octane.Type.Word32 (Word32(..), fromWord32, toWord32) where+module Octane.Type.Word32+  ( Word32(..)+  , fromWord32+  , toWord32+  ) where  import Data.Function ((&)) @@ -28,93 +32,52 @@ import qualified Octane.Utility.Endian as Endian import qualified Text.Printf as Printf --- $setup--- >>> import qualified Data.Binary.Get as Binary--- >>> import qualified Data.Binary.Put as Binary-- -- | A 32-bit unsigned integer. newtype Word32 = Word32-    { word32Unpack :: Word.Word32-    } deriving (Eq, Generics.Generic, Num, Ord)+  { word32Unpack :: Word.Word32+  } deriving (Eq, Generics.Generic, Num, Ord)  $(OverloadedRecords.overloadedRecord Default.def ''Word32)  -- | Little-endian.------ >>> Binary.decode "\x01\x00\x00\x00" :: Word32--- 0x00000001------ >>> Binary.encode (1 :: Word32)--- "\SOH\NUL\NUL\NUL" instance Binary.Binary Word32 where-    get = do-        value <- Binary.getWord32le-        pure (Word32 value)--    put word32 = do-        let value = #unpack word32-        Binary.putWord32le value+  get = do+    value <- Binary.getWord32le+    pure (Word32 value)+  put word32 = do+    let value = #unpack word32+    Binary.putWord32le value  -- | Little-endian with the bits in each byte reversed.------ >>> Binary.runGet (BinaryBit.runBitGet (BinaryBit.getBits 0)) "\x80\x00\x00\x00" :: Word32--- 0x00000001------ >>> Binary.runPut (BinaryBit.runBitPut (BinaryBit.putBits 0 (1 :: Word32)))--- "\128\NUL\NUL\NUL" instance BinaryBit.BinaryBit Word32 where-    getBits _ = do-        bytes <- BinaryBit.getByteString 4-        bytes-            & LazyBytes.fromStrict-            & Endian.reverseBitsInLazyBytes-            & Binary.runGet Binary.get-            & pure--    putBits _ word32 = word32-        & Binary.put-        & Binary.runPut-        & Endian.reverseBitsInLazyBytes-        & LazyBytes.toStrict-        & BinaryBit.putByteString+  getBits _ = do+    bytes <- BinaryBit.getByteString 4+    bytes & LazyBytes.fromStrict & Endian.reverseBitsInLazyBytes &+      Binary.runGet Binary.get &+      pure+  putBits _ word32 =+    word32 & Binary.put & Binary.runPut & Endian.reverseBitsInLazyBytes &+    LazyBytes.toStrict &+    BinaryBit.putByteString -instance DeepSeq.NFData Word32 where+instance DeepSeq.NFData Word32  -- | Shown as @0x01020304@.------ >>> show (1 :: Word32)--- "0x00000001" instance Show Word32 where-    show word32 = Printf.printf "0x%08x" (#unpack word32)+  show word32 = Printf.printf "0x%08x" (#unpack word32)  -- | Encoded as a JSON number.------ >>> Aeson.encode (1 :: Word32)--- "1" instance Aeson.ToJSON Word32 where-    toJSON word32 = word32-        & #unpack-        & Aeson.toJSON-+  toJSON word32 = word32 & #unpack & Aeson.toJSON  -- | Converts a 'Word32' into any 'Integral' value.------ >>> fromWord32 0x00000001 :: Word.Word32--- 1------ >>> fromWord32 0xffffffff :: Data.Int.Int32--- -1-fromWord32 :: (Integral a) => Word32 -> a+fromWord32+  :: (Integral a)+  => Word32 -> a fromWord32 word32 = fromIntegral (#unpack word32) - -- | Converts any 'Integral' value into a 'Word32'.------ >>> toWord32 (1 :: Word.Word32)--- 0x00000001------ >>> toWord32 (-1 :: Data.Int.Int32)--- 0xffffffff-toWord32 :: (Integral a) => a -> Word32+toWord32+  :: (Integral a)+  => a -> Word32 toWord32 value = Word32 (fromIntegral value)

@@ -8,7 +8,11 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -module Octane.Type.Word64 (Word64(..), fromWord64, toWord64) where+module Octane.Type.Word64+  ( Word64(..)+  , fromWord64+  , toWord64+  ) where  import Data.Function ((&)) @@ -28,93 +32,52 @@ import qualified Octane.Utility.Endian as Endian import qualified Text.Printf as Printf --- $setup--- >>> import qualified Data.Binary.Get as Binary--- >>> import qualified Data.Binary.Put as Binary-- -- | A 64-bit unsigned integer. newtype Word64 = Word64-    { word64Unpack :: Word.Word64-    } deriving (Eq, Generics.Generic, Num, Ord)+  { word64Unpack :: Word.Word64+  } deriving (Eq, Generics.Generic, Num, Ord)  $(OverloadedRecords.overloadedRecord Default.def ''Word64)  -- | Little-endian.------ >>> Binary.decode "\x01\x00\x00\x00\x00\x00\x00\x00" :: Word64--- 0x0000000000000001------ >>> Binary.encode (1 :: Word64)--- "\SOH\NUL\NUL\NUL\NUL\NUL\NUL\NUL" instance Binary.Binary Word64 where-    get = do-        value <- Binary.getWord64le-        pure (Word64 value)--    put word64 = do-        let value = #unpack word64-        Binary.putWord64le value+  get = do+    value <- Binary.getWord64le+    pure (Word64 value)+  put word64 = do+    let value = #unpack word64+    Binary.putWord64le value  -- | Little-endian with the bits in each byte reversed.------ >>> Binary.runGet (BinaryBit.runBitGet (BinaryBit.getBits 0)) "\x80\x00\x00\x00\x00\x00\x00\x00" :: Word64--- 0x0000000000000001------ >>> Binary.runPut (BinaryBit.runBitPut (BinaryBit.putBits 0 (1 :: Word64)))--- "\128\NUL\NUL\NUL\NUL\NUL\NUL\NUL" instance BinaryBit.BinaryBit Word64 where-    getBits _ = do-        bytes <- BinaryBit.getByteString 8-        bytes-            & LazyBytes.fromStrict-            & Endian.reverseBitsInLazyBytes-            & Binary.runGet Binary.get-            & pure--    putBits _ word64 = word64-        & Binary.put-        & Binary.runPut-        & Endian.reverseBitsInLazyBytes-        & LazyBytes.toStrict-        & BinaryBit.putByteString+  getBits _ = do+    bytes <- BinaryBit.getByteString 8+    bytes & LazyBytes.fromStrict & Endian.reverseBitsInLazyBytes &+      Binary.runGet Binary.get &+      pure+  putBits _ word64 =+    word64 & Binary.put & Binary.runPut & Endian.reverseBitsInLazyBytes &+    LazyBytes.toStrict &+    BinaryBit.putByteString -instance DeepSeq.NFData Word64 where+instance DeepSeq.NFData Word64  -- | Shown as @0x0102030405060708@.------ >>> show (1 :: Word64)--- "0x0000000000000001" instance Show Word64 where-    show word64 = Printf.printf "0x%016x" (#unpack word64)+  show word64 = Printf.printf "0x%016x" (#unpack word64)  -- | Encoded as a JSON number.------ >>> Aeson.encode (1 :: Word64)--- "1" instance Aeson.ToJSON Word64 where-    toJSON word64 = word64-        & #unpack-        & Aeson.toJSON-+  toJSON word64 = word64 & #unpack & Aeson.toJSON  -- | Converts a 'Word64' into any 'Integral' value.------ >>> fromWord64 0x0000000000000001 :: Word.Word64--- 1------ >>> fromWord64 0xffffffffffffffff :: Data.Int.Int64--- -1-fromWord64 :: (Integral a) => Word64 -> a+fromWord64+  :: (Integral a)+  => Word64 -> a fromWord64 word64 = fromIntegral (#unpack word64) - -- | Converts any 'Integral' value into a 'Word64'.------ >>> toWord64 (1 :: Word.Word64)--- 0x0000000000000001------ >>> toWord64 (-1 :: Data.Int.Int64)--- 0xffffffffffffffff-toWord64 :: (Integral a) => a -> Word64+toWord64+  :: (Integral a)+  => a -> Word64 toWord64 value = Word64 (fromIntegral value)

@@ -8,7 +8,11 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -module Octane.Type.Word8 (Word8(..), fromWord8, toWord8) where+module Octane.Type.Word8+  ( Word8(..)+  , fromWord8+  , toWord8+  ) where  import Data.Function ((&)) @@ -28,91 +32,51 @@ import qualified Octane.Utility.Endian as Endian import qualified Text.Printf as Printf --- $setup--- >>> import qualified Data.Binary.Get as Binary--- >>> import qualified Data.Binary.Put as Binary-- -- | A 8-bit unsigned integer. newtype Word8 = Word8-    { word8Unpack :: Word.Word8-    } deriving (Eq, Generics.Generic, Num, Ord)+  { word8Unpack :: Word.Word8+  } deriving (Eq, Generics.Generic, Num, Ord)  $(OverloadedRecords.overloadedRecord Default.def ''Word8) --- | >>> Binary.decode "\x01" :: Word8--- 0x01------ >>> Binary.encode (1 :: Word8)--- "\SOH" instance Binary.Binary Word8 where-    get = do-        value <- Binary.getWord8-        pure (Word8 value)--    put word8 = do-        let value = #unpack word8-        Binary.putWord8 value+  get = do+    value <- Binary.getWord8+    pure (Word8 value)+  put word8 = do+    let value = #unpack word8+    Binary.putWord8 value  -- | The bits are reversed.------ >>> Binary.runGet (BinaryBit.runBitGet (BinaryBit.getBits 0)) "\x80" :: Word8--- 0x01------ >>> Binary.runPut (BinaryBit.runBitPut (BinaryBit.putBits 0 (1 :: Word8)))--- "\128" instance BinaryBit.BinaryBit Word8 where-    getBits _ = do-        bytes <- BinaryBit.getByteString 1-        bytes-            & LazyBytes.fromStrict-            & Endian.reverseBitsInLazyBytes-            & Binary.runGet Binary.get-            & pure--    putBits _ word8 = word8-        & Binary.put-        & Binary.runPut-        & Endian.reverseBitsInLazyBytes-        & LazyBytes.toStrict-        & BinaryBit.putByteString+  getBits _ = do+    bytes <- BinaryBit.getByteString 1+    bytes & LazyBytes.fromStrict & Endian.reverseBitsInLazyBytes &+      Binary.runGet Binary.get &+      pure+  putBits _ word8 =+    word8 & Binary.put & Binary.runPut & Endian.reverseBitsInLazyBytes &+    LazyBytes.toStrict &+    BinaryBit.putByteString -instance DeepSeq.NFData Word8 where+instance DeepSeq.NFData Word8  -- | Shown as @0x01@.------ >>> show (1 :: Word8)--- "0x01" instance Show Word8 where-    show word8 = Printf.printf "0x%02x" (#unpack word8)+  show word8 = Printf.printf "0x%02x" (#unpack word8)  -- | Encoded as a JSON number.------ >>> Aeson.encode (1 :: Word8)--- "1" instance Aeson.ToJSON Word8 where-    toJSON word8 = word8-        & #unpack-        & Aeson.toJSON-+  toJSON word8 = word8 & #unpack & Aeson.toJSON  -- | Converts a 'Word8' into any 'Integral' value.------ >>> fromWord8 0x01 :: Word.Word8--- 1------ >>> fromWord8 0xff :: Data.Int.Int8--- -1-fromWord8 :: (Integral a) => Word8 -> a+fromWord8+  :: (Integral a)+  => Word8 -> a fromWord8 word8 = fromIntegral (#unpack word8) - -- | Converts any 'Integral' value into a 'Word8'.------ >>> toWord8 (1 :: Word.Word8)--- 0x01------ >>> toWord8 (-1 :: Data.Int.Int8)--- 0xff-toWord8 :: (Integral a) => a -> Word8+toWord8+  :: (Integral a)+  => a -> Word8 toWord8 value = Word8 (fromIntegral value)

@@ -1,12 +1,12 @@ module Octane.Utility-    ( module Octane.Utility.ClassPropertyMap-    , module Octane.Utility.CRC-    , module Octane.Utility.Embed-    , module Octane.Utility.Endian-    , module Octane.Utility.Generator-    , module Octane.Utility.Optimizer-    , module Octane.Utility.Parser-    ) where+  ( module Octane.Utility.ClassPropertyMap+  , module Octane.Utility.CRC+  , module Octane.Utility.Embed+  , module Octane.Utility.Endian+  , module Octane.Utility.Generator+  , module Octane.Utility.Optimizer+  , module Octane.Utility.Parser+  ) where  import Octane.Utility.ClassPropertyMap import Octane.Utility.CRC

@@ -1,106 +1,294 @@-module Octane.Utility.CRC (crc32) where+module Octane.Utility.CRC+  ( crc32+  ) where  import qualified Data.Bits as Bits import qualified Data.ByteString.Lazy as LazyBytes import qualified Data.Vector.Unboxed as Vector import qualified Data.Word as Word - -- | Computes the CRC32 of some bytes. Note that this is a non-standard CRC32. -- It probably only works for Rocket League.------ >>> crc32 ""--- 4023120385------ >>> crc32 "123456789"--- 3690624627 crc32 :: LazyBytes.ByteString -> Word.Word32 crc32 bytes = do-    let update = crc32Update crc32Table-    let initial = Bits.complement crc32Initial-    let crc = LazyBytes.foldl update initial bytes-    Bits.complement crc-+  let update = crc32Update crc32Table+  let initial = Bits.complement crc32Initial+  let crc = LazyBytes.foldl update initial bytes+  Bits.complement crc  crc32Update :: Vector.Vector Word.Word32 -> Word.Word32 -> Word.Word8 -> Word.Word32 crc32Update table crc byte = do-    let toWord8 = fromIntegral :: (Integral a) => a -> Word.Word8-    let toInt = fromIntegral :: (Integral a) => a -> Int-    let index = toInt (Bits.xor byte (toWord8 (Bits.shiftR crc 24)))-    let left = Vector.unsafeIndex table index-    let right = Bits.shiftL crc 8-    Bits.xor left right-+  let toWord8 =+        fromIntegral :: (Integral a) =>+                        a -> Word.Word8+  let toInt =+        fromIntegral :: (Integral a) =>+                        a -> Int+  let index = toInt (Bits.xor byte (toWord8 (Bits.shiftR crc 24)))+  let left = Vector.unsafeIndex table index+  let right = Bits.shiftL crc 8+  Bits.xor left right  crc32Initial :: Word.Word32 crc32Initial = 0xefcbf201 - crc32Table :: Vector.Vector Word.Word32-crc32Table = Vector.fromList-    [-        0x00000000, 0x04c11db7, 0x09823b6e, 0x0d4326d9,-        0x130476dc, 0x17c56b6b, 0x1a864db2, 0x1e475005,-        0x2608edb8, 0x22c9f00f, 0x2f8ad6d6, 0x2b4bcb61,-        0x350c9b64, 0x31cd86d3, 0x3c8ea00a, 0x384fbdbd,-        0x4c11db70, 0x48d0c6c7, 0x4593e01e, 0x4152fda9,-        0x5f15adac, 0x5bd4b01b, 0x569796c2, 0x52568b75,-        0x6a1936c8, 0x6ed82b7f, 0x639b0da6, 0x675a1011,-        0x791d4014, 0x7ddc5da3, 0x709f7b7a, 0x745e66cd,-        0x9823b6e0, 0x9ce2ab57, 0x91a18d8e, 0x95609039,-        0x8b27c03c, 0x8fe6dd8b, 0x82a5fb52, 0x8664e6e5,-        0xbe2b5b58, 0xbaea46ef, 0xb7a96036, 0xb3687d81,-        0xad2f2d84, 0xa9ee3033, 0xa4ad16ea, 0xa06c0b5d,-        0xd4326d90, 0xd0f37027, 0xddb056fe, 0xd9714b49,-        0xc7361b4c, 0xc3f706fb, 0xceb42022, 0xca753d95,-        0xf23a8028, 0xf6fb9d9f, 0xfbb8bb46, 0xff79a6f1,-        0xe13ef6f4, 0xe5ffeb43, 0xe8bccd9a, 0xec7dd02d,-        0x34867077, 0x30476dc0, 0x3d044b19, 0x39c556ae,-        0x278206ab, 0x23431b1c, 0x2e003dc5, 0x2ac12072,-        0x128e9dcf, 0x164f8078, 0x1b0ca6a1, 0x1fcdbb16,-        0x018aeb13, 0x054bf6a4, 0x0808d07d, 0x0cc9cdca,-        0x7897ab07, 0x7c56b6b0, 0x71159069, 0x75d48dde,-        0x6b93dddb, 0x6f52c06c, 0x6211e6b5, 0x66d0fb02,-        0x5e9f46bf, 0x5a5e5b08, 0x571d7dd1, 0x53dc6066,-        0x4d9b3063, 0x495a2dd4, 0x44190b0d, 0x40d816ba,-        0xaca5c697, 0xa864db20, 0xa527fdf9, 0xa1e6e04e,-        0xbfa1b04b, 0xbb60adfc, 0xb6238b25, 0xb2e29692,-        0x8aad2b2f, 0x8e6c3698, 0x832f1041, 0x87ee0df6,-        0x99a95df3, 0x9d684044, 0x902b669d, 0x94ea7b2a,-        0xe0b41de7, 0xe4750050, 0xe9362689, 0xedf73b3e,-        0xf3b06b3b, 0xf771768c, 0xfa325055, 0xfef34de2,-        0xc6bcf05f, 0xc27dede8, 0xcf3ecb31, 0xcbffd686,-        0xd5b88683, 0xd1799b34, 0xdc3abded, 0xd8fba05a,-        0x690ce0ee, 0x6dcdfd59, 0x608edb80, 0x644fc637,-        0x7a089632, 0x7ec98b85, 0x738aad5c, 0x774bb0eb,-        0x4f040d56, 0x4bc510e1, 0x46863638, 0x42472b8f,-        0x5c007b8a, 0x58c1663d, 0x558240e4, 0x51435d53,-        0x251d3b9e, 0x21dc2629, 0x2c9f00f0, 0x285e1d47,-        0x36194d42, 0x32d850f5, 0x3f9b762c, 0x3b5a6b9b,-        0x0315d626, 0x07d4cb91, 0x0a97ed48, 0x0e56f0ff,-        0x1011a0fa, 0x14d0bd4d, 0x19939b94, 0x1d528623,-        0xf12f560e, 0xf5ee4bb9, 0xf8ad6d60, 0xfc6c70d7,-        0xe22b20d2, 0xe6ea3d65, 0xeba91bbc, 0xef68060b,-        0xd727bbb6, 0xd3e6a601, 0xdea580d8, 0xda649d6f,-        0xc423cd6a, 0xc0e2d0dd, 0xcda1f604, 0xc960ebb3,-        0xbd3e8d7e, 0xb9ff90c9, 0xb4bcb610, 0xb07daba7,-        0xae3afba2, 0xaafbe615, 0xa7b8c0cc, 0xa379dd7b,-        0x9b3660c6, 0x9ff77d71, 0x92b45ba8, 0x9675461f,-        0x8832161a, 0x8cf30bad, 0x81b02d74, 0x857130c3,-        0x5d8a9099, 0x594b8d2e, 0x5408abf7, 0x50c9b640,-        0x4e8ee645, 0x4a4ffbf2, 0x470cdd2b, 0x43cdc09c,-        0x7b827d21, 0x7f436096, 0x7200464f, 0x76c15bf8,-        0x68860bfd, 0x6c47164a, 0x61043093, 0x65c52d24,-        0x119b4be9, 0x155a565e, 0x18197087, 0x1cd86d30,-        0x029f3d35, 0x065e2082, 0x0b1d065b, 0x0fdc1bec,-        0x3793a651, 0x3352bbe6, 0x3e119d3f, 0x3ad08088,-        0x2497d08d, 0x2056cd3a, 0x2d15ebe3, 0x29d4f654,-        0xc5a92679, 0xc1683bce, 0xcc2b1d17, 0xc8ea00a0,-        0xd6ad50a5, 0xd26c4d12, 0xdf2f6bcb, 0xdbee767c,-        0xe3a1cbc1, 0xe760d676, 0xea23f0af, 0xeee2ed18,-        0xf0a5bd1d, 0xf464a0aa, 0xf9278673, 0xfde69bc4,-        0x89b8fd09, 0x8d79e0be, 0x803ac667, 0x84fbdbd0,-        0x9abc8bd5, 0x9e7d9662, 0x933eb0bb, 0x97ffad0c,-        0xafb010b1, 0xab710d06, 0xa6322bdf, 0xa2f33668,-        0xbcb4666d, 0xb8757bda, 0xb5365d03, 0xb1f740b4+crc32Table =+  Vector.fromList+    [ 0x00000000+    , 0x04c11db7+    , 0x09823b6e+    , 0x0d4326d9+    , 0x130476dc+    , 0x17c56b6b+    , 0x1a864db2+    , 0x1e475005+    , 0x2608edb8+    , 0x22c9f00f+    , 0x2f8ad6d6+    , 0x2b4bcb61+    , 0x350c9b64+    , 0x31cd86d3+    , 0x3c8ea00a+    , 0x384fbdbd+    , 0x4c11db70+    , 0x48d0c6c7+    , 0x4593e01e+    , 0x4152fda9+    , 0x5f15adac+    , 0x5bd4b01b+    , 0x569796c2+    , 0x52568b75+    , 0x6a1936c8+    , 0x6ed82b7f+    , 0x639b0da6+    , 0x675a1011+    , 0x791d4014+    , 0x7ddc5da3+    , 0x709f7b7a+    , 0x745e66cd+    , 0x9823b6e0+    , 0x9ce2ab57+    , 0x91a18d8e+    , 0x95609039+    , 0x8b27c03c+    , 0x8fe6dd8b+    , 0x82a5fb52+    , 0x8664e6e5+    , 0xbe2b5b58+    , 0xbaea46ef+    , 0xb7a96036+    , 0xb3687d81+    , 0xad2f2d84+    , 0xa9ee3033+    , 0xa4ad16ea+    , 0xa06c0b5d+    , 0xd4326d90+    , 0xd0f37027+    , 0xddb056fe+    , 0xd9714b49+    , 0xc7361b4c+    , 0xc3f706fb+    , 0xceb42022+    , 0xca753d95+    , 0xf23a8028+    , 0xf6fb9d9f+    , 0xfbb8bb46+    , 0xff79a6f1+    , 0xe13ef6f4+    , 0xe5ffeb43+    , 0xe8bccd9a+    , 0xec7dd02d+    , 0x34867077+    , 0x30476dc0+    , 0x3d044b19+    , 0x39c556ae+    , 0x278206ab+    , 0x23431b1c+    , 0x2e003dc5+    , 0x2ac12072+    , 0x128e9dcf+    , 0x164f8078+    , 0x1b0ca6a1+    , 0x1fcdbb16+    , 0x018aeb13+    , 0x054bf6a4+    , 0x0808d07d+    , 0x0cc9cdca+    , 0x7897ab07+    , 0x7c56b6b0+    , 0x71159069+    , 0x75d48dde+    , 0x6b93dddb+    , 0x6f52c06c+    , 0x6211e6b5+    , 0x66d0fb02+    , 0x5e9f46bf+    , 0x5a5e5b08+    , 0x571d7dd1+    , 0x53dc6066+    , 0x4d9b3063+    , 0x495a2dd4+    , 0x44190b0d+    , 0x40d816ba+    , 0xaca5c697+    , 0xa864db20+    , 0xa527fdf9+    , 0xa1e6e04e+    , 0xbfa1b04b+    , 0xbb60adfc+    , 0xb6238b25+    , 0xb2e29692+    , 0x8aad2b2f+    , 0x8e6c3698+    , 0x832f1041+    , 0x87ee0df6+    , 0x99a95df3+    , 0x9d684044+    , 0x902b669d+    , 0x94ea7b2a+    , 0xe0b41de7+    , 0xe4750050+    , 0xe9362689+    , 0xedf73b3e+    , 0xf3b06b3b+    , 0xf771768c+    , 0xfa325055+    , 0xfef34de2+    , 0xc6bcf05f+    , 0xc27dede8+    , 0xcf3ecb31+    , 0xcbffd686+    , 0xd5b88683+    , 0xd1799b34+    , 0xdc3abded+    , 0xd8fba05a+    , 0x690ce0ee+    , 0x6dcdfd59+    , 0x608edb80+    , 0x644fc637+    , 0x7a089632+    , 0x7ec98b85+    , 0x738aad5c+    , 0x774bb0eb+    , 0x4f040d56+    , 0x4bc510e1+    , 0x46863638+    , 0x42472b8f+    , 0x5c007b8a+    , 0x58c1663d+    , 0x558240e4+    , 0x51435d53+    , 0x251d3b9e+    , 0x21dc2629+    , 0x2c9f00f0+    , 0x285e1d47+    , 0x36194d42+    , 0x32d850f5+    , 0x3f9b762c+    , 0x3b5a6b9b+    , 0x0315d626+    , 0x07d4cb91+    , 0x0a97ed48+    , 0x0e56f0ff+    , 0x1011a0fa+    , 0x14d0bd4d+    , 0x19939b94+    , 0x1d528623+    , 0xf12f560e+    , 0xf5ee4bb9+    , 0xf8ad6d60+    , 0xfc6c70d7+    , 0xe22b20d2+    , 0xe6ea3d65+    , 0xeba91bbc+    , 0xef68060b+    , 0xd727bbb6+    , 0xd3e6a601+    , 0xdea580d8+    , 0xda649d6f+    , 0xc423cd6a+    , 0xc0e2d0dd+    , 0xcda1f604+    , 0xc960ebb3+    , 0xbd3e8d7e+    , 0xb9ff90c9+    , 0xb4bcb610+    , 0xb07daba7+    , 0xae3afba2+    , 0xaafbe615+    , 0xa7b8c0cc+    , 0xa379dd7b+    , 0x9b3660c6+    , 0x9ff77d71+    , 0x92b45ba8+    , 0x9675461f+    , 0x8832161a+    , 0x8cf30bad+    , 0x81b02d74+    , 0x857130c3+    , 0x5d8a9099+    , 0x594b8d2e+    , 0x5408abf7+    , 0x50c9b640+    , 0x4e8ee645+    , 0x4a4ffbf2+    , 0x470cdd2b+    , 0x43cdc09c+    , 0x7b827d21+    , 0x7f436096+    , 0x7200464f+    , 0x76c15bf8+    , 0x68860bfd+    , 0x6c47164a+    , 0x61043093+    , 0x65c52d24+    , 0x119b4be9+    , 0x155a565e+    , 0x18197087+    , 0x1cd86d30+    , 0x029f3d35+    , 0x065e2082+    , 0x0b1d065b+    , 0x0fdc1bec+    , 0x3793a651+    , 0x3352bbe6+    , 0x3e119d3f+    , 0x3ad08088+    , 0x2497d08d+    , 0x2056cd3a+    , 0x2d15ebe3+    , 0x29d4f654+    , 0xc5a92679+    , 0xc1683bce+    , 0xcc2b1d17+    , 0xc8ea00a0+    , 0xd6ad50a5+    , 0xd26c4d12+    , 0xdf2f6bcb+    , 0xdbee767c+    , 0xe3a1cbc1+    , 0xe760d676+    , 0xea23f0af+    , 0xeee2ed18+    , 0xf0a5bd1d+    , 0xf464a0aa+    , 0xf9278673+    , 0xfde69bc4+    , 0x89b8fd09+    , 0x8d79e0be+    , 0x803ac667+    , 0x84fbdbd0+    , 0x9abc8bd5+    , 0x9e7d9662+    , 0x933eb0bb+    , 0x97ffad0c+    , 0xafb010b1+    , 0xab710d06+    , 0xa6322bdf+    , 0xa2f33668+    , 0xbcb4666d+    , 0xb8757bda+    , 0xb5365d03+    , 0xb1f740b4     ]

@@ -5,11 +5,11 @@ -- class IDs to a map of property IDs to property names. This map is the -- cornerstone of the replay stream parser. module Octane.Utility.ClassPropertyMap-    ( getClassPropertyMap-    , getPropertyMap-    , getActorMap-    , getClass-    ) where+  ( getClassPropertyMap+  , getPropertyMap+  , getActorMap+  , getClass+  ) where  import Data.Function ((&)) @@ -18,204 +18,190 @@ import qualified Data.Map.Strict as Map import qualified Data.Maybe as Maybe import qualified Data.Text as StrictText-import qualified Octane.Type.ReplayWithoutFrames as ReplayWithoutFrames+import qualified Octane.Type.ReplayWithoutFrames as Replay import qualified Octane.Type.Word32 as Word32 import qualified "regex-compat" Text.Regex as Regex - -- | The class property map is a map from class IDs in the stream to a map from -- property IDs in the stream to property names.-getClassPropertyMap :: ReplayWithoutFrames.ReplayWithoutFrames -> IntMap.IntMap (IntMap.IntMap StrictText.Text)-getClassPropertyMap replay = let-    basicClassPropertyMap = getBasicClassPropertyMap replay-    classMap = getClassMap replay-    in replay-        & getClassIds-        & map (\ classId -> let-            ownProperties = case IntMap.lookup classId basicClassPropertyMap of-                Nothing -> IntMap.empty-                Just x -> x-            parentProperties = case IntMap.lookup classId classMap of-                Nothing -> IntMap.empty-                Just parentClassIds -> parentClassIds-                    & map (\ parentClassId ->-                        case IntMap.lookup parentClassId basicClassPropertyMap of-                            Nothing -> IntMap.empty-                            Just x -> x)-                    & IntMap.unions-            properties = IntMap.union ownProperties parentProperties-            in (classId, properties))-        & IntMap.fromList-+getClassPropertyMap :: Replay.ReplayWithoutFrames+                    -> IntMap.IntMap (IntMap.IntMap StrictText.Text)+getClassPropertyMap replay =+  let basicClassPropertyMap = getBasicClassPropertyMap replay+      classMap = getClassMap replay+  in replay & getClassIds &+     map+       (\classId ->+           let ownProperties =+                 case IntMap.lookup classId basicClassPropertyMap of+                   Nothing -> IntMap.empty+                   Just x -> x+               parentProperties =+                 case IntMap.lookup classId classMap of+                   Nothing -> IntMap.empty+                   Just parentClassIds ->+                     parentClassIds &+                     map+                       (\parentClassId ->+                           case IntMap.lookup parentClassId basicClassPropertyMap of+                             Nothing -> IntMap.empty+                             Just x -> x) &+                     IntMap.unions+               properties = IntMap.union ownProperties parentProperties+           in (classId, properties)) &+     IntMap.fromList  -- | The class cache is a list of 3-tuples where the first element is a class -- ID, the second is its cache ID, and the third is its parent's cache ID.-getClassCache :: ReplayWithoutFrames.ReplayWithoutFrames -> [(Int, Int, Int)]-getClassCache replay = replay-    & #cache-    & #unpack-    & map (\ x ->+getClassCache :: Replay.ReplayWithoutFrames -> [(Int, Int, Int)]+getClassCache replay =+  replay & #cache & #unpack &+  map+    (\x ->         ( x & #classId & Word32.fromWord32         , x & #cacheId & Word32.fromWord32-        , x & #parentCacheId & Word32.fromWord32-        ))-+        , x & #parentCacheId & Word32.fromWord32))  -- | The class IDs in a replay. Comes from the class cache.-getClassIds :: ReplayWithoutFrames.ReplayWithoutFrames -> [Int]-getClassIds replay = replay-    & getClassCache-    & map (\ (x, _, _) -> x)-+getClassIds :: Replay.ReplayWithoutFrames -> [Int]+getClassIds replay = replay & getClassCache & map (\(x, _, _) -> x)  -- | Gets the parent class ID for the given parent cache ID. This is necessary -- because there is not always a class with the given cache ID in the cache. -- When that happens, the parent cache ID is decremented and tried again. getParentClassId :: Int -> [(Int, Int, Int)] -> Maybe Int getParentClassId parentCacheId xs =-    case dropWhile (\ (_, cacheId, _) -> cacheId /= parentCacheId) xs of-        [] -> if parentCacheId <= 0-            then Nothing-            else getParentClassId (parentCacheId - 1) xs-        (parentClassId, _, _) : _ -> Just parentClassId-+  case dropWhile (\(_, cacheId, _) -> cacheId /= parentCacheId) xs of+    [] ->+      if parentCacheId <= 0+        then Nothing+        else getParentClassId (parentCacheId - 1) xs+    (parentClassId, _, _):_ -> Just parentClassId  -- | The basic class map is a naive mapping from class ID to its parent class -- ID. It's naive because it only maps the class ID to its immediate parent. -- It does not chase the inheritance all the way down.-getBasicClassMap :: ReplayWithoutFrames.ReplayWithoutFrames -> IntMap.IntMap Int-getBasicClassMap replay = replay-    & getClassCache-    & reverse-    & List.tails-    & Maybe.mapMaybe (\ xs -> case xs of-        [] -> Nothing-        (classId, _, parentCacheId) : ys -> do+getBasicClassMap :: Replay.ReplayWithoutFrames -> IntMap.IntMap Int+getBasicClassMap replay =+  replay & getClassCache & reverse & List.tails &+  Maybe.mapMaybe+    (\xs ->+        case xs of+          [] -> Nothing+          (classId, _, parentCacheId):ys -> do             parentClassId <- getParentClassId parentCacheId ys-            pure (classId, parentClassId))-    & IntMap.fromList-+            pure (classId, parentClassId)) &+  IntMap.fromList  -- | Given a naive mapping from class ID to its parent class ID, pure all of -- the parent IDs for a given class. getParentClassIds :: Int -> IntMap.IntMap Int -> [Int] getParentClassIds classId basicClassMap =-    case IntMap.lookup classId basicClassMap of-        Nothing -> []-        Just parentClassId -> parentClassId : getParentClassIds parentClassId basicClassMap-+  case IntMap.lookup classId basicClassMap of+    Nothing -> []+    Just parentClassId -> parentClassId : getParentClassIds parentClassId basicClassMap  -- | The class map is a mapping from a class ID to all of its parent class IDs.-getClassMap :: ReplayWithoutFrames.ReplayWithoutFrames -> IntMap.IntMap [Int]-getClassMap replay = let-    basicClassMap = getBasicClassMap replay-    in replay-        & getClassIds-        & map (\ classId ->-            ( classId-            , getParentClassIds classId basicClassMap-            ))-        & IntMap.fromList-+getClassMap :: Replay.ReplayWithoutFrames -> IntMap.IntMap [Int]+getClassMap replay =+  let basicClassMap = getBasicClassMap replay+  in replay & getClassIds &+     map (\classId -> (classId, getParentClassIds classId basicClassMap)) &+     IntMap.fromList  -- | The property map is a mapping from property IDs to property names.-getPropertyMap :: ReplayWithoutFrames.ReplayWithoutFrames -> IntMap.IntMap StrictText.Text-getPropertyMap replay = replay-    & #objects-    & #unpack-    & map #unpack-    & zip [0 ..]-    & IntMap.fromList-+getPropertyMap :: Replay.ReplayWithoutFrames -> IntMap.IntMap StrictText.Text+getPropertyMap replay =+  replay & #objects & #unpack & map #unpack & zip [0 ..] & IntMap.fromList  -- | The basic class property map is a naive mapping from class IDs to a -- mapping from property IDs to property names. It's naive because it does -- not include the properties from the class's parents.-getBasicClassPropertyMap :: ReplayWithoutFrames.ReplayWithoutFrames -> IntMap.IntMap (IntMap.IntMap StrictText.Text)-getBasicClassPropertyMap replay = let-    propertyMap = getPropertyMap replay-    in replay-        & #cache-        & #unpack-        & map (\ x -> let-            classId = x & #classId & Word32.fromWord32-            properties = x-                & #properties-                & #unpack-                & Maybe.mapMaybe (\ y -> let-                    streamId = y & #streamId & Word32.fromWord32-                    propertyId = y & #objectId & Word32.fromWord32-                    in case IntMap.lookup propertyId propertyMap of-                        Nothing -> Nothing-                        Just name -> Just (streamId, name))-                & IntMap.fromList-            in (classId, properties))-        & IntMap.fromList-+getBasicClassPropertyMap :: Replay.ReplayWithoutFrames+                         -> IntMap.IntMap (IntMap.IntMap StrictText.Text)+getBasicClassPropertyMap replay =+  let propertyMap = getPropertyMap replay+  in replay & #cache & #unpack &+     map+       (\x ->+           let classId = x & #classId & Word32.fromWord32+               properties =+                 x & #properties & #unpack &+                 Maybe.mapMaybe+                   (\y ->+                       let streamId = y & #streamId & Word32.fromWord32+                           propertyId = y & #objectId & Word32.fromWord32+                       in case IntMap.lookup propertyId propertyMap of+                            Nothing -> Nothing+                            Just name -> Just (streamId, name)) &+                 IntMap.fromList+           in (classId, properties)) &+     IntMap.fromList  -- | The actor map is a mapping from class names to their IDs.-getActorMap :: ReplayWithoutFrames.ReplayWithoutFrames -> Map.Map StrictText.Text Int-getActorMap replay = replay-    & #classes-    & #unpack-    & map (\ x -> let-        className = x & #name & #unpack-        classId = x & #streamId & Word32.fromWord32-        in (className, classId))-    & Map.fromList-+getActorMap :: Replay.ReplayWithoutFrames -> Map.Map StrictText.Text Int+getActorMap replay =+  replay & #classes & #unpack &+  map+    (\x ->+        let className = x & #name & #unpack+            classId = x & #streamId & Word32.fromWord32+        in (className, classId)) &+  Map.fromList  -- | Gets the class ID and name for a given property ID. getClass-    :: (Monad m)-    => IntMap.IntMap StrictText.Text -- ^ Property ID to property name-    -> Map.Map StrictText.Text StrictText.Text -- ^ Property name to class name-    -> Map.Map StrictText.Text Int -- ^ Class name to class ID-    -> Int -- ^ property ID-    -> m (Int, StrictText.Text) -- ^ Maybe class ID and class name+  :: (Monad m)+  => IntMap.IntMap StrictText.Text -- ^ Property ID to property name+  -> Map.Map StrictText.Text StrictText.Text -- ^ Property name to class name+  -> Map.Map StrictText.Text Int -- ^ Class name to class ID+  -> Int -- ^ property ID+  -> m (Int, StrictText.Text) -- ^ Maybe class ID and class name getClass propertyIdsToNames propertyNamesToClassNames classNamesToIds propertyId = do-    rawPropertyName <- getPropertyName propertyIdsToNames propertyId-    let propertyName = normalizeName rawPropertyName-    className <- getClassName propertyNamesToClassNames propertyName-    classId <- getClassId classNamesToIds className-    pure (classId, className)-+  rawPropertyName <- getPropertyName propertyIdsToNames propertyId+  let propertyName = normalizeName rawPropertyName+  className <- getClassName propertyNamesToClassNames propertyName+  classId <- getClassId classNamesToIds className+  pure (classId, className) -getPropertyName :: (Monad m) => IntMap.IntMap StrictText.Text -> Int -> m StrictText.Text+getPropertyName+  :: (Monad m)+  => IntMap.IntMap StrictText.Text -> Int -> m StrictText.Text getPropertyName propertyNames propertyId = do-    case IntMap.lookup propertyId propertyNames of-        Nothing -> do-            fail ("Could not find name for property " ++ show propertyId)-        Just propertyName -> do-            pure propertyName-+  case IntMap.lookup propertyId propertyNames of+    Nothing -> do+      fail ("Could not find name for property " ++ show propertyId)+    Just propertyName -> do+      pure propertyName  normalizeName :: StrictText.Text -> StrictText.Text-normalizeName name = name-    & StrictText.unpack-    & replace "_[0-9]+$" ""-    & replace "^[A-Z_a-z]+[.]TheWorld:" "TheWorld:"-    & StrictText.pack-+normalizeName name =+  name & StrictText.unpack & replace "_[0-9]+$" "" &+  replace "^[A-Z_a-z]+[.]TheWorld:" "TheWorld:" &+  StrictText.pack  replace :: String -> String -> String -> String-replace pattern replacement input =-    Regex.subRegex (Regex.mkRegex pattern) input replacement-+replace needle replacement haystack =+  Regex.subRegex (Regex.mkRegex needle) haystack replacement -getClassName :: (Monad m) => Map.Map StrictText.Text StrictText.Text -> StrictText.Text -> m StrictText.Text+getClassName+  :: (Monad m)+  => Map.Map StrictText.Text StrictText.Text+  -> StrictText.Text+  -> m StrictText.Text getClassName classNames propertyName = do-    case Map.lookup propertyName classNames of-        Nothing -> do-            fail ("Could not find class for property " ++ show propertyName)-        Just className -> do-            pure className-+  case Map.lookup propertyName classNames of+    Nothing -> do+      fail ("Could not find class for property " ++ show propertyName)+    Just className -> do+      pure className -getClassId :: (Monad m) => Map.Map StrictText.Text Int -> StrictText.Text -> m Int+getClassId+  :: (Monad m)+  => Map.Map StrictText.Text Int -> StrictText.Text -> m Int getClassId classIds className = do-    case Map.lookup className classIds of-        Nothing -> do-            fail ("Could not find ID for class " ++ show className)-        Just classId -> do-            pure classId+  case Map.lookup className classIds of+    Nothing -> do+      fail ("Could not find ID for class " ++ show className)+    Just classId -> do+      pure classId

@@ -1,7 +1,11 @@ {-# LANGUAGE FlexibleContexts #-}  -- | These helper functions are usually used with 'Data.FileEmbed.embedFile'.-module Octane.Utility.Embed (decodeBimap, decodeMap, decodeSet) where+module Octane.Utility.Embed+  ( decodeBimap+  , decodeMap+  , decodeSet+  ) where  import Data.Function ((&)) @@ -12,47 +16,25 @@ import qualified Data.Maybe as Maybe import qualified Data.Set as Set - -- | Decodes some bytes into a bidirection map. The bytes are assumed to be a -- JSON object mapping values to keys. That means the resulting bimap is -- 'Bimap.twist'ed from what you might expect.------ >>> decodeBimap "{ \"value\": \"key\" }" :: Bimap.Bimap String String--- fromList [("key","value")] decodeBimap-    :: (Aeson.FromJSON (Map.Map b a), Ord a, Ord b)-    => StrictBytes.ByteString-    -> Bimap.Bimap a b-decodeBimap bytes = bytes-    & Aeson.decodeStrict-    & Maybe.fromMaybe Map.empty-    & Map.toList-    & Bimap.fromList-    & Bimap.twist-+  :: (Aeson.FromJSON (Map.Map b a), Ord a, Ord b)+  => StrictBytes.ByteString -> Bimap.Bimap a b+decodeBimap bytes =+  bytes & Aeson.decodeStrict & Maybe.fromMaybe Map.empty & Map.toList & Bimap.fromList &+  Bimap.twist  -- | Decodes some bytes into a map. The bytes are assumed to be a JSON object -- mapping keys to values.------ >>> decodeMap "{ \"key\": \"value\" }" :: Map.Map String String--- fromList [("key","value")] decodeMap-    :: (Aeson.FromJSON (Map.Map a b))-    => StrictBytes.ByteString-    -> Map.Map a b-decodeMap bytes = bytes-    & Aeson.decodeStrict-    & Maybe.fromMaybe Map.empty-+  :: (Aeson.FromJSON (Map.Map a b))+  => StrictBytes.ByteString -> Map.Map a b+decodeMap bytes = bytes & Aeson.decodeStrict & Maybe.fromMaybe Map.empty  -- | Decodes some bytes into a set. The bytes are assumed to be a JSON array.------ >>> decodeSet "[\"element\"]" :: Set.Set String--- fromList ["element"] decodeSet-    :: (Aeson.FromJSON a, Ord a)-    => StrictBytes.ByteString-    -> Set.Set a-decodeSet bytes = bytes-    & Aeson.decodeStrict-    & Maybe.fromMaybe Set.empty+  :: (Aeson.FromJSON a, Ord a)+  => StrictBytes.ByteString -> Set.Set a+decodeSet bytes = bytes & Aeson.decodeStrict & Maybe.fromMaybe Set.empty

@@ -1,39 +1,30 @@ {-# LANGUAGE BinaryLiterals #-}  module Octane.Utility.Endian-    ( reverseBitsInLazyBytes-    , reverseBitsInStrictBytes-    ) where+  ( reverseBitsInLazyBytes+  , reverseBitsInStrictBytes+  ) where  import qualified Data.Bits as Bits import qualified Data.ByteString as StrictBytes import qualified Data.ByteString.Lazy as LazyBytes import qualified Data.Word as Word - -- | Reverses all the bits in each lazy byte.------ >>> reverseBitsInLazyBytes "\x01"--- "\128" reverseBitsInLazyBytes :: LazyBytes.ByteString -> LazyBytes.ByteString reverseBitsInLazyBytes bytes = LazyBytes.map reverseBits bytes - -- | Reverses all the bits in each strict byte.------ >>> reverseBitsInStrictBytes "\x01"--- "\128" reverseBitsInStrictBytes :: StrictBytes.ByteString -> StrictBytes.ByteString reverseBitsInStrictBytes bytes = StrictBytes.map reverseBits bytes - reverseBits :: Word.Word8 -> Word.Word8-reverseBits byte-    = Bits.shiftR (byte Bits..&. 0b10000000) 7-    + Bits.shiftR (byte Bits..&. 0b01000000) 5-    + Bits.shiftR (byte Bits..&. 0b00100000) 3-    + Bits.shiftR (byte Bits..&. 0b00010000) 1-    + Bits.shiftL (byte Bits..&. 0b00001000) 1-    + Bits.shiftL (byte Bits..&. 0b00000100) 3-    + Bits.shiftL (byte Bits..&. 0b00000010) 5-    + Bits.shiftL (byte Bits..&. 0b00000001) 7+reverseBits byte =+  Bits.shiftR (byte Bits..&. 0b10000000) 7 ++  Bits.shiftR (byte Bits..&. 0b01000000) 5 ++  Bits.shiftR (byte Bits..&. 0b00100000) 3 ++  Bits.shiftR (byte Bits..&. 0b00010000) 1 ++  Bits.shiftL (byte Bits..&. 0b00001000) 1 ++  Bits.shiftL (byte Bits..&. 0b00000100) 3 ++  Bits.shiftL (byte Bits..&. 0b00000010) 5 ++  Bits.shiftL (byte Bits..&. 0b00000001) 7

@@ -1,6 +1,8 @@ {-# LANGUAGE OverloadedLabels #-} -module Octane.Utility.Generator (generateStream) where+module Octane.Utility.Generator+  ( generateStream+  ) where  import Data.Function ((&)) @@ -18,76 +20,68 @@ import qualified Octane.Type.Stream as Stream import qualified Octane.Type.Text as Text - -- | Generates a network stream. generateStream-    :: [Frame.Frame]-    -> List.List Text.Text-    -> List.List Text.Text-    -> List.List ClassItem.ClassItem-    -> List.List CacheItem.CacheItem-    -> Stream.Stream+  :: [Frame.Frame]+  -> List.List Text.Text+  -> List.List Text.Text+  -> List.List ClassItem.ClassItem+  -> List.List CacheItem.CacheItem+  -> Stream.Stream generateStream frames _objects _names _classes _cache = do-    let bitPut = putFrames frames-    let bytePut = BinaryBit.runBitPut bitPut-    let bytes = Binary.runPut bytePut-    Stream.Stream bytes-+  let bitPut = putFrames frames+  let bytePut = BinaryBit.runBitPut bitPut+  let bytes = Binary.runPut bytePut+  Stream.Stream bytes  putFrames :: [Frame.Frame] -> BinaryBit.BitPut () putFrames frames = do-    case frames of-        [] -> pure ()-        frame : rest -> do-            putFrame frame-            putFrames rest-+  case frames of+    [] -> pure ()+    frame:rest -> do+      putFrame frame+      putFrames rest  putFrame :: Frame.Frame -> BinaryBit.BitPut () putFrame frame = do-    frame & #time & BinaryBit.putBits 32-    frame & #delta & BinaryBit.putBits 32-    frame & #replications & putReplications-+  frame & #time & BinaryBit.putBits 32+  frame & #delta & BinaryBit.putBits 32+  frame & #replications & putReplications  putReplications :: [Replication.Replication] -> BinaryBit.BitPut () putReplications replications = do-    case replications of-        [] -> do-            False & Boolean.Boolean & BinaryBit.putBits 1-        replication : rest -> do-            True & Boolean.Boolean & BinaryBit.putBits 1-            putReplication replication-            putReplications rest-+  case replications of+    [] -> do+      False & Boolean.Boolean & BinaryBit.putBits 1+    replication:rest -> do+      True & Boolean.Boolean & BinaryBit.putBits 1+      putReplication replication+      putReplications rest  putReplication :: Replication.Replication -> BinaryBit.BitPut () putReplication replication = do-    replication & #actorId & BinaryBit.putBits 0-    case #state replication of-        State.SOpening -> putNewReplication replication-        State.SExisting -> putExistingReplication replication-        State.SClosing -> putClosedReplication replication-+  replication & #actorId & BinaryBit.putBits 0+  case #state replication of+    State.SOpening -> putNewReplication replication+    State.SExisting -> putExistingReplication replication+    State.SClosing -> putClosedReplication replication  putNewReplication :: Replication.Replication -> BinaryBit.BitPut () putNewReplication replication = do-    True & Boolean.Boolean & BinaryBit.putBits 1 -- open-    True & Boolean.Boolean & BinaryBit.putBits 1 -- new-    False & Boolean.Boolean & BinaryBit.putBits 1 -- unknown-    -- TODO: convert object name into ID and put it-    case #initialization replication of-        Nothing -> pure ()-        Just x -> Initialization.putInitialization x-+  True & Boolean.Boolean & BinaryBit.putBits 1 -- open+  True & Boolean.Boolean & BinaryBit.putBits 1 -- new+  False & Boolean.Boolean & BinaryBit.putBits 1 -- unknown+  pure () -- TODO: convert object name into ID and put it+  case #initialization replication of+    Nothing -> pure ()+    Just x -> Initialization.putInitialization x  putExistingReplication :: Replication.Replication -> BinaryBit.BitPut () putExistingReplication _replication = do-    True & Boolean.Boolean & BinaryBit.putBits 1 -- open-    False & Boolean.Boolean & BinaryBit.putBits 1 -- existing-    -- TODO: put props-+  True & Boolean.Boolean & BinaryBit.putBits 1 -- open+  False & Boolean.Boolean & BinaryBit.putBits 1 -- existing+  pure () -- TODO: put props  putClosedReplication :: Replication.Replication -> BinaryBit.BitPut () putClosedReplication _replication = do-    False & Boolean.Boolean & BinaryBit.putBits 1 -- closed+  False & Boolean.Boolean & BinaryBit.putBits 1 -- closed

@@ -1,7 +1,9 @@ {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} -module Octane.Utility.Optimizer (optimizeFrames) where+module Octane.Utility.Optimizer+  ( optimizeFrames+  ) where  import Data.Function ((&)) @@ -15,110 +17,112 @@ import qualified Octane.Type.State as State import qualified Octane.Type.Value as Value - -- | Optimizes frames by removing unnecessary replications. optimizeFrames :: [Frame.Frame] -> [Frame.Frame]-optimizeFrames frames = frames-    & Foldable.foldl'-        (\ (state, fs) f -> let-            newState = updateState f state+optimizeFrames frames =+  frames &+  Foldable.foldl'+    (\(state, fs) f ->+        let newState = updateState f state             minimalFrame = getDelta state f-            in (newState, minimalFrame : fs))-        (initialState, [])-    & snd-    & reverse-+        in (newState, minimalFrame : fs))+    (initialState, []) &+  snd &+  reverse  -- { actor id => (alive?, { property name => property value } ) } type State = IntMap.IntMap (Bool, Map.Map StrictText.Text Value.Value) - initialState :: State initialState = IntMap.empty - updateState :: Frame.Frame -> State -> State-updateState frame state1 = let-    spawned = frame-        & #replications-        & filter (\ replication -> replication-            & #state-            & (== State.SOpening))-        & map #actorId-        & map CompressedWord.fromCompressedWord-    state2 = spawned-        & foldr-            (IntMap.alter (\ maybeValue -> Just (case maybeValue of-                Nothing -> (True, Map.empty)-                Just (_, properties) -> (True, properties))))-            state1--    destroyed = frame-        & #replications-        & filter (\ replication -> replication-            & #state-            & (== State.SClosing))-        & map #actorId-        & map CompressedWord.fromCompressedWord-    state3 = destroyed-        & foldr-            (IntMap.alter (\ maybeValue -> Just (case maybeValue of-                Nothing -> (False, Map.empty)-                Just (_, properties) -> (False, properties))))-            state2--    updated = frame-        & #replications-        & filter (\ replication -> replication-            & #state-            & (== State.SExisting))-    state4 = updated-        & foldr-            (\ replication -> IntMap.alter-                (\ maybeValue -> Just (case maybeValue of-                    Nothing ->-                        (True, #properties replication)-                    Just (alive, properties) ->-                        ( alive-                        , Map.union-                            (#properties replication)-                            properties-                        )))+updateState frame state1 =+  let spawned =+        frame & #replications &+        filter (\replication -> replication & #state & (== State.SOpening)) &+        map #actorId &+        map CompressedWord.fromCompressedWord+      state2 =+        spawned &+        foldr+          (IntMap.alter+             (\maybeValue ->+                 Just+                   (case maybeValue of+                      Nothing -> (True, Map.empty)+                      Just (_, properties) -> (True, properties))))+          state1+      destroyed =+        frame & #replications &+        filter (\replication -> replication & #state & (== State.SClosing)) &+        map #actorId &+        map CompressedWord.fromCompressedWord+      state3 =+        destroyed &+        foldr+          (IntMap.alter+             (\maybeValue ->+                 Just+                   (case maybeValue of+                      Nothing -> (False, Map.empty)+                      Just (_, properties) -> (False, properties))))+          state2+      updated =+        frame & #replications &+        filter (\replication -> replication & #state & (== State.SExisting))+      state4 =+        updated &+        foldr+          (\replication ->+              IntMap.alter+                (\maybeValue ->+                    Just+                      (case maybeValue of+                         Nothing -> (True, #properties replication)+                         Just (alive, properties) ->+                           (alive, Map.union (#properties replication) properties)))                 (replication & #actorId & CompressedWord.fromCompressedWord))-            state3--    in state4-+          state3+  in state4  getDelta :: State -> Frame.Frame -> Frame.Frame-getDelta state frame = let-    newReplications = frame-        & #replications-        -- Remove replications that aren't actually new.-        & reject (\ replication -> let-            isOpening = #state replication == State.SOpening-            actorId = #actorId replication-            currentState = IntMap.lookup (CompressedWord.fromCompressedWord actorId) state-            isAlive = fmap fst currentState-            wasAlreadyAlive = isAlive == Just True-            in isOpening && wasAlreadyAlive)-        -- Remove properties that haven't changed.-        & map (\ replication ->-            if #state replication == State.SExisting-            then let-                actorId = #actorId replication-                currentState = IntMap.findWithDefault-                    (True, Map.empty) (CompressedWord.fromCompressedWord actorId) state-                currentProperties = snd currentState-                newProperties = #properties replication-                changes = newProperties-                    & Map.filterWithKey (\ name newValue -> let-                        oldValue = Map.lookup name currentProperties-                        in Just newValue /= oldValue)-                in replication { Replication.replicationProperties = changes }-            else replication)-    in frame { Frame.frameReplications = newReplications }-+getDelta state frame =+  let newReplications =+        frame & #replications &+        reject+          (\replication ->+              let isOpening = #state replication == State.SOpening+                  actorId = #actorId replication+                  currentState =+                    IntMap.lookup (CompressedWord.fromCompressedWord actorId) state+                  isAlive = fmap fst currentState+                  wasAlreadyAlive = isAlive == Just True+              in isOpening && wasAlreadyAlive) &+        map+          (\replication ->+              if #state replication == State.SExisting+                then let actorId = #actorId replication+                         currentState =+                           IntMap.findWithDefault+                             (True, Map.empty)+                             (CompressedWord.fromCompressedWord actorId)+                             state+                         currentProperties = snd currentState+                         newProperties = #properties replication+                         changes =+                           newProperties &+                           Map.filterWithKey+                             (\name newValue ->+                                 let oldValue = Map.lookup name currentProperties+                                 in Just newValue /= oldValue)+                     in replication+                        { Replication.replicationProperties = changes+                        }+                else replication)+  in frame+     { Frame.frameReplications = newReplications+     }  reject :: (a -> Bool) -> [a] -> [a]-reject p xs = filter (\ x -> not (p x)) xs+reject p xs = filter (\x -> not (p x)) xs

@@ -9,7 +9,9 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -module Octane.Utility.Parser (parseStream) where+module Octane.Utility.Parser+  ( parseStream+  ) where  import Data.Function ((&)) @@ -35,7 +37,7 @@ import qualified Octane.Type.Int32 as Int32 import qualified Octane.Type.Property as Property import qualified Octane.Type.RemoteId as RemoteId-import qualified Octane.Type.ReplayWithoutFrames as ReplayWithoutFrames+import qualified Octane.Type.ReplayWithoutFrames as Replay import qualified Octane.Type.Replication as Replication import qualified Octane.Type.State as State import qualified Octane.Type.Text as Text@@ -48,201 +50,197 @@ import qualified Octane.Utility.ClassPropertyMap as CPM import qualified Text.Printf as Printf - -- Data types-- -- { class stream id => { property stream id => name } } type ClassPropertyMap = IntMap.IntMap (IntMap.IntMap StrictText.Text) - -- { stream id => object name } type ObjectMap = IntMap.IntMap StrictText.Text - -- { class name => class id } type ClassMap = Map.Map StrictText.Text Int - data Thing = Thing-    { thingFlag :: Boolean.Boolean-    , thingObjectId :: Int32.Int32-    , thingObjectName :: StrictText.Text-    , thingClassId :: Int-    , thingClassName :: StrictText.Text-    , thingInitialization :: Initialization.Initialization-    } deriving (Eq, Generics.Generic, Show)+  { thingFlag :: Boolean.Boolean+  , thingObjectId :: Int32.Int32+  , thingObjectName :: StrictText.Text+  , thingClassId :: Int+  , thingClassName :: StrictText.Text+  , thingInitialization :: Initialization.Initialization+  } deriving (Eq, Generics.Generic, Show)  $(OverloadedRecords.overloadedRecord Default.def ''Thing)  instance DeepSeq.NFData Thing - data Context = Context-    { contextObjectMap :: ObjectMap-    , contextClassPropertyMap :: ClassPropertyMap-    , contextThings :: IntMap.IntMap Thing-    , contextClassMap :: ClassMap-    , contextKeyFrames :: Set.Set Word-    , contextVersion :: Version.Version-    } deriving (Eq, Generics.Generic, Show)+  { contextObjectMap :: ObjectMap+  , contextClassPropertyMap :: ClassPropertyMap+  , contextThings :: IntMap.IntMap Thing+  , contextClassMap :: ClassMap+  , contextKeyFrames :: Set.Set Word+  , contextVersion :: Version.Version+  } deriving (Eq, Generics.Generic, Show)  $(OverloadedRecords.overloadedRecord Default.def ''Context)  instance DeepSeq.NFData Context --extractContext :: ReplayWithoutFrames.ReplayWithoutFrames -> Context+extractContext :: Replay.ReplayWithoutFrames -> Context extractContext replay = do-    let keyFrames = replay-            & #keyFrames-            & #unpack-            & map #frame-            & map Word32.fromWord32-            & Set.fromList-    let version =-            [ replay & #version1-            , replay & #version2-            ] & map Word32.fromWord32 & Version.makeVersion-    Context-        (CPM.getPropertyMap replay)-        (CPM.getClassPropertyMap replay)-        IntMap.empty-        (CPM.getActorMap replay)-        keyFrames-        version-+  let keyFrames =+        replay & #keyFrames & #unpack & map #frame & map Word32.fromWord32 &+        Set.fromList+  let version =+        [replay & #version1, replay & #version2] & map Word32.fromWord32 &+        Version.makeVersion+  Context+    (CPM.getPropertyMap replay)+    (CPM.getClassPropertyMap replay)+    IntMap.empty+    (CPM.getActorMap replay)+    keyFrames+    version  -- | Parses the network stream and returns a list of frames.-parseStream :: ReplayWithoutFrames.ReplayWithoutFrames -> [Frame.Frame]-parseStream replay = let-    numFrames = replay-        & #properties-        & #unpack-        & Map.lookup ("NumFrames" & StrictText.pack & Text.Text)-        & (\ property -> case property of-            Just (Property.IntProperty _ x) -> x & #unpack & fromIntegral-            _ -> 0)-    get = replay & extractContext & getFrames 0 numFrames & BinaryBit.runBitGet-    stream = replay & #stream & #unpack-    (_context, frames) = Binary.runGet get stream-    in frames-+parseStream :: Replay.ReplayWithoutFrames -> [Frame.Frame]+parseStream replay =+  let numFrames =+        replay & #properties & #unpack &+        Map.lookup ("NumFrames" & StrictText.pack & Text.Text) &+        (\property ->+            case property of+              Just (Property.PropertyInt int) -> int & #content & Int32.fromInt32+              _ -> 0)+      get = replay & extractContext & getFrames 0 numFrames & BinaryBit.runBitGet+      stream = replay & #stream & #unpack+      (_context, frames) = Binary.runGet get stream+  in frames  getFrames :: Word -> Int -> Context -> BinaryBit.BitGet (Context, [Frame.Frame]) getFrames number numFrames context = do-    if fromIntegral number >= numFrames+  if fromIntegral number >= numFrames     then pure (context, [])     else do-        isEmpty <- BinaryBit.isEmpty-        if isEmpty+      isEmpty <- BinaryBit.isEmpty+      if isEmpty         then pure (context, [])         else do-            maybeFrame <- getMaybeFrame context number-            case maybeFrame of-                Nothing -> pure (context, [])-                Just (newContext, frame) -> do-                    (newerContext, frames) <- getFrames (number + 1) numFrames newContext-                    pure (newerContext, (frame : frames))-+          maybeFrame <- getMaybeFrame context number+          case maybeFrame of+            Nothing -> pure (context, [])+            Just (newContext, frame) -> do+              (newerContext, frames) <- getFrames (number + 1) numFrames newContext+              pure (newerContext, (frame : frames)) -getMaybeFrame :: Context -> Word -> BinaryBit.BitGet (Maybe (Context, Frame.Frame))+getMaybeFrame :: Context+              -> Word+              -> BinaryBit.BitGet (Maybe (Context, Frame.Frame)) getMaybeFrame context number = do-    time <- getFloat32-    delta <- getFloat32-    if time == 0 && delta == 0+  time <- getFloat32+  delta <- getFloat32+  if time == 0 && delta == 0     then pure Nothing     else if time < 0.001 || delta < 0.001-    then fail ("parsing previous frame probably failed. time: " ++ show time ++ ", delta: " ++ show delta)-    else do-        (newContext, frame) <- getFrame context number time delta-        pure (Just (newContext, frame))-+           then fail+                  ("parsing previous frame probably failed. time: " +++                   show time ++ ", delta: " ++ show delta)+           else do+             (newContext, frame) <- getFrame context number time delta+             pure (Just (newContext, frame)) -getFrame :: Context -> Word -> Float32.Float32 -> Float32.Float32 -> BinaryBit.BitGet (Context, Frame.Frame)+getFrame+  :: Context+  -> Word+  -> Float32.Float32+  -> Float32.Float32+  -> BinaryBit.BitGet (Context, Frame.Frame) getFrame context number time delta = do-    (newContext, replications) <- getReplications context-    let frame = Frame.Frame-            number-            (context & #keyFrames & Set.member number)-            time-            delta-            replications-    (newContext, frame) & DeepSeq.force & pure-+  (newContext, replications) <- getReplications context+  let frame =+        Frame.Frame+          number+          (context & #keyFrames & Set.member number)+          time+          delta+          replications+  (newContext, frame) & DeepSeq.force & pure -getReplications :: Context -> BinaryBit.BitGet (Context, [Replication.Replication])+getReplications :: Context+                -> BinaryBit.BitGet (Context, [Replication.Replication]) getReplications context = do-    maybeReplication <- getMaybeReplication context-    case maybeReplication of-        Nothing -> pure (context, [])-        Just (newContext, replication) -> do-            (newerContext, replications) <- getReplications newContext-            pure (newerContext, replication : replications)-+  maybeReplication <- getMaybeReplication context+  case maybeReplication of+    Nothing -> pure (context, [])+    Just (newContext, replication) -> do+      (newerContext, replications) <- getReplications newContext+      pure (newerContext, replication : replications) -getMaybeReplication :: Context -> BinaryBit.BitGet (Maybe (Context, Replication.Replication))+getMaybeReplication :: Context+                    -> BinaryBit.BitGet (Maybe (Context, Replication.Replication)) getMaybeReplication context = do-    hasReplication <- getBool-    if #unpack hasReplication-        then do-            (newContext,replication) <- getReplication context-            pure (Just (newContext, replication))-        else pure Nothing-+  hasReplication <- getBool+  if #unpack hasReplication+    then do+      (newContext, replication) <- getReplication context+      pure (Just (newContext, replication))+    else pure Nothing  getReplication :: Context -> BinaryBit.BitGet (Context, Replication.Replication) getReplication context = do-    actorId <- BinaryBit.getBits maxActorId-    isOpen <- getBool-    let go =-            if #unpack isOpen-                then getOpenReplication-                else getClosedReplication-    go context actorId-+  actorId <- BinaryBit.getBits maxActorId+  isOpen <- getBool+  let go =+        if #unpack isOpen+          then getOpenReplication+          else getClosedReplication+  go context actorId -getOpenReplication :: Context-                   -> CompressedWord.CompressedWord-                   -> BinaryBit.BitGet (Context, Replication.Replication)+getOpenReplication+  :: Context+  -> CompressedWord.CompressedWord+  -> BinaryBit.BitGet (Context, Replication.Replication) getOpenReplication context actorId = do-    isNew <- getBool-    let go =-            if #unpack isNew-                then getNewReplication-                else getExistingReplication-    go context actorId-+  isNew <- getBool+  let go =+        if #unpack isNew+          then getNewReplication+          else getExistingReplication+  go context actorId -getNewReplication :: Context-                  -> CompressedWord.CompressedWord-                  -> BinaryBit.BitGet (Context, Replication.Replication)+getNewReplication+  :: Context+  -> CompressedWord.CompressedWord+  -> BinaryBit.BitGet (Context, Replication.Replication) getNewReplication context actorId = do-    unknownFlag <- getBool-    if #unpack unknownFlag-        then fail "the unknown flag in a new replication is true! what does it mean?"-        else pure ()-    objectId <- getInt32-    objectName <- case context & #objectMap & IntMap.lookup (Int32.fromInt32 objectId) of-        Nothing -> fail ("could not find object name for id " ++ show objectId)-        Just x -> pure x-    (classId, className) <- CPM.getClass-        (#objectMap context)-        Data.classes-        (#classMap context)-        (Int32.fromInt32 objectId)-    classInit <- Initialization.getInitialization className-    let thing = Thing-            unknownFlag-            objectId-            objectName-            classId-            className-            classInit-    let things = #things context-    let newThings = IntMap.insert (CompressedWord.fromCompressedWord actorId) thing things-    let newContext = context { contextThings = newThings }-    pure (newContext, Replication.Replication+  unknownFlag <- getBool+  if #unpack unknownFlag+    then fail+           "the unknown flag in a new replication is true! what does it mean?"+    else pure ()+  objectId <- getInt32+  objectName <-+    case context & #objectMap & IntMap.lookup (Int32.fromInt32 objectId) of+      Nothing -> fail ("could not find object name for id " ++ show objectId)+      Just x -> pure x+  (classId, className) <-+    CPM.getClass+      (#objectMap context)+      Data.classes+      (#classMap context)+      (Int32.fromInt32 objectId)+  classInit <- Initialization.getInitialization className+  let thing = Thing unknownFlag objectId objectName classId className classInit+  let things = #things context+  let newThings =+        IntMap.insert (CompressedWord.fromCompressedWord actorId) thing things+  let newContext =+        context+        { contextThings = newThings+        }+  pure+    ( newContext+    , Replication.Replication         actorId         objectName         className@@ -250,16 +248,21 @@         (Just classInit)         Map.empty) --getExistingReplication :: Context-                       -> CompressedWord.CompressedWord-                       -> BinaryBit.BitGet (Context, Replication.Replication)+getExistingReplication+  :: Context+  -> CompressedWord.CompressedWord+  -> BinaryBit.BitGet (Context, Replication.Replication) getExistingReplication context actorId = do-    thing <- case context & #things & IntMap.lookup (CompressedWord.fromCompressedWord actorId) of-        Nothing -> fail ("could not find thing for existing actor " ++ show actorId)-        Just x -> pure x-    props <- getProps context thing-    pure (context, Replication.Replication+  thing <-+    case context & #things &+         IntMap.lookup (CompressedWord.fromCompressedWord actorId) of+      Nothing ->+        fail ("could not find thing for existing actor " ++ show actorId)+      Just x -> pure x+  props <- getProps context thing+  pure+    ( context+    , Replication.Replication         actorId         (#objectName thing)         (#className thing)@@ -267,64 +270,79 @@         Nothing         props) --getClosedReplication :: Context-                     -> CompressedWord.CompressedWord-                     -> BinaryBit.BitGet (Context, Replication.Replication)+getClosedReplication+  :: Context+  -> CompressedWord.CompressedWord+  -> BinaryBit.BitGet (Context, Replication.Replication) getClosedReplication context actorId = do-    thing <- case context & #things & IntMap.lookup (CompressedWord.fromCompressedWord actorId) of-        Nothing -> fail ("could not find thing for closed actor " ++ show actorId)-        Just x -> pure x-    let newThings = context & #things & IntMap.delete (CompressedWord.fromCompressedWord actorId)-    let newContext = context { contextThings = newThings }-    pure (newContext, Replication.Replication-          actorId-          (#objectName thing)-          (#className thing)-          State.SClosing-          Nothing-          Map.empty)-+  thing <-+    case context & #things &+         IntMap.lookup (CompressedWord.fromCompressedWord actorId) of+      Nothing -> fail ("could not find thing for closed actor " ++ show actorId)+      Just x -> pure x+  let newThings =+        context & #things &+        IntMap.delete (CompressedWord.fromCompressedWord actorId)+  let newContext =+        context+        { contextThings = newThings+        }+  pure+    ( newContext+    , Replication.Replication+        actorId+        (#objectName thing)+        (#className thing)+        State.SClosing+        Nothing+        Map.empty) -getProps :: Context -> Thing -> BinaryBit.BitGet (Map.Map StrictText.Text Value.Value)+getProps :: Context+         -> Thing+         -> BinaryBit.BitGet (Map.Map StrictText.Text Value.Value) getProps context thing = do-    maybeProp <- getMaybeProp context thing-    case maybeProp of-        Nothing -> pure Map.empty-        Just (k, v) -> do-            let m = Map.singleton k v-            props <- getProps context thing-            pure (Map.union m props)-+  maybeProp <- getMaybeProp context thing+  case maybeProp of+    Nothing -> pure Map.empty+    Just (k, v) -> do+      let m = Map.singleton k v+      props <- getProps context thing+      pure (Map.union m props) -getMaybeProp :: Context -> Thing -> BinaryBit.BitGet (Maybe (StrictText.Text, Value.Value))+getMaybeProp :: Context+             -> Thing+             -> BinaryBit.BitGet (Maybe (StrictText.Text, Value.Value)) getMaybeProp context thing = do-    hasProp <- getBool-    if #unpack hasProp+  hasProp <- getBool+  if #unpack hasProp     then do-        prop <- getProp context thing-        pure (Just prop)+      prop <- getProp context thing+      pure (Just prop)     else pure Nothing - getProp :: Context -> Thing -> BinaryBit.BitGet (StrictText.Text, Value.Value) getProp context thing = do-    let classId = #classId thing-    props <- case context & #classPropertyMap & IntMap.lookup classId of-        Nothing -> fail ("could not find property map for class id " ++ show classId)-        Just x -> pure x-    let maxId = props & IntMap.keys & (0 :) & maximum-    pid <- fmap CompressedWord.fromCompressedWord (BinaryBit.getBits maxId)-    name <- case props & IntMap.lookup pid of-        Nothing -> fail ("could not find property name for property id " ++ show pid)-        Just x -> pure x-    value <- getPropValue context name-    pure (name, value)-+  let classId = #classId thing+  props <-+    case context & #classPropertyMap & IntMap.lookup classId of+      Nothing ->+        fail ("could not find property map for class id " ++ show classId)+      Just x -> pure x+  let maxId = props & IntMap.keys & (0 :) & maximum+  pid <- fmap CompressedWord.fromCompressedWord (BinaryBit.getBits maxId)+  name <-+    case props & IntMap.lookup pid of+      Nothing ->+        fail ("could not find property name for property id " ++ show pid)+      Just x -> pure x+  value <- getPropValue context name+  pure (name, value)  getPropValue :: Context -> StrictText.Text -> BinaryBit.BitGet Value.Value-getPropValue context name = case Map.lookup name Data.properties of-    Just property -> case StrictText.unpack property of+getPropValue context name =+  case Map.lookup name Data.properties of+    Just property ->+      case StrictText.unpack property of         "boolean" -> getBooleanProperty         "byte" -> getByteProperty         "cam_settings" -> getCamSettingsProperty@@ -349,263 +367,296 @@         "string" -> getStringProperty         "team_paint" -> getTeamPaintProperty         "unique_id" -> getUniqueIdProperty-        _ -> fail ("Don't know how to read property type " ++ show property ++ " for " ++ show name)+        _ ->+          fail+            ("Don't know how to read property type " +++             show property ++ " for " ++ show name)     Nothing -> do-        fail ("Don't know how to read property " ++ show name)-+      fail ("Don't know how to read property " ++ show name)  getBooleanProperty :: BinaryBit.BitGet Value.Value getBooleanProperty = do-    bool <- getBool-    pure (Value.VBoolean bool)-+  bool <- getBool+  pure (Value.ValueBoolean (Value.BooleanValue bool))  getByteProperty :: BinaryBit.BitGet Value.Value getByteProperty = do-    word <- getWord8-    pure (Value.VByte word)-+  word <- getWord8+  pure (Value.ValueByte (Value.ByteValue word))  getCamSettingsProperty :: BinaryBit.BitGet Value.Value getCamSettingsProperty = do-    fov <- getFloat32-    height <- getFloat32-    angle <- getFloat32-    distance <- getFloat32-    stiffness <- getFloat32-    swivelSpeed <- getFloat32-    pure (Value.VCamSettings fov height angle distance stiffness swivelSpeed)-+  fov <- getFloat32+  height <- getFloat32+  angle <- getFloat32+  distance <- getFloat32+  stiffness <- getFloat32+  swivelSpeed <- getFloat32+  pure+    (Value.ValueCamSettings+       (Value.CamSettingsValue fov height angle distance stiffness swivelSpeed))  getDemolishProperty :: BinaryBit.BitGet Value.Value getDemolishProperty = do-    atkFlag <- getBool-    atk <- getWord32-    vicFlag <- getBool-    vic <- getWord32-    vec1 <- Vector.getIntVector-    vec2 <- Vector.getIntVector-    pure (Value.VDemolish atkFlag atk vicFlag vic vec1 vec2)-+  attackerFlag <- getBool+  attackerActorId <- getWord32+  victimFlag <- getBool+  victimActorId <- getWord32+  attackerVelocity <- Vector.getIntVector+  victimVelocity <- Vector.getIntVector+  pure+    (Value.ValueDemolish+       (Value.DemolishValue+          attackerFlag+          attackerActorId+          victimFlag+          victimActorId+          attackerVelocity+          victimVelocity))  getEnumProperty :: BinaryBit.BitGet Value.Value getEnumProperty = do-    x <- BinaryBit.getWord16be 10-    y <- if x == 1023-        then getBool-        else fail ("unexpected enum value " ++ show x)-    pure (Value.VEnum (Word16.toWord16 x) y)-+  value <- BinaryBit.getWord16be 10+  flag <-+    if value == 1023+      then getBool+      else fail ("unexpected enum value " ++ show value)+  pure (Value.ValueEnum (Value.EnumValue (Word16.toWord16 value) flag))  getExplosionProperty :: BinaryBit.BitGet Value.Value getExplosionProperty = do-    noGoal <- getBool-    a <- if #unpack noGoal-        then pure Nothing-        else fmap Just getInt32-    b <- Vector.getIntVector-    pure (Value.VExplosion noGoal a b)-+  actorless <- getBool+  actorId <-+    if #unpack actorless+      then pure Nothing+      else fmap Just getInt32+  position <- Vector.getIntVector+  pure (Value.ValueExplosion (Value.ExplosionValue actorless actorId position))  getFlaggedIntProperty :: BinaryBit.BitGet Value.Value getFlaggedIntProperty = do-    flag <- getBool-    int <- getInt32-    pure (Value.VFlaggedInt flag int)-+  flag <- getBool+  int <- getInt32+  pure (Value.ValueFlaggedInt (Value.FlaggedIntValue flag int))  getFloatProperty :: BinaryBit.BitGet Value.Value getFloatProperty = do-    float <- getFloat32-    pure (Value.VFloat float)-+  float <- getFloat32+  pure (Value.ValueFloat (Value.FloatValue float))  getGameModeProperty :: Context -> BinaryBit.BitGet Value.Value getGameModeProperty context = do-    let numBits = if atLeastNeoTokyo context then 8 else 2-    x <- BinaryBit.getWord8 numBits-    pure (Value.VGameMode (Word8.toWord8 x))-+  let numBits =+        if atLeastNeoTokyo context+          then 8+          else 2+  x <- BinaryBit.getWord8 numBits+  pure (Value.ValueGameMode (Value.GameModeValue (Word8.toWord8 x)))  getIntProperty :: BinaryBit.BitGet Value.Value getIntProperty = do-    int <- getInt32-    pure (Value.VInt int)-+  int <- getInt32+  pure (Value.ValueInt (Value.IntValue int))  getLoadoutOnlineProperty :: BinaryBit.BitGet Value.Value getLoadoutOnlineProperty = do-    size <- fmap Word8.fromWord8 getWord8-    values <- Monad.replicateM size (do-        innerSize <- fmap Word8.fromWord8 getWord8-        Monad.replicateM innerSize (do-            x <- getWord32-            y <- BinaryBit.getBits 27-            pure (x, y)))-    pure (Value.VLoadoutOnline values)-+  size <- fmap Word8.fromWord8 getWord8+  values <-+    Monad.replicateM+      size+      (do innerSize <- fmap Word8.fromWord8 getWord8+          Monad.replicateM+            innerSize+            (do x <- getWord32+                y <- BinaryBit.getBits 27+                pure (x, y)))+  pure (Value.ValueLoadoutOnline (Value.LoadoutOnlineValue values))  getLoadoutProperty :: BinaryBit.BitGet Value.Value getLoadoutProperty = do-    version <- getWord8-    body <- getWord32-    decal <- getWord32-    wheels <- getWord32-    rocketTrail <- getWord32-    antenna <- getWord32-    topper <- getWord32-    g <- getWord32-    h <- if version > 10 then fmap Just getWord32 else pure Nothing-    pure (Value.VLoadout version body decal wheels rocketTrail antenna topper g h)-+  version <- getWord8+  body <- getWord32+  decal <- getWord32+  wheels <- getWord32+  rocketTrail <- getWord32+  antenna <- getWord32+  topper <- getWord32+  g <- getWord32+  h <-+    if version > 10+      then fmap Just getWord32+      else pure Nothing+  pure+    (Value.ValueLoadout+       (Value.LoadoutValue+          version+          body+          decal+          wheels+          rocketTrail+          antenna+          topper+          g+          h))  getLocationProperty :: BinaryBit.BitGet Value.Value getLocationProperty = do-    vector <- Vector.getIntVector-    pure (Value.VLocation vector)-+  vector <- Vector.getIntVector+  pure (Value.ValueLocation (Value.LocationValue vector))  getMusicStingerProperty :: BinaryBit.BitGet Value.Value getMusicStingerProperty = do-    flag <- getBool-    cue <- getWord32-    trigger <- getWord8-    pure (Value.VMusicStinger flag cue trigger)-+  flag <- getBool+  cue <- getWord32+  trigger <- getWord8+  pure (Value.ValueMusicStinger (Value.MusicStingerValue flag cue trigger))  getPickupProperty :: BinaryBit.BitGet Value.Value getPickupProperty = do-    instigator <- getBool-    instigatorId <- if #unpack instigator-        then fmap Just getWord32-        else pure Nothing-    pickedUp <- getBool-    pure (Value.VPickup instigator instigatorId pickedUp)-+  instigator <- getBool+  instigatorId <-+    if #unpack instigator+      then fmap Just getWord32+      else pure Nothing+  pickedUp <- getBool+  pure (Value.ValuePickup (Value.PickupValue instigator instigatorId pickedUp))  getPrivateMatchSettingsProperty :: BinaryBit.BitGet Value.Value getPrivateMatchSettingsProperty = do-    mutators <- getText-    joinableBy <- getWord32-    maxPlayers <- getWord32-    gameName <- getText-    password <- getText-    flag <- getBool-    pure (Value.VPrivateMatchSettings mutators joinableBy maxPlayers gameName password flag)-+  mutators <- getText+  joinableBy <- getWord32+  maxPlayers <- getWord32+  gameName <- getText+  password <- getText+  flag <- getBool+  pure+    (Value.ValuePrivateMatchSettings+       (Value.PrivateMatchSettingsValue+          mutators+          joinableBy+          maxPlayers+          gameName+          password+          flag))  getQWordProperty :: BinaryBit.BitGet Value.Value getQWordProperty = do-    qword <- getWord64-    pure (Value.VQWord qword)-+  qword <- getWord64+  pure (Value.ValueQWord (Value.QWordValue qword))  getRelativeRotationProperty :: BinaryBit.BitGet Value.Value getRelativeRotationProperty = do-    vector <- Vector.getFloatVector-    pure (Value.VRelativeRotation vector)-+  vector <- Vector.getFloatVector+  pure (Value.ValueRelativeRotation (Value.RelativeRotationValue vector))  getReservationProperty :: Context -> BinaryBit.BitGet Value.Value-getReservationProperty context = do-    -- I think this is the connection order. The first player to connect-    -- gets number 0, and it goes up from there. The maximum is 7, which-    -- would be a full 4x4 game.-    number <- BinaryBit.getBits maxConnectionNumber-    (systemId, remoteId, localId) <- getUniqueId-    playerName <- if systemId == 0 then pure Nothing else fmap Just getText-    -- No idea what these two flags are. Might be for bots?-    a <- getBool-    b <- getBool--    -- The Neo Tokyo update added 6 bits to the reservation property that are-    -- always (as far as I can tell) 0.-    Monad.when (atLeastNeoTokyo context) (do-        x <- BinaryBit.getWord8 6-        Monad.when (x /= 0b000000) (do-            fail (Printf.printf "Read 6 reservation bits and they weren't all 0! 0b%06b" x)))--    pure (Value.VReservation number systemId remoteId localId playerName a b)-+getReservationProperty context+                       -- I think this is the connection order. The first player to connect+                       -- gets number 0, and it goes up from there. The maximum is 7, which+                       -- would be a full 4x4 game.+ = do+  number <- BinaryBit.getBits maxConnectionNumber+  (systemId, remoteId, localId) <- getUniqueId+  playerName <-+    if systemId == 0+      then pure Nothing+      else fmap Just getText+  -- No idea what these two flags are. Might be for bots?+  a <- getBool+  b <- getBool+  -- The Neo Tokyo update added 6 bits to the reservation property that are+  -- always (as far as I can tell) 0.+  Monad.when+    (atLeastNeoTokyo context)+    (do x <- BinaryBit.getWord8 6+        Monad.when+          (x /= 0b000000)+          (do fail+                (Printf.printf+                   "Read 6 reservation bits and they weren't all 0! 0b%06b"+                   x)))+  pure+    (Value.ValueReservation+       (Value.ReservationValue number systemId remoteId localId playerName a b))  getRigidBodyStateProperty :: BinaryBit.BitGet Value.Value getRigidBodyStateProperty = do-    flag <- getBool-    position <- Vector.getIntVector-    rotation <- Vector.getFloatVector-    x <- if #unpack flag-        then pure Nothing-        else fmap Just Vector.getIntVector-    y <- if #unpack flag-        then pure Nothing-        else fmap Just Vector.getIntVector-    pure (Value.VRigidBodyState flag position rotation x y)-+  flag <- getBool+  position <- Vector.getIntVector+  rotation <- Vector.getFloatVector+  x <-+    if #unpack flag+      then pure Nothing+      else fmap Just Vector.getIntVector+  y <-+    if #unpack flag+      then pure Nothing+      else fmap Just Vector.getIntVector+  pure+    (Value.ValueRigidBodyState+       (Value.RigidBodyStateValue flag position rotation x y))  getStringProperty :: BinaryBit.BitGet Value.Value getStringProperty = do-    string <- getText-    pure (Value.VString string)-+  string <- getText+  pure (Value.ValueString (Value.StringValue string))  getTeamPaintProperty :: BinaryBit.BitGet Value.Value getTeamPaintProperty = do-    team <- getWord8-    primaryColor <- getWord8-    accentColor <- getWord8-    primaryFinish <- getWord32-    accentFinish <- getWord32-    pure (Value.VTeamPaint team primaryColor accentColor primaryFinish accentFinish)-+  team <- getWord8+  primaryColor <- getWord8+  accentColor <- getWord8+  primaryFinish <- getWord32+  accentFinish <- getWord32+  pure+    (Value.ValueTeamPaint+       (Value.TeamPaintValue team primaryColor accentColor primaryFinish accentFinish))  getUniqueIdProperty :: BinaryBit.BitGet Value.Value getUniqueIdProperty = do-    (systemId, remoteId, localId) <- getUniqueId-    pure (Value.VUniqueId systemId remoteId localId)-+  (systemId, remoteId, localId) <- getUniqueId+  pure (Value.ValueUniqueId (Value.UniqueIdValue systemId remoteId localId))  -- | Even though this is just a unique ID property, it must be handled -- specially because it sometimes doesn't have the remote or local IDs. getPartyLeaderProperty :: BinaryBit.BitGet Value.Value getPartyLeaderProperty = do-    systemId <- getWord8-    (remoteId, localId) <- if systemId == 0-        then pure (RemoteId.RemoteSplitscreenId (RemoteId.SplitscreenId Nothing), Nothing)-        else do-            remoteId <- getRemoteId systemId-            localId <- fmap Just getWord8-            pure (remoteId, localId)-    pure (Value.VUniqueId systemId remoteId localId)-+  systemId <- getWord8+  (remoteId, localId) <-+    if systemId == 0+      then pure+             (RemoteId.RemoteSplitscreenId (RemoteId.SplitscreenId Nothing), Nothing)+      else do+        remoteId <- getRemoteId systemId+        localId <- fmap Just getWord8+        pure (remoteId, localId)+  pure (Value.ValueUniqueId (Value.UniqueIdValue systemId remoteId localId))  getUniqueId :: BinaryBit.BitGet (Word8.Word8, RemoteId.RemoteId, Maybe Word8.Word8) getUniqueId = do-    systemId <- getWord8-    remoteId <- getRemoteId systemId-    localId <- fmap Just getWord8-    pure (systemId, remoteId, localId)-+  systemId <- getWord8+  remoteId <- getRemoteId systemId+  localId <- fmap Just getWord8+  pure (systemId, remoteId, localId)  getRemoteId :: Word8.Word8 -> BinaryBit.BitGet RemoteId.RemoteId-getRemoteId systemId = case systemId of+getRemoteId systemId =+  case systemId of     0 -> do-        splitscreenId <- BinaryBit.getBits 0-        pure (RemoteId.RemoteSplitscreenId splitscreenId)+      splitscreenId <- BinaryBit.getBits 0+      pure (RemoteId.RemoteSplitscreenId splitscreenId)     1 -> do-        steamId <- BinaryBit.getBits 0-        pure (RemoteId.RemoteSteamId steamId)+      steamId <- BinaryBit.getBits 0+      pure (RemoteId.RemoteSteamId steamId)     2 -> do-        playStationId <- BinaryBit.getBits 0-        pure (RemoteId.RemotePlayStationId playStationId)+      playStationId <- BinaryBit.getBits 0+      pure (RemoteId.RemotePlayStationId playStationId)     4 -> do-        xboxId <- BinaryBit.getBits 0-        pure (RemoteId.RemoteXboxId xboxId)+      xboxId <- BinaryBit.getBits 0+      pure (RemoteId.RemoteXboxId xboxId)     _ -> fail ("unknown system id " ++ show systemId) - -- Helpers-- -- Some values are parsed differently depending on the version of the game that -- saved them. So far, all differences happened with the Neo Tokyo patch. This -- function takes a context and returns true if the replay was saved by a game@@ -613,48 +664,34 @@ atLeastNeoTokyo :: Context -> Bool atLeastNeoTokyo context = #version context >= neoTokyoVersion - -- Constants-- neoTokyoVersion :: Version.Version neoTokyoVersion = Version.makeVersion [868, 12] - maxActorId :: Int maxActorId = 1024 - maxConnectionNumber :: Int maxConnectionNumber = 7 - -- Type-restricted helpers.-- getBool :: BinaryBit.BitGet Boolean.Boolean getBool = BinaryBit.getBits 0 - getFloat32 :: BinaryBit.BitGet Float32.Float32 getFloat32 = BinaryBit.getBits 0 - getInt32 :: BinaryBit.BitGet Int32.Int32 getInt32 = BinaryBit.getBits 0 - getText :: BinaryBit.BitGet Text.Text getText = BinaryBit.getBits 0 - getWord8 :: BinaryBit.BitGet Word8.Word8 getWord8 = BinaryBit.getBits 0 - getWord32 :: BinaryBit.BitGet Word32.Word32 getWord32 = BinaryBit.getBits 0-  getWord64 :: BinaryBit.BitGet Word64.Word64 getWord64 = BinaryBit.getBits 0