packages feed

octane 0.11.0 → 0.12.0

raw patch · 39 files changed

+627/−192 lines, 39 files

Files

README.markdown view
@@ -4,14 +4,39 @@ [![Windows build badge][]][windows build] [![Build badge][]][build] -Octane parses [Rocket League][] replays.+Octane is the premier [Rocket League][] replay parser. [Rocket League+Replays][] parses tens of thousands of replays with it. Octane parses most+replays in less than 5 seconds. It outputs easy-to-read JSON. -To use Octane, first download and unpack the [latest release][] for your-operating system. Then run `octane path-to/the.replay`.+Octane has a command-line interface. To get it, download and unpack [the latest+release][] for your platform. You can run the executable one of three ways: -The [Rocket League Replays wiki][] has links to other Rocket League replay-parsers.+1.  Pipe a replay file into it. It will output a compact JSON object to+    standard out. +    ``` sh+    $ octane < a.replay > replay.json+    ```++2.  Pass it a path to a replay file. Both file paths and URLs work. It will+    output a compact JSON object to standard out.++    ``` sh+    $ octane a.replay > replay.json+    $ octane https://media.rocketleaguereplays.com/uploads/replay_files/9A06783F4FEA7AFF3D8298A3E5A412F5.replay > replay.json+    ```++3.  Pass it several paths to replay files. Both file paths and URLs work. It+    will output a compact JSON array of objects to standard out.++    ``` sh+    $ octane first.replay second.replay > replays.json+    ```++Octane is written in Haskell. If you're looking for a library written in+another language, check out the [Rocket League Replays wiki][]. It has links to+many other Rocket League replay parsers.+ [Octane]: https://github.com/tfausak/octane [Version badge]: https://www.stackage.org/package/octane/badge/nightly?label=version [version]: https://www.stackage.org/package/octane@@ -20,5 +45,6 @@ [Build badge]: https://travis-ci.org/tfausak/octane.svg?branch=main [build]: https://travis-ci.org/tfausak/octane [Rocket League]: http://www.rocketleaguegame.com-[latest release]: https://github.com/tfausak/octane/releases/latest+[Rocket League Replays]: https://www.rocketleaguereplays.com/replays/+[the latest release]: https://github.com/tfausak/octane/releases/latest [Rocket League Replays wiki]: https://github.com/rocket-league-replays/rocket-league-replays/wiki/Rocket-League-Replay-Parsers
library/Octane/Data/Classes.hs view
@@ -128,6 +128,7 @@     special =         [ ("TAGame.CrowdActor_TA", ".TheWorld:PersistentLevel.CrowdActor_TA_")         , ("TAGame.CrowdManager_TA", ".TheWorld:PersistentLevel.CrowdManager_TA_")+        , ("TAGame.InMapScoreboard_TA", ".TheWorld:PersistentLevel.InMapScoreboard_TA_")         , ("TAGame.VehiclePickup_Boost_TA", ".TheWorld:PersistentLevel.VehiclePickup_Boost_TA_")         ] & map (\ (klass, suffix) ->             ( StrictText.pack klass@@ -140,6 +141,7 @@ levels =     [ "EuroStadium_Rainy_P"     , "HoopsStadium_P"+    , "Neotokyo_p"     , "Park_Night_P"     , "Park_Rainy_P"     , "Stadium_p"@@ -156,10 +158,13 @@     , "eurostadium_p"     , "eurostadium_rainy_audio"     , "hoopsstadium_sfx"+    , "labs_circlepillars_p"     , "labs_cosmic_p"     , "labs_doublegoal_p"+    , "labs_sfx"     , "labs_underpass_p"     , "labs_utopia_p"+    , "neotokyo_sfx"     , "park_night_sfx"     , "park_p"     , "park_rainy_sfx"
library/Octane/Type/Boolean.hs view
@@ -19,8 +19,8 @@     { unpack :: Bool     } deriving (Eq, Generics.Generic, Show) --- | Boolean values are stored in the last bit of a byte. Decoding will fail if--- the byte is anything other than @0b00000000@ or @0b00000001@.+-- | Stored in the last bit of a byte. Decoding will fail if the byte is+-- anything other than @0b00000000@ or @0b00000001@. instance Binary.Binary Boolean where     get = do         value <- Binary.getWord8@@ -35,6 +35,7 @@         & fromIntegral         & Binary.putWord8 +-- | Stored as a bit. instance BinaryBit.BinaryBit Boolean where     getBits _ = do         value <- BinaryBit.getBool@@ -46,6 +47,7 @@  instance DeepSeq.NFData Boolean where +-- | Encoded directly as a JSON boolean. instance Aeson.ToJSON Boolean where     toJSON boolean = boolean         & unpack
library/Octane/Type/CacheItem.hs view
@@ -17,13 +17,23 @@ -- | An item in the class net cache map. data CacheItem = CacheItem     { classId :: Word32.Word32+    -- ^ The class ID.     , parentCacheId :: Word32.Word32+    -- ^ The cache ID of the parent class.     , cacheId :: Word32.Word32+    -- ^ The cache ID of the class.     , properties :: List.List CacheProperty.CacheProperty+    -- ^ The properties that belong to this class.     } deriving (Eq, Generics.Generic, Show) +-- | Fields are stored one after the other in order. instance Binary.Binary CacheItem where-    get = CacheItem <$> Binary.get <*> Binary.get <*> Binary.get <*> Binary.get+    get = CacheItem+        <$> Binary.get+        <*> Binary.get+        <*> Binary.get+        <*> Binary.get+     put cacheItem = do         cacheItem & classId & Binary.put         cacheItem & parentCacheId & Binary.put
library/Octane/Type/CacheProperty.hs view
@@ -15,11 +15,17 @@ -- | A property on an item in the class net cache map. data CacheProperty = CacheProperty     { objectId :: Word32.Word32+    -- ^ The object's ID.     , streamId :: Word32.Word32+    -- ^ The object's ID in the network stream.     } deriving (Eq, Generics.Generic, Show) +-- | Fields are stored one after the other in order. instance Binary.Binary CacheProperty where-    get = CacheProperty <$> Binary.get <*> Binary.get+    get = CacheProperty+        <$> Binary.get+        <*> Binary.get+     put cacheProperty = do         cacheProperty & objectId & Binary.put         cacheProperty & streamId & Binary.put
library/Octane/Type/ClassItem.hs view
@@ -17,11 +17,17 @@ -- (like 0). data ClassItem = ClassItem     { name :: Text.Text+    -- ^ The class's name.     , streamId :: Word32.Word32-    } deriving (Eq,Generics.Generic,Show)+    -- ^ The class's ID in the network stream.+    } deriving (Eq, Generics.Generic, Show) +-- | Fields are stored one after the other in order. instance Binary.Binary ClassItem where-    get = ClassItem <$> Binary.get <*> Binary.get+    get = ClassItem+        <$> Binary.get+        <*> Binary.get+     put classItem = do         classItem & name & Binary.put         classItem & streamId & Binary.put
library/Octane/Type/Dictionary.hs view
@@ -16,13 +16,13 @@ import qualified Octane.Type.Text as Text  --- | A dictionary that maps text to values.+-- | A mapping between text and arbitrary values. newtype Dictionary a = Dictionary     { unpack :: (Map.Map Text.Text a)     } deriving (Eq, Generics.Generic) --- | Reads elements are stored with the key first, then the value. The--- dictionary ends when a key is @"None"@.+-- | Elements are stored with the key first, then the value. The dictionary+-- ends when a key is @"None"@. instance (Binary.Binary a) => Binary.Binary (Dictionary a) where     get = do         element <- getElement@@ -36,6 +36,8 @@         dictionary & unpack & Map.assocs & mapM_ putElement         noneKey & Binary.put +-- | Allows creating 'Dictionary' values with 'Exts.fromList'. Also allows+-- 'Dictionary' literals with the @OverloadedLists@ extension. instance Exts.IsList (Dictionary a) where     type Item (Dictionary a) = (Text.Text, a) @@ -45,9 +47,11 @@  instance (DeepSeq.NFData a) => DeepSeq.NFData (Dictionary a) where +-- | Shown as @fromList [("key", "value")]@. instance (Show a) => Show (Dictionary a) where     show dictionary = show (unpack dictionary) +-- | Encoded directly as a JSON object. instance (Aeson.ToJSON a) => Aeson.ToJSON (Dictionary a) where     toJSON dictionary = dictionary         & unpack
library/Octane/Type/Float32.hs view
@@ -35,27 +35,30 @@         & unpack         & IEEE754.putFloat32le +-- | Stored little-endian with the bits in each byte reversed. instance BinaryBit.BinaryBit Float32 where     getBits _ = do         bytes <- BinaryBit.getByteString 4         bytes             & LazyBytes.fromStrict-            & Endian.reverseBitsInBytes+            & Endian.reverseBitsInLazyBytes             & Binary.runGet Binary.get             & pure      putBits _ float32 = float32         & Binary.put         & Binary.runPut-        & Endian.reverseBitsInBytes+        & Endian.reverseBitsInLazyBytes         & LazyBytes.toStrict         & BinaryBit.putByteString  instance DeepSeq.NFData Float32 +-- | Shown as @12.34@. instance Show Float32 where     show float32 = show (unpack float32) +-- | Encoded directly as a JSON number. instance Aeson.ToJSON Float32 where     toJSON float32 = float32         & unpack
library/Octane/Type/Frame.hs view
@@ -26,12 +26,18 @@ import qualified Octane.Type.Word8 as Word8  +-- | A frame in the network stream. This holds all the interesting game data. data Frame = Frame     { number :: Word+    -- ^ This frame's number in the network stream. Starts at 0.     , isKeyFrame :: Bool+    -- ^ Is this frame a key frame?     , time :: Float32.Float32+    -- ^ The since the start of the match that this frame occurred.     , delta :: Float32.Float32+    -- ^ The time between the last frame and this one.     , replications :: [Replication.Replication]+    -- ^ A list of all the replications in this frame.     } deriving (Eq, Generics.Generic, Show)  instance DeepSeq.NFData Frame where
library/Octane/Type/Initialization.hs view
@@ -10,9 +10,12 @@ import qualified Octane.Type.Vector as Vector  +-- | Information about a new instance of a class. data Initialization = Initialization     { location :: Maybe (Vector.Vector Int)+    -- ^ The instance's initial position.     , rotation :: Maybe (Vector.Vector Int8.Int8)+    -- ^ The instance's initial rotation.     } deriving (Eq, Generics.Generic, Show)  instance DeepSeq.NFData Initialization where
library/Octane/Type/Int32.hs view
@@ -35,19 +35,20 @@         let value = unpack int32         Binary.putInt32le value +-- | Store little-endian with the bits in each byte reversed. instance BinaryBit.BinaryBit Int32 where     getBits _ = do         bytes <- BinaryBit.getByteString 4         bytes             & LazyBytes.fromStrict-            & Endian.reverseBitsInBytes+            & Endian.reverseBitsInLazyBytes             & Binary.runGet Binary.get             & pure      putBits _ int32 = int32         & Binary.put         & Binary.runPut-        & Endian.reverseBitsInBytes+        & Endian.reverseBitsInLazyBytes         & LazyBytes.toStrict         & BinaryBit.putByteString @@ -57,6 +58,7 @@ instance Show Int32 where     show int32 = show (unpack int32) +-- | Encoded as a JSON number directly. instance Aeson.ToJSON Int32 where     toJSON int32 = int32         & unpack
library/Octane/Type/Int8.hs view
@@ -34,19 +34,20 @@         let value = unpack int8         Binary.putInt8 value +-- | Stored with the bits reversed. instance BinaryBit.BinaryBit Int8 where     getBits _ = do         bytes <- BinaryBit.getByteString 1         bytes             & LazyBytes.fromStrict-            & Endian.reverseBitsInBytes+            & Endian.reverseBitsInLazyBytes             & Binary.runGet Binary.get             & pure      putBits _ int8 = int8         & Binary.put         & Binary.runPut-        & Endian.reverseBitsInBytes+        & Endian.reverseBitsInLazyBytes         & LazyBytes.toStrict         & BinaryBit.putByteString @@ -56,6 +57,7 @@ instance Show Int8 where     show int8 = show (unpack int8) +-- | Encoded directly as a JSON number. instance Aeson.ToJSON Int8 where     toJSON int8 = int8         & unpack
library/Octane/Type/KeyFrame.hs view
@@ -13,14 +13,23 @@ import qualified Octane.Type.Word32 as Word32  +-- | A key frame. data KeyFrame = KeyFrame     { time :: Float32.Float32+    -- ^ When this key frame occurred.     , frame :: Word32.Word32+    -- ^ Which frame this key frame corresponds to.     , position :: Word32.Word32+    -- ^ The bit position of the start of this key frame in the network stream.     } deriving (Eq, Generics.Generic, Show) +-- | Stored with the fields one after the other in order. instance Binary.Binary KeyFrame where-    get = KeyFrame <$> Binary.get <*> Binary.get <*> Binary.get+    get = KeyFrame+        <$> Binary.get+        <*> Binary.get+        <*> Binary.get+     put keyFrame = do         keyFrame & time & Binary.put         keyFrame & frame & Binary.put
library/Octane/Type/List.hs view
@@ -18,12 +18,12 @@     { unpack :: [a]     } deriving (Eq, Generics.Generic, Ord, Show) --- | Bytewise lists are length-prefixed.+-- | Prefixed with the number of elements in the list. instance (Binary.Binary a) => Binary.Binary (List a) where     get = do         size <- Binary.get         elements <- Monad.replicateM (Word32.fromWord32 size) Binary.get-        elements & List & return+        elements & List & pure      put list = do         list & unpack & length & fromIntegral & Word32.Word32 & Binary.put@@ -31,6 +31,7 @@  instance (DeepSeq.NFData a) => DeepSeq.NFData (List a) where +-- | Encoded as a JSON array directly. instance (Aeson.ToJSON a) => Aeson.ToJSON (List a) where     toJSON list = list         & unpack
library/Octane/Type/Mark.hs view
@@ -15,11 +15,18 @@ -- | A tick mark on the replay. Both goals and saves make tick marks. data Mark = Mark     { label :: Text.Text+    -- ^ The description of the tick mark. Typically something like+    -- @"Team0Goal"@ or @"Team1Save"@ or @"User"@.     , frame :: Word32.Word32-    } deriving (Eq,Generics.Generic,Show)+    -- ^ Which frame this tick mark corresponds to.+    } deriving (Eq, Generics.Generic, Show) +-- | Fields are stored one after the other in order. instance Binary.Binary Mark where-    get = Mark <$> Binary.get <*> Binary.get+    get = Mark+        <$> Binary.get+        <*> Binary.get+     put mark = do         mark & label & Binary.put         mark & frame & Binary.put
library/Octane/Type/Message.hs view
@@ -15,12 +15,20 @@ -- | A debugging message. Replays do not have any of these anymore. data Message = Message     { frame :: Word32.Word32+    -- ^ The frame this message corresponds to.     , name :: Text.Text+    -- ^ The primary player name.     , content :: Text.Text+    -- ^ The actual content of the message.     } deriving (Eq, Generics.Generic, Show) +-- | Fields stored in order, one after the other. instance Binary.Binary Message where-    get = Message <$> Binary.get <*> Binary.get <*> Binary.get+    get = Message+        <$> Binary.get+        <*> Binary.get+        <*> Binary.get+     put message = do         message & frame & Binary.put         message & name & Binary.put
library/Octane/Type/OptimizedReplay.hs view
@@ -3,7 +3,11 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StrictData #-} -module Octane.Type.OptimizedReplay (OptimizedReplay(..), fromReplayWithFrames, toReplayWithFrames) where+module Octane.Type.OptimizedReplay+    ( OptimizedReplay(..)+    , fromReplayWithFrames+    , toReplayWithFrames+    ) where  import Data.Function ((&)) @@ -25,6 +29,10 @@ 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     { version1 :: Word32.Word32     , version2 :: Word32.Word32@@ -54,6 +62,8 @@ instance DeepSeq.NFData OptimizedReplay where  +-- | 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 replayWithFrames = do     pure OptimizedReplay@@ -74,6 +84,8 @@         }  +-- | 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 optimizedReplay = do     pure ReplayWithFrames.ReplayWithFrames
library/Octane/Type/Property.hs view
@@ -5,6 +5,7 @@  module Octane.Type.Property (Property(..)) where +import Data.Aeson ((.=)) import Data.Function ((&))  import qualified Control.DeepSeq as DeepSeq@@ -24,24 +25,33 @@ -- 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+    = 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) +-- | Stored with the size first, then the value. instance Binary.Binary Property where     get = do         kind <- Binary.get@@ -49,80 +59,93 @@             _ | kind == arrayProperty -> do                 size <- Binary.get                 value <- Binary.get-                value & ArrayProperty size & return+                value & ArrayProperty size & pure+             _ | kind == boolProperty -> do                 size <- Binary.get                 value <- Binary.get-                value & BoolProperty size & return+                value & BoolProperty size & pure+             _ | kind == byteProperty -> do                 size <- Binary.get                 key <- Binary.get                 if key == "OnlinePlatform_Steam"-                    then ("OnlinePlatform", key) & ByteProperty size & return+                    then ("OnlinePlatform", key) & ByteProperty size & pure                     else do                         value <- Binary.get-                        (key, value) & ByteProperty size & return+                        (key, value) & ByteProperty size & pure+             _ | kind == floatProperty -> do                 size <- Binary.get-                value <- case size of+                value <- case Word64.unpack size of                     4 -> Binary.get-                    (Word64.Word64 x) ->-                        fail ("unknown FloatProperty size " ++ show x)-                value & FloatProperty size & return+                    x -> fail ("unknown FloatProperty size " ++ show x)+                value & FloatProperty size & pure+             _ | kind == intProperty -> do                 size <- Binary.get-                value <- case size of+                value <- case Word64.unpack size of                     4 -> Binary.get-                    (Word64.Word64 x) ->-                        fail ("unknown IntProperty size " ++ show x)-                value & IntProperty size & return+                    x -> fail ("unknown IntProperty size " ++ show x)+                value & IntProperty size & pure+             _ | kind == nameProperty -> do                 size <- Binary.get                 value <- Binary.get-                value & NameProperty size & return+                value & NameProperty size & pure+             _ | kind == qWordProperty -> do                 size <- Binary.get-                value <- case size of+                value <- case Word64.unpack size of                     8 -> Binary.get-                    (Word64.Word64 x) ->-                        fail ("unknown QWordProperty size " ++ show x)-                value & QWordProperty size & return+                    x -> fail ("unknown QWordProperty size " ++ show x)+                value & QWordProperty size & pure+             _ | kind == strProperty -> do                 size <- Binary.get                 value <- Binary.get-                value & StrProperty size & return+                value & StrProperty size & pure+             _ -> fail ("unknown property type " ++ show (Text.unpack kind))+     put property =         case property of             ArrayProperty size value -> do                 Binary.put arrayProperty                 Binary.put size                 Binary.put value+             BoolProperty size value -> do                 Binary.put boolProperty                 Binary.put size                 Binary.put value-            ByteProperty size (key,value) -> do++            ByteProperty size (key, value) -> do                 Binary.put byteProperty                 Binary.put size                 Binary.put key                 Binary.put value+             FloatProperty size value -> do                 Binary.put floatProperty                 Binary.put size                 Binary.put value+             IntProperty size value -> do                 Binary.put intProperty                 Binary.put size                 Binary.put value+             NameProperty size value -> do                 Binary.put nameProperty                 Binary.put size                 Binary.put value+             QWordProperty size value -> do                 Binary.put qWordProperty                 Binary.put size                 Binary.put value+             StrProperty size value -> do                 Binary.put strProperty                 Binary.put size@@ -130,39 +153,77 @@  instance DeepSeq.NFData Property where --- TODO: This encoding is lossy. instance Aeson.ToJSON Property where     toJSON property = case property of-        ArrayProperty _size x -> Aeson.toJSON x-        BoolProperty _size x -> Aeson.toJSON x-        ByteProperty _size (_key, value) -> Aeson.toJSON value-        FloatProperty _size x -> Aeson.toJSON x-        IntProperty _size x -> Aeson.toJSON x-        NameProperty _size x -> Aeson.toJSON x-        QWordProperty _size x -> Aeson.toJSON x-        StrProperty _size x -> Aeson.toJSON x+        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+            ]   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"
library/Octane/Type/RawReplay.hs view
@@ -3,7 +3,10 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StrictData #-} -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@@ -17,6 +20,10 @@ 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     { headerSize :: Word32.Word32     -- ^ The byte size of the first section.@@ -68,10 +75,12 @@ instance DeepSeq.NFData RawReplay where  +-- | 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'.+    :: 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)
library/Octane/Type/RemoteId.hs view
@@ -1,9 +1,12 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StrictData #-}  module Octane.Type.RemoteId (RemoteId(..)) where +import Data.Aeson ((.=))+ import qualified Control.DeepSeq as DeepSeq import qualified Data.Aeson as Aeson import qualified GHC.Generics as Generics@@ -11,13 +14,36 @@ import qualified Octane.Type.Word64 as Word64  +-- | A player's canonical remote ID. This is the best way to uniquely identify+-- players. data RemoteId     = SteamId Word64.Word64+    -- ^ A Steam ID.     | PlayStationId Text.Text+    -- ^ A PlayStation Network ID.     | SplitscreenId (Maybe Int)+    -- ^ A local splitscreen ID.     | XboxId Word64.Word64+    -- ^ An Xbox Live ID.     deriving (Eq, Generics.Generic, Show)  instance DeepSeq.NFData RemoteId where  instance Aeson.ToJSON RemoteId where+    toJSON remoteId = case remoteId of+        PlayStationId x -> Aeson.object+            [ "Type" .= ("PlayStation" :: Text.Text)+            , "Value" .= x+            ]+        SplitscreenId x -> Aeson.object+            [ "Type" .= ("Splitscreen" :: Text.Text)+            , "Value" .= x+            ]+        SteamId x -> Aeson.object+            [ "Type" .= ("Steam" :: Text.Text)+            , "Value" .= x+            ]+        XboxId x -> Aeson.object+            [ "Type" .= ("Xbox" :: Text.Text)+            , "Value" .= x+            ]
library/Octane/Type/Replay.hs view
@@ -17,6 +17,7 @@ import qualified GHC.Generics as Generics import qualified Octane.Type.Dictionary as Dictionary import qualified Octane.Type.Frame as Frame+import qualified Octane.Type.KeyFrame as KeyFrame import qualified Octane.Type.List as List import qualified Octane.Type.Mark as Mark import qualified Octane.Type.Message as Message@@ -26,12 +27,55 @@ 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     { version :: Version.Version     , metadata :: 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:+    --+    -- - MapName: This is a 'Property.NameProperty'. It is a case-insensitive+    --   map identifier, like @"Stadium_P"@.+    --+    -- There are many other properties that affect how the replay looks in the+    -- list of replays in Rocket League:+    --+    -- - Date: A 'Property.StrProperty' with the format @"YYYY-mm-dd:HH-MM"@.+    --   Dates are not validated, but the month must be between 1 and 12 to+    --   show up. The hour is shown modulo 12 with AM or PM.+    --+    -- - MatchType: A 'Property.NameProperty'. If this is not one of the+    --   expected values, nothing will be shown next to the replay's map. The+    --   expected values are: @"Online"@, @"Offline"@, @"Private"@, and+    --   @"Season"@.+    --+    -- - NumFrames: This 'Property.IntProperty' is used to calculate the length+    --   of the match. There are 30 frames per second, meaning @9000@ frames is+    --   a 5-minute match.+    --+    -- - PrimaryPlayerTeam: This is an 'Property.IntProperty'. It is either 0+    --   (blue) or 1 (orange). Any other value is ignored. If this would be 0,+    --   you don't have to set it at all.+    --+    -- - ReplayName: An optional 'Property.StrProperty' with a user-supplied+    --   name for the replay.+    --+    -- - Team0Score: The blue team's score as an 'Property.IntProperty'. Can be+    --   omitted if the score is 0.+    --+    -- - Team1Score: The orange team's score as an 'Property.IntProperty'. Can+    --   also be omitted if the score is 0.+    --+    -- - TeamSize: An 'Property.IntProperty' with the number of players per+    --   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@.     , levels :: [StrictText.Text]     , messages :: Map.Map StrictText.Text StrictText.Text     , tickMarks :: Map.Map StrictText.Text StrictText.Text+    , packages :: [StrictText.Text]     , frames :: [Frame.Frame]     } deriving (Eq, Generics.Generic, Show) @@ -53,10 +97,13 @@         , "Levels" .= levels replay         , "Messages" .= messages replay         , "TickMarks" .= tickMarks replay+        , "Packages" .= packages replay         , "Frames" .= frames replay         ]  +-- | Converts an 'OptimizedReplay.OptimizedReplay' into a 'Replay'.+-- Operates in a 'Monad' so that it can 'fail' somewhat gracefully. fromOptimizedReplay :: (Monad m) => OptimizedReplay.OptimizedReplay -> m Replay fromOptimizedReplay optimizedReplay = do     pure Replay@@ -100,11 +147,17 @@                         & Text.unpack                 (key, value))             & Map.fromList+        , packages = optimizedReplay+            & OptimizedReplay.packages+            & List.unpack+            & map Text.unpack         , frames = optimizedReplay             & OptimizedReplay.frames         }  +-- | Converts a 'Replay' into an 'OptimizedReplay.OptimizedReplay'.+-- Operates in a 'Monad' so that it can 'fail' somewhat gracefully. toOptimizedReplay :: (Monad m) => Replay -> m OptimizedReplay.OptimizedReplay toOptimizedReplay replay = do     let [version1, version2] = replay@@ -118,7 +171,14 @@         , OptimizedReplay.label = "TAGame.Replay_Soccar_TA"         , OptimizedReplay.properties = replay & metadata & Map.mapKeys Text.Text & Dictionary.Dictionary         , OptimizedReplay.levels = replay & levels & map Text.Text & List.List-        , OptimizedReplay.keyFrames = List.List [] -- TODO+        , OptimizedReplay.keyFrames = replay+            & frames+            & filter Frame.isKeyFrame+            & map (\ frame -> KeyFrame.KeyFrame+                (Frame.time frame)+                (frame & Frame.number & Word32.toWord32)+                0) -- TODO: This is incorrect+            & List.List         , OptimizedReplay.frames = replay & frames         , OptimizedReplay.messages = replay             & messages@@ -136,7 +196,10 @@                 let frame = key & StrictText.unpack & read & Word32.Word32                 Mark.Mark label frame)             & List.List-        , OptimizedReplay.packages = List.List [] -- TODO+        , OptimizedReplay.packages = replay+            & packages+            & map Text.Text+            & List.List         , OptimizedReplay.objects = List.List [] -- TODO         , OptimizedReplay.names = List.List [] -- TODO         , OptimizedReplay.classes = List.List [] -- TODO
library/Octane/Type/ReplayWithFrames.hs view
@@ -26,6 +26,10 @@ 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     { version1 :: Word32.Word32     , version2 :: Word32.Word32@@ -55,6 +59,8 @@ instance DeepSeq.NFData ReplayWithFrames where  +-- | 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 replayWithoutFrames = do     pure ReplayWithFrames@@ -75,6 +81,8 @@         }  +-- | Converts a 'ReplayWithFrames' into a 'ReplayWithoutFrames.ReplayWithoutFrames'.+-- Operates in a 'Monad' so that it can 'fail' somewhat gracefully. toReplayWithoutFrames :: (Monad m) => ReplayWithFrames -> m ReplayWithoutFrames.ReplayWithoutFrames toReplayWithoutFrames replayWithFrames = do     pure ReplayWithoutFrames.ReplayWithoutFrames
library/Octane/Type/ReplayWithoutFrames.hs view
@@ -25,6 +25,10 @@ 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     { version1 :: Word32.Word32     , version2 :: Word32.Word32@@ -54,6 +58,8 @@ instance DeepSeq.NFData ReplayWithoutFrames where  +-- | 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 rawReplay = do     let header = RawReplay.header rawReplay@@ -81,6 +87,8 @@     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 replay = do     let header = Binary.runPut (do
library/Octane/Type/Replication.hs view
@@ -13,13 +13,21 @@ import qualified Octane.Type.Value as Value  +-- | A replicated actor in a frame. data Replication = Replication     { actorId :: Word+    -- ^ The actor's ID.     , objectName :: StrictText.Text+    -- ^ The name of the actor's object.     , className :: StrictText.Text+    -- ^ The name of the actor's class.     , state :: State.State+    -- ^ Which state this actor's replication is in.     , initialization :: Maybe Initialization.Initialization+    -- ^ The optional initialization information for this actor. These only+    -- exist for new actors.     , properties :: Map.Map StrictText.Text Value.Value+    -- ^ The property updates associated with this actor's replication.     } deriving (Eq, Generics.Generic, Show)  instance DeepSeq.NFData Replication where
library/Octane/Type/State.hs view
@@ -6,10 +6,14 @@ import qualified GHC.Generics as Generics  +-- | The state of an actor in a replication. data State     = SOpening+    -- ^ This is a new actor that we have not seen before.     | SExisting+    -- ^ We have seen this actor before.     | SClosing+    -- ^ This actor is going away.     deriving (Eq, Generics.Generic, Show)  instance DeepSeq.NFData State where
library/Octane/Type/Stream.hs view
@@ -13,22 +13,30 @@ import qualified GHC.Generics as Generics import qualified Octane.Type.Word32 as Word32 import qualified Octane.Utility.Endian as Endian+import qualified Text.Printf as Printf  --- | A length-prefixed stream of bits. The length is given in bytes. Each byte--- is reversed such that @0b01234567@ is actually @0b76543210@.+-- | A stream of bits. newtype Stream = Stream     { unpack :: LazyBytes.ByteString-    } deriving (Eq, Generics.Generic, Show)+    } deriving (Eq, Generics.Generic) +-- | Prefixed by a length in bytes. Each byte is reversed such that+-- @0b01234567@ is actually @0b76543210@. instance Binary.Binary Stream where     get = do         size <- Binary.get         content <- size & Word32.fromWord32 & Binary.getLazyByteString-        content & Endian.reverseBitsInBytes & Stream & return+        content & Endian.reverseBitsInLazyBytes & Stream & pure     put stream = do         let content = unpack stream         content & LazyBytes.length & Word32.toWord32 & Binary.put-        content & Endian.reverseBitsInBytes & Binary.putLazyByteString+        content & Endian.reverseBitsInLazyBytes & Binary.putLazyByteString  instance DeepSeq.NFData Stream where++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
library/Octane/Type/Text.hs view
@@ -42,26 +42,32 @@         id         text +-- | Both length-prefixed and null-terminated. The bits in each byte are+-- reversed. instance BinaryBit.BinaryBit Text where     getBits _ = getText         (BinaryBit.getBits 32)         BinaryBit.getByteString-        Endian.reverseBitsInBytes'+        Endian.reverseBitsInStrictBytes      putBits _ text = putText         (BinaryBit.putBits 32)         BinaryBit.putByteString-        Endian.reverseBitsInBytes'+        Endian.reverseBitsInStrictBytes         text +-- | Allows you to write 'Text' as string literals with @OverloadedStrings@.+-- Also allows using the 'String.fromString' helper function. instance String.IsString Text where     fromString string = Text (StrictText.pack string)  instance DeepSeq.NFData Text where +-- | Shown as a string literal, like @"this"@. instance Show Text where-    show text = StrictText.unpack (unpack text)+    show text = show (unpack text) +-- | Encoded directly as a JSON string. instance Aeson.ToJSON Text where     toJSON text = text         & unpack
library/Octane/Type/Value.hs view
@@ -18,6 +18,7 @@ import qualified Octane.Type.Word8 as Word8  +-- | A replicated property's value. data Value     = VBoolean         Boolean.Boolean
library/Octane/Type/Vector.hs view
@@ -9,6 +9,8 @@ import qualified GHC.Generics as Generics  +-- | Three values packed together. Although the fields are called @x@, @y@, and+-- @z@, that may not be what they actually represent. data Vector a = Vector     { x :: a     , y :: a@@ -17,6 +19,7 @@  instance (DeepSeq.NFData a) => DeepSeq.NFData (Vector a) where +-- | Encoded as a JSON array with 3 elements. instance (Aeson.ToJSON a) => Aeson.ToJSON (Vector a) where     toJSON vector = Aeson.toJSON         [ x vector
library/Octane/Type/Word16.hs view
@@ -37,6 +37,7 @@ instance Show Word16 where     show word16 = Printf.printf "0x%04x" (unpack word16) +-- | Encoded as a JSON number. instance Aeson.ToJSON Word16 where     toJSON word16 = word16         & unpack
library/Octane/Type/Word32.hs view
@@ -36,19 +36,20 @@         let value = unpack word32         Binary.putWord32le value +-- | Little-endian with the bits in each byte reversed. instance BinaryBit.BinaryBit Word32 where     getBits _ = do         bytes <- BinaryBit.getByteString 4         bytes             & LazyBytes.fromStrict-            & Endian.reverseBitsInBytes+            & Endian.reverseBitsInLazyBytes             & Binary.runGet Binary.get             & pure      putBits _ word32 = word32         & Binary.put         & Binary.runPut-        & Endian.reverseBitsInBytes+        & Endian.reverseBitsInLazyBytes         & LazyBytes.toStrict         & BinaryBit.putByteString @@ -58,6 +59,7 @@ instance Show Word32 where     show word32 = Printf.printf "0x%08x" (unpack word32) +-- | Encoded as a JSON number. instance Aeson.ToJSON Word32 where     toJSON word32 = word32         & unpack
library/Octane/Type/Word64.hs view
@@ -36,19 +36,20 @@         let value = unpack word64         Binary.putWord64le value +-- | Little-endian with the bits in each byte reversed. instance BinaryBit.BinaryBit Word64 where     getBits _ = do         bytes <- BinaryBit.getByteString 8         bytes             & LazyBytes.fromStrict-            & Endian.reverseBitsInBytes+            & Endian.reverseBitsInLazyBytes             & Binary.runGet Binary.get             & pure      putBits _ word64 = word64         & Binary.put         & Binary.runPut-        & Endian.reverseBitsInBytes+        & Endian.reverseBitsInLazyBytes         & LazyBytes.toStrict         & BinaryBit.putByteString @@ -58,6 +59,7 @@ instance Show Word64 where     show word64 = Printf.printf "0x%016x" (unpack word64) +-- | Encoded as a JSON number. instance Aeson.ToJSON Word64 where     toJSON word64 = word64         & unpack
library/Octane/Type/Word8.hs view
@@ -35,19 +35,20 @@         let value = unpack word8         Binary.putWord8 value +-- | The bits are reversed. instance BinaryBit.BinaryBit Word8 where     getBits _ = do         bytes <- BinaryBit.getByteString 1         bytes             & LazyBytes.fromStrict-            & Endian.reverseBitsInBytes+            & Endian.reverseBitsInLazyBytes             & Binary.runGet Binary.get             & pure      putBits _ word8 = word8         & Binary.put         & Binary.runPut-        & Endian.reverseBitsInBytes+        & Endian.reverseBitsInLazyBytes         & LazyBytes.toStrict         & BinaryBit.putByteString @@ -57,6 +58,7 @@ instance Show Word8 where     show word8 = Printf.printf "0x%02x" (unpack word8) +-- | Encoded as a JSON number. instance Aeson.ToJSON Word8 where     toJSON word8 = word8         & unpack
library/Octane/Utility/ClassPropertyMap.hs view
@@ -1,7 +1,12 @@ -- | This module is responsible for building the class property map, which maps -- 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 where+module Octane.Utility.ClassPropertyMap+    ( getClassPropertyMap+    , getPropertyMap+    , getActorMap+    , getClass+    ) where  import Data.Function ((&)) @@ -44,6 +49,7 @@             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)]@@ -56,12 +62,14 @@         , x & CacheItem.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) + -- | 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.@@ -73,6 +81,7 @@             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.@@ -85,10 +94,11 @@         [] -> Nothing         (classId, _, parentCacheId) : ys -> do             parentClassId <- getParentClassId parentCacheId ys-            return (classId, parentClassId))+            pure (classId, parentClassId))     & IntMap.fromList --- | Given a naive mapping from class ID to its parent class ID, return all of++-- | 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 =@@ -96,6 +106,7 @@         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@@ -108,6 +119,7 @@             ))         & IntMap.fromList + -- | The property map is a mapping from property IDs to property names. getPropertyMap :: ReplayWithoutFrames.ReplayWithoutFrames -> IntMap.IntMap StrictText.Text getPropertyMap replay = replay@@ -117,6 +129,7 @@     & 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.@@ -141,6 +154,7 @@             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@@ -151,6 +165,7 @@         classId = x & ClassItem.streamId & Word32.fromWord32         in (className, classId))     & Map.fromList+  -- | Gets the class ID and name for a given property ID. getClass
library/Octane/Utility/Endian.hs view
@@ -1,24 +1,26 @@ {-# LANGUAGE BinaryLiterals #-} -module Octane.Utility.Endian where+module Octane.Utility.Endian+    ( reverseBitsInLazyBytes+    , reverseBitsInStrictBytes+    ) where  import qualified Data.Bits as Bits-import qualified Data.ByteString.Lazy as LazyBytes 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.-reverseBitsInBytes :: LazyBytes.ByteString -> LazyBytes.ByteString-reverseBitsInBytes bytes = LazyBytes.map reverseBits bytes+reverseBitsInLazyBytes :: LazyBytes.ByteString -> LazyBytes.ByteString+reverseBitsInLazyBytes bytes = LazyBytes.map reverseBits bytes   -- | Reverses all the bits in each strict byte.-reverseBitsInBytes' :: StrictBytes.ByteString -> StrictBytes.ByteString-reverseBitsInBytes' bytes = StrictBytes.map reverseBits bytes+reverseBitsInStrictBytes :: StrictBytes.ByteString -> StrictBytes.ByteString+reverseBitsInStrictBytes bytes = StrictBytes.map reverseBits bytes  --- | Reverses the bits in a byte. reverseBits :: Word.Word8 -> Word.Word8 reverseBits byte     = Bits.shiftR (byte Bits..&. 0b10000000) 7
library/Octane/Utility/Optimizer.hs view
@@ -14,6 +14,7 @@ import qualified Octane.Type.Value as Value  +-- | Optimizes frames by removing unnecessary replications. optimizeFrames :: [Frame.Frame] -> [Frame.Frame] optimizeFrames frames = frames     & Foldable.foldl'
library/Octane/Utility/Parser.hs view
@@ -1,11 +1,13 @@+{-# LANGUAGE BinaryLiterals #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StrictData #-} -module Octane.Utility.Parser where+module Octane.Utility.Parser (parseFrames) where  import Data.Function ((&))  import qualified Control.DeepSeq as DeepSeq+import qualified Control.Monad as Monad import qualified Data.Binary.Bits as BinaryBit import qualified Data.Binary.Bits.Get as Bits import qualified Data.Binary.Get as Binary@@ -16,6 +18,7 @@ import qualified Data.Map.Strict as Map import qualified Data.Set as Set import qualified Data.Text as StrictText+import qualified Data.Version as Version import qualified GHC.Generics as Generics import qualified Octane.Data as Data import qualified Octane.Type.Boolean as Boolean@@ -45,6 +48,7 @@ import qualified Text.Printf as Printf  +-- | Parses the network stream and returns a list of frames. parseFrames :: ReplayWithoutFrames.ReplayWithoutFrames -> [Frame.Frame] parseFrames replay = let     numFrames = replay@@ -59,34 +63,37 @@     (_context, frames) = Binary.runGet get stream     in frames + getFrames :: Word -> Int -> Context -> Bits.BitGet (Context, [Frame.Frame]) getFrames number numFrames context = do     if fromIntegral number >= numFrames-    then return (context, [])+    then pure (context, [])     else do         isEmpty <- Bits.isEmpty         if isEmpty-        then return (context, [])+        then pure (context, [])         else do             maybeFrame <- getMaybeFrame context number             case maybeFrame of-                Nothing -> return (context, [])+                Nothing -> pure (context, [])                 Just (newContext, frame) -> do                     (newerContext, frames) <- getFrames (number + 1) numFrames newContext-                    return (newerContext, (frame : frames))+                    pure (newerContext, (frame : frames)) + getMaybeFrame :: Context -> Word -> Bits.BitGet (Maybe (Context, Frame.Frame)) getMaybeFrame context number = do     time <- getFloat32     delta <- getFloat32     if time == 0 && delta == 0-    then return Nothing+    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-        return (Just (newContext, frame))+        pure (Just (newContext, frame)) + getFrame :: Context -> Word -> Float32.Float32 -> Float32.Float32 -> Bits.BitGet (Context, Frame.Frame) getFrame context number time delta = do     (newContext, replications) <- getReplications context@@ -98,26 +105,29 @@             , Frame.delta = delta             , Frame.replications = replications             }-    (newContext, frame) & DeepSeq.force & return+    (newContext, frame) & DeepSeq.force & pure + getReplications :: Context -> Bits.BitGet (Context, [Replication.Replication]) getReplications context = do     maybeReplication <- getMaybeReplication context     case maybeReplication of-        Nothing -> return (context, [])+        Nothing -> pure (context, [])         Just (newContext, replication) -> do             (newerContext, replications) <- getReplications newContext-            return (newerContext, replication : replications)+            pure (newerContext, replication : replications) + getMaybeReplication :: Context -> Bits.BitGet (Maybe (Context, Replication.Replication)) getMaybeReplication context = do     hasReplication <- getBool     if Boolean.unpack hasReplication         then do             (newContext,replication) <- getReplication context-            return (Just (newContext, replication))-        else return Nothing+            pure (Just (newContext, replication))+        else pure Nothing + getReplication :: Context -> Bits.BitGet (Context, Replication.Replication) getReplication context = do     actorId <- getActorId@@ -128,6 +138,7 @@                 else getClosedReplication     go context actorId + getOpenReplication :: Context                    -> Int                    -> Bits.BitGet (Context, Replication.Replication)@@ -139,6 +150,7 @@                 else getExistingReplication     go context actorId + getNewReplication :: Context                   -> Int                   -> Bits.BitGet (Context, Replication.Replication)@@ -166,7 +178,7 @@     let things = contextThings context     let newThings = IntMap.insert actorId thing things     let newContext = context { contextThings = newThings }-    return+    pure         ( newContext         , Replication.Replication           { Replication.actorId = fromIntegral actorId@@ -177,6 +189,7 @@           , Replication.properties = Map.empty           }) + getExistingReplication :: Context                        -> Int                        -> Bits.BitGet (Context, Replication.Replication)@@ -185,7 +198,7 @@         Nothing -> fail ("could not find thing for actor id " ++ show actorId)         Just x -> pure x     props <- getProps context thing-    return (context, Replication.Replication+    pure (context, Replication.Replication         { Replication.actorId = fromIntegral actorId         , Replication.objectName = thingObjectName thing         , Replication.className = thingClassName thing@@ -194,6 +207,7 @@         , Replication.properties = props         }) + getClosedReplication :: Context                      -> Int                      -> Bits.BitGet (Context, Replication.Replication)@@ -203,7 +217,7 @@         Just x -> pure x     let newThings = context & contextThings & IntMap.delete actorId     let newContext = context { contextThings = newThings }-    return+    pure         ( newContext         , Replication.Replication           { Replication.actorId = fromIntegral actorId@@ -214,25 +228,28 @@           , Replication.properties = Map.empty           }) + getProps :: Context -> Thing -> Bits.BitGet (Map.Map StrictText.Text Value.Value) getProps context thing = do     maybeProp <- getMaybeProp context thing     case maybeProp of-        Nothing -> return Map.empty+        Nothing -> pure Map.empty         Just (k, v) -> do             let m = Map.singleton k v             props <- getProps context thing-            return (Map.union m props)+            pure (Map.union m props) + getMaybeProp :: Context -> Thing -> Bits.BitGet (Maybe (StrictText.Text, Value.Value)) getMaybeProp context thing = do     hasProp <- getBool     if Boolean.unpack hasProp     then do         prop <- getProp context thing-        return (Just prop)-    else return Nothing+        pure (Just prop)+    else pure Nothing + getProp :: Context -> Thing -> Bits.BitGet (StrictText.Text, Value.Value) getProp context thing = do     let classId = thing & thingClassId@@ -244,18 +261,18 @@     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 name-    return (name, value)+    value <- getPropValue context name+    pure (name, value) --- -getPropValue :: StrictText.Text -> Bits.BitGet Value.Value-getPropValue name = case Map.lookup name propertyNameToGet of+getPropValue :: Context -> StrictText.Text -> Bits.BitGet Value.Value+getPropValue context name = case Map.lookup name (propertyNameToGet context) of     Nothing -> fail ("don't know how to read property " ++ show name)     Just get -> get -propertyNameToGet :: Map.Map StrictText.Text (Bits.BitGet Value.Value)-propertyNameToGet =++propertyNameToGet :: Context -> Map.Map StrictText.Text (Bits.BitGet Value.Value)+propertyNameToGet context =     [ (Data.booleanProperties, getBooleanProperty)     , (Data.byteProperties, getByteProperty)     , (Data.camSettingsProperties, getCamSettingsProperty)@@ -274,7 +291,7 @@     , (Data.privateMatchSettingsProperties, getPrivateMatchSettingsProperty)     , (Data.qWordProperties, getQWordProperty)     , (Data.relativeRotationProperties, getRelativeRotationProperty)-    , (Data.reservationProperties, getReservationProperty)+    , (Data.reservationProperties, getReservationProperty context)     , (Data.rigidBodyStateProperties, getRigidBodyStateProperty)     , (Data.stringProperties, getStringProperty)     , (Data.teamPaintProperties, getTeamPaintProperty)@@ -284,16 +301,19 @@         & concatMap (\ (ks, v) -> ks & Set.toList & map (\ k -> (k, v)))         & Map.fromList + getBooleanProperty :: Bits.BitGet Value.Value getBooleanProperty = do     bool <- getBool-    return (Value.VBoolean bool)+    pure (Value.VBoolean bool) + getByteProperty :: Bits.BitGet Value.Value getByteProperty = do     word <- getWord8-    return (Value.VByte word)+    pure (Value.VByte word) + getCamSettingsProperty :: Bits.BitGet Value.Value getCamSettingsProperty = do     fov <- getFloat32@@ -302,8 +322,9 @@     distance <- getFloat32     stiffness <- getFloat32     swivelSpeed <- getFloat32-    return (Value.VCamSettings fov height angle distance stiffness swivelSpeed)+    pure (Value.VCamSettings fov height angle distance stiffness swivelSpeed) + getDemolishProperty :: Bits.BitGet Value.Value getDemolishProperty = do     atkFlag <- getBool@@ -312,46 +333,53 @@     vic <- getWord32     vec1 <- getVector     vec2 <- getVector-    return (Value.VDemolish atkFlag atk vicFlag vic vec1 vec2)+    pure (Value.VDemolish atkFlag atk vicFlag vic vec1 vec2) + getEnumProperty :: Bits.BitGet Value.Value getEnumProperty = do     x <- Bits.getWord16be 10     y <- if x == 1023         then getBool         else fail ("unexpected enum value " ++ show x)-    return (Value.VEnum (Word16.toWord16 x) y)+    pure (Value.VEnum (Word16.toWord16 x) y) + getExplosionProperty :: Bits.BitGet Value.Value getExplosionProperty = do     noGoal <- getBool     a <- if Boolean.unpack noGoal-        then return Nothing+        then pure Nothing         else fmap Just getInt32     b <- getVector-    return (Value.VExplosion noGoal a b)+    pure (Value.VExplosion noGoal a b) + getFlaggedIntProperty :: Bits.BitGet Value.Value getFlaggedIntProperty = do     flag <- getBool     int <- getInt32-    return (Value.VFlaggedInt flag int)+    pure (Value.VFlaggedInt flag int) + getFloatProperty :: Bits.BitGet Value.Value getFloatProperty = do     float <- getFloat32-    return (Value.VFloat float)+    pure (Value.VFloat float) + getGameModeProperty :: Bits.BitGet Value.Value getGameModeProperty = do     x <- Bits.getWord8 2-    return (Value.VGameMode (Word8.toWord8 x))+    pure (Value.VGameMode (Word8.toWord8 x)) + getIntProperty :: Bits.BitGet Value.Value getIntProperty = do     int <- getInt32-    return (Value.VInt int)+    pure (Value.VInt int) + getLoadoutOnlineProperty :: Bits.BitGet Value.Value getLoadoutOnlineProperty = do     version <- getWord32@@ -360,10 +388,20 @@     z <- if version >= 12         then do             value <- getWord8-            return (Just value)-        else return Nothing-    return (Value.VLoadoutOnline version x y z) +            -- After the Neo Tokyo update, online loadouts could have this+            -- ridiculously high "version". I think it means the player is+            -- using an item with an unusual color.+            Monad.when (version == 0x0100000c) (do+                unknown <- Bits.getWord64be 37+                Monad.when (unknown /= 0) (do+                    fail (Printf.printf "Read 37 online loadout bits and they weren't all 0! 0b%037b" unknown)))++            pure (Just value)+        else pure Nothing+    pure (Value.VLoadoutOnline version x y z)++ getLoadoutProperty :: Bits.BitGet Value.Value getLoadoutProperty = do     version <- getWord8@@ -377,31 +415,35 @@     h <- if version > 10         then do             value <- getWord32-            return (Just value)-        else return Nothing-    return (Value.VLoadout version body decal wheels rocketTrail antenna topper g h)+            pure (Just value)+        else pure Nothing+    pure (Value.VLoadout version body decal wheels rocketTrail antenna topper g h) + getLocationProperty :: Bits.BitGet Value.Value getLocationProperty = do     vector <- getVector-    return (Value.VLocation vector)+    pure (Value.VLocation vector) + getMusicStingerProperty :: Bits.BitGet Value.Value getMusicStingerProperty = do     flag <- getBool     cue <- getWord32     trigger <- getWord8-    return (Value.VMusicStinger flag cue trigger)+    pure (Value.VMusicStinger flag cue trigger) + getPickupProperty :: Bits.BitGet Value.Value getPickupProperty = do     instigator <- getBool     instigatorId <- if Boolean.unpack instigator         then fmap Just getWord32-        else return Nothing+        else pure Nothing     pickedUp <- getBool-    return (Value.VPickup instigator instigatorId pickedUp)+    pure (Value.VPickup instigator instigatorId pickedUp) + getPrivateMatchSettingsProperty :: Bits.BitGet Value.Value getPrivateMatchSettingsProperty = do     mutators <- getText@@ -410,51 +452,69 @@     gameName <- getText     password <- getText     flag <- getBool-    return (Value.VPrivateMatchSettings mutators joinableBy maxPlayers gameName password flag)+    pure (Value.VPrivateMatchSettings mutators joinableBy maxPlayers gameName password flag) + getQWordProperty :: Bits.BitGet Value.Value getQWordProperty = do     qword <- getWord64-    return (Value.VQWord qword)+    pure (Value.VQWord qword) + getRelativeRotationProperty :: Bits.BitGet Value.Value getRelativeRotationProperty = do     vector <- getFloatVector-    return (Value.VRelativeRotation vector)+    pure (Value.VRelativeRotation vector) -getReservationProperty :: Bits.BitGet Value.Value-getReservationProperty = do+getReservationProperty :: Context -> Bits.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 <- getInt7     (systemId, remoteId, localId) <- getUniqueId-    playerName <- if systemId == 0 then return Nothing else do+    playerName <- if systemId == 0 then pure Nothing else do         string <- getText-        return (Just string)+        pure (Just string)     -- No idea what these two flags are. Might be for bots?     a <- getBool     b <- getBool-    return (Value.VReservation number systemId remoteId localId playerName a b) +    -- The Neo Tokyo update added 6 bits to the reservation property that are+    -- always (as far as I can tell) 0. The only way to know about these bits+    -- is to check the top-level version number in the replay.+    Monad.when (contextVersion context >= neoTokyoVersion) (do+        x <- Bits.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)+++neoTokyoVersion :: Version.Version+neoTokyoVersion = Version.makeVersion [868, 12]++ getRigidBodyStateProperty :: Bits.BitGet Value.Value getRigidBodyStateProperty = do     flag <- getBool     position <- getVector     rotation <- getFloatVector     x <- if Boolean.unpack flag-        then return Nothing+        then pure Nothing         else fmap Just getVector     y <- if Boolean.unpack flag-        then return Nothing+        then pure Nothing         else fmap Just getVector-    return (Value.VRigidBodyState flag position rotation x y)+    pure (Value.VRigidBodyState flag position rotation x y) + getStringProperty :: Bits.BitGet Value.Value getStringProperty = do     string <- getText-    return (Value.VString string)+    pure (Value.VString string) + getTeamPaintProperty :: Bits.BitGet Value.Value getTeamPaintProperty = do     team <- getWord8@@ -462,75 +522,81 @@     accentColor <- getWord8     primaryFinish <- getWord32     accentFinish <- getWord32-    return (Value.VTeamPaint team primaryColor accentColor primaryFinish accentFinish)+    pure (Value.VTeamPaint team primaryColor accentColor primaryFinish accentFinish) + getUniqueIdProperty :: Bits.BitGet Value.Value getUniqueIdProperty = do     (systemId, remoteId, localId) <- getUniqueId-    return (Value.VUniqueId systemId remoteId localId)+    pure (Value.VUniqueId 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 :: Bits.BitGet Value.Value getPartyLeaderProperty = do     systemId <- getSystemId     (remoteId, localId) <- if systemId == 0-        then return (RemoteId.SplitscreenId Nothing, Nothing)+        then pure (RemoteId.SplitscreenId Nothing, Nothing)         else do             remoteId <- getRemoteId systemId             localId <- getLocalId-            return (remoteId, localId)-    return (Value.VUniqueId systemId remoteId localId)+            pure (remoteId, localId)+    pure (Value.VUniqueId systemId remoteId localId) ---  getFloat32 :: Bits.BitGet Float32.Float32 getFloat32 = BinaryBit.getBits unimportant + getText :: Bits.BitGet Text.Text getText = BinaryBit.getBits unimportant + getUniqueId :: Bits.BitGet (Word8.Word8, RemoteId.RemoteId, Maybe Word8.Word8) getUniqueId = do     systemId <- getSystemId     remoteId <- getRemoteId systemId     localId <- getLocalId-    return (systemId, remoteId, localId)+    pure (systemId, remoteId, localId) + getSystemId :: Bits.BitGet Word8.Word8 getSystemId = getWord8 + getRemoteId :: Word8.Word8 -> Bits.BitGet RemoteId.RemoteId getRemoteId systemId = case systemId of     0 -> do         remoteId <- Bits.getByteString 3         if StrictBytes.all (\ byte -> byte == 0) remoteId-            then 0 & Just & RemoteId.SplitscreenId & return+            then 0 & Just & RemoteId.SplitscreenId & pure             else fail ("unexpected splitscreen id " ++ show remoteId)     1 -> do         bytes <- Bits.getByteString 8         let remoteId = Binary.runGet                 Binary.getWord64le-                (bytes & LazyBytes.fromStrict & Endian.reverseBitsInBytes)-        remoteId & Word64.toWord64 & RemoteId.SteamId & return+                (bytes & LazyBytes.fromStrict & Endian.reverseBitsInLazyBytes)+        remoteId & Word64.toWord64 & RemoteId.SteamId & pure     2 -> do         bytes <- Bits.getByteString 32         let remoteId = bytes                 & LazyBytes.fromStrict-                & Endian.reverseBitsInBytes+                & Endian.reverseBitsInLazyBytes                 & LazyBytes.unpack                 & concatMap (\ b -> Printf.printf "%02x" b)                 & StrictText.pack                 & Text.Text-        remoteId & RemoteId.PlayStationId & return+        remoteId & RemoteId.PlayStationId & pure     4 -> do         bytes <- Bits.getByteString 8         let remoteId = Binary.runGet                 Binary.getWord64le-                (bytes & LazyBytes.fromStrict & Endian.reverseBitsInBytes)-        remoteId & Word64.toWord64 & RemoteId.XboxId & return+                (bytes & LazyBytes.fromStrict & Endian.reverseBitsInLazyBytes)+        remoteId & Word64.toWord64 & RemoteId.XboxId & pure     _ -> fail ("unknown system id " ++ show systemId) + getLocalId :: Bits.BitGet (Maybe Word8.Word8) getLocalId = fmap Just getWord8 @@ -546,25 +612,31 @@  instance DeepSeq.NFData Thing + -- { 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 Context = Context     { contextObjectMap :: ObjectMap     , contextClassPropertyMap :: ClassPropertyMap     , contextThings :: (IntMap.IntMap Thing)     , contextClassMap :: ClassMap     , contextKeyFrames :: (Set.Set Word)+    , contextVersion :: Version.Version     } deriving (Eq, Generics.Generic, Show)  instance DeepSeq.NFData Context + extractContext :: ReplayWithoutFrames.ReplayWithoutFrames -> Context extractContext replay =     Context@@ -578,8 +650,13 @@         & map KeyFrame.frame         & map Word32.fromWord32         & Set.fromList+    , contextVersion =+        [ replay & ReplayWithoutFrames.version1+        , replay & ReplayWithoutFrames.version2+        ] & map Word32.fromWord32 & Version.makeVersion     } + getVector :: Bits.BitGet (Vector.Vector Int) getVector = do     numBits <- getNumVectorBits@@ -589,29 +666,31 @@     dx <- getInt maxValue     dy <- getInt maxValue     dz <- getInt maxValue-    return+    pure         Vector.Vector         { Vector.x = dx - bias         , Vector.y = dy - bias         , Vector.z = dz - bias         } + getVectorBytewise     :: Bits.BitGet (Vector.Vector Int8.Int8) getVectorBytewise = do     hasX <- getBool-    x <- if Boolean.unpack hasX then getInt8 else return 0+    x <- if Boolean.unpack hasX then getInt8 else pure 0     hasY <- getBool-    y <- if Boolean.unpack hasY then getInt8 else return 0+    y <- if Boolean.unpack hasY then getInt8 else pure 0     hasZ <- getBool-    z <- if Boolean.unpack hasZ then getInt8 else return 0-    return+    z <- if Boolean.unpack hasZ then getInt8 else pure 0+    pure         Vector.Vector         { Vector.x = x         , Vector.y = y         , Vector.z = z         } + getFloatVector :: Bits.BitGet (Vector.Vector Float) getFloatVector = do     let maxValue = 1@@ -619,8 +698,9 @@     x <- getFloat maxValue numBits     y <- getFloat maxValue numBits     z <- getFloat maxValue numBits-    return Vector.Vector { Vector.x = x, Vector.y = y, Vector.z = z }+    pure Vector.Vector { Vector.x = x, Vector.y = y, Vector.z = z } + getFloat :: Int -> Int -> Bits.BitGet Float getFloat maxValue numBits = do     let maxBitValue = (Bits.shiftL 1 (numBits - 1)) - 1@@ -631,37 +711,40 @@     if maxValue > maxBitValue     then do         let invScale = fromIntegral maxValue / fromIntegral maxBitValue-        return (fromIntegral unscaledValue * invScale)+        pure (fromIntegral unscaledValue * invScale)     else do         let scale = fromIntegral maxBitValue / fromIntegral maxValue         let invScale = 1.0 / scale-        return (fromIntegral unscaledValue * invScale)+        pure (fromIntegral unscaledValue * invScale) + getInitialization :: StrictText.Text -> Bits.BitGet Initialization.Initialization getInitialization className = do     location <-         if Set.member className Data.locationClasses             then do                 vector <- getVector-                return (Just vector)-            else return Nothing+                pure (Just vector)+            else pure Nothing     rotation <-         if Set.member className Data.rotationClasses             then do                 vector <- getVectorBytewise-                return (Just vector)-            else return Nothing-    return+                pure (Just vector)+            else pure Nothing+    pure         Initialization.Initialization         { Initialization.location = location         , Initialization.rotation = rotation         } + bitSize     :: (Integral a)     => a -> a bitSize x = x & fromIntegral & logBase (2 :: Double) & ceiling + -- Reads an integer bitwise. The bits of the integer are backwards, so the -- least significant bit is first. The argument is the maximum value this -- integer can have. Bits will be read until the next bit would be greater than@@ -685,35 +768,45 @@                                 then value + x                                 else value                     go (i + 1) newValue-                else return value+                else pure value     go 0 0 + getInt32 :: Bits.BitGet Int32.Int32 getInt32 = BinaryBit.getBits unimportant + getInt8 :: Bits.BitGet Int8.Int8 getInt8 = BinaryBit.getBits unimportant + getWord64 :: Bits.BitGet Word64.Word64 getWord64 = BinaryBit.getBits unimportant + getWord32 :: Bits.BitGet Word32.Word32 getWord32 = BinaryBit.getBits unimportant + getWord8 :: Bits.BitGet Word8.Word8 getWord8 = BinaryBit.getBits unimportant + getActorId :: Bits.BitGet Int getActorId = getInt 1024 + getNumVectorBits :: Bits.BitGet Int getNumVectorBits = getInt 19 + getInt7 :: Bits.BitGet Int getInt7 = getInt 7 + getBool :: Bits.BitGet Boolean.Boolean getBool = BinaryBit.getBits unimportant+  -- | The 'getBits' function from "Data.Binary.Bits" requires a size parameter. -- None of Octane's instances use it.
octane.cabal view
@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack  name:           octane-version:        0.11.0+version:        0.12.0 synopsis:       Parse Rocket League replays. description:    Octane parses Rocket League replays. category:       Game
package.yaml view
@@ -76,4 +76,4 @@     - -with-rtsopts=-N     main: Main.hs     source-dirs: test-suite-version: '0.11.0'+version: '0.12.0'