octane 0.9.0 → 0.10.0
raw patch · 68 files changed
+1393/−907 lines, 68 filesdep +scientificdep +vector
Dependencies added: scientific, vector
Files
- benchmark/Octane/Type/ActorBench.hs +2/−2
- benchmark/Octane/Type/CacheItemBench.hs +3/−3
- benchmark/Octane/Type/CachePropertyBench.hs +2/−2
- benchmark/Octane/Type/KeyFrameBench.hs +3/−3
- benchmark/Octane/Type/MarkBench.hs +2/−2
- benchmark/Octane/Type/MessageBench.hs +3/−3
- benchmark/Octane/Type/Primitive/Float32Bench.hs +19/−0
- benchmark/Octane/Type/Primitive/Float32LEBench.hs +0/−19
- benchmark/Octane/Type/Primitive/Int32Bench.hs +19/−0
- benchmark/Octane/Type/Primitive/Int64Bench.hs +19/−0
- benchmark/Octane/Type/Primitive/PCStringBench.hs +0/−19
- benchmark/Octane/Type/Primitive/TextBench.hs +19/−0
- benchmark/Octane/Type/Primitive/Word32LEBench.hs +0/−19
- benchmark/Octane/Type/Primitive/Word64LEBench.hs +0/−19
- benchmark/Octane/Type/PrimitiveBench.hs +8/−8
- benchmark/Octane/Type/PropertyBench.hs +14/−14
- benchmark/Octane/Type/ReplayBench.hs +7/−7
- library/Octane/Analyzer.hs +3/−2
- library/Octane/FullReplay.hs +8/−8
- library/Octane/Parser.hs +133/−169
- library/Octane/Parser/ClassPropertyMap.hs +9/−9
- library/Octane/Parser/Garage.hs +15/−14
- library/Octane/Type/Actor.hs +4/−4
- library/Octane/Type/CacheItem.hs +4/−4
- library/Octane/Type/CacheProperty.hs +3/−3
- library/Octane/Type/KeyFrame.hs +5/−5
- library/Octane/Type/Mark.hs +4/−4
- library/Octane/Type/Message.hs +5/−5
- library/Octane/Type/Primitive/Boolean.hs +41/−11
- library/Octane/Type/Primitive/Dictionary.hs +6/−6
- library/Octane/Type/Primitive/Float32.hs +65/−0
- library/Octane/Type/Primitive/Float32LE.hs +0/−27
- library/Octane/Type/Primitive/Int32.hs +71/−0
- library/Octane/Type/Primitive/Int64.hs +45/−0
- library/Octane/Type/Primitive/Int8.hs +61/−0
- library/Octane/Type/Primitive/List.hs +39/−7
- library/Octane/Type/Primitive/PCString.hs +0/−80
- library/Octane/Type/Primitive/Stream.hs +7/−18
- library/Octane/Type/Primitive/Text.hs +111/−0
- library/Octane/Type/Primitive/Word32.hs +49/−0
- library/Octane/Type/Primitive/Word32LE.hs +0/−29
- library/Octane/Type/Primitive/Word64LE.hs +0/−29
- library/Octane/Type/Primitive/Word8.hs +60/−0
- library/Octane/Type/Property.hs +30/−30
- library/Octane/Type/Replay.hs +78/−30
- library/Octane/Utility.hs +116/−0
- octane.cabal +19/−13
- package.yaml +3/−1
- test-suite/Octane/Type/ActorSpec.hs +8/−8
- test-suite/Octane/Type/CacheItemSpec.hs +14/−14
- test-suite/Octane/Type/CachePropertySpec.hs +8/−8
- test-suite/Octane/Type/KeyFrameSpec.hs +12/−12
- test-suite/Octane/Type/MarkSpec.hs +8/−8
- test-suite/Octane/Type/MessageSpec.hs +8/−8
- test-suite/Octane/Type/Primitive/BooleanSpec.hs +1/−1
- test-suite/Octane/Type/Primitive/DictionarySpec.hs +4/−4
- test-suite/Octane/Type/Primitive/Float32LESpec.hs +0/−30
- test-suite/Octane/Type/Primitive/Float32Spec.hs +30/−0
- test-suite/Octane/Type/Primitive/Int32Spec.hs +30/−0
- test-suite/Octane/Type/Primitive/Int64Spec.hs +30/−0
- test-suite/Octane/Type/Primitive/ListSpec.hs +2/−2
- test-suite/Octane/Type/Primitive/PCStringSpec.hs +0/−40
- test-suite/Octane/Type/Primitive/TextSpec.hs +40/−0
- test-suite/Octane/Type/Primitive/Word32LESpec.hs +0/−30
- test-suite/Octane/Type/Primitive/Word64LESpec.hs +0/−30
- test-suite/Octane/Type/PrimitiveSpec.hs +8/−8
- test-suite/Octane/Type/PropertySpec.hs +58/−58
- test-suite/Octane/Type/ReplaySpec.hs +18/−18
benchmark/Octane/Type/ActorBench.hs view
@@ -15,8 +15,8 @@ \\1\0\0\0\0\ \\0\0\0\0") , bench "encode basic" (nf Binary.encode (Actor- (PCString "")- (Word32LE 0)))+ (Text "")+ (Int32 0))) ] decodeActor :: BSL.ByteString -> Either (BSL.ByteString, Binary.ByteOffset, String) (BSL.ByteString, Binary.ByteOffset, Actor)
benchmark/Octane/Type/CacheItemBench.hs view
@@ -17,9 +17,9 @@ \\0\0\0\0\ \\0\0\0\0") , bench "encode basic" (nf Binary.encode (CacheItem- (Word32LE 0)- (Word32LE 0)- (Word32LE 0)+ (Int32 0)+ (Int32 0)+ (Int32 0) (List []))) ]
benchmark/Octane/Type/CachePropertyBench.hs view
@@ -15,8 +15,8 @@ \\0\0\0\0\ \\0\0\0\0") , bench "encode basic" (nf Binary.encode (CacheProperty- (Word32LE 0)- (Word32LE 0)))+ (Int32 0)+ (Int32 0))) ] decodeCacheProperty :: BSL.ByteString -> Either (BSL.ByteString, Binary.ByteOffset, String) (BSL.ByteString, Binary.ByteOffset, CacheProperty)
benchmark/Octane/Type/KeyFrameBench.hs view
@@ -16,9 +16,9 @@ \\0\0\0\0\ \\0\0\0\0") , bench "encode basic" (nf Binary.encode (KeyFrame- (Float32LE 0.0)- (Word32LE 0)- (Word32LE 0)))+ (Float32 0.0)+ (Int32 0)+ (Int32 0))) ] decodeKeyFrame :: BSL.ByteString -> Either (BSL.ByteString, Binary.ByteOffset, String) (BSL.ByteString, Binary.ByteOffset, KeyFrame)
benchmark/Octane/Type/MarkBench.hs view
@@ -15,8 +15,8 @@ \\1\0\0\0\0\ \\0\0\0\0") , bench "encode basic" (nf Binary.encode (Mark- (PCString "")- (Word32LE 0)))+ (Text "")+ (Int32 0))) ] decodeMark :: BSL.ByteString -> Either (BSL.ByteString, Binary.ByteOffset, String) (BSL.ByteString, Binary.ByteOffset, Mark)
benchmark/Octane/Type/MessageBench.hs view
@@ -16,9 +16,9 @@ \\1\0\0\0\0\ \\1\0\0\0\0") , bench "encode basic" (nf Binary.encode (Message- (Word32LE 0)- (PCString "")- (PCString "")))+ (Int32 0)+ (Text "")+ (Text ""))) ] decodeMessage :: BSL.ByteString -> Either (BSL.ByteString, Binary.ByteOffset, String) (BSL.ByteString, Binary.ByteOffset, Message)
+ benchmark/Octane/Type/Primitive/Float32Bench.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE OverloadedStrings #-}++module Octane.Type.Primitive.Float32Bench (benchmarks) where++import Criterion+import Octane++import qualified Data.Binary as Binary+import qualified Data.Binary.Get as Binary+import qualified Data.ByteString.Lazy as BSL++benchmarks :: Benchmark+benchmarks = bgroup "Float32"+ [ bench "decode basic" (nf decodeFloat32 "\0\0\0\0")+ , bench "encode basic" (nf Binary.encode (Float32 0.0))+ ]++decodeFloat32 :: BSL.ByteString -> Either (BSL.ByteString, Binary.ByteOffset, String) (BSL.ByteString, Binary.ByteOffset, Float32)+decodeFloat32 = Binary.decodeOrFail
− benchmark/Octane/Type/Primitive/Float32LEBench.hs
@@ -1,19 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Octane.Type.Primitive.Float32LEBench (benchmarks) where--import Criterion-import Octane--import qualified Data.Binary as Binary-import qualified Data.Binary.Get as Binary-import qualified Data.ByteString.Lazy as BSL--benchmarks :: Benchmark-benchmarks = bgroup "Float32LE"- [ bench "decode basic" (nf decodeFloat32LE "\0\0\0\0")- , bench "encode basic" (nf Binary.encode (Float32LE 0.0))- ]--decodeFloat32LE :: BSL.ByteString -> Either (BSL.ByteString, Binary.ByteOffset, String) (BSL.ByteString, Binary.ByteOffset, Float32LE)-decodeFloat32LE = Binary.decodeOrFail
+ benchmark/Octane/Type/Primitive/Int32Bench.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE OverloadedStrings #-}++module Octane.Type.Primitive.Int32Bench (benchmarks) where++import Criterion+import Octane++import qualified Data.Binary as Binary+import qualified Data.Binary.Get as Binary+import qualified Data.ByteString.Lazy as BSL++benchmarks :: Benchmark+benchmarks = bgroup "Int32"+ [ bench "decode basic" (nf decodeInt32 "\0\0\0\0")+ , bench "encode basic" (nf Binary.encode (Int32 0))+ ]++decodeInt32 :: BSL.ByteString -> Either (BSL.ByteString, Binary.ByteOffset, String) (BSL.ByteString, Binary.ByteOffset, Int32)+decodeInt32 = Binary.decodeOrFail
+ benchmark/Octane/Type/Primitive/Int64Bench.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE OverloadedStrings #-}++module Octane.Type.Primitive.Int64Bench (benchmarks) where++import Criterion+import Octane++import qualified Data.Binary as Binary+import qualified Data.Binary.Get as Binary+import qualified Data.ByteString.Lazy as BSL++benchmarks :: Benchmark+benchmarks = bgroup "Int64"+ [ bench "decode basic" (nf decodeInt64 "\0\0\0\0")+ , bench "encode basic" (nf Binary.encode (Int64 0))+ ]++decodeInt64 :: BSL.ByteString -> Either (BSL.ByteString, Binary.ByteOffset, String) (BSL.ByteString, Binary.ByteOffset, Int64)+decodeInt64 = Binary.decodeOrFail
− benchmark/Octane/Type/Primitive/PCStringBench.hs
@@ -1,19 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Octane.Type.Primitive.PCStringBench (benchmarks) where--import Criterion-import Octane--import qualified Data.Binary as Binary-import qualified Data.Binary.Get as Binary-import qualified Data.ByteString.Lazy as BSL--benchmarks :: Benchmark-benchmarks = bgroup "PCString"- [ bench "decode basic" (nf decodePCString "\1\0\0\0\0")- , bench "encode basic" (nf Binary.encode (PCString ""))- ]--decodePCString :: BSL.ByteString -> Either (BSL.ByteString, Binary.ByteOffset, String) (BSL.ByteString, Binary.ByteOffset, PCString)-decodePCString = Binary.decodeOrFail
+ benchmark/Octane/Type/Primitive/TextBench.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE OverloadedStrings #-}++module Octane.Type.Primitive.TextBench (benchmarks) where++import Criterion+import Octane++import qualified Data.Binary as Binary+import qualified Data.Binary.Get as Binary+import qualified Data.ByteString.Lazy as BSL++benchmarks :: Benchmark+benchmarks = bgroup "Text"+ [ bench "decode basic" (nf decodeText "\1\0\0\0\0")+ , bench "encode basic" (nf Binary.encode (Text ""))+ ]++decodeText :: BSL.ByteString -> Either (BSL.ByteString, Binary.ByteOffset, String) (BSL.ByteString, Binary.ByteOffset, Text)+decodeText = Binary.decodeOrFail
− benchmark/Octane/Type/Primitive/Word32LEBench.hs
@@ -1,19 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Octane.Type.Primitive.Word32LEBench (benchmarks) where--import Criterion-import Octane--import qualified Data.Binary as Binary-import qualified Data.Binary.Get as Binary-import qualified Data.ByteString.Lazy as BSL--benchmarks :: Benchmark-benchmarks = bgroup "Word32LE"- [ bench "decode basic" (nf decodeWord32LE "\0\0\0\0")- , bench "encode basic" (nf Binary.encode (Word32LE 0))- ]--decodeWord32LE :: BSL.ByteString -> Either (BSL.ByteString, Binary.ByteOffset, String) (BSL.ByteString, Binary.ByteOffset, Word32LE)-decodeWord32LE = Binary.decodeOrFail
− benchmark/Octane/Type/Primitive/Word64LEBench.hs
@@ -1,19 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Octane.Type.Primitive.Word64LEBench (benchmarks) where--import Criterion-import Octane--import qualified Data.Binary as Binary-import qualified Data.Binary.Get as Binary-import qualified Data.ByteString.Lazy as BSL--benchmarks :: Benchmark-benchmarks = bgroup "Word64LE"- [ bench "decode basic" (nf decodeWord64LE "\0\0\0\0")- , bench "encode basic" (nf Binary.encode (Word64LE 0))- ]--decodeWord64LE :: BSL.ByteString -> Either (BSL.ByteString, Binary.ByteOffset, String) (BSL.ByteString, Binary.ByteOffset, Word64LE)-decodeWord64LE = Binary.decodeOrFail
benchmark/Octane/Type/PrimitiveBench.hs view
@@ -4,21 +4,21 @@ import qualified Octane.Type.Primitive.BooleanBench import qualified Octane.Type.Primitive.DictionaryBench-import qualified Octane.Type.Primitive.Float32LEBench+import qualified Octane.Type.Primitive.Float32Bench import qualified Octane.Type.Primitive.ListBench-import qualified Octane.Type.Primitive.PCStringBench+import qualified Octane.Type.Primitive.TextBench import qualified Octane.Type.Primitive.StreamBench-import qualified Octane.Type.Primitive.Word32LEBench-import qualified Octane.Type.Primitive.Word64LEBench+import qualified Octane.Type.Primitive.Int32Bench+import qualified Octane.Type.Primitive.Int64Bench benchmarks :: Benchmark benchmarks = bgroup "Primitive" [ Octane.Type.Primitive.BooleanBench.benchmarks , Octane.Type.Primitive.DictionaryBench.benchmarks- , Octane.Type.Primitive.Float32LEBench.benchmarks+ , Octane.Type.Primitive.Float32Bench.benchmarks , Octane.Type.Primitive.ListBench.benchmarks- , Octane.Type.Primitive.PCStringBench.benchmarks+ , Octane.Type.Primitive.TextBench.benchmarks , Octane.Type.Primitive.StreamBench.benchmarks- , Octane.Type.Primitive.Word32LEBench.benchmarks- , Octane.Type.Primitive.Word64LEBench.benchmarks+ , Octane.Type.Primitive.Int32Bench.benchmarks+ , Octane.Type.Primitive.Int64Bench.benchmarks ]
benchmark/Octane/Type/PropertyBench.hs view
@@ -17,7 +17,7 @@ \\0\0\0\0\0\0\0\0\ \\0\0\0\0") , bench "encode basic" (nf Binary.encode (ArrayProperty- (Word64LE 0)+ (Int64 0) (List []))) ] , bgroup "Bool"@@ -26,7 +26,7 @@ \\0\0\0\0\0\0\0\0\ \\0") , bench "encode basic" (nf Binary.encode (BoolProperty- (Word64LE 0)+ (Int64 0) (Boolean False))) ] , bgroup "Byte"@@ -36,8 +36,8 @@ \\1\0\0\0\0\ \\1\0\0\0\0") , bench "encode basic" (nf Binary.encode (ByteProperty- (Word64LE 0)- (PCString "", PCString "")))+ (Int64 0)+ (Text "", Text ""))) ] , bgroup "Float" [ bench "decode basic" (nf decodeProperty "\@@ -45,8 +45,8 @@ \\4\0\0\0\0\0\0\0\ \\0\0\0\0") , bench "encode basic" (nf Binary.encode (FloatProperty- (Word64LE 4)- (Float32LE 0.0)))+ (Int64 4)+ (Float32 0.0))) ] , bgroup "Int" [ bench "decode basic" (nf decodeProperty "\@@ -54,8 +54,8 @@ \\4\0\0\0\0\0\0\0\ \\0\0\0\0") , bench "encode basic" (nf Binary.encode (IntProperty- (Word64LE 4)- (Word32LE 0)))+ (Int64 4)+ (Int32 0))) ] , bgroup "Name" [ bench "decode basic" (nf decodeProperty "\@@ -63,8 +63,8 @@ \\0\0\0\0\0\0\0\0\ \\1\0\0\0\0") , bench "encode basic" (nf Binary.encode (NameProperty- (Word64LE 0)- (PCString "")))+ (Int64 0)+ (Text ""))) ] , bgroup "QWord" [ bench "decode basic" (nf decodeProperty "\@@ -72,8 +72,8 @@ \\8\0\0\0\0\0\0\0\ \\0\0\0\0\0\0\0\0") , bench "encode basic" (nf Binary.encode (QWordProperty- (Word64LE 8)- (Word64LE 0)))+ (Int64 8)+ (Int64 0))) ] , bgroup "String" [ bench "decode basic" (nf decodeProperty "\@@ -81,8 +81,8 @@ \\0\0\0\0\0\0\0\0\ \\1\0\0\0\0") , bench "encode basic" (nf Binary.encode (StrProperty- (Word64LE 0)- (PCString "")))+ (Int64 0)+ (Text ""))) ] ]
benchmark/Octane/Type/ReplayBench.hs view
@@ -32,14 +32,14 @@ \\0\0\0\0\ \\0\0\0\0") , bench "encode basic" (nf Binary.encode (Replay- (Word32LE 0)- (Word32LE 0)- (Word32LE 0)- (Word32LE 0)- (PCString "")+ (Word32 0)+ (Word32 0)+ (Int32 0)+ (Int32 0)+ (Text "") (Dictionary Map.empty)- (Word32LE 0)- (Word32LE 0)+ (Word32 0)+ (Word32 0) (List []) (List []) (Stream "")
library/Octane/Analyzer.hs view
@@ -8,6 +8,7 @@ import qualified Data.Set as Set import qualified Data.Text as Text import qualified Octane.Parser as Parser+import qualified Octane.Type as Type import qualified System.Environment as Environment type Point = (Int, Int, Int)@@ -31,7 +32,7 @@ in case maybeProperty of Nothing -> Nothing Just property -> case property of- Parser.PFlaggedInt _ playerActorId -> Just (carActorId, playerActorId)+ Parser.PFlaggedInt _ playerActorId -> Just (carActorId, Type.fromInt32 playerActorId) _ -> Nothing) & Map.fromList @@ -61,7 +62,7 @@ in case maybeProperty of Nothing -> Nothing Just property -> case property of- Parser.PString name -> Just (actorId, name)+ Parser.PString name -> Just (actorId, Type.unpackText name) _ -> Nothing) & Map.fromList
library/Octane/FullReplay.hs view
@@ -61,13 +61,13 @@ & unpackFullReplay & Prelude.fst & Type.replayVersion1- & Type.unpackWord32LE+ & Type.unpackInt32 & Prelude.fromIntegral , fullReplay & unpackFullReplay & Prelude.fst & Type.replayVersion2- & Type.unpackWord32LE+ & Type.unpackInt32 & Prelude.fromIntegral ] & Version.makeVersion & Version.showVersion @@ -78,7 +78,7 @@ & Prelude.fst & Type.replayProperties & Type.unpackDictionary- & Map.mapKeys Type.unpackPCString+ & Map.mapKeys Type.unpackText & Map.map Aeson.toJSON @@ -88,10 +88,10 @@ & Prelude.fst & Type.replayLevels & Type.unpackList- & Prelude.map Type.unpackPCString+ & Prelude.map Type.unpackText -getMessages :: FullReplay -> Map.Map Text.Text Type.PCString+getMessages :: FullReplay -> Map.Map Text.Text Type.Text getMessages fullReplay = fullReplay & unpackFullReplay & Prelude.fst@@ -100,7 +100,7 @@ & Prelude.map (\ message -> ( message & Type.messageFrame- & Type.unpackWord32LE+ & Type.unpackInt32 & Prelude.show & Text.pack , message & Type.messageContent@@ -108,7 +108,7 @@ & Map.fromList -getTickMarks :: FullReplay -> Map.Map Text.Text Type.PCString+getTickMarks :: FullReplay -> Map.Map Text.Text Type.Text getTickMarks fullReplay = fullReplay & unpackFullReplay & Prelude.fst@@ -117,7 +117,7 @@ & Prelude.map (\ mark -> ( mark & Type.markFrame- & Type.unpackWord32LE+ & Type.unpackInt32 & Prelude.show & Text.pack , mark & Type.markLabel
library/Octane/Parser.hs view
@@ -6,24 +6,23 @@ import qualified Control.DeepSeq as DeepSeq import qualified Data.Aeson as Aeson+import qualified Data.Binary.Bits as BinaryBit import qualified Data.Binary.Bits.Get as Bits-import qualified Data.Binary.IEEE754 as IEEE754 import qualified Data.Binary.Get as Binary import qualified Data.Bits as Bits import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL-import qualified Data.Int as Int import qualified Data.IntMap.Strict as IntMap import qualified Data.Map.Strict as Map import qualified Data.Set as Set import qualified Data.Text as Text-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.Json as Json import qualified Octane.Parser.ClassPropertyMap as CPM import qualified Octane.Type as Type+import qualified Octane.Utility as Utility import qualified Text.Printf as Printf parseFrames :: Type.Replay -> [Frame]@@ -31,9 +30,9 @@ numFrames = replay & Type.replayProperties & Type.unpackDictionary- & Map.lookup ("NumFrames" & Text.pack & Type.PCString)+ & Map.lookup ("NumFrames" & Text.pack & Type.Text) & (\ property -> case property of- Just (Type.IntProperty _ x) -> x & Type.unpackWord32LE & fromIntegral+ Just (Type.IntProperty _ x) -> x & Type.unpackInt32 & fromIntegral _ -> 0) get = replay & extractContext & getFrames 0 numFrames & Bits.runBitGet stream = replay & Type.replayStream & Type.unpackStream & BSL.fromStrict@@ -63,7 +62,7 @@ if time == 0 && delta == 0 then return Nothing else if time < 0.001 || delta < 0.001- then error ("parsing previous frame probably failed. time: " ++ show time ++ ", delta: " ++ show delta)+ 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))@@ -92,19 +91,19 @@ getMaybeReplication :: Context -> Bits.BitGet (Maybe (Context, Replication)) getMaybeReplication context = do- hasReplication <- Bits.getBool- if not hasReplication- then return Nothing- else do+ hasReplication <- getBool+ if Type.unpackBoolean hasReplication+ then do (newContext,replication) <- getReplication context return (Just (newContext, replication))+ else return Nothing getReplication :: Context -> Bits.BitGet (Context, Replication) getReplication context = do actorId <- getActorId- isOpen <- Bits.getBool+ isOpen <- getBool let go =- if isOpen+ if Type.unpackBoolean isOpen then getOpenReplication else getClosedReplication go context actorId@@ -113,9 +112,9 @@ -> ActorId -> Bits.BitGet (Context, Replication) getOpenReplication context actorId = do- isNew <- Bits.getBool+ isNew <- getBool let go =- if isNew+ if Type.unpackBoolean isNew then getNewReplication else getExistingReplication go context actorId@@ -124,17 +123,17 @@ -> ActorId -> Bits.BitGet (Context, Replication) getNewReplication context actorId = do- unknownFlag <- Bits.getBool- if unknownFlag- then error "the unknown flag in a new replication is true! what does it mean?"- else return ()+ unknownFlag <- getBool+ if Type.unpackBoolean unknownFlag+ then fail "the unknown flag in a new replication is true! what does it mean?"+ else pure () objectId <- getInt32- 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) Data.objectToClass (contextClassMap context) objectId of- Nothing -> error ("could not find class for object id " ++ show objectId)- Just x -> x+ objectName <- case context & contextObjectMap & IntMap.lookup (Type.fromInt32 objectId) of+ Nothing -> fail ("could not find object name for id " ++ show objectId)+ Just x -> pure x+ (classId, className) <- case CPM.getClass (contextObjectMap context) Data.objectToClass (contextClassMap context) (Type.fromInt32 objectId) of+ Nothing -> fail ("could not find class for object id " ++ show objectId)+ Just x -> pure x classInit <- getClassInit className let thing = Thing { thingFlag = unknownFlag@@ -162,9 +161,9 @@ -> ActorId -> Bits.BitGet (Context, Replication) getExistingReplication 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+ thing <- case context & contextThings & IntMap.lookup actorId of+ Nothing -> fail ("could not find thing for actor id " ++ show actorId)+ Just x -> pure x props <- getProps context thing return (context, Replication { replicationActorId = actorId@@ -179,9 +178,9 @@ -> 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+ thing <- case context & contextThings & IntMap.lookup actorId of+ Nothing -> fail ("could not find thing for actor id " ++ show actorId)+ Just x -> pure x let newThings = context & contextThings & IntMap.delete actorId let newContext = context { contextThings = newThings } return@@ -209,8 +208,8 @@ getMaybeProp :: Context -> Thing -> Bits.BitGet (Maybe Prop) getMaybeProp context thing = do- hasProp <- Bits.getBool- if hasProp+ hasProp <- getBool+ if Type.unpackBoolean hasProp then do prop <- getProp context thing return (Just prop)@@ -219,14 +218,14 @@ getProp :: Context -> Thing -> Bits.BitGet Prop getProp context thing = do let classId = thing & thingClassId- let props = case context & contextClassPropertyMap & IntMap.lookup classId of- Nothing -> error ("could not find property map for class id " ++ show classId)- Just x -> x+ props <- case context & contextClassPropertyMap & IntMap.lookup classId of+ Nothing -> fail ("could not find property map for class id " ++ show classId)+ Just x -> pure x let maxId = props & IntMap.keys & (0 :) & maximum pid <- getInt maxId- let name = case props & IntMap.lookup pid of- Nothing -> error ("could not find property name for property id " ++ show pid)- Just x -> x+ 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 (Prop { propName = name, propValue = value }) @@ -234,7 +233,7 @@ getPropValue :: Text.Text -> Bits.BitGet PropValue getPropValue name = case Map.lookup name propertyNameToGet of- Nothing -> error ("don't know how to read property " ++ show name)+ Nothing -> fail ("don't know how to read property " ++ show name) Just get -> get propertyNameToGet :: Map.Map Text.Text (Bits.BitGet PropValue)@@ -269,7 +268,7 @@ getBooleanProperty :: Bits.BitGet PropValue getBooleanProperty = do- bool <- Bits.getBool+ bool <- getBool return (PBoolean bool) getByteProperty :: Bits.BitGet PropValue@@ -289,9 +288,9 @@ getDemolishProperty :: Bits.BitGet PropValue getDemolishProperty = do- atkFlag <- Bits.getBool+ atkFlag <- getBool atk <- getInt32- vicFlag <- Bits.getBool+ vicFlag <- getBool vic <- getInt32 vec1 <- getVector vec2 <- getVector@@ -301,22 +300,24 @@ getEnumProperty = do x <- Bits.getWord16be 10 y <- if x == 1023- then Bits.getBool- else error ("unexpected enum value " ++ show x)+ then getBool+ else fail ("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+ noGoal <- getBool+ a <- if Type.unpackBoolean noGoal+ then return Nothing+ else fmap Just getInt32 b <- getVector return (PExplosion noGoal a b) getFlaggedIntProperty :: Bits.BitGet PropValue getFlaggedIntProperty = do- flag <- Bits.getBool+ flag <- getBool int <- getInt32- return (PFlaggedInt flag (fromIntegral int))+ return (PFlaggedInt flag int) getFloatProperty :: Bits.BitGet PropValue getFloatProperty = do@@ -369,26 +370,28 @@ getMusicStingerProperty :: Bits.BitGet PropValue getMusicStingerProperty = do- flag <- Bits.getBool+ flag <- 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+ instigator <- getBool+ instigatorId <- if Type.unpackBoolean instigator+ then fmap Just getInt32+ else return Nothing+ pickedUp <- getBool return (PPickup instigator instigatorId pickedUp) getPrivateMatchSettingsProperty :: Bits.BitGet PropValue getPrivateMatchSettingsProperty = do- mutators <- getString+ mutators <- getText joinableBy <- getInt32 maxPlayers <- getInt32- gameName <- getString- password <- getString- flag <- Bits.getBool+ gameName <- getText+ password <- getText+ flag <- getBool return (PPrivateMatchSettings mutators joinableBy maxPlayers gameName password flag) getQWordProperty :: Bits.BitGet PropValue@@ -410,25 +413,29 @@ number <- getInt7 (systemId, remoteId, localId) <- getUniqueId playerName <- if systemId == 0 then return Nothing else do- string <- getString+ string <- getText return (Just string) -- No idea what these two flags are. Might be for bots?- a <- Bits.getBool- b <- Bits.getBool+ a <- getBool+ b <- getBool return (PReservation number systemId remoteId localId playerName a b) getRigidBodyStateProperty :: Bits.BitGet PropValue getRigidBodyStateProperty = do- flag <- Bits.getBool+ flag <- 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+ x <- if Type.unpackBoolean flag+ then return Nothing+ else fmap Just getVector+ y <- if Type.unpackBoolean flag+ then return Nothing+ else fmap Just getVector return (PRigidBodyState flag position rotation x y) getStringProperty :: Bits.BitGet PropValue getStringProperty = do- string <- getString+ string <- getText return (PString string) getTeamPaintProperty :: Bits.BitGet PropValue@@ -460,23 +467,11 @@ -- -getFloat32 :: Bits.BitGet Float-getFloat32 = do- bytes <- Bits.getByteString 4- bytes & byteStringToFloat & return+getFloat32 :: Bits.BitGet Type.Float32+getFloat32 = BinaryBit.getBits unimportant -getString :: Bits.BitGet Text.Text-getString = do- rawSize <- getInt32- rawText <- if rawSize < 0- then do- let size = -2 * rawSize- bytes <- Bits.getByteString size- bytes & BS.map Type.reverseBits & Encoding.decodeUtf16LE & return- else do- bytes <- Bits.getByteString rawSize- bytes & BS.map Type.reverseBits & Encoding.decodeLatin1 & return- rawText & Text.dropEnd 1 & return+getText :: Bits.BitGet Type.Text+getText = BinaryBit.getBits unimportant getUniqueId :: Bits.BitGet (SystemId, RemoteId, LocalId) getUniqueId = do@@ -486,9 +481,7 @@ return (systemId, remoteId, localId) getSystemId :: Bits.BitGet SystemId-getSystemId = do- byte <- Bits.getWord8 8- byte & Type.reverseBits & return+getSystemId = getWord8 getRemoteId :: SystemId -> Bits.BitGet RemoteId getRemoteId systemId = case systemId of@@ -496,17 +489,17 @@ remoteId <- Bits.getByteString 3 if BS.all (\ byte -> byte == 0) remoteId then 0 & Just & SplitscreenId & return- else error ("unexpected splitscreen id " ++ show remoteId)+ else fail ("unexpected splitscreen id " ++ show remoteId) 1 -> do bytes <- Bits.getByteString 8 let remoteId = Binary.runGet Binary.getWord64le- (bytes & BS.map Type.reverseBits & BSL.fromStrict)+ (bytes & BS.map Utility.reverseBits & BSL.fromStrict) remoteId & SteamId & return 2 -> do bytes <- Bits.getByteString 32 let remoteId = bytes- & BS.map Type.reverseBits+ & BS.map Utility.reverseBits & BS.unpack & concatMap (\ b -> Printf.printf "%02x" b) & Text.pack@@ -515,22 +508,20 @@ bytes <- Bits.getByteString 8 let remoteId = Binary.runGet Binary.getWord64le- (bytes & BS.map Type.reverseBits & BSL.fromStrict)+ (bytes & BS.map Utility.reverseBits & BSL.fromStrict) remoteId & XboxId & return- _ -> error ("unknown system id " ++ show systemId)+ _ -> fail ("unknown system id " ++ show systemId) getLocalId :: Bits.BitGet LocalId-getLocalId = do- localId <- Bits.getWord8 8- localId & Just & return+getLocalId = fmap Just getWord8 -type SystemId = Word.Word8+type SystemId = Type.Word8 -- This is the number associated with a splitscreen player. So the first player -- is 0, the second is 1, and so on. -- - 0 "Someone" -- - 1 "Someone (1)"-type LocalId = Maybe Word.Word8+type LocalId = Maybe Type.Word8 data RemoteId = SteamId !Word.Word64@@ -552,28 +543,28 @@ toJSON = Aeson.genericToJSON (Json.toJsonOptions "Prop") data PropValue- = PBoolean !Bool- | PByte !Word.Word8- | 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- | PFloat !Float+ = PBoolean !Type.Boolean+ | PByte !Type.Word8+ | PCamSettings !Type.Float32 !Type.Float32 !Type.Float32 !Type.Float32 !Type.Float32 !Type.Float32+ | PDemolish !Type.Boolean !Type.Int32 !Type.Boolean !Type.Int32 !(Vector Int) !(Vector Int)+ | PEnum !Word.Word16 !Type.Boolean+ | PExplosion !Type.Boolean !(Maybe Type.Int32) !(Vector Int)+ | PFlaggedInt !Type.Boolean !Type.Int32+ | PFloat !Type.Float32 | PGameMode !Word.Word8- | PInt !Int- | PLoadout !Int !Int !Int !Int !Int !Int !Int !Int !(Maybe Int)- | PLoadoutOnline !Int !Int !Int !(Maybe Int)+ | PInt !Type.Int32+ | PLoadout !Type.Int8 !Type.Int32 !Type.Int32 !Type.Int32 !Type.Int32 !Type.Int32 !Type.Int32 !Type.Int32 !(Maybe Type.Int32)+ | PLoadoutOnline !Type.Int32 !Type.Int32 !Type.Int32 !(Maybe Type.Int8) | PLocation !(Vector Int)- | PMusicStinger !Bool !Int !Int- | PPickup !Bool !(Maybe Int) !Bool- | PPrivateMatchSettings !Text.Text !Int !Int !Text.Text !Text.Text !Bool- | PQWord !Int !Int+ | PMusicStinger !Type.Boolean !Type.Int32 !Type.Int8+ | PPickup !Type.Boolean !(Maybe Type.Int32) !Type.Boolean+ | PPrivateMatchSettings !Type.Text !Type.Int32 !Type.Int32 !Type.Text !Type.Text !Type.Boolean+ | PQWord !Type.Int32 !Type.Int32 | PRelativeRotation !(Vector Float)- | 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+ | PReservation !Int !SystemId !RemoteId !LocalId !(Maybe Type.Text) !Type.Boolean !Type.Boolean+ | PRigidBodyState !Type.Boolean !(Vector Int) !(Vector Float) !(Maybe (Vector Int)) !(Maybe (Vector Int))+ | PString !Type.Text+ | PTeamPaint !Type.Int8 !Type.Int8 !Type.Int8 !Type.Int32 !Type.Int32 | PUniqueId !SystemId !RemoteId !LocalId deriving (Eq, Generics.Generic, Show) @@ -586,8 +577,8 @@ data Frame = Frame { frameNumber :: !Int , frameIsKeyFrame :: !Bool- , frameTime :: !Float- , frameDelta :: !Float+ , frameTime :: !Time+ , frameDelta :: !Delta , frameReplications :: ![Replication] } deriving (Eq,Generics.Generic,Show) @@ -623,8 +614,8 @@ toJSON = Aeson.genericToJSON (Json.toJsonOptions "Replication") data Thing = Thing- { thingFlag :: !Bool- , thingObjectId :: !Int+ { thingFlag :: !Type.Boolean+ , thingObjectId :: !Type.Int32 , thingObjectName :: !Text.Text , thingClassId :: !Int , thingClassName :: !Text.Text@@ -633,9 +624,9 @@ instance DeepSeq.NFData Thing -type Time = Float+type Time = Type.Float32 -type Delta = Float+type Delta = Type.Float32 type ActorId = Int @@ -655,7 +646,7 @@ data ClassInit = ClassInit { classInitLocation :: !(Maybe (Vector Int))- , classInitRotation :: !(Maybe (Vector Int))+ , classInitRotation :: !(Maybe (Vector Type.Int8)) } deriving (Eq, Generics.Generic, Show) instance DeepSeq.NFData ClassInit@@ -692,16 +683,11 @@ & Type.replayKeyFrames & Type.unpackList & map Type.keyFrameFrame- & map Type.unpackWord32LE+ & map Type.unpackInt32 & map fromIntegral & Set.fromList } -byteStringToFloat :: BS.ByteString -> Float-byteStringToFloat bytes = Binary.runGet- IEEE754.getFloat32le- (bytes & BSL.fromStrict & BSL.map Type.reverseBits)- getVector :: Bits.BitGet (Vector Int) getVector = do numBits <- getNumVectorBits@@ -719,29 +705,14 @@ } getVectorBytewise- :: Bits.BitGet (Vector Int)+ :: Bits.BitGet (Vector Type.Int8) getVectorBytewise = do- hasX <- Bits.getBool- x <-- if hasX- then do- word <- Bits.getWord8 8- word & Type.reverseBits & fromIntegral & return- else return 0- hasY <- Bits.getBool- y <-- if hasY- then do- word <- Bits.getWord8 8- word & Type.reverseBits & fromIntegral & return- else return 0- hasZ <- Bits.getBool- z <-- if hasZ- then do- word <- Bits.getWord8 8- word & Type.reverseBits & fromIntegral & return- else return 0+ hasX <- getBool+ x <- if Type.unpackBoolean hasX then getInt8 else return 0+ hasY <- getBool+ y <- if Type.unpackBoolean hasY then getInt8 else return 0+ hasZ <- getBool+ z <- if Type.unpackBoolean hasZ then getInt8 else return 0 return Vector { vectorX = x@@ -816,38 +787,23 @@ let x = Bits.shiftL 1 i if i < maxBits && value + x <= maxValue then do- bit <- Bits.getBool+ bit <- getBool let newValue =- if bit+ if Type.unpackBoolean bit then value + x else value go (i + 1) newValue else return value go 0 0 -getInt32 :: Bits.BitGet Int-getInt32 = do- bytes <- Bits.getByteString 4- let word = Binary.runGet- Binary.getWord32le- (bytes & BSL.fromStrict & BSL.map Type.reverseBits)- word & fromIntegral & (\ x -> x :: Int.Int32) & fromIntegral & return+getInt32 :: Bits.BitGet Type.Int32+getInt32 = BinaryBit.getBits unimportant -getInt8 :: Bits.BitGet Int-getInt8 = do- byte <- Bits.getByteString 1- let word = Binary.runGet- Binary.getWord8- (byte & BSL.fromStrict & BSL.map Type.reverseBits)- word & fromIntegral & (\ x -> x :: Int.Int8) & fromIntegral & return+getInt8 :: Bits.BitGet Type.Int8+getInt8 = BinaryBit.getBits unimportant -getWord8 :: Bits.BitGet Word.Word8-getWord8 = do- byte <- Bits.getByteString 1- let word = Binary.runGet- Binary.getWord8- (byte & BSL.fromStrict & BSL.map Type.reverseBits)- return word+getWord8 :: Bits.BitGet Type.Word8+getWord8 = BinaryBit.getBits unimportant getActorId :: Bits.BitGet Int getActorId = getInt 1024@@ -857,3 +813,11 @@ getInt7 :: Bits.BitGet Int getInt7 = getInt 7++getBool :: Bits.BitGet Type.Boolean+getBool = BinaryBit.getBits unimportant++-- | The 'getBits' function from "Data.Binary.Bits" requires a size parameter.+-- None of Octane's instances use it.+unimportant :: Int+unimportant = 0
library/Octane/Parser/ClassPropertyMap.hs view
@@ -44,9 +44,9 @@ & Type.replayCacheItems & Type.unpackList & map (\ x ->- ( x & Type.cacheItemClassId & Type.unpackWord32LE & fromIntegral- , x & Type.cacheItemCacheId & Type.unpackWord32LE & fromIntegral- , x & Type.cacheItemParentCacheId & Type.unpackWord32LE & fromIntegral+ ( x & Type.cacheItemClassId & Type.unpackInt32 & fromIntegral+ , x & Type.cacheItemCacheId & Type.unpackInt32 & fromIntegral+ , x & Type.cacheItemParentCacheId & Type.unpackInt32 & fromIntegral )) -- | The class IDs in a replay. Comes from the class cache.@@ -106,7 +106,7 @@ getPropertyMap replay = replay & Type.replayObjects & Type.unpackList- & map Type.unpackPCString+ & map Type.unpackText & zip [0 ..] & IntMap.fromList @@ -120,13 +120,13 @@ & Type.replayCacheItems & Type.unpackList & map (\ x -> let- classId = x & Type.cacheItemClassId & Type.unpackWord32LE & fromIntegral+ classId = x & Type.cacheItemClassId & Type.unpackInt32 & fromIntegral properties = x & Type.cacheItemCacheProperties & Type.unpackList & Maybe.mapMaybe (\ y -> let- streamId = y & Type.cachePropertyStreamId & Type.unpackWord32LE & fromIntegral- propertyId = y & Type.cachePropertyObjectId & Type.unpackWord32LE & fromIntegral+ streamId = y & Type.cachePropertyStreamId & Type.unpackInt32 & fromIntegral+ propertyId = y & Type.cachePropertyObjectId & Type.unpackInt32 & fromIntegral in case IntMap.lookup propertyId propertyMap of Nothing -> Nothing Just name -> Just (streamId, name))@@ -140,8 +140,8 @@ & Type.replayActors & Type.unpackList & map (\ x -> let- className = x & Type.actorName & Type.unpackPCString- classId = x & Type.actorStreamId & Type.unpackWord32LE & fromIntegral+ className = x & Type.actorName & Type.unpackText+ classId = x & Type.actorStreamId & Type.unpackInt32 & fromIntegral in (className, classId)) & Map.fromList
library/Octane/Parser/Garage.hs view
@@ -3,6 +3,7 @@ import qualified Data.Bimap as Bimap import qualified Data.Text as Text import qualified Octane.Data as Data+import qualified Octane.Type as Type type Body = Text.Text@@ -14,29 +15,29 @@ type Finish = Text.Text -getBody :: Int -> Maybe Body-getBody bodyId = Bimap.lookup bodyId Data.bodies+getBody :: Type.Int32 -> Maybe Body+getBody bodyId = Bimap.lookup (Type.fromInt32 bodyId) Data.bodies -getDecal :: Int -> Maybe Decal-getDecal decalId = Bimap.lookup decalId Data.decals+getDecal :: Type.Int32 -> Maybe Decal+getDecal decalId = Bimap.lookup (Type.fromInt32 decalId) Data.decals -getWheels :: Int -> Maybe Wheels-getWheels wheelsId = Bimap.lookup wheelsId Data.wheels+getWheels :: Type.Int32 -> Maybe Wheels+getWheels wheelsId = Bimap.lookup (Type.fromInt32 wheelsId) Data.wheels -getRocketTrail :: Int -> Maybe RocketTrail-getRocketTrail rocketTrailId = Bimap.lookup rocketTrailId Data.rocketTrails+getRocketTrail :: Type.Int32 -> Maybe RocketTrail+getRocketTrail rocketTrailId = Bimap.lookup (Type.fromInt32 rocketTrailId) Data.rocketTrails -getAntenna :: Int -> Maybe Antenna-getAntenna antennaId = Bimap.lookup antennaId Data.antennas+getAntenna :: Type.Int32 -> Maybe Antenna+getAntenna antennaId = Bimap.lookup (Type.fromInt32 antennaId) Data.antennas -getTopper :: Int -> Maybe Topper-getTopper topperId = Bimap.lookup topperId Data.toppers+getTopper :: Type.Int32 -> Maybe Topper+getTopper topperId = Bimap.lookup (Type.fromInt32 topperId) Data.toppers -getFinish :: Int -> Maybe Finish-getFinish finishId = Bimap.lookup finishId Data.finishes+getFinish :: Type.Int32 -> Maybe Finish+getFinish finishId = Bimap.lookup (Type.fromInt32 finishId) Data.finishes
library/Octane/Type/Actor.hs view
@@ -8,14 +8,14 @@ import Data.Function ((&)) import qualified GHC.Generics as Generics import qualified Octane.Json as Json-import qualified Octane.Type.Primitive.PCString as PCString-import qualified Octane.Type.Primitive.Word32LE as Word32LE+import qualified Octane.Type.Primitive.Text as Text+import qualified Octane.Type.Primitive.Int32 as Int32 -- | 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+ { actorName :: !Text.Text+ , actorStreamId :: !Int32.Int32 } deriving (Eq,Generics.Generic,Show) instance Binary.Binary Actor where
library/Octane/Type/CacheItem.hs view
@@ -10,13 +10,13 @@ import qualified Octane.Json as Json import qualified Octane.Type.CacheProperty as CacheProperty import qualified Octane.Type.Primitive.List as List-import qualified Octane.Type.Primitive.Word32LE as Word32LE+import qualified Octane.Type.Primitive.Int32 as Int32 -- | An item in the class net cache map. data CacheItem = CacheItem- { cacheItemClassId :: !Word32LE.Word32LE- , cacheItemParentCacheId :: !Word32LE.Word32LE- , cacheItemCacheId :: !Word32LE.Word32LE+ { cacheItemClassId :: !Int32.Int32+ , cacheItemParentCacheId :: !Int32.Int32+ , cacheItemCacheId :: !Int32.Int32 , cacheItemCacheProperties :: !(List.List CacheProperty.CacheProperty) } deriving (Eq,Generics.Generic,Show)
library/Octane/Type/CacheProperty.hs view
@@ -8,12 +8,12 @@ import Data.Function ((&)) import qualified GHC.Generics as Generics import qualified Octane.Json as Json-import qualified Octane.Type.Primitive.Word32LE as Word32LE+import qualified Octane.Type.Primitive.Int32 as Int32 -- | A property on an item in the class net cache map. data CacheProperty = CacheProperty- { cachePropertyObjectId :: !Word32LE.Word32LE- , cachePropertyStreamId :: !Word32LE.Word32LE+ { cachePropertyObjectId :: !Int32.Int32+ , cachePropertyStreamId :: !Int32.Int32 } deriving (Eq,Generics.Generic,Show) instance Binary.Binary CacheProperty where
library/Octane/Type/KeyFrame.hs view
@@ -8,16 +8,16 @@ import Data.Function ((&)) import qualified GHC.Generics as Generics import qualified Octane.Json as Json-import qualified Octane.Type.Primitive.Float32LE as Float32LE-import qualified Octane.Type.Primitive.Word32LE as Word32LE+import qualified Octane.Type.Primitive.Float32 as Float32+import qualified Octane.Type.Primitive.Int32 as Int32 -- | 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. data KeyFrame = KeyFrame- { keyFrameTime :: !Float32LE.Float32LE- , keyFrameFrame :: !Word32LE.Word32LE- , keyFramePosition :: !Word32LE.Word32LE+ { keyFrameTime :: !Float32.Float32+ , keyFrameFrame :: !Int32.Int32+ , keyFramePosition :: !Int32.Int32 } deriving (Eq,Generics.Generic,Show) instance Binary.Binary KeyFrame where
library/Octane/Type/Mark.hs view
@@ -8,13 +8,13 @@ import Data.Function ((&)) import qualified GHC.Generics as Generics import qualified Octane.Json as Json-import qualified Octane.Type.Primitive.PCString as PCString-import qualified Octane.Type.Primitive.Word32LE as Word32LE+import qualified Octane.Type.Primitive.Text as Text+import qualified Octane.Type.Primitive.Int32 as Int32 -- | A tick mark on the replay. Both goals and saves make tick marks. data Mark = Mark- { markLabel :: !PCString.PCString- , markFrame :: !Word32LE.Word32LE+ { markLabel :: !Text.Text+ , markFrame :: !Int32.Int32 } deriving (Eq,Generics.Generic,Show) instance Binary.Binary Mark where
library/Octane/Type/Message.hs view
@@ -8,14 +8,14 @@ import Data.Function ((&)) import qualified GHC.Generics as Generics import qualified Octane.Json as Json-import qualified Octane.Type.Primitive.PCString as PCString-import qualified Octane.Type.Primitive.Word32LE as Word32LE+import qualified Octane.Type.Primitive.Text as Text+import qualified Octane.Type.Primitive.Int32 as Int32 -- | A debugging message. Replays do not have any of these anymore. data Message = Message- { messageFrame :: !Word32LE.Word32LE- , messageName :: !PCString.PCString- , messageContent :: !PCString.PCString+ { messageFrame :: !Int32.Int32+ , messageName :: !Text.Text+ , messageContent :: !Text.Text } deriving (Eq,Generics.Generic,Show) instance Binary.Binary Message where
library/Octane/Type/Primitive/Boolean.hs view
@@ -2,27 +2,57 @@ module Octane.Type.Primitive.Boolean (Boolean(..)) where +import Data.Function ((&))+ import qualified Control.DeepSeq as DeepSeq import qualified Data.Aeson as Aeson+import qualified Data.Aeson.Types as Aeson import qualified Data.Binary as Binary-import Data.Function ((&))+import qualified Data.Binary.Bits as BinaryBit+import qualified Data.Binary.Bits.Get as BinaryBit+import qualified Data.Binary.Bits.Put as BinaryBit import qualified GHC.Generics as Generics --- | A boolean value, stored in the first bit of a byte.++-- | A boolean value. newtype Boolean = Boolean { unpackBoolean :: Bool- } deriving (Eq,Generics.Generic,Show)+ } 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@. instance Binary.Binary Boolean where get = do- boolean <- Binary.getWord8- if boolean > 1- then fail ("invalid Boolean value " ++ show boolean)- else boolean & fromIntegral & toEnum & Boolean & return- put boolean = do- boolean & unpackBoolean & fromEnum & fromIntegral & Binary.putWord8+ value <- Binary.getWord8+ case value of+ 0 -> pure (Boolean False)+ 1 -> pure (Boolean True)+ _ -> fail ("Unexpected Boolean value " ++ show value) -instance DeepSeq.NFData Boolean+ put boolean = boolean+ & unpackBoolean+ & fromEnum+ & fromIntegral+ & Binary.putWord8 +-- | Boolean values are stored as a single bit.+instance BinaryBit.BinaryBit Boolean where+ getBits _ = do+ value <- BinaryBit.getBool+ pure (Boolean value)++ putBits _ boolean = boolean+ & unpackBoolean+ & BinaryBit.putBool++instance Aeson.FromJSON Boolean where+ parseJSON json = case json of+ Aeson.Bool value -> pure (Boolean value)+ _ -> Aeson.typeMismatch "Boolean" json++instance DeepSeq.NFData Boolean where+ instance Aeson.ToJSON Boolean where- toJSON boolean = boolean & unpackBoolean & Aeson.toJSON+ toJSON boolean = boolean+ & unpackBoolean+ & Aeson.toJSON
library/Octane/Type/Primitive/Dictionary.hs view
@@ -9,12 +9,12 @@ import Data.Function ((&)) import qualified Data.Map.Strict as Map import qualified GHC.Generics as Generics-import qualified Octane.Type.Primitive.PCString as PCString+import qualified Octane.Type.Primitive.Text as Text -- | A dictionary that maps strings to values. The dictionary is terminated by -- the key "None". newtype Dictionary a = Dictionary- { unpackDictionary :: (Map.Map PCString.PCString a)+ { unpackDictionary :: (Map.Map Text.Text a) } deriving (Eq,Generics.Generic,Show) instance (Binary.Binary a) => Binary.Binary (Dictionary a) where@@ -34,11 +34,11 @@ instance (Aeson.ToJSON a) => Aeson.ToJSON (Dictionary a) where toJSON dictionary =- dictionary & unpackDictionary & Map.mapKeys PCString.unpackPCString & Aeson.toJSON+ dictionary & unpackDictionary & Map.mapKeys Text.unpackText & Aeson.toJSON getElement :: (Binary.Binary a)- => Binary.Get (Map.Map PCString.PCString a)+ => Binary.Get (Map.Map Text.Text a) getElement = do key <- Binary.get if key == noneKey@@ -50,10 +50,10 @@ putElement :: (Binary.Binary a)- => (PCString.PCString, a) -> Binary.Put+ => (Text.Text, a) -> Binary.Put putElement (key,value) = do Binary.put key Binary.put value -noneKey :: PCString.PCString+noneKey :: Text.Text noneKey = "None"
+ library/Octane/Type/Primitive/Float32.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Octane.Type.Primitive.Float32 (Float32(..)) where++import Data.Function ((&))++import qualified Control.DeepSeq as DeepSeq+import qualified Data.Aeson as Aeson+import qualified Data.Aeson.Types as Aeson+import qualified Data.Binary as Binary+import qualified Data.Binary.Bits as BinaryBit+import qualified Data.Binary.Bits.Get as BinaryBit+import qualified Data.Binary.Bits.Put as BinaryBit+import qualified Data.Binary.Get as Binary+import qualified Data.Binary.IEEE754 as Binary+import qualified Data.Binary.Put as Binary+import qualified Data.ByteString.Lazy as LazyBytes+import qualified Data.Scientific as Scientific+import qualified GHC.Generics as Generics+import qualified Octane.Utility as Utility+++-- | A 32-bit little-endian float.+newtype Float32 = Float32+ { unpackFloat32 :: Float+ } deriving (Eq, Fractional, Generics.Generic, Num, Ord, Show)++instance Binary.Binary Float32 where+ get = do+ value <- Binary.getFloat32le+ value & Float32 & pure++ put float32 = float32+ & unpackFloat32+ & Binary.putFloat32le++instance BinaryBit.BinaryBit Float32 where+ getBits _ = do+ bytes <- BinaryBit.getByteString 4+ let value = Binary.runGet+ Binary.getFloat32le+ (bytes & LazyBytes.fromStrict & Utility.reverseBitsInBytes)+ value & Float32 & pure++ putBits _ float32 = float32+ & unpackFloat32+ & Binary.putFloat32le+ & Binary.runPut+ & LazyBytes.toStrict+ & BinaryBit.putByteString++instance Aeson.FromJSON Float32 where+ parseJSON json = case json of+ Aeson.Number number -> case Scientific.toBoundedRealFloat number of+ Right float -> pure (Float32 float)+ _ -> Aeson.typeMismatch "Float32" json+ _ -> Aeson.typeMismatch "Float32" json++instance DeepSeq.NFData Float32++instance Aeson.ToJSON Float32 where+ toJSON float32 = float32+ & unpackFloat32+ & Aeson.toJSON
− library/Octane/Type/Primitive/Float32LE.hs
@@ -1,27 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}--module Octane.Type.Primitive.Float32LE (Float32LE(..)) where--import qualified Control.DeepSeq as DeepSeq-import qualified Data.Aeson as Aeson-import qualified Data.Binary as Binary-import qualified Data.Binary.IEEE754 as IEEE754-import Data.Function ((&))-import qualified GHC.Generics as Generics---- | A 32-bit little-endian float.-newtype Float32LE = Float32LE- { unpackFloat32LE :: Float- } deriving (Eq,Generics.Generic,Show)--instance Binary.Binary Float32LE where- get = do- float <- IEEE754.getFloat32le- float & Float32LE & return- put float = do- float & unpackFloat32LE & IEEE754.putFloat32le--instance DeepSeq.NFData Float32LE--instance Aeson.ToJSON Float32LE where- toJSON float = float & unpackFloat32LE & Aeson.toJSON
+ library/Octane/Type/Primitive/Int32.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Octane.Type.Primitive.Int32 (Int32(..), fromInt32) where++import Data.Function ((&))++import qualified Control.DeepSeq as DeepSeq+import qualified Data.Aeson as Aeson+import qualified Data.Aeson.Types as Aeson+import qualified Data.Binary as Binary+import qualified Data.Binary.Bits as BinaryBit+import qualified Data.Binary.Bits.Get as BinaryBit+import qualified Data.Binary.Bits.Put as BinaryBit+import qualified Data.Binary.Get as Binary+import qualified Data.Binary.Put as Binary+import qualified Data.ByteString.Lazy as LazyBytes+import qualified Data.Int as Int+import qualified Data.Scientific as Scientific+import qualified GHC.Generics as Generics+import qualified Octane.Utility as Utility+++-- | A 32-bit little-endian integer.+newtype Int32 = Int32+ { unpackInt32 :: Int.Int32+ } deriving (Eq, Generics.Generic, Num, Ord, Show)++instance Binary.Binary Int32 where+ get = do+ value <- Binary.getWord32le+ value & fromIntegral & Int32 & pure++ put int32 = int32+ & unpackInt32+ & fromIntegral+ & Binary.putWord32le++instance BinaryBit.BinaryBit Int32 where+ getBits _ = do+ bytes <- BinaryBit.getByteString 4+ let value = Binary.runGet+ Binary.getWord32le+ (bytes & LazyBytes.fromStrict & Utility.reverseBitsInBytes)+ value & fromIntegral & Int32 & pure++ putBits _ int32 = int32+ & unpackInt32+ & fromIntegral+ & Binary.putWord32le+ & Binary.runPut+ & LazyBytes.toStrict+ & BinaryBit.putByteString++instance Aeson.FromJSON Int32 where+ parseJSON json = case json of+ Aeson.Number number -> case Scientific.toBoundedInteger number of+ Just integer -> pure (Int32 integer)+ _ -> Aeson.typeMismatch "Int32" json+ _ -> Aeson.typeMismatch "Int32" json++instance DeepSeq.NFData Int32 where++instance Aeson.ToJSON Int32 where+ toJSON int32 = int32+ & unpackInt32+ & Aeson.toJSON+++fromInt32 :: (Integral a) => Int32 -> a+fromInt32 int32 = int32 & unpackInt32 & fromIntegral
+ library/Octane/Type/Primitive/Int64.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE DeriveGeneric #-}++module Octane.Type.Primitive.Int64 (Int64(..)) where++import Data.Function ((&))++import qualified Control.DeepSeq as DeepSeq+import qualified Data.Aeson as Aeson+import qualified Data.Aeson.Types as Aeson+import qualified Data.Binary as Binary+import qualified Data.Binary.Get as Binary+import qualified Data.Binary.Put as Binary+import qualified Data.Int as Int+import qualified Data.Scientific as Scientific+import qualified GHC.Generics as Generics+++-- | A 64-bit little-endian integer.+newtype Int64 = Int64+ { unpackInt64 :: Int.Int64+ } deriving (Eq, Generics.Generic, Show)++instance Binary.Binary Int64 where+ get = do+ value <- Binary.getWord64le+ value & fromIntegral & Int64 & return++ put word64 = word64+ & unpackInt64+ & fromIntegral+ & Binary.putWord64le++instance Aeson.FromJSON Int64 where+ parseJSON json = case json of+ Aeson.Number number -> case Scientific.toBoundedInteger number of+ Just integer -> pure (Int64 integer)+ _ -> Aeson.typeMismatch "Int64" json+ _ -> Aeson.typeMismatch "Int64" json++instance DeepSeq.NFData Int64++instance Aeson.ToJSON Int64 where+ toJSON int64 = int64+ & unpackInt64+ & Aeson.toJSON
+ library/Octane/Type/Primitive/Int8.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Octane.Type.Primitive.Int8 (Int8(..), fromInt8) where++import Data.Function ((&))++import qualified Control.DeepSeq as DeepSeq+import qualified Data.Aeson as Aeson+import qualified Data.Aeson.Types as Aeson+import qualified Data.Binary as Binary+import qualified Data.Binary.Bits as BinaryBit+import qualified Data.Binary.Bits.Get as BinaryBit+import qualified Data.Binary.Bits.Put as BinaryBit+import qualified Data.Binary.Get as Binary+import qualified Data.Binary.Put as Binary+import qualified Data.ByteString.Lazy as LazyBytes+import qualified Data.Int as Int+import qualified Data.Scientific as Scientific+import qualified GHC.Generics as Generics+import qualified Octane.Utility as Utility+++-- | An 8-bit little-endian integer.+newtype Int8 = Int8+ { unpackInt8 :: Int.Int8+ } deriving (Eq, Generics.Generic, Num, Ord, Show)++instance BinaryBit.BinaryBit Int8 where+ getBits _ = do+ bytes <- BinaryBit.getByteString 1+ let value = Binary.runGet+ Binary.getWord8+ (bytes & LazyBytes.fromStrict & Utility.reverseBitsInBytes)+ value & fromIntegral & Int8 & pure++ putBits _ int8 = int8+ & unpackInt8+ & fromIntegral+ & Binary.putWord8+ & Binary.runPut+ & LazyBytes.toStrict+ & BinaryBit.putByteString++instance Aeson.FromJSON Int8 where+ parseJSON json = case json of+ Aeson.Number number -> case Scientific.toBoundedInteger number of+ Just integer -> pure (Int8 integer)+ _ -> Aeson.typeMismatch "Int8" json+ _ -> Aeson.typeMismatch "Int8" json++instance DeepSeq.NFData Int8 where++instance Aeson.ToJSON Int8 where+ toJSON int8 = int8+ & unpackInt8+ & Aeson.toJSON+++fromInt8 :: (Integral a) => Int8 -> a+fromInt8 int8 = int8 & unpackInt8 & fromIntegral
library/Octane/Type/Primitive/List.hs view
@@ -2,28 +2,60 @@ module Octane.Type.Primitive.List (List(..)) where +import Data.Function ((&))+ import qualified Control.DeepSeq as DeepSeq import qualified Control.Monad as Monad import qualified Data.Aeson as Aeson+import qualified Data.Aeson.Types as Aeson import qualified Data.Binary as Binary-import Data.Function ((&))+import qualified Data.Binary.Bits as BinaryBit+import qualified Data.Vector as Vector import qualified GHC.Generics as Generics-import qualified Octane.Type.Primitive.Word32LE as Word32LE+import qualified Octane.Type.Primitive.Int32 as Int32+import qualified Octane.Type.Primitive.Boolean as Boolean --- | A length-prefixed list.++-- | A list of valeus. newtype List a = List { unpackList :: [a]- } deriving (Eq,Generics.Generic,Show)+ } deriving (Eq, Generics.Generic, Show) +-- | Bytewise lists are length-prefixed. instance (Binary.Binary a) => Binary.Binary (List a) where get = do- (Word32LE.Word32LE size) <- Binary.get+ (Int32.Int32 size) <- Binary.get elements <- Monad.replicateM (fromIntegral size) Binary.get elements & List & return+ put list = do- list & unpackList & length & fromIntegral & Word32LE.Word32LE &- Binary.put+ list & unpackList & length & fromIntegral & Int32.Int32 & Binary.put list & unpackList & mapM_ Binary.put++-- | Bitwise lists use a bit to signify if there is another element.+instance (BinaryBit.BinaryBit a) => BinaryBit.BinaryBit (List a) where+ getBits _ = do+ (Boolean.Boolean hasMore) <- BinaryBit.getBits 0+ if hasMore+ then do+ x <- BinaryBit.getBits 0+ (List xs) <- BinaryBit.getBits 0+ pure (List (x : xs))+ else pure (List [])++ putBits _ list = case unpackList list of+ [] -> BinaryBit.putBits 0 (Boolean.Boolean False)+ x : xs -> do+ BinaryBit.putBits 0 (Boolean.Boolean True)+ BinaryBit.putBits 0 x+ BinaryBit.putBits 0 (List xs)++instance (Aeson.FromJSON a) => Aeson.FromJSON (List a) where+ parseJSON json = case json of+ Aeson.Array array -> do+ values <- Vector.mapM Aeson.parseJSON array+ values & Vector.toList & List & pure+ _ -> Aeson.typeMismatch "List" json instance (DeepSeq.NFData a) => DeepSeq.NFData (List a)
− library/Octane/Type/Primitive/PCString.hs
@@ -1,80 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}--module Octane.Type.Primitive.PCString (PCString(..)) where--import qualified Control.DeepSeq as DeepSeq-import qualified Data.Aeson as Aeson-import qualified Data.Binary as Binary-import qualified Data.Binary.Get as Binary-import qualified Data.Binary.Put as Binary-import qualified Data.ByteString as BS-import qualified Data.ByteString.Char8 as BS8-import qualified Data.Char as Char-import Data.Function ((&))-import qualified Data.String as String-import qualified Data.Text as Text-import qualified Data.Text.Encoding as Encoding-import qualified GHC.Generics as Generics-import qualified Octane.Type.Primitive.Word32LE as Word32LE---- | A length-prefixed null-terminated string.-newtype PCString = PCString- { unpackPCString :: Text.Text- } deriving (Eq,Generics.Generic,Ord,Show)--instance Binary.Binary PCString where- get = do- (Word32LE.Word32LE rawSize) <- Binary.get- -- In some tiny percentage of replays, this nonsensical string size- -- shows up. As far as I can tell the next 3 bytes are always null. And- -- the actual string is "None", which is 5 bytes including the null- -- terminator.- --- -- These annoying replays come from around 2015-10-25 to 2015-11-01.- size <- if rawSize == 0x05000000- then do- bytes <- Binary.getByteString 3- if BS.all (== 0) bytes- then return 5- else error- ( "read special size "- ++ show rawSize- ++ " but next 3 bytes were "- ++ show bytes- ++ " instead of all null"- )- else return rawSize- string <-- if size == 0- then fail ("invalid PCString size " ++ show size)- else if size < 0- then do- let actualSize = 2 * negate size- bytes <-- Binary.getByteString (fromIntegral actualSize)- bytes & Encoding.decodeUtf16LE & return- else do- bytes <- Binary.getByteString (fromIntegral size)- bytes & Encoding.decodeLatin1 & return- string & Text.dropEnd 1 & PCString & return- put string = do- let cString = string & unpackPCString & flip Text.snoc '\NUL'- let size = cString & Text.length & fromIntegral- if Text.all Char.isLatin1 cString- then do- size & Word32LE.Word32LE & Binary.put- cString & encodeLatin1 & Binary.putByteString- else do- size & negate & Word32LE.Word32LE & Binary.put- cString & Encoding.encodeUtf16LE & Binary.putByteString--instance String.IsString PCString where- fromString string = string & Text.pack & PCString--instance DeepSeq.NFData PCString--instance Aeson.ToJSON PCString where- toJSON string = string & unpackPCString & Aeson.toJSON--encodeLatin1 :: Text.Text -> BS.ByteString-encodeLatin1 text = text & Text.unpack & BS8.pack
library/Octane/Type/Primitive/Stream.hs view
@@ -1,18 +1,17 @@ {-# LANGUAGE DeriveGeneric #-} -module Octane.Type.Primitive.Stream (Stream(..), reverseBits) where+module Octane.Type.Primitive.Stream (Stream(..)) where import qualified Control.DeepSeq as DeepSeq import qualified Data.Aeson as Aeson import qualified Data.Binary as Binary import qualified Data.Binary.Get as Binary import qualified Data.Binary.Put as Binary-import qualified Data.Bits as Bits import qualified Data.ByteString as BS import Data.Function ((&))-import qualified Data.Word as Word import qualified GHC.Generics as Generics-import qualified Octane.Type.Primitive.Word32LE as Word32LE+import qualified Octane.Type.Primitive.Int32 as Int32+import qualified Octane.Utility as Utility -- | A length-prefixed stream of bits. The length is given in bytes. Each byte -- is reversed such that 0b01234567 is actually 0b76543210.@@ -22,13 +21,13 @@ instance Binary.Binary Stream where get = do- Word32LE.Word32LE size <- Binary.get+ Int32.Int32 size <- Binary.get content <- size & fromIntegral & Binary.getByteString- content & BS.map reverseBits & Stream & return+ content & BS.map Utility.reverseBits & Stream & return put stream = do let content = unpackStream stream- content & BS.length & fromIntegral & Word32LE.Word32LE & Binary.put- content & BS.map reverseBits & Binary.putByteString+ content & BS.length & fromIntegral & Int32.Int32 & Binary.put+ content & BS.map Utility.reverseBits & Binary.putByteString instance DeepSeq.NFData Stream @@ -40,13 +39,3 @@ then "byte" else "bytes" in Aeson.toJSON (unwords ["Stream:", show size, bytes, "..."])--reverseBits :: Word.Word8 -> Word.Word8-reverseBits word =- Bits.shiftR (word Bits..&. 128) 7 + Bits.shiftR (word Bits..&. 64) 5 +- Bits.shiftR (word Bits..&. 32) 3 +- Bits.shiftR (word Bits..&. 16) 1 +- Bits.shiftL (word Bits..&. 8) 1 +- Bits.shiftL (word Bits..&. 4) 3 +- Bits.shiftL (word Bits..&. 2) 5 +- Bits.shiftL (word Bits..&. 1) 7
+ library/Octane/Type/Primitive/Text.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}++module Octane.Type.Primitive.Text (Text(..)) where++import Data.Function ((&))++import qualified Control.DeepSeq as DeepSeq+import qualified Data.Aeson as Aeson+import qualified Data.Aeson.Types as Aeson+import qualified Data.Binary as Binary+import qualified Data.Binary.Bits as BinaryBit+import qualified Data.Binary.Bits.Get as BinaryBit+import qualified Data.Binary.Bits.Put as BinaryBit+import qualified Data.Binary.Get as Binary+import qualified Data.Binary.Put as Binary+import qualified Data.ByteString.Char8 as Bytes+import qualified Data.Char as Char+import qualified Data.String as String+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Encoding+import qualified GHC.Generics as Generics+import qualified Octane.Type.Primitive.Int32 as Int32+import qualified Octane.Utility as Utility+++-- | A length-prefixed null-terminated string.+newtype Text = Text+ { unpackText :: Text.Text+ } deriving (Eq, Generics.Generic, Ord, Show)++instance Binary.Binary Text where+ get = getText Binary.get Binary.getByteString++ put text = putText+ Binary.put+ Binary.putByteString+ id+ text++instance BinaryBit.BinaryBit Text where+ getBits _ = getText (BinaryBit.getBits 32) (BinaryBit.getByteString)++ putBits _ text = putText+ (BinaryBit.putBits 32)+ BinaryBit.putByteString+ Utility.reverseBitsInBytes'+ text++instance String.IsString Text where+ fromString string = string+ & Text.pack+ & Text++instance Aeson.FromJSON Text where+ parseJSON json = case json of+ Aeson.String text -> text & Text & pure+ _ -> Aeson.typeMismatch "Text" json++instance DeepSeq.NFData Text++instance Aeson.ToJSON Text where+ toJSON text = text+ & unpackText+ & Aeson.toJSON+++getText :: (Monad m) => (m Int32.Int32) -> (Int -> m Bytes.ByteString) -> m Text+getText getInt getBytes = do+ (Int32.Int32 rawSize) <- getInt+ (size, decode) <-+ -- In some tiny percentage of replays, this nonsensical string size+ -- shows up. As far as I can tell the next 3 bytes are always null. And+ -- the actual string is "None", which is 5 bytes including the null+ -- terminator.+ --+ -- These annoying replays come from around 2015-10-25 to 2015-11-01.+ if rawSize == 0x05000000+ then do+ bytes <- getBytes 3+ if Bytes.all (== '\0') bytes+ then pure (5, Encoding.decodeLatin1)+ else fail ("Unexpected Text bytes " ++ show bytes ++ " after size " ++ show rawSize)+ else if rawSize < 0+ then pure (-2 * fromIntegral rawSize, Encoding.decodeUtf16LE)+ else pure (fromIntegral rawSize, Encoding.decodeLatin1)+ bytes <- getBytes size+ let rawText = decode bytes+ case Text.splitAt (Text.length rawText - 1) rawText of+ (text, "") -> text & Text & pure+ (text, "\0") -> text & Text & pure+ _ -> fail ("Unexpected Text value " ++ show rawText)+++putText :: (Monad m) => (Int32.Int32 -> m ()) -> (Bytes.ByteString -> m ()) -> (Bytes.ByteString -> Bytes.ByteString) -> Text -> m ()+putText putInt putBytes convertBytes text = do+ let fullText = text & unpackText & flip Text.snoc '\NUL'+ let size = fullText & Text.length & fromIntegral+ if Text.all Char.isLatin1 fullText+ then do+ size & Int32.Int32 & putInt+ fullText & encodeLatin1 & convertBytes & putBytes+ else do+ size & negate & Int32.Int32 & putInt+ fullText & Encoding.encodeUtf16LE & convertBytes & putBytes+++encodeLatin1 :: Text.Text -> Bytes.ByteString+encodeLatin1 text = text+ & Text.unpack+ & Bytes.pack
+ library/Octane/Type/Primitive/Word32.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Octane.Type.Primitive.Word32 (Word32(..), fromWord32) where++import Data.Function ((&))++import qualified Control.DeepSeq as DeepSeq+import qualified Data.Aeson as Aeson+import qualified Data.Aeson.Types as Aeson+import qualified Data.Binary as Binary+import qualified Data.Binary.Get as Binary+import qualified Data.Binary.Put as Binary+import qualified Data.Scientific as Scientific+import qualified Data.Word as Word+import qualified GHC.Generics as Generics+++-- | A 32-bit little-endian word.+newtype Word32 = Word32+ { unpackWord32 :: Word.Word32+ } deriving (Eq, Generics.Generic, Num, Ord, Show)++instance Binary.Binary Word32 where+ get = do+ value <- Binary.getWord32le+ value & Word32 & pure++ put word32 = word32+ & unpackWord32+ & Binary.putWord32le++instance Aeson.FromJSON Word32 where+ parseJSON json = case json of+ Aeson.Number number -> case Scientific.toBoundedInteger number of+ Just integer -> pure (Word32 integer)+ _ -> Aeson.typeMismatch "Word32" json+ _ -> Aeson.typeMismatch "Word32" json++instance DeepSeq.NFData Word32 where++instance Aeson.ToJSON Word32 where+ toJSON word32 = word32+ & unpackWord32+ & Aeson.toJSON+++fromWord32 :: (Integral a) => Word32 -> a+fromWord32 word32 = word32 & unpackWord32 & fromIntegral
− library/Octane/Type/Primitive/Word32LE.hs
@@ -1,29 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}--module Octane.Type.Primitive.Word32LE (Word32LE(..)) where--import qualified Control.DeepSeq as DeepSeq-import qualified Data.Aeson as Aeson-import qualified Data.Binary as Binary-import qualified Data.Binary.Get as Binary-import qualified Data.Binary.Put as Binary-import Data.Function ((&))-import qualified Data.Int as Int-import qualified GHC.Generics as Generics---- | A 32-bit little-endian integer.-newtype Word32LE = Word32LE- { unpackWord32LE :: Int.Int32- } deriving (Eq,Generics.Generic,Show)--instance Binary.Binary Word32LE where- get = do- word <- Binary.getWord32le- word & fromIntegral & Word32LE & return- put word = do- word & unpackWord32LE & fromIntegral & Binary.putWord32le--instance DeepSeq.NFData Word32LE--instance Aeson.ToJSON Word32LE where- toJSON word = word & unpackWord32LE & Aeson.toJSON
− library/Octane/Type/Primitive/Word64LE.hs
@@ -1,29 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}--module Octane.Type.Primitive.Word64LE (Word64LE(..)) where--import qualified Control.DeepSeq as DeepSeq-import qualified Data.Aeson as Aeson-import qualified Data.Binary as Binary-import qualified Data.Binary.Get as Binary-import qualified Data.Binary.Put as Binary-import Data.Function ((&))-import qualified Data.Int as Int-import qualified GHC.Generics as Generics---- | A 64-bit little-endian integer.-newtype Word64LE = Word64LE- { unpackWord64LE :: Int.Int64- } deriving (Eq,Generics.Generic,Show)--instance Binary.Binary Word64LE where- get = do- word <- Binary.getWord64le- word & fromIntegral & Word64LE & return- put word = do- word & unpackWord64LE & fromIntegral & Binary.putWord64le--instance DeepSeq.NFData Word64LE--instance Aeson.ToJSON Word64LE where- toJSON word = word & unpackWord64LE & Aeson.toJSON
+ library/Octane/Type/Primitive/Word8.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Octane.Type.Primitive.Word8 (Word8(..), fromWord8) where++import Data.Function ((&))++import qualified Control.DeepSeq as DeepSeq+import qualified Data.Aeson as Aeson+import qualified Data.Aeson.Types as Aeson+import qualified Data.Binary as Binary+import qualified Data.Binary.Bits as BinaryBit+import qualified Data.Binary.Bits.Get as BinaryBit+import qualified Data.Binary.Bits.Put as BinaryBit+import qualified Data.Binary.Get as Binary+import qualified Data.Binary.Put as Binary+import qualified Data.ByteString.Lazy as LazyBytes+import qualified Data.Word as Word+import qualified Data.Scientific as Scientific+import qualified GHC.Generics as Generics+import qualified Octane.Utility as Utility+++-- | An 8-bit little-endian word.+newtype Word8 = Word8+ { unpackWord8 :: Word.Word8+ } deriving (Eq, Generics.Generic, Num, Ord, Show)++instance BinaryBit.BinaryBit Word8 where+ getBits _ = do+ bytes <- BinaryBit.getByteString 1+ let value = Binary.runGet+ Binary.getWord8+ (bytes & LazyBytes.fromStrict & Utility.reverseBitsInBytes)+ value & Word8 & pure++ putBits _ word8 = word8+ & unpackWord8+ & Binary.putWord8+ & Binary.runPut+ & LazyBytes.toStrict+ & BinaryBit.putByteString++instance Aeson.FromJSON Word8 where+ parseJSON json = case json of+ Aeson.Number number -> case Scientific.toBoundedInteger number of+ Just integer -> pure (Word8 integer)+ _ -> Aeson.typeMismatch "Word8" json+ _ -> Aeson.typeMismatch "Word8" json++instance DeepSeq.NFData Word8 where++instance Aeson.ToJSON Word8 where+ toJSON word8 = word8+ & unpackWord8+ & Aeson.toJSON+++fromWord8 :: (Integral a) => Word8 -> a+fromWord8 word8 = word8 & unpackWord8 & fromIntegral
library/Octane/Type/Property.hs view
@@ -10,32 +10,32 @@ import qualified GHC.Generics as Generics import qualified Octane.Type.Primitive.Boolean as Boolean import qualified Octane.Type.Primitive.Dictionary as Dictionary-import qualified Octane.Type.Primitive.Float32LE as Float32LE+import qualified Octane.Type.Primitive.Float32 as Float32 import qualified Octane.Type.Primitive.List as List-import qualified Octane.Type.Primitive.PCString as PCString-import qualified Octane.Type.Primitive.Word32LE as Word32LE-import qualified Octane.Type.Primitive.Word64LE as Word64LE+import qualified Octane.Type.Primitive.Text as Text+import qualified Octane.Type.Primitive.Int32 as Int32+import qualified Octane.Type.Primitive.Int64 as Int64 -- | A metadata property. All properties have a size, but only some actually -- use it. The value stored in the property can be an array, a boolean, and -- so on. data Property- = ArrayProperty !Word64LE.Word64LE+ = ArrayProperty !Int64.Int64 !(List.List (Dictionary.Dictionary Property))- | BoolProperty !Word64LE.Word64LE+ | BoolProperty !Int64.Int64 !Boolean.Boolean- | ByteProperty !Word64LE.Word64LE- !(PCString.PCString, PCString.PCString)- | FloatProperty !Word64LE.Word64LE- !Float32LE.Float32LE- | IntProperty !Word64LE.Word64LE- !Word32LE.Word32LE- | NameProperty !Word64LE.Word64LE- !PCString.PCString- | QWordProperty !Word64LE.Word64LE- !Word64LE.Word64LE- | StrProperty !Word64LE.Word64LE- !PCString.PCString+ | ByteProperty !Int64.Int64+ !(Text.Text, Text.Text)+ | FloatProperty !Int64.Int64+ !Float32.Float32+ | IntProperty !Int64.Int64+ !Int32.Int32+ | NameProperty !Int64.Int64+ !Text.Text+ | QWordProperty !Int64.Int64+ !Int64.Int64+ | StrProperty !Int64.Int64+ !Text.Text deriving (Eq,Generics.Generic,Show) instance Binary.Binary Property where@@ -61,14 +61,14 @@ _ | kind == floatProperty -> do size <- Binary.get value <-- case Word64LE.unpackWord64LE size of+ case Int64.unpackInt64 size of 4 -> Binary.get x -> fail ("unknown FloatProperty size " ++ show x) value & FloatProperty size & return _ | kind == intProperty -> do size <- Binary.get value <-- case Word64LE.unpackWord64LE size of+ case Int64.unpackInt64 size of 4 -> Binary.get x -> fail ("unknown IntProperty size " ++ show x) value & IntProperty size & return@@ -79,7 +79,7 @@ _ | kind == qWordProperty -> do size <- Binary.get value <-- case Word64LE.unpackWord64LE size of+ case Int64.unpackInt64 size of 8 -> Binary.get x -> fail ("unknown QWordProperty size " ++ show x) value & QWordProperty size & return@@ -87,7 +87,7 @@ size <- Binary.get value <- Binary.get value & StrProperty size & return- _ -> fail ("unknown property type " ++ show (PCString.unpackPCString kind))+ _ -> fail ("unknown property type " ++ show (Text.unpackText kind)) put property = case property of ArrayProperty size value -> do@@ -138,26 +138,26 @@ QWordProperty _ x -> Aeson.toJSON x StrProperty _ x -> Aeson.toJSON x -arrayProperty :: PCString.PCString+arrayProperty :: Text.Text arrayProperty = "ArrayProperty" -boolProperty :: PCString.PCString+boolProperty :: Text.Text boolProperty = "BoolProperty" -byteProperty :: PCString.PCString+byteProperty :: Text.Text byteProperty = "ByteProperty" -floatProperty :: PCString.PCString+floatProperty :: Text.Text floatProperty = "FloatProperty" -intProperty :: PCString.PCString+intProperty :: Text.Text intProperty = "IntProperty" -nameProperty :: PCString.PCString+nameProperty :: Text.Text nameProperty = "NameProperty" -qWordProperty :: PCString.PCString+qWordProperty :: Text.Text qWordProperty = "QWordProperty" -strProperty :: PCString.PCString+strProperty :: Text.Text strProperty = "StrProperty"
library/Octane/Type/Replay.hs view
@@ -2,10 +2,14 @@ module Octane.Type.Replay (Replay(..)) where +import Data.Function ((&))+ import qualified Control.DeepSeq as DeepSeq+import qualified Control.Monad as Monad import qualified Data.Aeson as Aeson import qualified Data.Binary as Binary-import Data.Function ((&))+import qualified Data.Binary.Get as Binary+import qualified Data.ByteString.Lazy as LazyBytes import qualified GHC.Generics as Generics import qualified Octane.Json as Json import qualified Octane.Type.Actor as Actor@@ -14,34 +18,37 @@ import qualified Octane.Type.Mark as Mark import qualified Octane.Type.Message as Message import qualified Octane.Type.Primitive.Dictionary as Dictionary+import qualified Octane.Type.Primitive.Int32 as Int32 import qualified Octane.Type.Primitive.List as List-import qualified Octane.Type.Primitive.PCString as PCString import qualified Octane.Type.Primitive.Stream as Stream-import qualified Octane.Type.Primitive.Word32LE as Word32LE+import qualified Octane.Type.Primitive.Text as Text+import qualified Octane.Type.Primitive.Word32 as Word32 import qualified Octane.Type.Property as Property+import qualified Octane.Utility as Utility+import qualified Text.Printf as Printf -- | An entire replay. All of the metadata has been parsed, but the actual net -- stream has not. data Replay = Replay -- Number of bytes in the first section.- { replaySize1 :: !Word32LE.Word32LE+ { replaySize1 :: !Word32.Word32 -- CRC to check the first section.- , replayCRC1 :: !Word32LE.Word32LE+ , replayCRC1 :: !Word32.Word32 -- Major replay version number.- , replayVersion1 :: !Word32LE.Word32LE+ , replayVersion1 :: !Int32.Int32 -- Minor replay version number.- , replayVersion2 :: !Word32LE.Word32LE+ , replayVersion2 :: !Int32.Int32 -- Label, which is always "TAGame.Replay_Soccar_TA".- , replayLabel :: !PCString.PCString+ , replayLabel :: !Text.Text -- High-level metadata about the replay. , replayProperties :: !(Dictionary.Dictionary Property.Property) -- Number of bytes in the last section.- , replaySize2 :: !Word32LE.Word32LE+ , replaySize2 :: !Word32.Word32 -- CRC to check the last section.- , replayCRC2 :: !Word32LE.Word32LE+ , replayCRC2 :: !Word32.Word32 -- Array of strings for all of the levels that need to be loaded (array -- length followed by each string)- , replayLevels :: !(List.List PCString.PCString)+ , replayLevels :: !(List.List Text.Text) -- Array of Keyframe information used for timeline scrubbing (array -- length followed by each keyframe struct) (Time, Frame, File Position) , replayKeyFrames :: !(List.List KeyFrame.KeyFrame)@@ -56,14 +63,14 @@ -- scores). (array length followed by each tick struct) (Type, Frame) , replayMarks :: !(List.List Mark.Mark) -- Array of strings of replicated Packages- , replayPackages :: !(List.List PCString.PCString)+ , replayPackages :: !(List.List Text.Text) -- Array of strings for the Object table. Whenever a persistent object gets -- referenced in the network stream its path gets added to this array. Then -- its index in this array is used in the network stream.- , replayObjects :: !(List.List PCString.PCString)+ , replayObjects :: !(List.List Text.Text) -- Array of strings for the Name table. "Names" are commonly used strings -- that get assigned an integer for use in the network stream.- , replayNames :: !(List.List PCString.PCString)+ , replayNames :: !(List.List Text.Text) -- Map of string, integer pairs for the Class Index Map. Whenever a class -- is used in the network stream it is given an integer id by this map. , replayActors :: !(List.List Actor.Actor)@@ -73,22 +80,63 @@ } deriving (Eq,Generics.Generic,Show) instance Binary.Binary Replay where- get =- Replay <$> Binary.get <*> Binary.get <*> Binary.get <*> Binary.get <*>- Binary.get <*>- Binary.get <*>- Binary.get <*>- Binary.get <*>- Binary.get <*>- Binary.get <*>- Binary.get <*>- Binary.get <*>- Binary.get <*>- Binary.get <*>- Binary.get <*>- Binary.get <*>- Binary.get <*>- Binary.get+ get = do+ size1 <- Binary.get+ crc1 <- Binary.get+ data1 <- Binary.getLazyByteString (Word32.fromWord32 size1)+ let actualCRC1 = Utility.crc32 data1+ let expectedCRC1 = Word32.fromWord32 crc1+ Monad.when (actualCRC1 /= expectedCRC1) (fail (Printf.printf+ "First CRC 0x%08x does not match expected value 0x%08x"+ actualCRC1 expectedCRC1))++ size2 <- Binary.get+ crc2 <- Binary.get+ data2 <- Binary.getLazyByteString (Word32.fromWord32 size2)+ let actualCRC2 = Utility.crc32 data2+ let expectedCRC2 = Word32.fromWord32 crc2+ Monad.when (actualCRC2 /= expectedCRC2) (fail (Printf.printf+ "Second CRC 0x%08x does not match expected value 0x%08x"+ actualCRC2 expectedCRC2))++ pure (flip Binary.runGet (LazyBytes.append data1 data2) (do+ version1 <- Binary.get+ version2 <- Binary.get+ label <- Binary.get+ properties <- Binary.get++ levels <- Binary.get+ keyFrames <- Binary.get+ stream <- Binary.get+ messages <- Binary.get+ marks <- Binary.get+ packages <- Binary.get+ objects <- Binary.get+ names <- Binary.get+ actors <- Binary.get+ cacheItems <- Binary.get++ pure Replay+ { replaySize1 = size1+ , replayCRC1 = crc1+ , replayVersion1 = version1+ , replayVersion2 = version2+ , replayLabel = label+ , replayProperties = properties+ , replaySize2 = size2+ , replayCRC2 = crc2+ , replayLevels = levels+ , replayKeyFrames = keyFrames+ , replayStream = stream+ , replayMessages = messages+ , replayMarks = marks+ , replayPackages = packages+ , replayObjects = objects+ , replayNames = names+ , replayActors = actors+ , replayCacheItems = cacheItems+ }))+ put replay = do replay & replaySize1 & Binary.put replay & replayCRC1 & Binary.put
+ library/Octane/Utility.hs view
@@ -0,0 +1,116 @@+{-# LANGUAGE BinaryLiterals #-}++module Octane.Utility where++import qualified Data.Bits as Bits+import qualified Data.ByteString as StrictBytes+import qualified Data.ByteString.Lazy as LazyBytes+import qualified Data.Vector.Unboxed as Vector+import qualified Data.Word as Word+++-- | Computes the CRC32 of some bytes. Note that this is a non-standard CRC32.+-- It probably only works for Rocket League.+crc32 :: LazyBytes.ByteString -> Word.Word32+crc32 bytes = Bits.xor 0xffffffff (LazyBytes.foldl+ (\ crc byte -> Bits.xor+ (crc32Table Vector.! fromIntegral+ (Bits.xor byte (fromIntegral (Bits.shiftR crc 24))))+ (Bits.shiftL crc 8))+ 0x10340dfe+ bytes)+++-- | The lookup table of values for 'crc32'. Computed from the polynomial+-- @0x04c11db7@.+crc32Table :: Vector.Vector Word.Word32+crc32Table = Vector.fromList+ [+ 0x00000000, 0x04c11db7, 0x09823b6e, 0x0d4326d9,+ 0x130476dc, 0x17c56b6b, 0x1a864db2, 0x1e475005,+ 0x2608edb8, 0x22c9f00f, 0x2f8ad6d6, 0x2b4bcb61,+ 0x350c9b64, 0x31cd86d3, 0x3c8ea00a, 0x384fbdbd,+ 0x4c11db70, 0x48d0c6c7, 0x4593e01e, 0x4152fda9,+ 0x5f15adac, 0x5bd4b01b, 0x569796c2, 0x52568b75,+ 0x6a1936c8, 0x6ed82b7f, 0x639b0da6, 0x675a1011,+ 0x791d4014, 0x7ddc5da3, 0x709f7b7a, 0x745e66cd,+ 0x9823b6e0, 0x9ce2ab57, 0x91a18d8e, 0x95609039,+ 0x8b27c03c, 0x8fe6dd8b, 0x82a5fb52, 0x8664e6e5,+ 0xbe2b5b58, 0xbaea46ef, 0xb7a96036, 0xb3687d81,+ 0xad2f2d84, 0xa9ee3033, 0xa4ad16ea, 0xa06c0b5d,+ 0xd4326d90, 0xd0f37027, 0xddb056fe, 0xd9714b49,+ 0xc7361b4c, 0xc3f706fb, 0xceb42022, 0xca753d95,+ 0xf23a8028, 0xf6fb9d9f, 0xfbb8bb46, 0xff79a6f1,+ 0xe13ef6f4, 0xe5ffeb43, 0xe8bccd9a, 0xec7dd02d,+ 0x34867077, 0x30476dc0, 0x3d044b19, 0x39c556ae,+ 0x278206ab, 0x23431b1c, 0x2e003dc5, 0x2ac12072,+ 0x128e9dcf, 0x164f8078, 0x1b0ca6a1, 0x1fcdbb16,+ 0x018aeb13, 0x054bf6a4, 0x0808d07d, 0x0cc9cdca,+ 0x7897ab07, 0x7c56b6b0, 0x71159069, 0x75d48dde,+ 0x6b93dddb, 0x6f52c06c, 0x6211e6b5, 0x66d0fb02,+ 0x5e9f46bf, 0x5a5e5b08, 0x571d7dd1, 0x53dc6066,+ 0x4d9b3063, 0x495a2dd4, 0x44190b0d, 0x40d816ba,+ 0xaca5c697, 0xa864db20, 0xa527fdf9, 0xa1e6e04e,+ 0xbfa1b04b, 0xbb60adfc, 0xb6238b25, 0xb2e29692,+ 0x8aad2b2f, 0x8e6c3698, 0x832f1041, 0x87ee0df6,+ 0x99a95df3, 0x9d684044, 0x902b669d, 0x94ea7b2a,+ 0xe0b41de7, 0xe4750050, 0xe9362689, 0xedf73b3e,+ 0xf3b06b3b, 0xf771768c, 0xfa325055, 0xfef34de2,+ 0xc6bcf05f, 0xc27dede8, 0xcf3ecb31, 0xcbffd686,+ 0xd5b88683, 0xd1799b34, 0xdc3abded, 0xd8fba05a,+ 0x690ce0ee, 0x6dcdfd59, 0x608edb80, 0x644fc637,+ 0x7a089632, 0x7ec98b85, 0x738aad5c, 0x774bb0eb,+ 0x4f040d56, 0x4bc510e1, 0x46863638, 0x42472b8f,+ 0x5c007b8a, 0x58c1663d, 0x558240e4, 0x51435d53,+ 0x251d3b9e, 0x21dc2629, 0x2c9f00f0, 0x285e1d47,+ 0x36194d42, 0x32d850f5, 0x3f9b762c, 0x3b5a6b9b,+ 0x0315d626, 0x07d4cb91, 0x0a97ed48, 0x0e56f0ff,+ 0x1011a0fa, 0x14d0bd4d, 0x19939b94, 0x1d528623,+ 0xf12f560e, 0xf5ee4bb9, 0xf8ad6d60, 0xfc6c70d7,+ 0xe22b20d2, 0xe6ea3d65, 0xeba91bbc, 0xef68060b,+ 0xd727bbb6, 0xd3e6a601, 0xdea580d8, 0xda649d6f,+ 0xc423cd6a, 0xc0e2d0dd, 0xcda1f604, 0xc960ebb3,+ 0xbd3e8d7e, 0xb9ff90c9, 0xb4bcb610, 0xb07daba7,+ 0xae3afba2, 0xaafbe615, 0xa7b8c0cc, 0xa379dd7b,+ 0x9b3660c6, 0x9ff77d71, 0x92b45ba8, 0x9675461f,+ 0x8832161a, 0x8cf30bad, 0x81b02d74, 0x857130c3,+ 0x5d8a9099, 0x594b8d2e, 0x5408abf7, 0x50c9b640,+ 0x4e8ee645, 0x4a4ffbf2, 0x470cdd2b, 0x43cdc09c,+ 0x7b827d21, 0x7f436096, 0x7200464f, 0x76c15bf8,+ 0x68860bfd, 0x6c47164a, 0x61043093, 0x65c52d24,+ 0x119b4be9, 0x155a565e, 0x18197087, 0x1cd86d30,+ 0x029f3d35, 0x065e2082, 0x0b1d065b, 0x0fdc1bec,+ 0x3793a651, 0x3352bbe6, 0x3e119d3f, 0x3ad08088,+ 0x2497d08d, 0x2056cd3a, 0x2d15ebe3, 0x29d4f654,+ 0xc5a92679, 0xc1683bce, 0xcc2b1d17, 0xc8ea00a0,+ 0xd6ad50a5, 0xd26c4d12, 0xdf2f6bcb, 0xdbee767c,+ 0xe3a1cbc1, 0xe760d676, 0xea23f0af, 0xeee2ed18,+ 0xf0a5bd1d, 0xf464a0aa, 0xf9278673, 0xfde69bc4,+ 0x89b8fd09, 0x8d79e0be, 0x803ac667, 0x84fbdbd0,+ 0x9abc8bd5, 0x9e7d9662, 0x933eb0bb, 0x97ffad0c,+ 0xafb010b1, 0xab710d06, 0xa6322bdf, 0xa2f33668,+ 0xbcb4666d, 0xb8757bda, 0xb5365d03, 0xb1f740b4+ ]+++-- | Reverses all the bits in each lazy byte.+reverseBitsInBytes :: LazyBytes.ByteString -> LazyBytes.ByteString+reverseBitsInBytes bytes = LazyBytes.map reverseBits bytes+++-- | Reverses all the bits in each strict byte.+reverseBitsInBytes' :: StrictBytes.ByteString -> StrictBytes.ByteString+reverseBitsInBytes' bytes = StrictBytes.map reverseBits bytes+++-- | Reverses the bits in a byte.+reverseBits :: Word.Word8 -> Word.Word8+reverseBits byte+ = Bits.shiftR (byte Bits..&. 0b10000000) 7+ + Bits.shiftR (byte Bits..&. 0b01000000) 5+ + Bits.shiftR (byte Bits..&. 0b00100000) 3+ + Bits.shiftR (byte Bits..&. 0b00010000) 1+ + Bits.shiftL (byte Bits..&. 0b00001000) 1+ + Bits.shiftL (byte Bits..&. 0b00000100) 3+ + Bits.shiftL (byte Bits..&. 0b00000010) 5+ + Bits.shiftL (byte Bits..&. 0b00000001) 7
octane.cabal view
@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: octane-version: 0.9.0+version: 0.10.0 synopsis: Parse Rocket League replays. description: Octane parses Rocket League replays. category: Game@@ -40,7 +40,9 @@ , containers ==0.5.* , data-binary-ieee754 ==0.4.* , deepseq ==1.4.*+ , scientific ==0.3.* , text ==1.2.*+ , vector ==0.11.* exposed-modules: Octane Octane.Analyzer@@ -61,14 +63,18 @@ Octane.Type.Primitive Octane.Type.Primitive.Boolean Octane.Type.Primitive.Dictionary- Octane.Type.Primitive.Float32LE+ Octane.Type.Primitive.Float32+ Octane.Type.Primitive.Int32+ Octane.Type.Primitive.Int64+ Octane.Type.Primitive.Int8 Octane.Type.Primitive.List- Octane.Type.Primitive.PCString Octane.Type.Primitive.Stream- Octane.Type.Primitive.Word32LE- Octane.Type.Primitive.Word64LE+ Octane.Type.Primitive.Text+ Octane.Type.Primitive.Word32+ Octane.Type.Primitive.Word8 Octane.Type.Property Octane.Type.Replay+ Octane.Utility Octane.Version other-modules: Paths_octane@@ -108,12 +114,12 @@ Octane.Type.MessageSpec Octane.Type.Primitive.BooleanSpec Octane.Type.Primitive.DictionarySpec- Octane.Type.Primitive.Float32LESpec+ Octane.Type.Primitive.Float32Spec+ Octane.Type.Primitive.Int32Spec+ Octane.Type.Primitive.Int64Spec Octane.Type.Primitive.ListSpec- Octane.Type.Primitive.PCStringSpec Octane.Type.Primitive.StreamSpec- Octane.Type.Primitive.Word32LESpec- Octane.Type.Primitive.Word64LESpec+ Octane.Type.Primitive.TextSpec Octane.Type.PrimitiveSpec Octane.Type.PropertySpec Octane.Type.ReplaySpec@@ -145,12 +151,12 @@ Octane.Type.MessageBench Octane.Type.Primitive.BooleanBench Octane.Type.Primitive.DictionaryBench- Octane.Type.Primitive.Float32LEBench+ Octane.Type.Primitive.Float32Bench+ Octane.Type.Primitive.Int32Bench+ Octane.Type.Primitive.Int64Bench Octane.Type.Primitive.ListBench- Octane.Type.Primitive.PCStringBench Octane.Type.Primitive.StreamBench- Octane.Type.Primitive.Word32LEBench- Octane.Type.Primitive.Word64LEBench+ Octane.Type.Primitive.TextBench Octane.Type.PrimitiveBench Octane.Type.PropertyBench Octane.Type.ReplayBench
package.yaml view
@@ -45,7 +45,9 @@ - containers ==0.5.* - data-binary-ieee754 ==0.4.* - deepseq ==1.4.*+ - scientific ==0.3.* - text ==1.2.*+ - vector ==0.11.* other-modules: Paths_octane source-dirs: library license: MIT@@ -69,4 +71,4 @@ - -with-rtsopts=-N main: TestSuite.hs source-dirs: test-suite-version: '0.9.0'+version: '0.10.0'
test-suite/Octane/Type/ActorSpec.hs view
@@ -17,27 +17,27 @@ \\1\0\0\0\0\ \\0\0\0\0") (Right ("", 9, Actor- (PCString "")- (Word32LE 0)))+ (Text "")+ (Int32 0))) shouldBe (decodeActor "\ \\2\0\0\0a\0\ \\2\0\0\0") (Right ("", 10, Actor- (PCString "a")- (Word32LE 2)))+ (Text "a")+ (Int32 2))) it "can be encoded" $ do shouldBe (Binary.encode (Actor- (PCString "")- (Word32LE 0)))+ (Text "")+ (Int32 0))) "\ \\1\0\0\0\0\ \\0\0\0\0" shouldBe (Binary.encode (Actor- (PCString "a")- (Word32LE 2)))+ (Text "a")+ (Int32 2))) "\ \\2\0\0\0a\0\ \\2\0\0\0"
test-suite/Octane/Type/CacheItemSpec.hs view
@@ -19,9 +19,9 @@ \\0\0\0\0\ \\0\0\0\0") (Right ("", 16, CacheItem- (Word32LE 0)- (Word32LE 0)- (Word32LE 0)+ (Int32 0)+ (Int32 0)+ (Int32 0) (List []))) shouldBe (decodeCacheItem "\@@ -31,16 +31,16 @@ \\1\0\0\0\ \\4\0\0\0\5\0\0\0") (Right ("", 24, CacheItem- (Word32LE 1)- (Word32LE 2)- (Word32LE 3)- (List [CacheProperty (Word32LE 4) (Word32LE 5)])))+ (Int32 1)+ (Int32 2)+ (Int32 3)+ (List [CacheProperty (Int32 4) (Int32 5)]))) it "can be encoded" $ do shouldBe (Binary.encode (CacheItem- (Word32LE 0)- (Word32LE 0)- (Word32LE 0)+ (Int32 0)+ (Int32 0)+ (Int32 0) (List []))) "\ \\0\0\0\0\@@ -49,10 +49,10 @@ \\0\0\0\0" shouldBe (Binary.encode (CacheItem- (Word32LE 1)- (Word32LE 2)- (Word32LE 3)- (List [CacheProperty (Word32LE 4) (Word32LE 5)])))+ (Int32 1)+ (Int32 2)+ (Int32 3)+ (List [CacheProperty (Int32 4) (Int32 5)]))) "\ \\1\0\0\0\ \\2\0\0\0\
test-suite/Octane/Type/CachePropertySpec.hs view
@@ -17,27 +17,27 @@ \\0\0\0\0\ \\0\0\0\0") (Right ("", 8, CacheProperty- (Word32LE 0)- (Word32LE 0)))+ (Int32 0)+ (Int32 0))) shouldBe (decodeCacheProperty "\ \\1\0\0\0\ \\2\0\0\0") (Right ("", 8, CacheProperty- (Word32LE 1)- (Word32LE 2)))+ (Int32 1)+ (Int32 2))) it "can be encoded" $ do shouldBe (Binary.encode (CacheProperty- (Word32LE 0)- (Word32LE 0)))+ (Int32 0)+ (Int32 0))) "\ \\0\0\0\0\ \\0\0\0\0" shouldBe (Binary.encode (CacheProperty- (Word32LE 1)- (Word32LE 2)))+ (Int32 1)+ (Int32 2))) "\ \\1\0\0\0\ \\2\0\0\0"
test-suite/Octane/Type/KeyFrameSpec.hs view
@@ -18,33 +18,33 @@ \\0\0\0\0\ \\0\0\0\0") (Right ("", 12, KeyFrame- (Float32LE 0.0)- (Word32LE 0)- (Word32LE 0)))+ (Float32 0.0)+ (Int32 0)+ (Int32 0))) shouldBe (decodeKeyFrame "\ \\0\0\128\63\ \\2\0\0\0\ \\3\0\0\0") (Right ("", 12, KeyFrame- (Float32LE 1.0)- (Word32LE 2)- (Word32LE 3)))+ (Float32 1.0)+ (Int32 2)+ (Int32 3))) it "can be encoded" $ do shouldBe (Binary.encode (KeyFrame- (Float32LE 0.0)- (Word32LE 0)- (Word32LE 0)))+ (Float32 0.0)+ (Int32 0)+ (Int32 0))) "\ \\0\0\0\0\ \\0\0\0\0\ \\0\0\0\0" shouldBe (Binary.encode (KeyFrame- (Float32LE 1.0)- (Word32LE 2)- (Word32LE 3)))+ (Float32 1.0)+ (Int32 2)+ (Int32 3))) "\ \\0\0\128\63\ \\2\0\0\0\
test-suite/Octane/Type/MarkSpec.hs view
@@ -17,27 +17,27 @@ \\1\0\0\0\0\ \\0\0\0\0") (Right ("", 9, Mark- (PCString "")- (Word32LE 0)))+ (Text "")+ (Int32 0))) shouldBe (decodeMark "\ \\2\0\0\0a\0\ \\1\0\0\0") (Right ("", 10, Mark- (PCString "a")- (Word32LE 1)))+ (Text "a")+ (Int32 1))) it "can be encoded" $ do shouldBe (Binary.encode (Mark- (PCString "")- (Word32LE 0)))+ (Text "")+ (Int32 0))) "\ \\1\0\0\0\0\ \\0\0\0\0" shouldBe (Binary.encode (Mark- (PCString "a")- (Word32LE 1)))+ (Text "a")+ (Int32 1))) "\ \\2\0\0\0a\0\ \\1\0\0\0"
test-suite/Octane/Type/MessageSpec.hs view
@@ -18,27 +18,27 @@ \\1\0\0\0\0\ \\1\0\0\0\0") (Right ("", 14, Message- (Word32LE 0)- (PCString "")- (PCString "")))+ (Int32 0)+ (Text "")+ (Text ""))) shouldBe (decodeMessage "\ \\1\0\0\0\ \\2\0\0\0a\0\ \\2\0\0\0b\0") (Right ("", 16, Message- (Word32LE 1)- (PCString "a")- (PCString "b")))+ (Int32 1)+ (Text "a")+ (Text "b"))) it "can be encoded" $ do shouldBe- (Binary.encode (Message (Word32LE 0) (PCString "") (PCString "")))+ (Binary.encode (Message (Int32 0) (Text "") (Text ""))) "\ \\0\0\0\0\ \\1\0\0\0\0\ \\1\0\0\0\0" shouldBe- (Binary.encode (Message (Word32LE 1) (PCString "a") (PCString "b")))+ (Binary.encode (Message (Int32 1) (Text "a") (Text "b"))) "\ \\1\0\0\0\ \\2\0\0\0a\0\
test-suite/Octane/Type/Primitive/BooleanSpec.hs view
@@ -28,7 +28,7 @@ it "does not raise a runtime error when decoding garbage" $ do shouldBe (decodeBoolean "garbage")- (Left ("arbage", 1, "invalid Boolean value 103"))+ (Left ("arbage", 1, "Unexpected Boolean value 103")) decodeBoolean :: BSL.ByteString -> Either (BSL.ByteString, Binary.ByteOffset, String) (BSL.ByteString, Binary.ByteOffset, Boolean) decodeBoolean = Binary.decodeOrFail
test-suite/Octane/Type/Primitive/DictionarySpec.hs view
@@ -18,19 +18,19 @@ (Right ("", 9, Dictionary Map.empty :: Dictionary Boolean)) shouldBe (decodeDictionary "\6\0\0\0Hello\0\6\0\0\0World\0\5\0\0\0None\0")- (Right ("", 29, Dictionary (Map.singleton (PCString "Hello") (PCString "World"))))+ (Right ("", 29, Dictionary (Map.singleton (Text "Hello") (Text "World")))) shouldBe (decodeDictionary "\7\0\0\0falsey\0\0\7\0\0\0truthy\0\1\5\0\0\0None\0")- (Right ("", 33, Dictionary (Map.fromList [(PCString "truthy", Boolean True), (PCString "falsey", Boolean False)])))+ (Right ("", 33, Dictionary (Map.fromList [(Text "truthy", Boolean True), (Text "falsey", Boolean False)]))) it "can be encoded" $ do shouldBe (Binary.encode (Dictionary Map.empty :: Dictionary Boolean)) "\5\0\0\0None\0" shouldBe- (Binary.encode (Dictionary (Map.singleton (PCString "Hello") (PCString "World"))))+ (Binary.encode (Dictionary (Map.singleton (Text "Hello") (Text "World")))) "\6\0\0\0Hello\0\6\0\0\0World\0\5\0\0\0None\0" shouldBe- (Binary.encode (Dictionary (Map.fromList [(PCString "truthy", Boolean True), (PCString "falsey", Boolean False)])))+ (Binary.encode (Dictionary (Map.fromList [(Text "truthy", Boolean True), (Text "falsey", Boolean False)]))) "\7\0\0\0falsey\0\0\7\0\0\0truthy\0\1\5\0\0\0None\0" decodeDictionary :: (Binary.Binary a) => BSL.ByteString -> Either (BSL.ByteString, Binary.ByteOffset, String) (BSL.ByteString, Binary.ByteOffset, Dictionary a)
− test-suite/Octane/Type/Primitive/Float32LESpec.hs
@@ -1,30 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Octane.Type.Primitive.Float32LESpec (spec) where--import Octane-import Test.Tasty.Hspec--import qualified Data.Binary as Binary-import qualified Data.Binary.Get as Binary-import qualified Data.ByteString.Lazy as BSL--spec :: Spec-spec = describe "Float32LE" $ do- it "can be decoded" $ do- shouldBe- (decodeFloat32LE "\0\0\0\0")- (Right ("", 4, Float32LE 0.0))- shouldBe- (decodeFloat32LE "\0\0\128\63")- (Right ("", 4, Float32LE 1.0))- it "can be encoded" $ do- shouldBe- (Binary.encode (Float32LE 0.0))- "\0\0\0\0"- shouldBe- (Binary.encode (Float32LE 1.0))- "\0\0\128\63"--decodeFloat32LE :: BSL.ByteString -> Either (BSL.ByteString, Binary.ByteOffset, String) (BSL.ByteString, Binary.ByteOffset, Float32LE)-decodeFloat32LE = Binary.decodeOrFail
+ test-suite/Octane/Type/Primitive/Float32Spec.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE OverloadedStrings #-}++module Octane.Type.Primitive.Float32Spec (spec) where++import Octane+import Test.Tasty.Hspec++import qualified Data.Binary as Binary+import qualified Data.Binary.Get as Binary+import qualified Data.ByteString.Lazy as BSL++spec :: Spec+spec = describe "Float32" $ do+ it "can be decoded" $ do+ shouldBe+ (decodeFloat32 "\0\0\0\0")+ (Right ("", 4, Float32 0.0))+ shouldBe+ (decodeFloat32 "\0\0\128\63")+ (Right ("", 4, Float32 1.0))+ it "can be encoded" $ do+ shouldBe+ (Binary.encode (Float32 0.0))+ "\0\0\0\0"+ shouldBe+ (Binary.encode (Float32 1.0))+ "\0\0\128\63"++decodeFloat32 :: BSL.ByteString -> Either (BSL.ByteString, Binary.ByteOffset, String) (BSL.ByteString, Binary.ByteOffset, Float32)+decodeFloat32 = Binary.decodeOrFail
+ test-suite/Octane/Type/Primitive/Int32Spec.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE OverloadedStrings #-}++module Octane.Type.Primitive.Int32Spec (spec) where++import Octane+import Test.Tasty.Hspec++import qualified Data.Binary as Binary+import qualified Data.Binary.Get as Binary+import qualified Data.ByteString.Lazy as BSL++spec :: Spec+spec = describe "Int32" $ do+ it "can be decoded" $ do+ shouldBe+ (decodeInt32 "\0\0\0\0")+ (Right ("", 4, Int32 0))+ shouldBe+ (decodeInt32 "\1\0\0\0")+ (Right ("", 4, Int32 1))+ it "can be encoded" $ do+ shouldBe+ (Binary.encode (Int32 0))+ "\0\0\0\0"+ shouldBe+ (Binary.encode (Int32 1))+ "\1\0\0\0"++decodeInt32 :: BSL.ByteString -> Either (BSL.ByteString, Binary.ByteOffset, String) (BSL.ByteString, Binary.ByteOffset, Int32)+decodeInt32 = Binary.decodeOrFail
+ test-suite/Octane/Type/Primitive/Int64Spec.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE OverloadedStrings #-}++module Octane.Type.Primitive.Int64Spec (spec) where++import Octane+import Test.Tasty.Hspec++import qualified Data.Binary as Binary+import qualified Data.Binary.Get as Binary+import qualified Data.ByteString.Lazy as BSL++spec :: Spec+spec = describe "Int64" $ do+ it "can be decoded" $ do+ shouldBe+ (decodeInt64 "\0\0\0\0\0\0\0\0")+ (Right ("", 8, Int64 0))+ shouldBe+ (decodeInt64 "\1\0\0\0\0\0\0\0")+ (Right ("", 8, Int64 1))+ it "can be encoded" $ do+ shouldBe+ (Binary.encode (Int64 0))+ "\0\0\0\0\0\0\0\0"+ shouldBe+ (Binary.encode (Int64 1))+ "\1\0\0\0\0\0\0\0"++decodeInt64 :: BSL.ByteString -> Either (BSL.ByteString, Binary.ByteOffset, String) (BSL.ByteString, Binary.ByteOffset, Int64)+decodeInt64 = Binary.decodeOrFail
test-suite/Octane/Type/Primitive/ListSpec.hs view
@@ -17,7 +17,7 @@ (Right ("", 4, List [] :: List Boolean)) shouldBe (decodeList "\1\0\0\0\0\0\0\0")- (Right ("", 8, List [Word32LE 0]))+ (Right ("", 8, List [Int32 0])) shouldBe (decodeList "\2\0\0\0\0\1") (Right ("", 6, List [Boolean False, Boolean True]))@@ -26,7 +26,7 @@ (Binary.encode (List [] :: List Boolean)) "\0\0\0\0" shouldBe- (Binary.encode (List [Word32LE 0]))+ (Binary.encode (List [Int32 0])) "\1\0\0\0\0\0\0\0" shouldBe (Binary.encode (List [Boolean False, Boolean True]))
− test-suite/Octane/Type/Primitive/PCStringSpec.hs
@@ -1,40 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Octane.Type.Primitive.PCStringSpec (spec) where--import Octane-import Test.Tasty.Hspec--import qualified Data.Binary as Binary-import qualified Data.Binary.Get as Binary-import qualified Data.ByteString.Lazy as BSL--spec :: Spec-spec = describe "PCString" $ do- it "can be decoded" $ do- shouldBe- (decodePCString "\1\0\0\0\0")- (Right ("", 5, PCString ""))- shouldBe- (decodePCString "\6\0\0\0ascii\0")- (Right ("", 10, PCString "ascii"))- shouldBe- (decodePCString "\8\0\0\0\251\241\239\231\248d\233\0")- (Right ("", 12, PCString "ûñïçødé"))- it "can be encoded" $ do- shouldBe- (Binary.encode (PCString ""))- "\1\0\0\0\0"- shouldBe- (Binary.encode (PCString "ascii"))- "\6\0\0\0ascii\0"- shouldBe- (Binary.encode (PCString "ûñïçødé"))- "\8\0\0\0\251\241\239\231\248d\233\0"- it "does not decode strings of length 0" $ do- shouldBe- (decodePCString "\0\0\0\0")- (Left ("", 4, "invalid PCString size 0"))--decodePCString :: BSL.ByteString -> Either (BSL.ByteString, Binary.ByteOffset, String) (BSL.ByteString, Binary.ByteOffset, PCString)-decodePCString = Binary.decodeOrFail
+ test-suite/Octane/Type/Primitive/TextSpec.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE OverloadedStrings #-}++module Octane.Type.Primitive.TextSpec (spec) where++import Octane+import Test.Tasty.Hspec++import qualified Data.Binary as Binary+import qualified Data.Binary.Get as Binary+import qualified Data.ByteString.Lazy as BSL++spec :: Spec+spec = describe "Text" $ do+ it "can be decoded" $ do+ shouldBe+ (decodeText "\1\0\0\0\0")+ (Right ("", 5, Text ""))+ shouldBe+ (decodeText "\6\0\0\0ascii\0")+ (Right ("", 10, Text "ascii"))+ shouldBe+ (decodeText "\254\255\255\255\24\35\0\0")+ (Right ("", 8, Text "\8984"))+ it "can be encoded" $ do+ shouldBe+ (Binary.encode (Text ""))+ "\1\0\0\0\0"+ shouldBe+ (Binary.encode (Text "ascii"))+ "\6\0\0\0ascii\0"+ shouldBe+ (Binary.encode (Text "\8984"))+ "\254\255\255\255\24\35\0\0"+ it "decodes strings of length 0" $ do+ shouldBe+ (decodeText "\0\0\0\0")+ (Right ("", 4, ""))++decodeText :: BSL.ByteString -> Either (BSL.ByteString, Binary.ByteOffset, String) (BSL.ByteString, Binary.ByteOffset, Text)+decodeText = Binary.decodeOrFail
− test-suite/Octane/Type/Primitive/Word32LESpec.hs
@@ -1,30 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Octane.Type.Primitive.Word32LESpec (spec) where--import Octane-import Test.Tasty.Hspec--import qualified Data.Binary as Binary-import qualified Data.Binary.Get as Binary-import qualified Data.ByteString.Lazy as BSL--spec :: Spec-spec = describe "Word32LE" $ do- it "can be decoded" $ do- shouldBe- (decodeWord32LE "\0\0\0\0")- (Right ("", 4, Word32LE 0))- shouldBe- (decodeWord32LE "\1\0\0\0")- (Right ("", 4, Word32LE 1))- it "can be encoded" $ do- shouldBe- (Binary.encode (Word32LE 0))- "\0\0\0\0"- shouldBe- (Binary.encode (Word32LE 1))- "\1\0\0\0"--decodeWord32LE :: BSL.ByteString -> Either (BSL.ByteString, Binary.ByteOffset, String) (BSL.ByteString, Binary.ByteOffset, Word32LE)-decodeWord32LE = Binary.decodeOrFail
− test-suite/Octane/Type/Primitive/Word64LESpec.hs
@@ -1,30 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Octane.Type.Primitive.Word64LESpec (spec) where--import Octane-import Test.Tasty.Hspec--import qualified Data.Binary as Binary-import qualified Data.Binary.Get as Binary-import qualified Data.ByteString.Lazy as BSL--spec :: Spec-spec = describe "Word64LE" $ do- it "can be decoded" $ do- shouldBe- (decodeWord64LE "\0\0\0\0\0\0\0\0")- (Right ("", 8, Word64LE 0))- shouldBe- (decodeWord64LE "\1\0\0\0\0\0\0\0")- (Right ("", 8, Word64LE 1))- it "can be encoded" $ do- shouldBe- (Binary.encode (Word64LE 0))- "\0\0\0\0\0\0\0\0"- shouldBe- (Binary.encode (Word64LE 1))- "\1\0\0\0\0\0\0\0"--decodeWord64LE :: BSL.ByteString -> Either (BSL.ByteString, Binary.ByteOffset, String) (BSL.ByteString, Binary.ByteOffset, Word64LE)-decodeWord64LE = Binary.decodeOrFail
test-suite/Octane/Type/PrimitiveSpec.hs view
@@ -4,20 +4,20 @@ import qualified Octane.Type.Primitive.BooleanSpec import qualified Octane.Type.Primitive.DictionarySpec-import qualified Octane.Type.Primitive.Float32LESpec+import qualified Octane.Type.Primitive.Float32Spec import qualified Octane.Type.Primitive.ListSpec-import qualified Octane.Type.Primitive.PCStringSpec+import qualified Octane.Type.Primitive.TextSpec import qualified Octane.Type.Primitive.StreamSpec-import qualified Octane.Type.Primitive.Word32LESpec-import qualified Octane.Type.Primitive.Word64LESpec+import qualified Octane.Type.Primitive.Int32Spec+import qualified Octane.Type.Primitive.Int64Spec spec :: Spec spec = describe "Primitive" $ do Octane.Type.Primitive.BooleanSpec.spec Octane.Type.Primitive.DictionarySpec.spec- Octane.Type.Primitive.Float32LESpec.spec+ Octane.Type.Primitive.Float32Spec.spec Octane.Type.Primitive.ListSpec.spec- Octane.Type.Primitive.PCStringSpec.spec+ Octane.Type.Primitive.TextSpec.spec Octane.Type.Primitive.StreamSpec.spec- Octane.Type.Primitive.Word32LESpec.spec- Octane.Type.Primitive.Word64LESpec.spec+ Octane.Type.Primitive.Int32Spec.spec+ Octane.Type.Primitive.Int64Spec.spec
test-suite/Octane/Type/PropertySpec.hs view
@@ -20,19 +20,19 @@ \\0\0\0\0\0\0\0\0\ \\0\0\0\0") (Right ("", 30, ArrayProperty- (Word64LE 0)+ (Int64 0) (List []))) shouldBe (decodeProperty "\ \\14\0\0\0ArrayProperty\0\ \\1\0\0\0\0\0\0\0\1\0\0\0\2\0\0\0a\0\13\0\0\0BoolProperty\0\2\0\0\0\0\0\0\0\1\5\0\0\0None\0") (Right ("", 71, ArrayProperty- (Word64LE 1)- (List [Dictionary (Map.singleton (PCString "a") (BoolProperty (Word64LE 2) (Boolean True)))])))+ (Int64 1)+ (List [Dictionary (Map.singleton (Text "a") (BoolProperty (Int64 2) (Boolean True)))]))) it "can be encoded" $ do shouldBe (Binary.encode (ArrayProperty- (Word64LE 0)+ (Int64 0) (List []))) "\ \\14\0\0\0ArrayProperty\0\@@ -40,8 +40,8 @@ \\0\0\0\0" shouldBe (Binary.encode (ArrayProperty- (Word64LE 1)- (List [Dictionary (Map.singleton (PCString "a") (BoolProperty (Word64LE 2) (Boolean True)))])))+ (Int64 1)+ (List [Dictionary (Map.singleton (Text "a") (BoolProperty (Int64 2) (Boolean True)))]))) "\ \\14\0\0\0ArrayProperty\0\ \\1\0\0\0\0\0\0\0\1\0\0\0\2\0\0\0a\0\13\0\0\0BoolProperty\0\2\0\0\0\0\0\0\0\1\5\0\0\0None\0"@@ -53,7 +53,7 @@ \\0\0\0\0\0\0\0\0\ \\0") (Right ("", 26, BoolProperty- (Word64LE 0)+ (Int64 0) (Boolean False))) shouldBe (decodeProperty "\@@ -61,12 +61,12 @@ \\1\0\0\0\0\0\0\0\ \\1") (Right ("", 26, BoolProperty- (Word64LE 1)+ (Int64 1) (Boolean True))) it "can be encoded" $ do shouldBe (Binary.encode (BoolProperty- (Word64LE 0)+ (Int64 0) (Boolean False))) "\ \\13\0\0\0BoolProperty\0\@@ -74,7 +74,7 @@ \\0" shouldBe (Binary.encode (BoolProperty- (Word64LE 1)+ (Int64 1) (Boolean True))) "\ \\13\0\0\0BoolProperty\0\@@ -88,29 +88,29 @@ \\0\0\0\0\0\0\0\0\ \\1\0\0\0\0\1\0\0\0\0") (Right ("", 35, ByteProperty- (Word64LE 0)- (PCString "", PCString "")))+ (Int64 0)+ (Text "", Text ""))) shouldBe (decodeProperty "\ \\13\0\0\0ByteProperty\0\ \\1\0\0\0\0\0\0\0\ \\2\0\0\0a\0\2\0\0\0b\0") (Right ("", 37, ByteProperty- (Word64LE 1)- (PCString "a", PCString "b")))+ (Int64 1)+ (Text "a", Text "b"))) it "can be encoded" $ do shouldBe (Binary.encode (ByteProperty- (Word64LE 0)- (PCString "", PCString "")))+ (Int64 0)+ (Text "", Text ""))) "\ \\13\0\0\0ByteProperty\0\ \\0\0\0\0\0\0\0\0\ \\1\0\0\0\0\1\0\0\0\0" shouldBe (Binary.encode (ByteProperty- (Word64LE 1)- (PCString "a", PCString "b")))+ (Int64 1)+ (Text "a", Text "b"))) "\ \\13\0\0\0ByteProperty\0\ \\1\0\0\0\0\0\0\0\@@ -123,29 +123,29 @@ \\4\0\0\0\0\0\0\0\ \\0\0\0\0") (Right ("", 30, FloatProperty- (Word64LE 4)- (Float32LE 0.0)))+ (Int64 4)+ (Float32 0.0))) shouldBe (decodeProperty "\ \\14\0\0\0FloatProperty\0\ \\4\0\0\0\0\0\0\0\ \\0\0\128\63") (Right ("", 30, FloatProperty- (Word64LE 4)- (Float32LE 1.0)))+ (Int64 4)+ (Float32 1.0))) it "can be encoded" $ do shouldBe (Binary.encode (FloatProperty- (Word64LE 4)- (Float32LE 0.0)))+ (Int64 4)+ (Float32 0.0))) "\ \\14\0\0\0FloatProperty\0\ \\4\0\0\0\0\0\0\0\ \\0\0\0\0" shouldBe (Binary.encode (FloatProperty- (Word64LE 4)- (Float32LE 1.0)))+ (Int64 4)+ (Float32 1.0))) "\ \\14\0\0\0FloatProperty\0\ \\4\0\0\0\0\0\0\0\@@ -164,29 +164,29 @@ \\4\0\0\0\0\0\0\0\ \\0\0\0\0") (Right ("", 28, IntProperty- (Word64LE 4)- (Word32LE 0)))+ (Int64 4)+ (Int32 0))) shouldBe (decodeProperty "\ \\12\0\0\0IntProperty\0\ \\4\0\0\0\0\0\0\0\ \\1\0\0\0") (Right ("", 28, IntProperty- (Word64LE 4)- (Word32LE 1)))+ (Int64 4)+ (Int32 1))) it "can be encoded" $ do shouldBe (Binary.encode (IntProperty- (Word64LE 4)- (Word32LE 0)))+ (Int64 4)+ (Int32 0))) "\ \\12\0\0\0IntProperty\0\ \\4\0\0\0\0\0\0\0\ \\0\0\0\0" shouldBe (Binary.encode (IntProperty- (Word64LE 4)- (Word32LE 1)))+ (Int64 4)+ (Int32 1))) "\ \\12\0\0\0IntProperty\0\ \\4\0\0\0\0\0\0\0\@@ -205,29 +205,29 @@ \\0\0\0\0\0\0\0\0\ \\1\0\0\0\0") (Right ("", 30, NameProperty- (Word64LE 0)- (PCString "")))+ (Int64 0)+ (Text ""))) shouldBe (decodeProperty "\ \\13\0\0\0NameProperty\0\ \\1\0\0\0\0\0\0\0\ \\2\0\0\0a\0") (Right ("", 31, NameProperty- (Word64LE 1)- (PCString "a")))+ (Int64 1)+ (Text "a"))) it "can be encoded" $ do shouldBe (Binary.encode (NameProperty- (Word64LE 0)- (PCString "")))+ (Int64 0)+ (Text ""))) "\ \\13\0\0\0NameProperty\0\ \\0\0\0\0\0\0\0\0\ \\1\0\0\0\0" shouldBe (Binary.encode (NameProperty- (Word64LE 1)- (PCString "a")))+ (Int64 1)+ (Text "a"))) "\ \\13\0\0\0NameProperty\0\ \\1\0\0\0\0\0\0\0\@@ -240,29 +240,29 @@ \\8\0\0\0\0\0\0\0\ \\0\0\0\0\0\0\0\0") (Right ("", 34, QWordProperty- (Word64LE 8)- (Word64LE 0)))+ (Int64 8)+ (Int64 0))) shouldBe (decodeProperty "\ \\14\0\0\0QWordProperty\0\ \\8\0\0\0\0\0\0\0\ \\2\0\0\0\0\0\0\0") (Right ("", 34, QWordProperty- (Word64LE 8)- (Word64LE 2)))+ (Int64 8)+ (Int64 2))) it "can be encoded" $ do shouldBe (Binary.encode (QWordProperty- (Word64LE 8)- (Word64LE 0)))+ (Int64 8)+ (Int64 0))) "\ \\14\0\0\0QWordProperty\0\ \\8\0\0\0\0\0\0\0\ \\0\0\0\0\0\0\0\0" shouldBe (Binary.encode (QWordProperty- (Word64LE 8)- (Word64LE 2)))+ (Int64 8)+ (Int64 2))) "\ \\14\0\0\0QWordProperty\0\ \\8\0\0\0\0\0\0\0\@@ -279,29 +279,29 @@ \\0\0\0\0\0\0\0\0\ \\1\0\0\0\0") (Right ("", 29, StrProperty- (Word64LE 0)- (PCString "")))+ (Int64 0)+ (Text ""))) shouldBe (decodeProperty "\ \\12\0\0\0StrProperty\0\ \\1\0\0\0\0\0\0\0\ \\2\0\0\0a\0") (Right ("", 30, StrProperty- (Word64LE 1)- (PCString "a")))+ (Int64 1)+ (Text "a"))) it "can be encoded" $ do shouldBe (Binary.encode (StrProperty- (Word64LE 0)- (PCString "")))+ (Int64 0)+ (Text ""))) "\ \\12\0\0\0StrProperty\0\ \\0\0\0\0\0\0\0\0\ \\1\0\0\0\0" shouldBe (Binary.encode (StrProperty- (Word64LE 1)- (PCString "a")))+ (Int64 1)+ (Text "a"))) "\ \\12\0\0\0StrProperty\0\ \\1\0\0\0\0\0\0\0\
test-suite/Octane/Type/ReplaySpec.hs view
@@ -15,14 +15,14 @@ it "can be decoded" $ do shouldBe (decodeReplay "\- \\0\0\0\0\- \\0\0\0\0\+ \\x16\x00\x00\x00\+ \\xc5\x30\xa7\xe2\ \\0\0\0\0\ \\0\0\0\0\ \\1\0\0\0\0\ \\5\0\0\0None\0\- \\0\0\0\0\- \\0\0\0\0\+ \\x28\x00\x00\x00\+ \\xf5\x9a\x89\x13\ \\0\0\0\0\ \\0\0\0\0\ \\0\0\0\0\@@ -34,14 +34,14 @@ \\0\0\0\0\ \\0\0\0\0") (Right ("", 78, Replay- (Word32LE 0)- (Word32LE 0)- (Word32LE 0)- (Word32LE 0)- (PCString "")+ (Word32 22)+ (Word32 3802607813)+ (Int32 0)+ (Int32 0)+ (Text "") (Dictionary Map.empty)- (Word32LE 0)- (Word32LE 0)+ (Word32 40)+ (Word32 327785205) (List []) (List []) (Stream "")@@ -55,14 +55,14 @@ it "can be encoded" $ do shouldBe (Binary.encode (Replay- (Word32LE 0)- (Word32LE 0)- (Word32LE 0)- (Word32LE 0)- (PCString "")+ (Word32 0)+ (Word32 0)+ (Int32 0)+ (Int32 0)+ (Text "") (Dictionary Map.empty)- (Word32LE 0)- (Word32LE 0)+ (Word32 0)+ (Word32 0) (List []) (List []) (Stream "")