octane 0.5.2 → 0.5.3
raw patch · 19 files changed
+807/−619 lines, 19 filesdep −newtype-generics
Dependencies removed: newtype-generics
Files
- library/Octane/Data.hs +399/−0
- library/Octane/Main.hs +5/−6
- library/Octane/Parser.hs +305/−350
- library/Octane/Parser/ClassPropertyMap.hs +29/−170
- library/Octane/Type/Actor.hs +2/−2
- library/Octane/Type/KeyFrame.hs +2/−2
- library/Octane/Type/Primitive/Boolean.hs +5/−8
- library/Octane/Type/Primitive/Dictionary.hs +8/−11
- library/Octane/Type/Primitive/Float32LE.hs +5/−8
- library/Octane/Type/Primitive/List.hs +6/−9
- library/Octane/Type/Primitive/PCString.hs +6/−9
- library/Octane/Type/Primitive/Stream.hs +7/−10
- library/Octane/Type/Primitive/Word32LE.hs +5/−8
- library/Octane/Type/Primitive/Word64LE.hs +5/−8
- library/Octane/Type/Property.hs +6/−7
- library/Octane/Type/Replay.hs +1/−1
- octane.cabal +6/−6
- package.yaml +4/−3
- stack.yaml +1/−1
+ library/Octane/Data.hs view
@@ -0,0 +1,399 @@+-- | This module contains largely static data about Rocket League itself, such+-- as which classes objects belong to.+module Octane.Data where++import Data.Function ((&))+import Data.Monoid ((<>))++import qualified Data.Map.Strict as Map+import qualified Data.Set as Set+import qualified Data.Text as Text++-- * Classes++-- | A map from class names to a set of object names that are that class. This+-- is typically not useful by itself, as it is used to build the+-- 'objectToClass' map.+classToObjects :: Map.Map Text.Text (Set.Set Text.Text)+classToObjects = let+ normal =+ [ ( "TAGame.Ball_TA",+ [ "Archetypes.Ball.Ball_Default"+ , "Archetypes.Ball.Ball_Basketball"+ , "Archetypes.Ball.Ball_Puck"+ ])+ , ( "TAGame.CameraSettingsActor_TA",+ [ "TAGame.CameraSettingsActor_TA:PRI"+ , "TAGame.Default__CameraSettingsActor_TA"+ ])+ , ( "TAGame.CarComponent_Boost_TA",+ [ "Archetypes.CarComponents.CarComponent_Boost"+ ])+ , ( "TAGame.CarComponent_Dodge_TA",+ [ "Archetypes.CarComponents.CarComponent_Dodge"+ ])+ , ( "TAGame.CarComponent_DoubleJump_TA",+ [ "Archetypes.CarComponents.CarComponent_DoubleJump"+ ])+ , ( "TAGame.CarComponent_FlipCar_TA",+ [ "Archetypes.CarComponents.CarComponent_FlipCar"+ ])+ , ( "TAGame.CarComponent_Jump_TA",+ [ "Archetypes.CarComponents.CarComponent_Jump"+ ])+ , ( "TAGame.Car_Season_TA",+ [ "Archetypes.GameEvent.GameEvent_Season:CarArchetype"+ ])+ , ( "TAGame.Car_TA",+ [ "Archetypes.Car.Car_Default"+ ])+ , ( "TAGame.GameEvent_Season_TA",+ [ "Archetypes.GameEvent.GameEvent_Season"+ ])+ , ( "TAGame.GameEvent_SoccarPrivate_TA",+ [ "Archetypes.GameEvent.GameEvent_SoccarPrivate"+ ])+ , ( "TAGame.GameEvent_SoccarSplitscreen_TA",+ [ "Archetypes.GameEvent.GameEvent_SoccarSplitscreen"+ ])+ , ( "TAGame.GameEvent_Soccar_TA",+ [ "Archetypes.GameEvent.GameEvent_Soccar"+ , "Archetypes.GameEvent.GameEvent_Basketball"+ ])+ , ( "TAGame.GRI_TA",+ [ "GameInfo_Basketball.GameInfo.GameInfo_Basketball:GameReplicationInfoArchetype"+ , "GameInfo_Season.GameInfo.GameInfo_Season:GameReplicationInfoArchetype"+ , "GameInfo_Soccar.GameInfo.GameInfo_Soccar:GameReplicationInfoArchetype"+ ])+ , ( "TAGame.PRI_TA",+ [ "TAGame.Default__PRI_TA"+ ])+ , ( "TAGame.Team_TA",+ [ "Archetypes.Teams.Team"+ ])+ ] & map (\ (klass, objects) ->+ ( Text.pack klass+ , objects & map Text.pack & Set.fromList+ ))+ special =+ [ ("TAGame.CrowdActor_TA", ".TheWorld:PersistentLevel.CrowdActor_TA_")+ , ("TAGame.CrowdManager_TA", ".TheWorld:PersistentLevel.CrowdManager_TA_")+ , ("TAGame.VehiclePickup_Boost_TA", ".TheWorld:PersistentLevel.VehiclePickup_Boost_TA_")+ ] & map (\ (klass, suffix) ->+ ( Text.pack klass+ , levels & Set.map (\ level -> level <> Text.pack suffix)+ ))+ in Map.fromList (normal ++ special)++-- | A set of classes that have an initial location vector.+locationClasses :: Set.Set Text.Text+locationClasses =+ [ "TAGame.Ball_TA"+ , "TAGame.CameraSettingsActor_TA"+ , "TAGame.CarComponent_Boost_TA"+ , "TAGame.CarComponent_Dodge_TA"+ , "TAGame.CarComponent_DoubleJump_TA"+ , "TAGame.CarComponent_FlipCar_TA"+ , "TAGame.CarComponent_Jump_TA"+ , "TAGame.Car_Season_TA"+ , "TAGame.Car_TA"+ , "TAGame.GRI_TA"+ , "TAGame.GameEvent_Season_TA"+ , "TAGame.GameEvent_SoccarPrivate_TA"+ , "TAGame.GameEvent_SoccarSplitscreen_TA"+ , "TAGame.GameEvent_Soccar_TA"+ , "TAGame.PRI_TA"+ , "TAGame.Team_TA"+ ] & map Text.pack & Set.fromList++-- | A set of classes that have an initial rotation vector.+rotationClasses :: Set.Set Text.Text+rotationClasses =+ [ "TAGame.Ball_TA"+ , "TAGame.Car_Season_TA"+ , "TAGame.Car_TA"+ ] & map Text.pack & Set.fromList++-- * Levels++-- | A set of level names. This is typically not useful by itself, as it is+-- used to build the 'classToObjects' map. If you are going to use it, be+-- aware that many of the levels are duplicated with strange capitalization.+-- For example, this set contains both @Wasteland_P@ and @Wasteland_p@.+levels :: Set.Set Text.Text+levels =+ [ "EuroStadium_Rainy_P"+ , "HoopsStadium_P"+ , "Park_Night_P"+ , "Park_Rainy_P"+ , "Stadium_p"+ , "TrainStation_Night_P"+ , "TrainStation_P"+ , "Trainstation_Night_P"+ , "UtopiaStadium_Dusk_P"+ , "UtopiaStadium_Dusk_p"+ , "UtopiaStadium_P"+ , "Utopiastadium_p"+ , "Wasteland_P"+ , "Wasteland_p"+ , "eurostad_oob_audio_map"+ , "eurostadium_p"+ , "eurostadium_rainy_audio"+ , "hoopsstadium_sfx"+ , "labs_doublegoal_p"+ , "labs_underpass_p"+ , "labs_utopia_p"+ , "park_night_sfx"+ , "park_p"+ , "park_rainy_sfx"+ , "park_sfx"+ , "stadium_oob_audio_map"+ , "stadium_p"+ , "stadium_winter_p"+ , "trainstation_p"+ , "utopiastadium_p"+ , "utopiastadium_sfx"+ , "wasteland_sfx"+ ] & map Text.pack & Set.fromList++-- * Objects++-- | A map from object names to their class names. Note that any trailing+-- numbers have been stripped from the object names. So+-- @Archetypes.Teams.Team0@ is in this map as @Archetypes.Teams.Team@.+objectToClass :: Map.Map Text.Text Text.Text+objectToClass = Map.foldrWithKey+ (\ klass objects m -> objects+ & Set.map (\ object -> (object, klass))+ & Set.toList+ & Map.fromList+ & Map.union m)+ Map.empty+ classToObjects++-- * Properties++-- | A set of properties that are booleans.+booleanProperties :: Set.Set Text.Text+booleanProperties =+ [ "Engine.Actor:bBlockActors"+ , "Engine.Actor:bCollideActors"+ , "Engine.Actor:bHardAttach"+ , "Engine.Actor:bHidden"+ , "Engine.Actor:bProjTarget"+ , "Engine.Actor:bTearOff"+ , "Engine.GameReplicationInfo:bMatchIsOver"+ , "Engine.Pawn:bCanSwatTurn"+ , "Engine.Pawn:bRootMotionFromInterpCurve"+ , "Engine.Pawn:bSimulateGravity"+ , "Engine.PlayerReplicationInfo:bBot"+ , "Engine.PlayerReplicationInfo:bIsSpectator"+ , "Engine.PlayerReplicationInfo:bOnlySpectator"+ , "Engine.PlayerReplicationInfo:bOutOfLives"+ , "Engine.PlayerReplicationInfo:bReadyToPlay"+ , "Engine.PlayerReplicationInfo:bWaitingPlayer"+ , "ProjectX.GRI_X:bGameStarted"+ , "TAGame.CameraSettingsActor_TA:bUsingBehindView"+ , "TAGame.CameraSettingsActor_TA:bUsingSecondaryCamera"+ , "TAGame.CarComponent_FlipCar_TA:bFlipRight"+ , "TAGame.GameEvent_Soccar_TA:bBallHasBeenHit"+ , "TAGame.GameEvent_Soccar_TA:bOverTime"+ , "TAGame.GameEvent_TA:bHasLeaveMatchPenalty"+ , "TAGame.GameEvent_Team_TA:bDisableMutingOtherTeam"+ , "TAGame.PRI_TA:bIsInSplitScreen"+ , "TAGame.PRI_TA:bMatchMVP"+ , "TAGame.PRI_TA:bOnlineLoadoutSet"+ , "TAGame.PRI_TA:bReady"+ , "TAGame.PRI_TA:bUsingBehindView"+ , "TAGame.PRI_TA:bUsingSecondaryCamera"+ , "TAGame.RBActor_TA:bFrozen"+ , "TAGame.RBActor_TA:bReplayActor"+ , "TAGame.Vehicle_TA:bDriving"+ , "TAGame.Vehicle_TA:bReplicatedHandbrake"+ ] & map Text.pack & Set.fromList++-- | A set of properties that are bytes.+byteProperties :: Set.Set Text.Text+byteProperties =+ [ "Engine.PlayerReplicationInfo:Ping"+ , "TAGame.Ball_TA:HitTeamNum"+ , "TAGame.CameraSettingsActor_TA:CameraPitch"+ , "TAGame.CameraSettingsActor_TA:CameraYaw"+ , "TAGame.CarComponent_Boost_TA:ReplicatedBoostAmount"+ , "TAGame.CarComponent_TA:ReplicatedActive"+ , "TAGame.GameEvent_Soccar_TA:ReplicatedScoredOnTeam"+ , "TAGame.GameEvent_TA:ReplicatedStateIndex"+ , "TAGame.PRI_TA:CameraPitch"+ , "TAGame.PRI_TA:CameraYaw"+ , "TAGame.Vehicle_TA:ReplicatedSteer"+ , "TAGame.Vehicle_TA:ReplicatedThrottle"+ ] & map Text.pack & Set.fromList++-- | A set of properties that are camera settings.+camSettingsProperties :: Set.Set Text.Text+camSettingsProperties =+ [ "TAGame.CameraSettingsActor_TA:ProfileSettings"+ , "TAGame.PRI_TA:CameraSettings"+ ] & map Text.pack & Set.fromList++-- | A set of properties that are demolition.+demolishProperties :: Set.Set Text.Text+demolishProperties =+ [ "TAGame.Car_TA:ReplicatedDemolish"+ ] & map Text.pack & Set.fromList++-- | A set of properties that are enumerations.+enumProperties :: Set.Set Text.Text+enumProperties =+ [ "Engine.Actor:Role"+ ] & map Text.pack & Set.fromList++-- | A set of properties that are explosions.+explosionProperties :: Set.Set Text.Text+explosionProperties =+ [ "TAGame.Ball_TA:ReplicatedExplosionData"+ ] & map Text.pack & Set.fromList++-- | A set of properties that are flagged integers.+flaggedIntProperties :: Set.Set Text.Text+flaggedIntProperties =+ [ "Engine.GameReplicationInfo:GameClass"+ , "Engine.Actor:ReplicatedCollisionType"+ , "Engine.Pawn:PlayerReplicationInfo"+ , "Engine.PlayerReplicationInfo:Team"+ , "TAGame.Ball_TA:GameEvent"+ , "TAGame.CameraSettingsActor_TA:PRI"+ , "TAGame.CarComponent_TA:Vehicle"+ , "TAGame.CrowdActor_TA:GameEvent"+ , "TAGame.CrowdActor_TA:ReplicatedOneShotSound"+ , "TAGame.CrowdManager_TA:GameEvent"+ , "TAGame.CrowdManager_TA:ReplicatedGlobalOneShotSound"+ , "TAGame.PRI_TA:PersistentCamera"+ , "TAGame.PRI_TA:ReplicatedGameEvent"+ , "TAGame.Team_TA:GameEvent"+ , "TAGame.Team_TA:LogoData"+ ] & map Text.pack & Set.fromList++-- | A set of properties that are floats.+floatProperties :: Set.Set Text.Text+floatProperties =+ [ "Engine.Actor:DrawScale"+ , "TAGame.Ball_TA:ReplicatedAddedCarBounceScale"+ , "TAGame.Ball_TA:ReplicatedBallMaxLinearSpeedScale"+ , "TAGame.Ball_TA:ReplicatedBallScale"+ , "TAGame.Ball_TA:ReplicatedWorldBounceScale"+ , "TAGame.CarComponent_FlipCar_TA:FlipCarTime"+ , "TAGame.CrowdActor_TA:ModifiedNoise"+ ] & map Text.pack & Set.fromList++-- | A set of properties that are game modes.+gameModeProperties :: Set.Set Text.Text+gameModeProperties =+ [ "TAGame.GameEvent_TA:GameMode"+ ] & map Text.pack & Set.fromList++-- | A set of properties that are integers.+intProperties :: Set.Set Text.Text+intProperties =+ [ "Engine.PlayerReplicationInfo:PlayerID"+ , "Engine.PlayerReplicationInfo:Score"+ , "Engine.TeamInfo:Score"+ , "ProjectX.GRI_X:ReplicatedGameMutatorIndex"+ , "ProjectX.GRI_X:ReplicatedGamePlaylist"+ , "TAGame.CrowdActor_TA:ReplicatedCountDownNumber"+ , "TAGame.GameEvent_Soccar_TA:RoundNum"+ , "TAGame.GameEvent_Soccar_TA:SecondsRemaining"+ , "TAGame.GameEvent_TA:BotSkill"+ , "TAGame.GameEvent_TA:ReplicatedGameStateTimeRemaining"+ , "TAGame.GameEvent_TA:ReplicatedStateName"+ , "TAGame.GameEvent_Team_TA:MaxTeamSize"+ , "TAGame.PRI_TA:MatchAssists"+ , "TAGame.PRI_TA:MatchGoals"+ , "TAGame.PRI_TA:MatchSaves"+ , "TAGame.PRI_TA:MatchScore"+ , "TAGame.PRI_TA:MatchShots"+ , "TAGame.PRI_TA:Title"+ , "TAGame.PRI_TA:TotalXP"+ ] & map Text.pack & Set.fromList++-- | A set of properties that are online loadouts.+loadoutOnlineProperties :: Set.Set Text.Text+loadoutOnlineProperties =+ [ "TAGame.PRI_TA:ClientLoadoutOnline"+ ] & map Text.pack & Set.fromList++-- | A set of properties that are loadouts.+loadoutProperties :: Set.Set Text.Text+loadoutProperties =+ [ "TAGame.PRI_TA:ClientLoadout"+ ] & map Text.pack & Set.fromList++-- | A set of properties that are locations.+locationProperties :: Set.Set Text.Text+locationProperties =+ [ "TAGame.CarComponent_Dodge_TA:DodgeTorque"+ ] & map Text.pack & Set.fromList++-- | A set of properties that are music stingers.+musicStingerProperties :: Set.Set Text.Text+musicStingerProperties =+ [ "TAGame.GameEvent_Soccar_TA:ReplicatedMusicStinger"+ ] & map Text.pack & Set.fromList++-- | A set of properties that are pickups.+pickupProperties :: Set.Set Text.Text+pickupProperties =+ [ "TAGame.VehiclePickup_TA:ReplicatedPickupData"+ ] & map Text.pack & Set.fromList++-- | A set of properties that are private match settings.+privateMatchSettingsProperties :: Set.Set Text.Text+privateMatchSettingsProperties =+ [ "TAGame.GameEvent_SoccarPrivate_TA:MatchSettings"+ ] & map Text.pack & Set.fromList++-- | A set of properties that are Q words, whatever those are.+qWordProperties :: Set.Set Text.Text+qWordProperties =+ [ "ProjectX.GRI_X:GameServerID"+ ] & map Text.pack & Set.fromList++-- | A set of properties that are relation rotations.+relativeRotationProperties :: Set.Set Text.Text+relativeRotationProperties =+ [ "Engine.Actor:RelativeRotation"+ ] & map Text.pack & Set.fromList++-- | A set of properties that are reservations.+reservationProperties :: Set.Set Text.Text+reservationProperties =+ [ "ProjectX.GRI_X:Reservations"+ ] & map Text.pack & Set.fromList++-- | A set of properties that are rigid body states.+rigidBodyStateProperties :: Set.Set Text.Text+rigidBodyStateProperties =+ [ "TAGame.RBActor_TA:ReplicatedRBState"+ ] & map Text.pack & Set.fromList++-- | A set of properties that are strings.+stringProperties :: Set.Set Text.Text+stringProperties =+ [ "Engine.GameReplicationInfo:ServerName"+ , "Engine.PlayerReplicationInfo:PlayerName"+ , "Engine.PlayerReplicationInfo:RemoteUserData"+ , "TAGame.GRI_TA:NewDedicatedServerIP"+ , "TAGame.Team_TA:CustomTeamName"+ ] & map Text.pack & Set.fromList++-- | A set of properties that are team paints.+teamPaintProperties :: Set.Set Text.Text+teamPaintProperties =+ [ "TAGame.Car_TA:TeamPaint"+ ] & map Text.pack & Set.fromList++-- | A set of properties that are unique IDs.+uniqueIdProperties :: Set.Set Text.Text+uniqueIdProperties =+ [ "Engine.PlayerReplicationInfo:UniqueId"+ ] & map Text.pack & Set.fromList
library/Octane/Main.hs view
@@ -2,7 +2,6 @@ import qualified Control.DeepSeq as DeepSeq import qualified Control.Monad as Monad-import qualified Control.Newtype as Newtype import qualified Data.Aeson as Aeson import qualified Data.Binary as Binary import qualified Data.Binary.Get as Binary@@ -52,14 +51,14 @@ let frames = Parser.parseFrames replay let expectedFrames = replay & Type.replayProperties- & Newtype.unpack- & Map.lookup ("NumFrames" & Text.pack & Newtype.pack)- & Maybe.fromMaybe (Type.IntProperty (Newtype.pack 4) (Newtype.pack 0))+ & Type.unpackDictionary+ & Map.lookup ("NumFrames" & Text.pack & Type.PCString)+ & Maybe.fromMaybe (Type.IntProperty (Type.Word64LE 4) (Type.Word32LE 0)) let actualFrames = frames & length & fromIntegral- & Newtype.pack- & Type.IntProperty (Newtype.pack 4)+ & Type.Word32LE+ & Type.IntProperty (Type.Word64LE 4) & DeepSeq.deepseq frames Monad.when (expectedFrames /= actualFrames) (error ( "expected "
library/Octane/Parser.hs view
@@ -5,7 +5,6 @@ import Data.Function ((&)) import qualified Control.DeepSeq as DeepSeq-import qualified Control.Newtype as Newtype import qualified Data.Aeson as Aeson import qualified Data.Aeson.Types as Aeson import qualified Data.Binary.Bits.Get as Bits@@ -22,6 +21,7 @@ import qualified Data.Text.Encoding as Encoding import qualified Data.Word as Word import qualified GHC.Generics as Generics+import qualified Octane.Data as Data import qualified Octane.Parser.ClassPropertyMap as CPM import qualified Octane.Type as Type import qualified Text.Printf as Printf@@ -30,13 +30,13 @@ parseFrames replay = let numFrames = replay & Type.replayProperties- & Newtype.unpack- & Map.lookup ("NumFrames" & Text.pack & Newtype.pack)+ & Type.unpackDictionary+ & Map.lookup ("NumFrames" & Text.pack & Type.PCString) & (\ property -> case property of- Just (Type.IntProperty _ x) -> x & Newtype.unpack & fromIntegral+ Just (Type.IntProperty _ x) -> x & Type.unpackWord32LE & fromIntegral _ -> 0) get = replay & extractContext & getFrames numFrames & Bits.runBitGet- stream = replay & Type.replayStream & Newtype.unpack & BSL.fromStrict+ stream = replay & Type.replayStream & Type.unpackStream & BSL.fromStrict (_context, frames) = Binary.runGet get stream in frames @@ -130,7 +130,7 @@ let objectName = case context & contextObjectMap & IntMap.lookup objectId of Nothing -> error ("could not find object name for id " ++ show objectId) Just x -> x- let (classId,className) = case CPM.getClass (contextObjectMap context) CPM.archetypeMap (contextClassMap context) objectId of+ let (classId,className) = case CPM.getClass (contextObjectMap context) Data.objectToClass (contextClassMap context) objectId of Nothing -> error ("could not find class for object id " ++ show objectId) Just x -> x classInit <- getClassInit className@@ -148,11 +148,11 @@ return ( newContext , Replication- { replicationActorId = actorId- , replicationIsOpen = True- , replicationIsNew = Just True- , replicationClassInit = Just classInit- , replicationProps = []+ { replicationObjectName = objectName+ , replicationClassName = className+ , replicationState = RSOpening+ , replicationInitialization = Just classInit+ , replicationProperties = Map.empty }) getExistingReplication :: Context@@ -164,37 +164,43 @@ Just x -> x props <- getProps context thing return (context, Replication- { replicationActorId = actorId- , replicationIsOpen = True- , replicationIsNew = Just False- , replicationClassInit = Nothing- , replicationProps = props+ { replicationObjectName = thingObjectName thing+ , replicationClassName = thingClassName thing+ , replicationState = RSExisting+ , replicationInitialization = Nothing+ , replicationProperties = props }) getClosedReplication :: Context -> ActorId -> Bits.BitGet (Context, Replication) getClosedReplication context actorId = do+ let thing = case context & contextThings & IntMap.lookup actorId of+ Nothing -> error ("could not find thing for actor id " ++ show actorId)+ Just x -> x let newThings = context & contextThings & IntMap.delete actorId let newContext = context { contextThings = newThings } return ( newContext , Replication- { replicationActorId = actorId- , replicationIsOpen = False- , replicationIsNew = Nothing- , replicationClassInit = Nothing- , replicationProps = []+ { replicationObjectName = thingObjectName thing+ , replicationClassName = thingClassName thing+ , replicationState = RSClosing+ , replicationInitialization = Nothing+ , replicationProperties = Map.empty }) -getProps :: Context -> Thing -> Bits.BitGet [Prop]+getProps :: Context -> Thing -> Bits.BitGet (Map.Map Text.Text PropValue) getProps context thing = do maybeProp <- getMaybeProp context thing case maybeProp of- Nothing -> return []+ Nothing -> return Map.empty Just prop -> do+ let k = propName prop+ let v = propValue prop+ let m = Map.singleton k v props <- getProps context thing- return (prop : props)+ return (Map.union m props) getMaybeProp :: Context -> Thing -> Bits.BitGet (Maybe Prop) getMaybeProp context thing = do@@ -219,150 +225,238 @@ value <- getPropValue name return (Prop { propName = name, propValue = value }) +--+ getPropValue :: Text.Text -> Bits.BitGet PropValue-getPropValue name = case Text.unpack name of- _ | Set.member name propsWithRigidBodyState -> do- flag <- Bits.getBool- position <- getVector- rotation <- getFloatVector- x <- if flag then return Nothing else fmap Just getVector- y <- if flag then return Nothing else fmap Just getVector- return (PRigidBodyState flag position rotation x y)- _ | Set.member name propsWithFlaggedInt -> do- flag <- Bits.getBool- int <- getInt32- return (PFlaggedInt flag (fromIntegral int))- _ | Set.member name propsWithString -> do+getPropValue name = case Map.lookup name propertyNameToGet of+ Nothing -> error ("don't know how to read property " ++ show name)+ Just get -> get++propertyNameToGet :: Map.Map Text.Text (Bits.BitGet PropValue)+propertyNameToGet =+ [ (Data.booleanProperties, getBooleanProperty)+ , (Data.byteProperties, getByteProperty)+ , (Data.camSettingsProperties, getCamSettingsProperty)+ , (Data.demolishProperties, getDemolishProperty)+ , (Data.enumProperties, getEnumProperty)+ , (Data.explosionProperties, getExplosionProperty)+ , (Data.flaggedIntProperties, getFlaggedIntProperty)+ , (Data.floatProperties, getFloatProperty)+ , (Data.gameModeProperties, getGameModeProperty)+ , (Data.intProperties, getIntProperty)+ , (Data.loadoutOnlineProperties, getLoadoutOnlineProperty)+ , (Data.loadoutProperties, getLoadoutProperty)+ , (Data.locationProperties, getLocationProperty)+ , (Data.musicStingerProperties, getMusicStingerProperty)+ , (Data.pickupProperties, getPickupProperty)+ , (Data.privateMatchSettingsProperties, getPrivateMatchSettingsProperty)+ , (Data.qWordProperties, getQWordProperty)+ , (Data.relativeRotationProperties, getRelativeRotationProperty)+ , (Data.reservationProperties, getReservationProperty)+ , (Data.rigidBodyStateProperties, getRigidBodyStateProperty)+ , (Data.stringProperties, getStringProperty)+ , (Data.teamPaintProperties, getTeamPaintProperty)+ , (Data.uniqueIdProperties, getUniqueIdProperty)+ , (Set.fromList [Text.pack "TAGame.PRI_TA:PartyLeader"], getPartyLeaderProperty)+ ]+ & concatMap (\ (ks, v) -> ks & Set.toList & map (\ k -> (k, v)))+ & Map.fromList++getBooleanProperty :: Bits.BitGet PropValue+getBooleanProperty = do+ bool <- Bits.getBool+ return (PBoolean bool)++getByteProperty :: Bits.BitGet PropValue+getByteProperty = do+ int <- getInt8+ return (PByte int)++getCamSettingsProperty :: Bits.BitGet PropValue+getCamSettingsProperty = do+ fov <- getFloat32+ height <- getFloat32+ pitch <- getFloat32+ dist <- getFloat32+ stiff <- getFloat32+ swiv <- getFloat32+ return (PCamSettings fov height pitch dist stiff swiv)++getDemolishProperty :: Bits.BitGet PropValue+getDemolishProperty = do+ atkFlag <- Bits.getBool+ atk <- getInt32+ vicFlag <- Bits.getBool+ vic <- getInt32+ vec1 <- getVector+ vec2 <- getVector+ return (PDemolish atkFlag atk vicFlag vic vec1 vec2)++getEnumProperty :: Bits.BitGet PropValue+getEnumProperty = do+ x <- Bits.getWord16be 10+ y <- if x == 1023+ then Bits.getBool+ else error ("unexpected enum value " ++ show x)+ return (PEnum x y)++getExplosionProperty :: Bits.BitGet PropValue+getExplosionProperty = do+ noGoal <- Bits.getBool+ a <- if noGoal then return Nothing else fmap Just getInt32+ b <- getVector+ return (PExplosion noGoal a b)++getFlaggedIntProperty :: Bits.BitGet PropValue+getFlaggedIntProperty = do+ flag <- Bits.getBool+ int <- getInt32+ return (PFlaggedInt flag (fromIntegral int))++getFloatProperty :: Bits.BitGet PropValue+getFloatProperty = do+ float <- getFloat32+ return (PFloat float)++getGameModeProperty :: Bits.BitGet PropValue+getGameModeProperty = do+ x <- Bits.getWord8 2+ if x == 2+ then return (PGameMode x)+ else error ("unexpected game mode value " ++ show x)++getIntProperty :: Bits.BitGet PropValue+getIntProperty = do+ int <- getInt32+ return (PInt int)++getLoadoutOnlineProperty :: Bits.BitGet PropValue+getLoadoutOnlineProperty = do+ version <- getInt32+ x <- getInt32+ y <- getInt32+ z <- if version >= 12+ then do+ value <- getInt8+ return (Just value)+ else return Nothing+ return (PLoadoutOnline version x y z)++getLoadoutProperty :: Bits.BitGet PropValue+getLoadoutProperty = do+ version <- getInt8+ a <- getInt32+ b <- getInt32+ c <- getInt32+ d <- getInt32+ e <- getInt32+ f <- getInt32+ g <- getInt32+ h <- if version > 10+ then do+ value <- getInt32+ return (Just value)+ else return Nothing+ return (PLoadout version a b c d e f g h)++getLocationProperty :: Bits.BitGet PropValue+getLocationProperty = do+ vector <- getVector+ return (PLocation vector)++getMusicStingerProperty :: Bits.BitGet PropValue+getMusicStingerProperty = do+ flag <- Bits.getBool+ cue <- getInt32+ trigger <- getInt8+ return (PMusicStinger flag cue trigger)++getPickupProperty :: Bits.BitGet PropValue+getPickupProperty = do+ instigator <- Bits.getBool+ instigatorId <- if instigator then fmap Just getInt32 else return Nothing+ pickedUp <- Bits.getBool+ return (PPickup instigator instigatorId pickedUp)++getPrivateMatchSettingsProperty :: Bits.BitGet PropValue+getPrivateMatchSettingsProperty = do+ mutators <- getString+ joinableBy <- getInt32+ maxPlayers <- getInt32+ gameName <- getString+ password <- getString+ flag <- Bits.getBool+ return (PPrivateMatchSettings mutators joinableBy maxPlayers gameName password flag)++getQWordProperty :: Bits.BitGet PropValue+getQWordProperty = do+ x <- getInt32+ y <- getInt32+ return (PQWord x y)++getRelativeRotationProperty :: Bits.BitGet PropValue+getRelativeRotationProperty = do+ vector <- getFloatVector+ return (PRelativeRotation vector)++getReservationProperty :: Bits.BitGet PropValue+getReservationProperty = 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 string <- getString- return (PString string)- _ | Set.member name propsWithBoolean -> do- bool <- Bits.getBool- return (PBoolean bool)- _ | Set.member name propsWithQWord -> do- x <- getInt32- y <- getInt32- return (PQWord x y)- _ | Set.member name propsWithInt -> do- int <- getInt32- return (PInt int)- _ | Set.member name propsWithByte -> do- int <- getInt8- return (PByte int)- _ | Set.member name propsWithCamSettings -> do- fov <- getFloat32- height <- getFloat32- pitch <- getFloat32- dist <- getFloat32- stiff <- getFloat32- swiv <- getFloat32- return (PCamSettings fov height pitch dist stiff swiv)- _ | Set.member name propsWithLocation -> do- vector <- getVector- return (PLocation vector)- _ | Set.member name propsWithFloat -> do- float <- getFloat32- return (PFloat float)- "Engine.PlayerReplicationInfo:UniqueId" -> do- (systemId, remoteId, localId) <- getUniqueId- return (PUniqueId systemId remoteId localId)- "TAGame.PRI_TA:PartyLeader" -> do- systemId <- getSystemId- if systemId == 0- then do- let remoteId = SplitscreenId Nothing- let localId = Nothing- return (PUniqueId systemId remoteId localId)- else do- remoteId <- getRemoteId systemId- localId <- getLocalId- return (PUniqueId systemId remoteId localId)- "ProjectX.GRI_X:Reservations" -> 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- string <- getString- return (Just string)- -- No idea what these two flags are. Might be for bots?- a <- Bits.getBool- b <- Bits.getBool- return (PReservation number systemId remoteId localId playerName a b)- "TAGame.PRI_TA:ClientLoadoutOnline" -> do- version <- getInt32- x <- getInt32- y <- getInt32- z <- if version >= 12- then do- value <- getInt8- return (Just value)- else return Nothing- return (PLoadoutOnline version x y z)- "TAGame.PRI_TA:ClientLoadout" -> do- version <- getInt8- a <- getInt32- b <- getInt32- c <- getInt32- d <- getInt32- e <- getInt32- f <- getInt32- g <- getInt32- h <- if version > 10- then do- value <- getInt32- return (Just value)- else return Nothing- return (PLoadout version a b c d e f g h)- "TAGame.Car_TA:TeamPaint" -> do- team <- getInt8- teamColor <- getInt8- customColor <- getInt8- teamFinish <- getInt32- customFinish <- getInt32- return (PTeamPaint team teamColor customColor teamFinish customFinish)- "TAGame.VehiclePickup_TA:ReplicatedPickupData" -> do- instigator <- Bits.getBool- instigatorId <- if instigator then fmap Just getInt32 else return Nothing- pickedUp <- Bits.getBool- return (PPickup instigator instigatorId pickedUp)- "Engine.Actor:Role" -> do- x <- Bits.getWord16be 11- return (PEnum x)- "TAGame.Ball_TA:ReplicatedExplosionData" -> do- noGoal <- Bits.getBool- a <- if noGoal then return Nothing else fmap Just getInt32- b <- getVector- return (PExplosion noGoal a b)- "TAGame.GameEvent_Soccar_TA:ReplicatedMusicStinger" -> do- flag <- Bits.getBool- cue <- getInt32- trigger <- getInt8- return (PMusicStinger flag cue trigger)- "TAGame.Car_TA:ReplicatedDemolish" -> do- hasAtk <- Bits.getBool- atk <- getInt32- hasVic <- Bits.getBool- vic <- getInt32- vec1 <- getVector- vec2 <- getVector- return (PDemolish hasAtk (Just atk) hasVic (Just vic) vec1 vec2)- "TAGame.GameEvent_SoccarPrivate_TA:MatchSettings" -> do- mutators <- getString- joinableBy <- getInt32- maxPlayers <- getInt32- gameName <- getString- password <- getString- flag <- Bits.getBool- return (PPrivateMatchSettings mutators joinableBy maxPlayers gameName password flag)- "Engine.Actor:RelativeRotation" -> do- vector <- getFloatVector- return (PRelativeRotation vector)- "TAGame.GameEvent_TA:GameMode" -> do- mode <- Bits.getWord8 2- return (PGameMode mode)- _ -> fail ("don't know how to read property " ++ show name)+ return (Just string)+ -- No idea what these two flags are. Might be for bots?+ a <- Bits.getBool+ b <- Bits.getBool+ return (PReservation number systemId remoteId localId playerName a b) +getRigidBodyStateProperty :: Bits.BitGet PropValue+getRigidBodyStateProperty = do+ flag <- Bits.getBool+ position <- getVector+ rotation <- getFloatVector+ x <- if flag then return Nothing else fmap Just getVector+ y <- if flag then return Nothing else fmap Just getVector+ return (PRigidBodyState flag position rotation x y)++getStringProperty :: Bits.BitGet PropValue+getStringProperty = do+ string <- getString+ return (PString string)++getTeamPaintProperty :: Bits.BitGet PropValue+getTeamPaintProperty = do+ team <- getInt8+ teamColor <- getInt8+ customColor <- getInt8+ teamFinish <- getInt32+ customFinish <- getInt32+ return (PTeamPaint team teamColor customColor teamFinish customFinish)++getUniqueIdProperty :: Bits.BitGet PropValue+getUniqueIdProperty = do+ (systemId, remoteId, localId) <- getUniqueId+ return (PUniqueId 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 PropValue+getPartyLeaderProperty = do+ systemId <- getSystemId+ (remoteId, localId) <- if systemId == 0+ then return (SplitscreenId Nothing, Nothing)+ else do+ remoteId <- getRemoteId systemId+ localId <- getLocalId+ return (remoteId, localId)+ return (PUniqueId systemId remoteId localId)++--+ getFloat32 :: Bits.BitGet Float getFloat32 = do bytes <- Bits.getByteString 4@@ -427,142 +521,10 @@ localId <- Bits.getWord8 8 localId & Just & return -propsWithRigidBodyState :: Set.Set Text.Text-propsWithRigidBodyState =- [ "TAGame.RBActor_TA:ReplicatedRBState"- ] & map Text.pack & Set.fromList--propsWithFlaggedInt :: Set.Set Text.Text-propsWithFlaggedInt =- [ "Engine.GameReplicationInfo:GameClass"- , "Engine.Actor:ReplicatedCollisionType"- , "Engine.Pawn:PlayerReplicationInfo"- , "Engine.PlayerReplicationInfo:Team"- , "TAGame.Ball_TA:GameEvent"- , "TAGame.CameraSettingsActor_TA:PRI"- , "TAGame.CarComponent_TA:Vehicle"- , "TAGame.CrowdActor_TA:GameEvent"- , "TAGame.CrowdActor_TA:ReplicatedOneShotSound"- , "TAGame.CrowdManager_TA:GameEvent"- , "TAGame.CrowdManager_TA:ReplicatedGlobalOneShotSound"- , "TAGame.PRI_TA:PersistentCamera"- , "TAGame.PRI_TA:ReplicatedGameEvent"- , "TAGame.Team_TA:GameEvent"- , "TAGame.Team_TA:LogoData"- ] & map Text.pack & Set.fromList--propsWithString :: Set.Set Text.Text-propsWithString =- [ "Engine.GameReplicationInfo:ServerName"- , "Engine.PlayerReplicationInfo:PlayerName"- , "Engine.PlayerReplicationInfo:RemoteUserData"- , "TAGame.GRI_TA:NewDedicatedServerIP"- , "TAGame.Team_TA:CustomTeamName"- ] & map Text.pack & Set.fromList--propsWithBoolean :: Set.Set Text.Text-propsWithBoolean =- [ "Engine.Actor:bBlockActors"- , "Engine.Actor:bCollideActors"- , "Engine.Actor:bHardAttach"- , "Engine.Actor:bHidden"- , "Engine.Actor:bProjTarget"- , "Engine.Actor:bTearOff"- , "Engine.GameReplicationInfo:bMatchIsOver"- , "Engine.Pawn:bCanSwatTurn"- , "Engine.Pawn:bRootMotionFromInterpCurve"- , "Engine.Pawn:bSimulateGravity"- , "Engine.PlayerReplicationInfo:bBot"- , "Engine.PlayerReplicationInfo:bIsSpectator"- , "Engine.PlayerReplicationInfo:bOnlySpectator"- , "Engine.PlayerReplicationInfo:bOutOfLives"- , "Engine.PlayerReplicationInfo:bReadyToPlay"- , "Engine.PlayerReplicationInfo:bWaitingPlayer"- , "ProjectX.GRI_X:bGameStarted"- , "TAGame.CameraSettingsActor_TA:bUsingBehindView"- , "TAGame.CameraSettingsActor_TA:bUsingSecondaryCamera"- , "TAGame.CarComponent_FlipCar_TA:bFlipRight"- , "TAGame.GameEvent_Soccar_TA:bBallHasBeenHit"- , "TAGame.GameEvent_Soccar_TA:bOverTime"- , "TAGame.GameEvent_TA:bHasLeaveMatchPenalty"- , "TAGame.GameEvent_Team_TA:bDisableMutingOtherTeam"- , "TAGame.PRI_TA:bIsInSplitScreen"- , "TAGame.PRI_TA:bMatchMVP"- , "TAGame.PRI_TA:bOnlineLoadoutSet"- , "TAGame.PRI_TA:bReady"- , "TAGame.PRI_TA:bUsingBehindView"- , "TAGame.PRI_TA:bUsingSecondaryCamera"- , "TAGame.RBActor_TA:bFrozen"- , "TAGame.RBActor_TA:bReplayActor"- , "TAGame.Vehicle_TA:bDriving"- , "TAGame.Vehicle_TA:bReplicatedHandbrake"- ] & map Text.pack & Set.fromList--propsWithQWord :: Set.Set Text.Text-propsWithQWord =- [ "ProjectX.GRI_X:GameServerID"- ] & map Text.pack & Set.fromList--propsWithInt :: Set.Set Text.Text-propsWithInt =- [ "Engine.PlayerReplicationInfo:PlayerID"- , "Engine.PlayerReplicationInfo:Score"- , "Engine.TeamInfo:Score"- , "ProjectX.GRI_X:ReplicatedGameMutatorIndex"- , "ProjectX.GRI_X:ReplicatedGamePlaylist"- , "TAGame.CrowdActor_TA:ReplicatedCountDownNumber"- , "TAGame.GameEvent_Soccar_TA:RoundNum"- , "TAGame.GameEvent_Soccar_TA:SecondsRemaining"- , "TAGame.GameEvent_TA:BotSkill"- , "TAGame.GameEvent_TA:ReplicatedGameStateTimeRemaining"- , "TAGame.GameEvent_TA:ReplicatedStateName"- , "TAGame.GameEvent_Team_TA:MaxTeamSize"- , "TAGame.PRI_TA:MatchAssists"- , "TAGame.PRI_TA:MatchGoals"- , "TAGame.PRI_TA:MatchSaves"- , "TAGame.PRI_TA:MatchScore"- , "TAGame.PRI_TA:MatchShots"- , "TAGame.PRI_TA:Title"- , "TAGame.PRI_TA:TotalXP"- ] & map Text.pack & Set.fromList--propsWithByte :: Set.Set Text.Text-propsWithByte =- [ "Engine.PlayerReplicationInfo:Ping"- , "TAGame.Ball_TA:HitTeamNum"- , "TAGame.CameraSettingsActor_TA:CameraPitch"- , "TAGame.CameraSettingsActor_TA:CameraYaw"- , "TAGame.CarComponent_Boost_TA:ReplicatedBoostAmount"- , "TAGame.CarComponent_TA:ReplicatedActive"- , "TAGame.GameEvent_Soccar_TA:ReplicatedScoredOnTeam"- , "TAGame.GameEvent_TA:ReplicatedStateIndex"- , "TAGame.PRI_TA:CameraPitch"- , "TAGame.PRI_TA:CameraYaw"- , "TAGame.Vehicle_TA:ReplicatedSteer"- , "TAGame.Vehicle_TA:ReplicatedThrottle"- ] & map Text.pack & Set.fromList--propsWithCamSettings :: Set.Set Text.Text-propsWithCamSettings =- [ "TAGame.CameraSettingsActor_TA:ProfileSettings"- , "TAGame.PRI_TA:CameraSettings"- ] & map Text.pack & Set.fromList--propsWithLocation :: Set.Set Text.Text-propsWithLocation =- [ "TAGame.CarComponent_Dodge_TA:DodgeTorque"- ] & map Text.pack & Set.fromList--propsWithFloat :: Set.Set Text.Text-propsWithFloat =- [ "Engine.Actor:DrawScale"- , "TAGame.Ball_TA:ReplicatedAddedCarBounceScale"- , "TAGame.Ball_TA:ReplicatedBallMaxLinearSpeedScale"- , "TAGame.Ball_TA:ReplicatedBallScale"- , "TAGame.Ball_TA:ReplicatedWorldBounceScale"- , "TAGame.CarComponent_FlipCar_TA:FlipCarTime"- , "TAGame.CrowdActor_TA:ModifiedNoise"- ] & map Text.pack & Set.fromList+toJsonOptions :: String -> Aeson.Options+toJsonOptions name = Aeson.defaultOptions+ { Aeson.fieldLabelModifier = Aeson.camelTo2 '_' . drop (length name)+ } type SystemId = Word.Word8 @@ -589,48 +551,40 @@ instance DeepSeq.NFData Prop instance Aeson.ToJSON Prop where- toJSON =- Aeson.genericToJSON- Aeson.defaultOptions- { Aeson.fieldLabelModifier = drop 4- }+ toJSON = Aeson.genericToJSON (toJsonOptions "Prop") data PropValue- = PRigidBodyState !Bool !(Vector Int) !(Vector Float) !(Maybe (Vector Int)) !(Maybe (Vector Int))+ = PBoolean !Bool+ | PByte !Int+ | PCamSettings !Float !Float !Float !Float !Float !Float+ | PDemolish !Bool !Int !Bool !Int !(Vector Int) !(Vector Int)+ | PEnum !Word.Word16 !Bool+ | PExplosion !Bool !(Maybe Int) !(Vector Int) | PFlaggedInt !Bool !Int- | PString !Text.Text- | PBoolean !Bool- | PQWord Int !Int- | PReservation !Int !SystemId !RemoteId !LocalId !(Maybe Text.Text) !Bool !Bool+ | PFloat !Float+ | PGameMode !Word.Word8 | PInt !Int- | PByte !Int- | PUniqueId !SystemId !RemoteId !LocalId- | PLoadoutOnline !Int !Int !Int !(Maybe Int) | PLoadout !Int !Int !Int !Int !Int !Int !Int !Int !(Maybe Int)- | PCamSettings !Float !Float !Float !Float !Float !Float- | PTeamPaint !Int !Int !Int !Int !Int+ | PLoadoutOnline !Int !Int !Int !(Maybe Int) | PLocation !(Vector Int)- | PPickup !Bool !(Maybe Int) !Bool- | PEnum !Word.Word16- | PExplosion !Bool !(Maybe Int) !(Vector Int) | PMusicStinger !Bool !Int !Int- | PFloat !Float- | PDemolish !Bool !(Maybe Int) !Bool !(Maybe Int) !(Vector Int) !(Vector Int)+ | PPickup !Bool !(Maybe Int) !Bool | PPrivateMatchSettings !Text.Text !Int !Int !Text.Text !Text.Text !Bool+ | PQWord !Int !Int | PRelativeRotation !(Vector Float)- | PGameMode !Word.Word8+ | PReservation !Int !SystemId !RemoteId !LocalId !(Maybe Text.Text) !Bool !Bool+ | PRigidBodyState !Bool !(Vector Int) !(Vector Float) !(Maybe (Vector Int)) !(Maybe (Vector Int))+ | PString !Text.Text+ | PTeamPaint !Int !Int !Int !Int !Int+ | PUniqueId !SystemId !RemoteId !LocalId deriving (Eq, Generics.Generic, Show) instance DeepSeq.NFData PropValue instance Aeson.ToJSON PropValue where- toJSON =- Aeson.genericToJSON- Aeson.defaultOptions- { Aeson.fieldLabelModifier = drop 9- }+ toJSON = Aeson.genericToJSON (toJsonOptions "PropValue") -- | A frame in the net stream. Each frame has the time since the beginning of--- | the match, the time since the last frame, and a list of replications.+-- the match, the time since the last frame, and a list of replications. data Frame = Frame { frameTime :: !Float , frameDelta :: !Float@@ -639,28 +593,33 @@ instance DeepSeq.NFData Frame instance Aeson.ToJSON Frame where- toJSON =- Aeson.genericToJSON- Aeson.defaultOptions- { Aeson.fieldLabelModifier = drop 5- }+ toJSON = Aeson.genericToJSON (toJsonOptions "Frame") +data ReplicationState+ = RSOpening+ | RSExisting+ | RSClosing+ deriving (Eq, Generics.Generic, Show)++instance DeepSeq.NFData ReplicationState+instance Aeson.ToJSON ReplicationState where+ toJSON rs = Aeson.toJSON (case rs of+ RSOpening -> "opening"+ RSExisting -> "existing"+ RSClosing -> "closing")+ -- | Replication information about an actor in the net stream. data Replication = Replication- { replicationActorId :: !Int- , replicationIsOpen :: !Bool- , replicationIsNew :: !(Maybe Bool)- , replicationClassInit :: !(Maybe ClassInit)- , replicationProps :: ![Prop]+ { replicationObjectName :: !Text.Text+ , replicationClassName :: !Text.Text+ , replicationState :: !ReplicationState+ , replicationInitialization :: !(Maybe ClassInit)+ , replicationProperties :: !(Map.Map Text.Text PropValue) } deriving (Eq,Generics.Generic,Show) instance DeepSeq.NFData Replication instance Aeson.ToJSON Replication where- toJSON =- Aeson.genericToJSON- Aeson.defaultOptions- { Aeson.fieldLabelModifier = drop 11- }+ toJSON = Aeson.genericToJSON (toJsonOptions "Replication") data Thing = Thing { thingFlag :: !Bool@@ -698,11 +657,7 @@ instance DeepSeq.NFData ClassInit instance Aeson.ToJSON ClassInit where- toJSON =- Aeson.genericToJSON- Aeson.defaultOptions- { Aeson.fieldLabelModifier = drop 9- }+ toJSON = Aeson.genericToJSON (toJsonOptions "ClassInit") -- { class stream id => { property stream id => name } } type ClassPropertyMap = IntMap.IntMap (IntMap.IntMap Text.Text)@@ -809,13 +764,13 @@ getClassInit :: Text.Text -> Bits.BitGet ClassInit getClassInit className = do location <-- if Set.member className CPM.classesWithLocation+ if Set.member className Data.locationClasses then do vector <- getVector return (Just vector) else return Nothing rotation <-- if Set.member className CPM.classesWithRotation+ if Set.member className Data.rotationClasses then do vector <- getVectorBytewise return (Just vector)
library/Octane/Parser/ClassPropertyMap.hs view
@@ -1,20 +1,20 @@+-- | 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.Parser.ClassPropertyMap where import Data.Function ((&))-import Debug.Trace -import qualified Control.Newtype as Newtype import qualified Data.Char as Char import qualified Data.IntMap.Strict as IntMap import qualified Data.List as List import qualified Data.Map.Strict as Map import qualified Data.Maybe as Maybe-import qualified Data.Set as Set import qualified Data.Text as Text import qualified Octane.Type as Type -- | 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.+-- property IDs in the stream to property names. getClassPropertyMap :: Type.Replay -> IntMap.IntMap (IntMap.IntMap Text.Text) getClassPropertyMap replay = let basicClassPropertyMap = getBasicClassPropertyMap replay@@ -38,15 +38,15 @@ & 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.+-- ID, the second is its cache ID, and the third is its parent's cache ID. getClassCache :: Type.Replay -> [(Int, Int, Int)] getClassCache replay = replay & Type.replayCacheItems- & Newtype.unpack+ & Type.unpackList & map (\ x ->- ( x & Type.cacheItemClassId & Newtype.unpack & fromIntegral- , x & Type.cacheItemCacheId & Newtype.unpack & fromIntegral- , x & Type.cacheItemParentCacheId & Newtype.unpack & fromIntegral+ ( x & Type.cacheItemClassId & Type.unpackWord32LE & fromIntegral+ , x & Type.cacheItemCacheId & Type.unpackWord32LE & fromIntegral+ , x & Type.cacheItemParentCacheId & Type.unpackWord32LE & fromIntegral )) -- | The class IDs in a replay. Comes from the class cache.@@ -56,8 +56,8 @@ & 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.+-- 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@@ -67,8 +67,8 @@ (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.+-- 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 :: Type.Replay -> IntMap.IntMap Int getBasicClassMap replay = replay & getClassCache@@ -82,7 +82,7 @@ & IntMap.fromList -- | Given a naive mapping from class ID to its parent class ID, return all of--- | the parent IDs for a given class.+-- the parent IDs for a given class. getParentClassIds :: Int -> IntMap.IntMap Int -> [Int] getParentClassIds classId basicClassMap = case IntMap.lookup classId basicClassMap of@@ -105,28 +105,28 @@ getPropertyMap :: Type.Replay -> IntMap.IntMap Text.Text getPropertyMap replay = replay & Type.replayObjects- & Newtype.unpack- & map Newtype.unpack+ & Type.unpackList+ & map Type.unpackPCString & 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.+-- mapping from property IDs to property names. It's naive because it does+-- not include the properties from the class's parents. getBasicClassPropertyMap :: Type.Replay -> IntMap.IntMap (IntMap.IntMap Text.Text) getBasicClassPropertyMap replay = let propertyMap = getPropertyMap replay in replay & Type.replayCacheItems- & Newtype.unpack+ & Type.unpackList & map (\ x -> let- classId = x & Type.cacheItemClassId & Newtype.unpack & fromIntegral+ classId = x & Type.cacheItemClassId & Type.unpackWord32LE & fromIntegral properties = x & Type.cacheItemCacheProperties- & Newtype.unpack+ & Type.unpackList & Maybe.mapMaybe (\ y -> let- streamId = y & Type.cachePropertyStreamId & Newtype.unpack & fromIntegral- propertyId = y & Type.cachePropertyObjectId & Newtype.unpack & fromIntegral+ streamId = y & Type.cachePropertyStreamId & Type.unpackWord32LE & fromIntegral+ propertyId = y & Type.cachePropertyObjectId & Type.unpackWord32LE & fromIntegral in case IntMap.lookup propertyId propertyMap of Nothing -> Nothing Just name -> Just (streamId, name))@@ -138,10 +138,10 @@ getActorMap :: Type.Replay -> Map.Map Text.Text Int getActorMap replay = replay & Type.replayActors- & Newtype.unpack+ & Type.unpackList & map (\ x -> let- className = x & Type.actorName & Newtype.unpack- classId = x & Type.actorStreamId & Newtype.unpack & fromIntegral+ className = x & Type.actorName & Type.unpackPCString+ classId = x & Type.actorStreamId & Type.unpackWord32LE & fromIntegral in (className, classId)) & Map.fromList @@ -154,155 +154,14 @@ -> Maybe (Int, Text.Text) -- ^ Maybe class ID and class name getClass propertyIdsToNames propertyNamesToClassNames classNamesToIds propertyId = case IntMap.lookup propertyId propertyIdsToNames of- Nothing -> trace ("could not find property name for property id " ++ show propertyId) Nothing+ Nothing -> Nothing Just rawPropertyName -> let -- There are a large number of properties that end in numbers that -- should all be treated the same. Instead of explicitly mapping -- each of them, we can remove the numbers and treat them the same. propertyName = rawPropertyName & Text.dropWhileEnd Char.isDigit in case Map.lookup propertyName propertyNamesToClassNames of- Nothing -> trace ("could not find class name for property name " ++ show propertyName) $ trace (classNamesToIds & Map.toList & map (\ (k, v) -> " " ++ show v ++ " => " ++ show k) & unlines) $ Nothing+ Nothing -> Nothing Just className -> case Map.lookup className classNamesToIds of- Nothing -> trace ("could not find class id for class name " ++ show className) Nothing+ Nothing -> Nothing Just classId -> Just (classId, className)---- | The archetype maps is a mapping from object names to their class names.-archetypeMap :: Map.Map Text.Text Text.Text-archetypeMap =- -- We start by mapping class names to object names of that class. This- -- allows us to avoid repeating the class name a bunch.- [ ( "TAGame.Ball_TA"- , [ "Archetypes.Ball.Ball_Default"- , "Archetypes.Ball.Ball_Basketball"- , "Archetypes.Ball.Ball_Puck"- ])- , ( "TAGame.CameraSettingsActor_TA"- , [ "TAGame.CameraSettingsActor_TA:PRI"- , "TAGame.Default__CameraSettingsActor_TA"- ])- , ( "TAGame.CarComponent_Boost_TA"- , [ "Archetypes.CarComponents.CarComponent_Boost"- ])- , ( "TAGame.CarComponent_Dodge_TA"- , [ "Archetypes.CarComponents.CarComponent_Dodge"- ])- , ( "TAGame.CarComponent_DoubleJump_TA"- , [ "Archetypes.CarComponents.CarComponent_DoubleJump"- ])- , ( "TAGame.CarComponent_FlipCar_TA"- , [ "Archetypes.CarComponents.CarComponent_FlipCar"- ])- , ( "TAGame.CarComponent_Jump_TA"- , [ "Archetypes.CarComponents.CarComponent_Jump"- ])- , ( "TAGame.Car_Season_TA"- , [ "Archetypes.GameEvent.GameEvent_Season:CarArchetype"- ])- , ( "TAGame.Car_TA"- , [ "Archetypes.Car.Car_Default"- ])- , ( "TAGame.GameEvent_Season_TA"- , [ "Archetypes.GameEvent.GameEvent_Season"- ])- , ( "TAGame.GameEvent_SoccarPrivate_TA"- , [ "Archetypes.GameEvent.GameEvent_SoccarPrivate"- ])- , ( "TAGame.GameEvent_SoccarSplitscreen_TA"- , [ "Archetypes.GameEvent.GameEvent_SoccarSplitscreen"- ])- , ( "TAGame.GameEvent_Soccar_TA"- , [ "Archetypes.GameEvent.GameEvent_Soccar"- , "Archetypes.GameEvent.GameEvent_Basketball"- ])- , ( "TAGame.GRI_TA"- , [ "GameInfo_Basketball.GameInfo.GameInfo_Basketball:GameReplicationInfoArchetype"- , "GameInfo_Season.GameInfo.GameInfo_Season:GameReplicationInfoArchetype"- , "GameInfo_Soccar.GameInfo.GameInfo_Soccar:GameReplicationInfoArchetype"- ])- , ( "TAGame.PRI_TA"- , [ "TAGame.Default__PRI_TA"- ])- , ( "TAGame.Team_TA"- , [ "Archetypes.Teams.Team"- ])- -- These ones are special. They have specific names for each level.- , ( "TAGame.VehiclePickup_Boost_TA"- , levels & Set.toList & map (\ level -> level ++ ".TheWorld:PersistentLevel.VehiclePickup_Boost_TA_")- )- , ( "TAGame.CrowdActor_TA"- , levels & Set.toList & map (\ level -> level ++ ".TheWorld:PersistentLevel.CrowdActor_TA_")- )- , ( "TAGame.CrowdManager_TA"- , levels & Set.toList & map (\ level -> level ++ ".TheWorld:PersistentLevel.CrowdManager_TA_")- )- ]- & concatMap (\ (v, ks) -> ks & map (\ k -> (k, v)))- & map (\ (k, v) -> (Text.pack k, Text.pack v))- & Map.fromList---- | These are the levels that we know about. The capitalization of these--- | drives me nuts.-levels :: Set.Set String-levels =- [ "EuroStadium_Rainy_P"- , "HoopsStadium_P"- , "Park_Night_P"- , "Park_Rainy_P"- , "Stadium_p"- , "TrainStation_Night_P"- , "TrainStation_P"- , "Trainstation_Night_P"- , "UtopiaStadium_Dusk_P"- , "UtopiaStadium_Dusk_p"- , "UtopiaStadium_P"- , "Utopiastadium_p"- , "Wasteland_P"- , "Wasteland_p"- , "eurostad_oob_audio_map"- , "eurostadium_p"- , "eurostadium_rainy_audio"- , "hoopsstadium_sfx"- , "labs_doublegoal_p"- , "labs_underpass_p"- , "labs_utopia_p"- , "park_night_sfx"- , "park_p"- , "park_rainy_sfx"- , "park_sfx"- , "stadium_oob_audio_map"- , "stadium_p"- , "stadium_winter_p"- , "trainstation_p"- , "utopiastadium_p"- , "utopiastadium_sfx"- , "wasteland_sfx"- ] & Set.fromList---- | These classes have an initial location vector.-classesWithLocation :: Set.Set Text.Text-classesWithLocation =- [ "TAGame.Ball_TA"- , "TAGame.CameraSettingsActor_TA"- , "TAGame.CarComponent_Boost_TA"- , "TAGame.CarComponent_Dodge_TA"- , "TAGame.CarComponent_DoubleJump_TA"- , "TAGame.CarComponent_FlipCar_TA"- , "TAGame.CarComponent_Jump_TA"- , "TAGame.Car_Season_TA"- , "TAGame.Car_TA"- , "TAGame.GRI_TA"- , "TAGame.GameEvent_Season_TA"- , "TAGame.GameEvent_SoccarPrivate_TA"- , "TAGame.GameEvent_SoccarSplitscreen_TA"- , "TAGame.GameEvent_Soccar_TA"- , "TAGame.PRI_TA"- , "TAGame.Team_TA"- ] & map Text.pack & Set.fromList---- | These classes have an initial rotation vector.-classesWithRotation :: Set.Set Text.Text-classesWithRotation =- [ "TAGame.Ball_TA"- , "TAGame.Car_Season_TA"- , "TAGame.Car_TA"- ] & map Text.pack & Set.fromList
library/Octane/Type/Actor.hs view
@@ -10,8 +10,8 @@ import qualified Octane.Type.Primitive.PCString as PCString import qualified Octane.Type.Primitive.Word32LE as Word32LE --- | A class (like "Core.Object") and it's associated ID in the net stream--- | (like 0).+-- | A class (like @Core.Object@) and it's associated ID in the net stream+-- (like 0). data Actor = Actor { actorName :: !PCString.PCString , actorStreamId :: !Word32LE.Word32LE
library/Octane/Type/KeyFrame.hs view
@@ -11,8 +11,8 @@ import qualified Octane.Type.Primitive.Word32LE as Word32LE -- | A key frame. Each key frame has the time since the beginning of the match,--- | the frame it corresponds to, and that frame's bit position in the network--- | stream.+-- the frame it corresponds to, and that frame's bit position in the network+-- stream. data KeyFrame = KeyFrame { keyFrameTime :: !Float32LE.Float32LE , keyFrameFrame :: !Word32LE.Word32LE
library/Octane/Type/Primitive/Boolean.hs view
@@ -3,27 +3,24 @@ module Octane.Type.Primitive.Boolean (Boolean(..)) where import qualified Control.DeepSeq as DeepSeq-import qualified Control.Newtype as Newtype import qualified Data.Aeson as Aeson import qualified Data.Binary as Binary import Data.Function ((&)) import qualified GHC.Generics as Generics -- | A boolean value, stored in the first bit of a byte.-newtype Boolean =- Boolean Bool- deriving (Eq,Generics.Generic,Show)+newtype Boolean = Boolean+ { unpackBoolean :: Bool+ } deriving (Eq,Generics.Generic,Show) instance Binary.Binary Boolean where get = do boolean <- Binary.getWord8 if boolean > 1 then fail ("invalid Boolean value " ++ show boolean)- else boolean & fromIntegral & toEnum & Newtype.pack & return+ else boolean & fromIntegral & toEnum & Boolean & return put boolean = do- boolean & Newtype.unpack & fromEnum & fromIntegral & Binary.putWord8--instance Newtype.Newtype Boolean+ boolean & unpackBoolean & fromEnum & fromIntegral & Binary.putWord8 instance DeepSeq.NFData Boolean
library/Octane/Type/Primitive/Dictionary.hs view
@@ -4,7 +4,6 @@ module Octane.Type.Primitive.Dictionary (Dictionary(..)) where import qualified Control.DeepSeq as DeepSeq-import qualified Control.Newtype as Newtype import qualified Data.Aeson as Aeson import qualified Data.Binary as Binary import Data.Function ((&))@@ -13,31 +12,29 @@ import qualified Octane.Type.Primitive.PCString as PCString -- | A dictionary that maps strings to values. The dictionary is terminated by--- | the key "None".-newtype Dictionary a =- Dictionary (Map.Map PCString.PCString a)- deriving (Eq,Generics.Generic,Show)+-- the key "None".+newtype Dictionary a = Dictionary+ { unpackDictionary :: (Map.Map PCString.PCString a)+ } deriving (Eq,Generics.Generic,Show) instance (Binary.Binary a) => Binary.Binary (Dictionary a) where get = do element <- getElement if Map.null element then do- element & Newtype.pack & return+ element & Dictionary & return else do Dictionary elements <- Binary.get- elements & Map.union element & Newtype.pack & return+ elements & Map.union element & Dictionary & return put dictionary = do- dictionary & Newtype.unpack & Map.assocs & mapM_ putElement+ dictionary & unpackDictionary & Map.assocs & mapM_ putElement noneKey & Binary.put -instance Newtype.Newtype (Dictionary a)- instance (DeepSeq.NFData a) => DeepSeq.NFData (Dictionary a) instance (Aeson.ToJSON a) => Aeson.ToJSON (Dictionary a) where toJSON dictionary =- dictionary & Newtype.unpack & Map.mapKeys Newtype.unpack & Aeson.toJSON+ dictionary & unpackDictionary & Map.mapKeys PCString.unpackPCString & Aeson.toJSON getElement :: (Binary.Binary a)
library/Octane/Type/Primitive/Float32LE.hs view
@@ -3,7 +3,6 @@ module Octane.Type.Primitive.Float32LE (Float32LE(..)) where import qualified Control.DeepSeq as DeepSeq-import qualified Control.Newtype as Newtype import qualified Data.Aeson as Aeson import qualified Data.Binary as Binary import qualified Data.Binary.IEEE754 as IEEE754@@ -11,18 +10,16 @@ import qualified GHC.Generics as Generics -- | A 32-bit little-endian float.-newtype Float32LE =- Float32LE Float- deriving (Eq,Generics.Generic,Show)+newtype Float32LE = Float32LE+ { unpackFloat32LE :: Float+ } deriving (Eq,Generics.Generic,Show) instance Binary.Binary Float32LE where get = do float <- IEEE754.getFloat32le- float & Newtype.pack & return+ float & Float32LE & return put float = do- float & Newtype.unpack & IEEE754.putFloat32le--instance Newtype.Newtype Float32LE+ float & unpackFloat32LE & IEEE754.putFloat32le instance DeepSeq.NFData Float32LE
library/Octane/Type/Primitive/List.hs view
@@ -4,7 +4,6 @@ import qualified Control.DeepSeq as DeepSeq import qualified Control.Monad as Monad-import qualified Control.Newtype as Newtype import qualified Data.Aeson as Aeson import qualified Data.Binary as Binary import Data.Function ((&))@@ -12,21 +11,19 @@ import qualified Octane.Type.Primitive.Word32LE as Word32LE -- | A length-prefixed list.-newtype List a =- List [a]- deriving (Eq,Generics.Generic,Show)+newtype List a = List+ { unpackList :: [a]+ } deriving (Eq,Generics.Generic,Show) instance (Binary.Binary a) => Binary.Binary (List a) where get = do (Word32LE.Word32LE size) <- Binary.get elements <- Monad.replicateM (fromIntegral size) Binary.get- elements & Newtype.pack & return+ elements & List & return put list = do- list & Newtype.unpack & length & fromIntegral & Word32LE.Word32LE &+ list & unpackList & length & fromIntegral & Word32LE.Word32LE & Binary.put- list & Newtype.unpack & mapM_ Binary.put--instance Newtype.Newtype (List a)+ list & unpackList & mapM_ Binary.put instance (DeepSeq.NFData a) => DeepSeq.NFData (List a)
library/Octane/Type/Primitive/PCString.hs view
@@ -3,7 +3,6 @@ module Octane.Type.Primitive.PCString (PCString(..)) where import qualified Control.DeepSeq as DeepSeq-import qualified Control.Newtype as Newtype import qualified Data.Aeson as Aeson import qualified Data.Binary as Binary import qualified Data.Binary.Get as Binary@@ -19,9 +18,9 @@ import qualified Octane.Type.Primitive.Word32LE as Word32LE -- | A length-prefixed null-terminated string.-newtype PCString =- PCString Text.Text- deriving (Eq,Generics.Generic,Ord,Show)+newtype PCString = PCString+ { unpackPCString :: Text.Text+ } deriving (Eq,Generics.Generic,Ord,Show) instance Binary.Binary PCString where get = do@@ -57,9 +56,9 @@ else do bytes <- Binary.getByteString (fromIntegral size) bytes & Encoding.decodeLatin1 & return- string & Text.dropEnd 1 & Newtype.pack & return+ string & Text.dropEnd 1 & PCString & return put string = do- let cString = string & Newtype.unpack & flip Text.snoc '\NUL'+ let cString = string & unpackPCString & flip Text.snoc '\NUL' let size = cString & Text.length & fromIntegral if Text.all Char.isLatin1 cString then do@@ -70,9 +69,7 @@ cString & Encoding.encodeUtf16LE & Binary.putByteString instance String.IsString PCString where- fromString string = string & Text.pack & Newtype.pack--instance Newtype.Newtype PCString+ fromString string = string & Text.pack & PCString instance DeepSeq.NFData PCString
library/Octane/Type/Primitive/Stream.hs view
@@ -3,7 +3,6 @@ module Octane.Type.Primitive.Stream (Stream(..), reverseBits) where import qualified Control.DeepSeq as DeepSeq-import qualified Control.Newtype as Newtype import qualified Data.Aeson as Aeson import qualified Data.Binary as Binary import qualified Data.Binary.Get as Binary@@ -16,28 +15,26 @@ import qualified Octane.Type.Primitive.Word32LE as Word32LE -- | A length-prefixed stream of bits. The length is given in bytes. Each byte--- | is reversed such that 0b01234567 is actually 0b76543210.-newtype Stream =- Stream BS.ByteString- deriving (Eq,Generics.Generic,Show)+-- is reversed such that 0b01234567 is actually 0b76543210.+newtype Stream = Stream+ { unpackStream :: BS.ByteString+ } deriving (Eq,Generics.Generic,Show) instance Binary.Binary Stream where get = do Word32LE.Word32LE size <- Binary.get content <- size & fromIntegral & Binary.getByteString- content & BS.map reverseBits & Newtype.pack & return+ content & BS.map reverseBits & Stream & return put stream = do- let content = Newtype.unpack stream+ let content = unpackStream stream content & BS.length & fromIntegral & Word32LE.Word32LE & Binary.put content & BS.map reverseBits & Binary.putByteString -instance Newtype.Newtype Stream- instance DeepSeq.NFData Stream instance Aeson.ToJSON Stream where toJSON stream =- let size = stream & Newtype.unpack & BS.length+ let size = stream & unpackStream & BS.length bytes = if size == 1 then "byte"
library/Octane/Type/Primitive/Word32LE.hs view
@@ -3,7 +3,6 @@ module Octane.Type.Primitive.Word32LE (Word32LE(..)) where import qualified Control.DeepSeq as DeepSeq-import qualified Control.Newtype as Newtype import qualified Data.Aeson as Aeson import qualified Data.Binary as Binary import qualified Data.Binary.Get as Binary@@ -13,18 +12,16 @@ import qualified GHC.Generics as Generics -- | A 32-bit little-endian integer.-newtype Word32LE =- Word32LE Int.Int32- deriving (Eq,Generics.Generic,Show)+newtype Word32LE = Word32LE+ { unpackWord32LE :: Int.Int32+ } deriving (Eq,Generics.Generic,Show) instance Binary.Binary Word32LE where get = do word <- Binary.getWord32le- word & fromIntegral & Newtype.pack & return+ word & fromIntegral & Word32LE & return put word = do- word & Newtype.unpack & fromIntegral & Binary.putWord32le--instance Newtype.Newtype Word32LE+ word & unpackWord32LE & fromIntegral & Binary.putWord32le instance DeepSeq.NFData Word32LE
library/Octane/Type/Primitive/Word64LE.hs view
@@ -3,7 +3,6 @@ module Octane.Type.Primitive.Word64LE (Word64LE(..)) where import qualified Control.DeepSeq as DeepSeq-import qualified Control.Newtype as Newtype import qualified Data.Aeson as Aeson import qualified Data.Binary as Binary import qualified Data.Binary.Get as Binary@@ -13,18 +12,16 @@ import qualified GHC.Generics as Generics -- | A 64-bit little-endian integer.-newtype Word64LE =- Word64LE Int.Int64- deriving (Eq,Generics.Generic,Show)+newtype Word64LE = Word64LE+ { unpackWord64LE :: Int.Int64+ } deriving (Eq,Generics.Generic,Show) instance Binary.Binary Word64LE where get = do word <- Binary.getWord64le- word & fromIntegral & Newtype.pack & return+ word & fromIntegral & Word64LE & return put word = do- word & Newtype.unpack & fromIntegral & Binary.putWord64le--instance Newtype.Newtype Word64LE+ word & unpackWord64LE & fromIntegral & Binary.putWord64le instance DeepSeq.NFData Word64LE
library/Octane/Type/Property.hs view
@@ -4,7 +4,6 @@ module Octane.Type.Property (Property(..)) where import qualified Control.DeepSeq as DeepSeq-import qualified Control.Newtype as Newtype import qualified Data.Aeson.Types as Aeson import qualified Data.Binary as Binary import Data.Function ((&))@@ -18,8 +17,8 @@ import qualified Octane.Type.Primitive.Word64LE as Word64LE -- | 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.+-- use it. The value stored in the property can be an array, a boolean, and+-- so on. data Property = ArrayProperty !Word64LE.Word64LE !(List.List (Dictionary.Dictionary Property))@@ -62,14 +61,14 @@ _ | kind == floatProperty -> do size <- Binary.get value <-- case Newtype.unpack size of+ case Word64LE.unpackWord64LE size of 4 -> Binary.get x -> fail ("unknown FloatProperty size " ++ show x) value & FloatProperty size & return _ | kind == intProperty -> do size <- Binary.get value <-- case Newtype.unpack size of+ case Word64LE.unpackWord64LE size of 4 -> Binary.get x -> fail ("unknown IntProperty size " ++ show x) value & IntProperty size & return@@ -80,7 +79,7 @@ _ | kind == qWordProperty -> do size <- Binary.get value <-- case Newtype.unpack size of+ case Word64LE.unpackWord64LE size of 8 -> Binary.get x -> fail ("unknown QWordProperty size " ++ show x) value & QWordProperty size & return@@ -88,7 +87,7 @@ size <- Binary.get value <- Binary.get value & StrProperty size & return- _ -> fail ("unknown property type " ++ show (Newtype.unpack kind))+ _ -> fail ("unknown property type " ++ show (PCString.unpackPCString kind)) put property = case property of ArrayProperty size value -> do
library/Octane/Type/Replay.hs view
@@ -20,7 +20,7 @@ import qualified Octane.Type.Property as Property -- | An entire replay. All of the metadata has been parsed, but the actual net--- | stream has not.+-- stream has not. data Replay = Replay -- Number of bytes in the first section. { replaySize1 :: !Word32LE.Word32LE
octane.cabal view
@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: octane-version: 0.5.2+version: 0.5.3 synopsis: Parse Rocket League replays. description: Octane parses Rocket League replays. category: Game@@ -28,7 +28,7 @@ library hs-source-dirs: library- ghc-options: -Wall+ ghc-options: -O2 -Wall build-depends: aeson >=0.9 && <0.12 , autoexporter ==0.2.*@@ -39,10 +39,10 @@ , containers ==0.5.* , data-binary-ieee754 ==0.4.* , deepseq ==1.4.*- , newtype-generics ==0.4.* , text ==1.2.* exposed-modules: Octane+ Octane.Data Octane.Main Octane.Parser Octane.Parser.ClassPropertyMap@@ -73,7 +73,7 @@ main-is: Executable.hs hs-source-dirs: executable- ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N+ ghc-options: -O2 -Wall -rtsopts -threaded -with-rtsopts=-N build-depends: base , octane@@ -84,7 +84,7 @@ main-is: TestSuite.hs hs-source-dirs: test-suite- ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N+ ghc-options: -O2 -Wall -rtsopts -threaded -with-rtsopts=-N build-depends: base , binary@@ -122,7 +122,7 @@ main-is: Benchmark.hs hs-source-dirs: benchmark- ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N+ ghc-options: -O2 -Wall -rtsopts -threaded -with-rtsopts=-N build-depends: base , binary
package.yaml view
@@ -31,7 +31,9 @@ - package.yaml - README.markdown - stack.yaml-ghc-options: -Wall+ghc-options:+- -O2+- -Wall github: tfausak/octane library: dependencies:@@ -44,7 +46,6 @@ - containers ==0.5.* - data-binary-ieee754 ==0.4.* - deepseq ==1.4.*- - newtype-generics ==0.4.* - text ==1.2.* other-modules: Paths_octane source-dirs: library@@ -69,4 +70,4 @@ - -with-rtsopts=-N main: TestSuite.hs source-dirs: test-suite-version: '0.5.2'+version: '0.5.3'
stack.yaml view
@@ -1,1 +1,1 @@-resolver: nightly-2016-05-12+resolver: nightly-2016-05-30