packages feed

rattletrap 7.0.2 → 7.0.3

raw patch · 16 files changed

+121/−121 lines, 16 files

Files

library/Rattletrap/Console/Main.hs view
@@ -195,9 +195,9 @@  parseMode :: String -> Either String Mode parseMode mode = case mode of-  "decode" -> pure ModeDecode-  "encode" -> pure ModeEncode-  _ -> fail (Printf.printf "invalid mode: %s" (show mode))+  "decode" -> Right ModeDecode+  "encode" -> Right ModeEncode+  _ -> Left (Printf.printf "invalid mode: %s" (show mode))  printUnexpectedArguments :: [String] -> IO () printUnexpectedArguments = mapM_ printUnexpectedArgument
library/Rattletrap/Decode/Common.hs view
@@ -47,13 +47,15 @@ runDecode :: Decode a -> Bytes.ByteString -> Either String a runDecode decode bytes =   case Binary.runGetOrFail decode (LazyBytes.fromStrict bytes) of-    Left (_, _, x) -> fail x-    Right (_, _, x) -> pure x+    Left (_, _, x) -> Left x+    Right (_, _, x) -> Right x  runDecodeBits :: DecodeBits a -> Bytes.ByteString -> Either String a runDecodeBits = runDecode . BinaryBits.runBitGet  toBits :: Decode a -> Int -> DecodeBits a-toBits decode =-  fmap (Binary.runGet decode . LazyBytes.fromStrict . Utility.reverseBytes)-    . BinaryBits.getByteString+toBits decode size = do+  bytes <- BinaryBits.getByteString size+  case runDecode decode (Utility.reverseBytes bytes) of+    Left problem -> fail problem+    Right result -> pure result
library/Rattletrap/Decode/Content.hs view
@@ -19,6 +19,8 @@ import Rattletrap.Utility.Bytes  import qualified Control.Monad.Trans.State as State+import qualified Data.Binary.Get as Binary+import qualified Data.ByteString.Lazy as LazyBytes  decodeContent   :: (Int, Int, Int)@@ -53,7 +55,7 @@       (decodeFramesBits version numFrames maxChannels classAttributeMap)       mempty   frames <- either fail pure (runDecodeBits bitGet (reverseBytes stream))-  unknown <- decodeWhen (version >= (868, 23, 9)) decodeWord32le+  unknown <- Binary.getRemainingLazyByteString   pure     (Content       levels@@ -67,5 +69,5 @@       names       classMappings       caches-      unknown+      (LazyBytes.unpack unknown)     )
library/Rattletrap/Decode/GameModeAttribute.hs view
@@ -12,4 +12,4 @@     (numBits version)  numBits :: (Int, Int, Int) -> Int-numBits version = if version < (868, 12, 0) then 2 else 8+numBits version = if version >= (868, 12, 0) then 8 else 2
library/Rattletrap/Decode/LoadoutAttribute.hs view
@@ -20,7 +20,7 @@     <*> decodeWord32leBits     <*> decodeWord32leBits     <*> decodeWord32leBits-    <*> decodeWhen (version > Word8le 10) decodeWord32leBits+    <*> decodeWhen (version >= Word8le 11) decodeWord32leBits     <*> decodeWhen (version >= Word8le 16) decodeWord32leBits     <*> decodeWhen (version >= Word8le 16) decodeWord32leBits     <*> decodeWhen (version >= Word8le 16) decodeWord32leBits
library/Rattletrap/Decode/SpawnedReplication.hs view
@@ -30,11 +30,11 @@   nameIndex <- decodeWhen     (version >= (868, 14, 0))     (Trans.lift decodeWord32leBits)-  name <- lookupName classAttributeMap nameIndex+  name <- either fail pure (lookupName classAttributeMap nameIndex)   objectId <- Trans.lift decodeWord32leBits   State.modify (Map.insert actorId objectId)-  objectName <- lookupObjectName classAttributeMap objectId-  className <- lookupClassName objectName+  objectName <- either fail pure (lookupObjectName classAttributeMap objectId)+  className <- either fail pure (lookupClassName objectName)   let hasLocation = classHasLocation className   let hasRotation = classHasRotation className   initialization <- Trans.lift@@ -50,21 +50,21 @@       initialization     ) -lookupName :: Monad m => ClassAttributeMap -> Maybe Word32le -> m (Maybe Str)+lookupName :: ClassAttributeMap -> Maybe Word32le -> Either String (Maybe Str) lookupName classAttributeMap maybeNameIndex = case maybeNameIndex of-  Nothing -> pure Nothing+  Nothing -> Right Nothing   Just nameIndex ->     case getName (classAttributeMapNameMap classAttributeMap) nameIndex of-      Nothing -> fail ("could not get name for index " <> show nameIndex)-      Just name -> pure (Just name)+      Nothing -> Left ("could not get name for index " <> show nameIndex)+      Just name -> Right (Just name) -lookupObjectName :: Monad m => ClassAttributeMap -> Word32le -> m Str+lookupObjectName :: ClassAttributeMap -> Word32le -> Either String Str lookupObjectName classAttributeMap objectId =   case getObjectName (classAttributeMapObjectMap classAttributeMap) objectId of-    Nothing -> fail ("could not get object name for id " <> show objectId)-    Just objectName -> pure objectName+    Nothing -> Left ("could not get object name for id " <> show objectId)+    Just objectName -> Right objectName -lookupClassName :: Monad m => Str -> m Str+lookupClassName :: Str -> Either String Str lookupClassName objectName = case getClassName objectName of-  Nothing -> fail ("could not get class name for object " <> show objectName)-  Just className -> pure className+  Nothing -> Left ("could not get class name for object " <> show objectName)+  Just className -> Right className
library/Rattletrap/Encode/Content.hs view
@@ -40,6 +40,4 @@   putList putText (contentNames content)   putList putClassMapping (contentClassMappings content)   putList putCache (contentCaches content)-  case contentUnknown content of-    Nothing -> pure ()-    Just unknown -> putWord32 unknown+  mapM_ Binary.putWord8 (contentUnknown content)
library/Rattletrap/Encode/Str.hs view
@@ -43,8 +43,7 @@     size = if value == Text.pack "\x00\x00\x00None"       then 0x05000000       else scale * rawSize :: Int32-  in-    Int32le size+  in Int32le size  getTextEncoder :: Int32le -> Text.Text -> Bytes.ByteString getTextEncoder size text =
library/Rattletrap/Type/Bitstream.hs view
@@ -12,18 +12,16 @@   } deriving (Eq, Ord, Show)  instance Json.FromJSON Bitstream where-  parseJSON =-    Json.withText-      "Bitstream"-      (\text ->-         Bitstream <$>-         mapM-           (\char ->-              case char of-                '0' -> pure False-                '1' -> pure True-                _ -> fail ("invalid bit: " <> show char))-           (Text.unpack text))+  parseJSON = Json.withText+    "Bitstream"+    (\text -> Bitstream <$> mapM+      (\char -> case char of+        '0' -> pure False+        '1' -> pure True+        _ -> fail ("invalid bit: " <> show char)+      )+      (Text.unpack text)+    )  instance Json.ToJSON Bitstream where   toJSON = Json.toJSON . fmap (Bool.bool '0' '1') . bitstreamValue
library/Rattletrap/Type/ClassAttributeMap.hs view
@@ -69,36 +69,36 @@   -> List Str   -- ^ From 'Rattletrap.Content.contentNames'.   -> ClassAttributeMap-makeClassAttributeMap objects classMappings caches names-  = let-      objectMap = makeObjectMap objects-      classMap = makeClassMap classMappings-      objectClassMap = makeObjectClassMap objectMap classMap-      classCache = makeClassCache classMap caches-      attributeMap = makeAttributeMap caches-      classIds = fmap (\(_, classId, _, _) -> classId) classCache-      parentMap = makeParentMap classCache-      value = Map.fromList-        (fmap-          (\classId ->-            let-              ownAttributes =-                Maybe.fromMaybe Map.empty (Map.lookup classId attributeMap)-              parentsAttributes = case Map.lookup classId parentMap of-                Nothing -> []-                Just parentClassIds -> fmap-                  (\parentClassId -> Maybe.fromMaybe-                    Map.empty-                    (Map.lookup parentClassId attributeMap)-                  )-                  parentClassIds-              attributes = ownAttributes : parentsAttributes-            in (classId, Map.fromList (concatMap Map.toList attributes))-          )-          classIds+makeClassAttributeMap objects classMappings caches names =+  let+    objectMap = makeObjectMap objects+    classMap = makeClassMap classMappings+    objectClassMap = makeObjectClassMap objectMap classMap+    classCache = makeClassCache classMap caches+    attributeMap = makeAttributeMap caches+    classIds = fmap (\(_, classId, _, _) -> classId) classCache+    parentMap = makeParentMap classCache+    value = Map.fromList+      (fmap+        (\classId ->+          let+            ownAttributes =+              Maybe.fromMaybe Map.empty (Map.lookup classId attributeMap)+            parentsAttributes = case Map.lookup classId parentMap of+              Nothing -> []+              Just parentClassIds -> fmap+                (\parentClassId -> Maybe.fromMaybe+                  Map.empty+                  (Map.lookup parentClassId attributeMap)+                )+                parentClassIds+            attributes = ownAttributes : parentsAttributes+          in (classId, Map.fromList (concatMap Map.toList attributes))         )-      nameMap = makeNameMap names-    in ClassAttributeMap objectMap objectClassMap value nameMap+        classIds+      )+    nameMap = makeNameMap names+  in ClassAttributeMap objectMap objectClassMap value nameMap  makeNameMap :: List Str -> IntMap.IntMap Str makeNameMap names = IntMap.fromDistinctAscList (zip [0 ..] (listValue names))
library/Rattletrap/Type/Content.hs view
@@ -49,7 +49,7 @@   , contentCaches :: List Cache   -- ^ A list of classes along with their parent classes and attributes. Used   -- for the 'Rattletrap.Type.ClassAttributeMap.ClassAttributeMap'.-  , contentUnknown :: Maybe Word32le+  , contentUnknown :: [Word8]   } deriving (Eq, Ord, Show)  $(deriveJson ''Content)@@ -67,5 +67,5 @@   , contentNames = List []   , contentClassMappings = List []   , contentCaches = List []-  , contentUnknown = Nothing+  , contentUnknown = []   }
library/Rattletrap/Type/Dictionary.hs view
@@ -19,28 +19,27 @@   deriving (Eq, Ord, Show)  instance Json.FromJSON a => Json.FromJSON (Dictionary a) where-  parseJSON =-    Json.withObject-      "Dictionary"-      (\o -> do-         keys <- get o "keys"-         lastKey <- get o "last_key"-         value <- get o "value"-         Monad.foldM-           (\d k ->-              case Map.lookup k value of-                Nothing -> fail (unwords ["missing key", show k])-                Just v -> pure (DictionaryElement (Str k) v d))-           (DictionaryEnd lastKey)-           (reverse keys))+  parseJSON = Json.withObject+    "Dictionary"+    (\o -> do+      keys <- get o "keys"+      lastKey <- get o "last_key"+      value <- get o "value"+      Monad.foldM+        (\d k -> case Map.lookup k value of+          Nothing -> fail (unwords ["missing key", show k])+          Just v -> pure (DictionaryElement (Str k) v d)+        )+        (DictionaryEnd lastKey)+        (reverse keys)+    )  instance Json.ToJSON a => Json.ToJSON (Dictionary a) where-  toJSON d =-    Json.object-      [ pair "keys" (dictionaryKeys d)-      , pair "last_key" (dictionaryLastKey d)-      , pair "value" (dictionaryValue d)-      ]+  toJSON d = Json.object+    [ pair "keys" (dictionaryKeys d)+    , pair "last_key" (dictionaryLastKey d)+    , pair "value" (dictionaryValue d)+    ]  dictionaryKeys :: Dictionary a -> [Str] dictionaryKeys = fmap fst . toList
library/Rattletrap/Type/Quaternion.hs view
@@ -64,27 +64,27 @@     $ compressedWordValue x  maxComponent :: Quaternion -> Component-maxComponent quaternion-  = let-      x = quaternionX quaternion-      y = quaternionY quaternion-      z = quaternionZ quaternion-      w = quaternionW quaternion-      parts =-        [(x, ComponentX), (y, ComponentY), (z, ComponentZ), (w, ComponentW)]-      biggestPart = maximum parts-      roundTrip = decompressPart . compressPart-      computedPart = Maybe.fromMaybe-        biggestPart-        (Maybe.listToMaybe-          (filter (\(value, _) -> value /= roundTrip value) parts)-        )-    in snd-      (if (biggestPart == computedPart)-          || (abs (fst biggestPart - fst computedPart) > 0.00001)-        then biggestPart-        else computedPart+maxComponent quaternion =+  let+    x = quaternionX quaternion+    y = quaternionY quaternion+    z = quaternionZ quaternion+    w = quaternionW quaternion+    parts =+      [(x, ComponentX), (y, ComponentY), (z, ComponentZ), (w, ComponentW)]+    biggestPart = maximum parts+    roundTrip = decompressPart . compressPart+    computedPart = Maybe.fromMaybe+      biggestPart+      (Maybe.listToMaybe+        (filter (\(value, _) -> value /= roundTrip value) parts)       )+  in snd+    (if (biggestPart == computedPart)+        || (abs (fst biggestPart - fst computedPart) > 0.00001)+      then biggestPart+      else computedPart+    )  numBits :: Word numBits = 18
library/Rattletrap/Type/Section.hs view
@@ -31,10 +31,11 @@ $(deriveJson ''Section)  toSection :: (a -> Binary.Put) -> a -> Section a-toSection encode body = let-  bytes = LazyBytes.toStrict . Binary.runPut $ encode body-  in Section-  { sectionSize = Word32le . fromIntegral $ Bytes.length bytes-  , sectionCrc = Word32le $ getCrc32 bytes-  , sectionBody = body-  }+toSection encode body =+  let bytes = LazyBytes.toStrict . Binary.runPut $ encode body+  in+    Section+      { sectionSize = Word32le . fromIntegral $ Bytes.length bytes+      , sectionCrc = Word32le $ getCrc32 bytes+      , sectionBody = body+      }
rattletrap.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.2  name: rattletrap-version: 7.0.2+version: 7.0.3  category: Game description: Rattletrap parses and generates Rocket League replays.
tests/Main.hs view
@@ -149,6 +149,7 @@   , ("946f", "patch 1.43")   , ("9704", "a batarang")   , ("98e5", "a player using behind view")+  , ("9eaa", "newer replay without trailing bytes")   , ("a09e", "a tournament")   , ("a128", "a round count down")   , ("a52f", "some more mutators")