diff --git a/LICENSE.md b/LICENSE.md new file mode 100644 --- /dev/null +++ b/LICENSE.md @@ -0,0 +1,23 @@ +[The MIT License (MIT)][] + +Copyright (c) 2016 Taylor Fausak + +Permission is hereby granted, free of charge, to any person obtaining a copy of +this software and associated documentation files (the "Software"), to deal in +the Software without restriction, including without limitation the rights to +use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies +of the Software, and to permit persons to whom the Software is furnished to do +so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. + +[The MIT License (MIT)]: http://opensource.org/licenses/MIT diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -6,13 +6,11 @@ Octane parses [Rocket League][] replays. -## Usage - -1. Install [Stack][]. - -2. `stack --resolver nightly install octane` +To use Octane, first download and unpack the [latest release][] for your +operating system. Then run `octane path-to/the.replay`. -3. `stack exec octane path/to.replay` +The [Rocket League Replays wiki][] has links to other Rocket League replay +parsers. [Octane]: https://github.com/tfausak/octane [Version badge]: https://www.stackage.org/package/octane/badge/nightly?label=version @@ -21,5 +19,6 @@ [windows build]: https://ci.appveyor.com/project/TaylorFausak/octane [Build badge]: https://travis-ci.org/tfausak/octane.svg?branch=main [build]: https://travis-ci.org/tfausak/octane -[Rocket League]: http://rocketleague.psyonix.com -[Stack]: http://haskellstack.org +[Rocket League]: http://www.rocketleaguegame.com +[latest release]: https://github.com/tfausak/octane/releases/latest +[Rocket League Replays wiki]: https://github.com/rocket-league-replays/rocket-league-replays/wiki/Rocket-League-Replay-Parsers diff --git a/benchmark/Octane/Type/ActorBench.hs b/benchmark/Octane/Type/ActorBench.hs --- a/benchmark/Octane/Type/ActorBench.hs +++ b/benchmark/Octane/Type/ActorBench.hs @@ -3,10 +3,11 @@ module Octane.Type.ActorBench (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 -import Octane benchmarks :: Benchmark benchmarks = bgroup "Actor" diff --git a/benchmark/Octane/Type/CacheItemBench.hs b/benchmark/Octane/Type/CacheItemBench.hs --- a/benchmark/Octane/Type/CacheItemBench.hs +++ b/benchmark/Octane/Type/CacheItemBench.hs @@ -3,10 +3,11 @@ module Octane.Type.CacheItemBench (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 -import Octane benchmarks :: Benchmark benchmarks = bgroup "CacheItem" diff --git a/benchmark/Octane/Type/CachePropertyBench.hs b/benchmark/Octane/Type/CachePropertyBench.hs --- a/benchmark/Octane/Type/CachePropertyBench.hs +++ b/benchmark/Octane/Type/CachePropertyBench.hs @@ -3,10 +3,11 @@ module Octane.Type.CachePropertyBench (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 -import Octane benchmarks :: Benchmark benchmarks = bgroup "CacheProperty" diff --git a/benchmark/Octane/Type/FrameBench.hs b/benchmark/Octane/Type/FrameBench.hs deleted file mode 100644 --- a/benchmark/Octane/Type/FrameBench.hs +++ /dev/null @@ -1,30 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Octane.Type.FrameBench (benchmarks) where - -import Criterion -import qualified Data.Binary.Bits as Bits -import qualified Data.Binary.Bits.Get as Bits -import qualified Data.Binary.Bits.Put as Bits -import qualified Data.Binary.Get as Binary -import qualified Data.Binary.Put as Binary -import qualified Data.ByteString.Lazy as BSL -import Octane - -benchmarks :: Benchmark -benchmarks = bgroup "Frame" - [ bench "decode basic" (nf decodeFrame "\ - \\0\0\0\0\ - \\0\0\0\0\ - \\0") - , bench "encode basic" (nf encodeFrame (Frame - (Float32LE 0.0) - (Float32LE 0.0) - [])) - ] - -decodeFrame :: BSL.ByteString -> Either (BSL.ByteString, Binary.ByteOffset, String) (BSL.ByteString, Binary.ByteOffset, Frame) -decodeFrame bytes = Binary.runGetOrFail (Bits.runBitGet (Bits.getBits undefined)) bytes - -encodeFrame :: Frame -> BSL.ByteString -encodeFrame frame = Binary.runPut (Bits.runBitPut (Bits.putBits undefined frame)) diff --git a/benchmark/Octane/Type/KeyFrameBench.hs b/benchmark/Octane/Type/KeyFrameBench.hs --- a/benchmark/Octane/Type/KeyFrameBench.hs +++ b/benchmark/Octane/Type/KeyFrameBench.hs @@ -3,10 +3,11 @@ module Octane.Type.KeyFrameBench (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 -import Octane benchmarks :: Benchmark benchmarks = bgroup "KeyFrame" diff --git a/benchmark/Octane/Type/MarkBench.hs b/benchmark/Octane/Type/MarkBench.hs --- a/benchmark/Octane/Type/MarkBench.hs +++ b/benchmark/Octane/Type/MarkBench.hs @@ -3,10 +3,11 @@ module Octane.Type.MarkBench (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 -import Octane benchmarks :: Benchmark benchmarks = bgroup "Mark" diff --git a/benchmark/Octane/Type/MessageBench.hs b/benchmark/Octane/Type/MessageBench.hs --- a/benchmark/Octane/Type/MessageBench.hs +++ b/benchmark/Octane/Type/MessageBench.hs @@ -3,10 +3,11 @@ module Octane.Type.MessageBench (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 -import Octane benchmarks :: Benchmark benchmarks = bgroup "Message" diff --git a/benchmark/Octane/Type/Primitive/BooleanBench.hs b/benchmark/Octane/Type/Primitive/BooleanBench.hs --- a/benchmark/Octane/Type/Primitive/BooleanBench.hs +++ b/benchmark/Octane/Type/Primitive/BooleanBench.hs @@ -3,10 +3,11 @@ module Octane.Type.Primitive.BooleanBench (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 -import Octane benchmarks :: Benchmark benchmarks = bgroup "Boolean" diff --git a/benchmark/Octane/Type/Primitive/DictionaryBench.hs b/benchmark/Octane/Type/Primitive/DictionaryBench.hs --- a/benchmark/Octane/Type/Primitive/DictionaryBench.hs +++ b/benchmark/Octane/Type/Primitive/DictionaryBench.hs @@ -3,11 +3,12 @@ module Octane.Type.Primitive.DictionaryBench (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 import qualified Data.Map as Map -import Octane benchmarks :: Benchmark benchmarks = bgroup "Dictionary" diff --git a/benchmark/Octane/Type/Primitive/Float32LEBench.hs b/benchmark/Octane/Type/Primitive/Float32LEBench.hs --- a/benchmark/Octane/Type/Primitive/Float32LEBench.hs +++ b/benchmark/Octane/Type/Primitive/Float32LEBench.hs @@ -3,10 +3,11 @@ 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 -import Octane benchmarks :: Benchmark benchmarks = bgroup "Float32LE" diff --git a/benchmark/Octane/Type/Primitive/ListBench.hs b/benchmark/Octane/Type/Primitive/ListBench.hs --- a/benchmark/Octane/Type/Primitive/ListBench.hs +++ b/benchmark/Octane/Type/Primitive/ListBench.hs @@ -3,10 +3,11 @@ module Octane.Type.Primitive.ListBench (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 -import Octane benchmarks :: Benchmark benchmarks = bgroup "List" diff --git a/benchmark/Octane/Type/Primitive/PCStringBench.hs b/benchmark/Octane/Type/Primitive/PCStringBench.hs --- a/benchmark/Octane/Type/Primitive/PCStringBench.hs +++ b/benchmark/Octane/Type/Primitive/PCStringBench.hs @@ -3,10 +3,11 @@ 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 -import Octane benchmarks :: Benchmark benchmarks = bgroup "PCString" diff --git a/benchmark/Octane/Type/Primitive/StreamBench.hs b/benchmark/Octane/Type/Primitive/StreamBench.hs --- a/benchmark/Octane/Type/Primitive/StreamBench.hs +++ b/benchmark/Octane/Type/Primitive/StreamBench.hs @@ -3,10 +3,11 @@ module Octane.Type.Primitive.StreamBench (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 -import Octane benchmarks :: Benchmark benchmarks = bgroup "Stream" diff --git a/benchmark/Octane/Type/Primitive/Word32LEBench.hs b/benchmark/Octane/Type/Primitive/Word32LEBench.hs --- a/benchmark/Octane/Type/Primitive/Word32LEBench.hs +++ b/benchmark/Octane/Type/Primitive/Word32LEBench.hs @@ -3,10 +3,11 @@ 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 -import Octane benchmarks :: Benchmark benchmarks = bgroup "Word32LE" diff --git a/benchmark/Octane/Type/Primitive/Word64LEBench.hs b/benchmark/Octane/Type/Primitive/Word64LEBench.hs --- a/benchmark/Octane/Type/Primitive/Word64LEBench.hs +++ b/benchmark/Octane/Type/Primitive/Word64LEBench.hs @@ -3,10 +3,11 @@ 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 -import Octane benchmarks :: Benchmark benchmarks = bgroup "Word64LE" diff --git a/benchmark/Octane/Type/PrimitiveBench.hs b/benchmark/Octane/Type/PrimitiveBench.hs --- a/benchmark/Octane/Type/PrimitiveBench.hs +++ b/benchmark/Octane/Type/PrimitiveBench.hs @@ -1,6 +1,7 @@ module Octane.Type.PrimitiveBench (benchmarks) where import Criterion + import qualified Octane.Type.Primitive.BooleanBench import qualified Octane.Type.Primitive.DictionaryBench import qualified Octane.Type.Primitive.Float32LEBench diff --git a/benchmark/Octane/Type/PropertyBench.hs b/benchmark/Octane/Type/PropertyBench.hs --- a/benchmark/Octane/Type/PropertyBench.hs +++ b/benchmark/Octane/Type/PropertyBench.hs @@ -3,10 +3,11 @@ module Octane.Type.PropertyBench (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 -import Octane benchmarks :: Benchmark benchmarks = bgroup "Property" diff --git a/benchmark/Octane/Type/ReplayBench.hs b/benchmark/Octane/Type/ReplayBench.hs --- a/benchmark/Octane/Type/ReplayBench.hs +++ b/benchmark/Octane/Type/ReplayBench.hs @@ -3,11 +3,12 @@ module Octane.Type.ReplayBench (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 import qualified Data.Map as Map -import Octane benchmarks :: Benchmark benchmarks = bgroup "Replay" diff --git a/benchmark/Octane/TypeBench.hs b/benchmark/Octane/TypeBench.hs --- a/benchmark/Octane/TypeBench.hs +++ b/benchmark/Octane/TypeBench.hs @@ -1,10 +1,10 @@ module Octane.TypeBench (benchmarks) where import Criterion + import qualified Octane.Type.ActorBench import qualified Octane.Type.CacheItemBench import qualified Octane.Type.CachePropertyBench -import qualified Octane.Type.FrameBench import qualified Octane.Type.KeyFrameBench import qualified Octane.Type.MarkBench import qualified Octane.Type.MessageBench @@ -17,7 +17,6 @@ [ Octane.Type.ActorBench.benchmarks , Octane.Type.CacheItemBench.benchmarks , Octane.Type.CachePropertyBench.benchmarks - , Octane.Type.FrameBench.benchmarks , Octane.Type.KeyFrameBench.benchmarks , Octane.Type.MarkBench.benchmarks , Octane.Type.MessageBench.benchmarks diff --git a/benchmark/OctaneBench.hs b/benchmark/OctaneBench.hs --- a/benchmark/OctaneBench.hs +++ b/benchmark/OctaneBench.hs @@ -1,6 +1,7 @@ module OctaneBench (benchmarks) where import Criterion + import qualified Octane.MainBench import qualified Octane.TypeBench diff --git a/library/Octane.hs b/library/Octane.hs --- a/library/Octane.hs +++ b/library/Octane.hs @@ -1,7 +1,1 @@ -module Octane - ( module Octane.Main - , module Octane.Type - ) where - -import Octane.Main -import Octane.Type +{-# OPTIONS_GHC -F -pgmF autoexporter #-} diff --git a/library/Octane/Core.hs b/library/Octane/Core.hs deleted file mode 100644 --- a/library/Octane/Core.hs +++ /dev/null @@ -1,27 +0,0 @@ -module Octane.Core - ( module Control.DeepSeq - , module Data.Binary - , module Data.Binary.Bits - , module Data.Binary.Bits.Get - , module Data.Binary.Bits.Put - , module Data.ByteString - , module Data.Function - , module Data.IntMap - , module Data.Map - , module Data.Text - , module Data.Word - , module GHC.Generics - ) where - -import Control.DeepSeq (NFData) -import Data.Binary (Binary, Get, Put, get, put) -import Data.Binary.Bits (BinaryBit, getBits, putBits) -import Data.Binary.Bits.Get (BitGet) -import Data.Binary.Bits.Put (BitPut) -import Data.ByteString (ByteString) -import Data.Function ((&)) -import Data.IntMap (IntMap) -import Data.Map (Map) -import Data.Text (Text) -import Data.Word (Word32, Word64) -import GHC.Generics (Generic) diff --git a/library/Octane/Main.hs b/library/Octane/Main.hs --- a/library/Octane/Main.hs +++ b/library/Octane/Main.hs @@ -1,12 +1,15 @@ module Octane.Main (main) where import qualified Control.Monad as Monad +import qualified Data.Aeson.Encode.Pretty as Aeson import qualified Data.Binary as Binary import qualified Data.Binary.Get as Binary import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL -import Octane.Core -import Octane.Type +import qualified Data.ByteString.Lazy.Char8 as BSL8 +import Data.Function ((&)) +import qualified Octane.Parser as Parser +import qualified Octane.Type as Type import qualified System.Environment as Environment import qualified System.IO as IO @@ -17,13 +20,29 @@ results <- mapM Binary.decodeFileOrFail files mapM_ debug (zip3 files contents results) -debug :: (String, ByteString, Either (Binary.ByteOffset, String) Replay) -> IO () -debug (file, contents, result) = case result of - Left (offset, message) -> IO.hPutStrLn IO.stderr - (file ++ " @ byte " ++ show offset ++ " - " ++ message) - Right replay -> do - let inputSize = contents & BS.length & fromIntegral - let outputSize = replay & Binary.encode & BSL.length - Monad.when (inputSize /= outputSize) $ do - IO.hPutStrLn IO.stderr ("input size (" ++ show inputSize ++ ") not equal to output size (" ++ show outputSize ++ ")!") - print replay +debug :: (String, BS.ByteString, Either (Binary.ByteOffset, String) Type.Replay) + -> IO () +debug (file,contents,result) = + case result of + Left (offset,message) -> + IO.hPutStrLn + IO.stderr + (file ++ " @ byte " ++ show offset ++ " - " ++ message) + Right replay -> do + let inputSize = contents & BS.length & fromIntegral + let outputSize = replay & Binary.encode & BSL.length + Monad.when (inputSize /= outputSize) $ + do IO.hPutStrLn + IO.stderr + ("input size (" ++ + show inputSize ++ + ") not equal to output size (" ++ + show outputSize ++ ")!") + let config = + Aeson.defConfig + { Aeson.confCompare = compare + } + replay & Aeson.encodePretty' config & BSL8.putStrLn + let frames = Parser.parseFrames replay + let frame = take 1 frames + print frame diff --git a/library/Octane/Parser.hs b/library/Octane/Parser.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Parser.hs @@ -0,0 +1,143 @@ +module Octane.Parser where + +import qualified Control.Newtype as Newtype +import qualified Data.Binary.Bits.Get as Bits +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 Data.Function ((&)) +import qualified Octane.Type as Type + +parseFrames :: Type.Replay -> [Type.Frame] +parseFrames replay = + Binary.runGet + (replay & extractContext & getFrames & Bits.runBitGet) + (replay & Type.replayStream & Newtype.unpack & BSL.fromStrict) + +-- TODO: This will need at least the actors and cache items. +data Context = Context + { + } + +extractContext :: Type.Replay -> Context +extractContext _replay = + Context + { + } + +getFrames :: Context -> Bits.BitGet [Type.Frame] +getFrames context = do + maybeFrame <- getFrame context + case maybeFrame of + Nothing -> return [] + Just frame -> do + frames <- getFrames context + return (frame : frames) + +getFrame :: Context -> Bits.BitGet (Maybe Type.Frame) +getFrame context = do + -- TODO: Convert time bytes into a float. + time <- Bits.getByteString 32 + -- TODO: Convert delta bytes into a float. + delta <- Bits.getByteString 32 + if BS.all (== 0) time && BS.all (== 0) delta + then return Nothing + else do + replications <- getReplications context + let frame = + Type.Frame + { Type.frameTime = time + , Type.frameDelta = delta + , Type.frameReplications = replications + } + return (Just frame) + +getReplications :: Context -> Bits.BitGet [Type.Replication] +getReplications context = do + (context',maybeReplication) <- getReplication context + case maybeReplication of + Nothing -> return [] + Just replication -> do + replications <- getReplications context' + return (replication : replications) + +getReplication :: Context -> Bits.BitGet (Context, Maybe Type.Replication) +getReplication context = do + hasReplication <- Bits.getBool + if not hasReplication + then return (context, Nothing) + else do + -- TODO: Convert actor ID into an integer. + actorId <- Bits.getByteString (bitSize maxChannels) + isOpen <- Bits.getBool + if isOpen + then do + isNew <- Bits.getBool + if isNew + then do + _unknownFlag <- Bits.getBool + _objectId <- getInt 32 + -- TODO: Parse new actor. + return + ( context + , Just + (Type.Replication + { Type.replicationActorId = actorId + , Type.replicationIsOpen = isOpen + , Type.replicationIsNew = Just isNew + })) + else do + -- TODO: Parse existing actor. + return + ( context + , Just + (Type.Replication + { Type.replicationActorId = actorId + , Type.replicationIsOpen = isOpen + , Type.replicationIsNew = Just isNew + })) + else return + ( context + , Just + (Type.Replication + { Type.replicationActorId = actorId + , Type.replicationIsOpen = isOpen + , Type.replicationIsNew = Nothing + })) + +maxChannels + :: (Integral a) + => a +maxChannels = 1024 + +bitSize + :: (Integral a) + => a -> a +bitSize x = x & fromIntegral & logBase (2 :: Double) & ceiling + +-- Reads an integer bitwise. The bits of the integer are backwards, so the +-- least significant bit is first. The argument is the maximum value this +-- integer can have. Bits will be read until the next bit would be greater than +-- the maximum value, or the number of bits necessary to reach the maximum +-- value has been reached, whichever comes first. +-- +-- For example, if the maximum value is 4 and "11" has been read already, +-- nothing more will be read because another "1" would put the value over the +-- maximum. +getInt + :: Int -> Bits.BitGet Int +getInt maxValue = do + let maxBits = bitSize maxValue + go i value = do + let x = Bits.shiftL 1 i + if i < maxBits && value + x <= maxValue + then do + bit <- Bits.getBool + let newValue = + if bit + then value + x + else value + go (i + 1) newValue + else return value + go 0 0 diff --git a/library/Octane/Type.hs b/library/Octane/Type.hs --- a/library/Octane/Type.hs +++ b/library/Octane/Type.hs @@ -1,25 +1,1 @@ -module Octane.Type - ( module Octane.Type.Actor - , module Octane.Type.CacheItem - , module Octane.Type.CacheProperty - , module Octane.Type.Frame - , module Octane.Type.KeyFrame - , module Octane.Type.Mark - , module Octane.Type.Message - , module Octane.Type.Primitive - , module Octane.Type.Property - , module Octane.Type.Replay - , module Octane.Type.Replication - ) where - -import Octane.Type.Actor -import Octane.Type.CacheItem -import Octane.Type.CacheProperty -import Octane.Type.Frame -import Octane.Type.KeyFrame -import Octane.Type.Mark -import Octane.Type.Message -import Octane.Type.Primitive -import Octane.Type.Property -import Octane.Type.Replay -import Octane.Type.Replication +{-# OPTIONS_GHC -F -pgmF autoexporter #-} diff --git a/library/Octane/Type/Actor.hs b/library/Octane/Type/Actor.hs --- a/library/Octane/Type/Actor.hs +++ b/library/Octane/Type/Actor.hs @@ -1,26 +1,31 @@ -{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} module Octane.Type.Actor (Actor(..)) where -import Octane.Core -import Octane.Type.Primitive.PCString -import Octane.Type.Primitive.Word32LE +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson.Types as Aeson +import qualified Data.Binary as Binary +import Data.Function ((&)) +import qualified GHC.Generics as Generics +import qualified Octane.Type.Primitive.PCString as PCString +import qualified Octane.Type.Primitive.Word32LE as Word32LE data Actor = Actor - { actorName :: PCString - , actorTag :: Word32LE - } deriving (Eq, Generic, NFData, Show) - -instance Binary Actor where - get = do - name <- get - tag <- get - return Actor - { actorName = name - , actorTag = tag - } + { actorName :: PCString.PCString + , actorTag :: Word32LE.Word32LE + } deriving (Eq,Generics.Generic,Show) +instance Binary.Binary Actor where + get = Actor <$> Binary.get <*> Binary.get put actor = do - actor & actorName & put - actor & actorTag & put + actor & actorName & Binary.put + actor & actorTag & Binary.put + +instance DeepSeq.NFData Actor + +instance Aeson.ToJSON Actor where + toJSON = + Aeson.genericToJSON + Aeson.defaultOptions + { Aeson.fieldLabelModifier = drop 5 + } diff --git a/library/Octane/Type/CacheItem.hs b/library/Octane/Type/CacheItem.hs --- a/library/Octane/Type/CacheItem.hs +++ b/library/Octane/Type/CacheItem.hs @@ -1,35 +1,36 @@ -{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} module Octane.Type.CacheItem (CacheItem(..)) where -import Octane.Core -import Octane.Type.CacheProperty -import Octane.Type.Primitive.List -import Octane.Type.Primitive.Word32LE +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson.Types as Aeson +import qualified Data.Binary as Binary +import Data.Function ((&)) +import qualified GHC.Generics as Generics +import qualified Octane.Type.CacheProperty as CacheProperty +import qualified Octane.Type.Primitive.List as List +import qualified Octane.Type.Primitive.Word32LE as Word32LE data CacheItem = CacheItem - { cacheItemTag :: Word32LE - , cacheItemStart :: Word32LE - , cacheItemEnd :: Word32LE - , cacheItemCacheProperties :: List CacheProperty - } deriving (Eq, Generic, NFData, Show) - -instance Binary CacheItem where - get = do - tag <- get - start <- get - end <- get - cacheProperties <- get - return CacheItem - { cacheItemTag = tag - , cacheItemStart = start - , cacheItemEnd = end - , cacheItemCacheProperties = cacheProperties - } + { cacheItemTag :: Word32LE.Word32LE + , cacheItemStart :: Word32LE.Word32LE + , cacheItemEnd :: Word32LE.Word32LE + , cacheItemCacheProperties :: List.List CacheProperty.CacheProperty + } deriving (Eq,Generics.Generic,Show) +instance Binary.Binary CacheItem where + get = CacheItem <$> Binary.get <*> Binary.get <*> Binary.get <*> Binary.get put cacheItem = do - cacheItem & cacheItemTag & put - cacheItem & cacheItemStart & put - cacheItem & cacheItemEnd & put - cacheItem & cacheItemCacheProperties & put + cacheItem & cacheItemTag & Binary.put + cacheItem & cacheItemStart & Binary.put + cacheItem & cacheItemEnd & Binary.put + cacheItem & cacheItemCacheProperties & Binary.put + +instance DeepSeq.NFData CacheItem + +instance Aeson.ToJSON CacheItem where + toJSON = + Aeson.genericToJSON + Aeson.defaultOptions + { Aeson.fieldLabelModifier = drop 9 + } diff --git a/library/Octane/Type/CacheProperty.hs b/library/Octane/Type/CacheProperty.hs --- a/library/Octane/Type/CacheProperty.hs +++ b/library/Octane/Type/CacheProperty.hs @@ -1,25 +1,30 @@ -{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} module Octane.Type.CacheProperty (CacheProperty(..)) where -import Octane.Core -import Octane.Type.Primitive.Word32LE +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson.Types as Aeson +import qualified Data.Binary as Binary +import Data.Function ((&)) +import qualified GHC.Generics as Generics +import qualified Octane.Type.Primitive.Word32LE as Word32LE data CacheProperty = CacheProperty - { cachePropertyIndex :: Word32LE - , cachePropertyTag :: Word32LE - } deriving (Eq, Generic, NFData, Show) - -instance Binary CacheProperty where - get = do - index <- get - tag <- get - return CacheProperty - { cachePropertyIndex = index - , cachePropertyTag = tag - } + { cachePropertyIndex :: Word32LE.Word32LE + , cachePropertyTag :: Word32LE.Word32LE + } deriving (Eq,Generics.Generic,Show) +instance Binary.Binary CacheProperty where + get = CacheProperty <$> Binary.get <*> Binary.get put cacheProperty = do - cacheProperty & cachePropertyIndex & put - cacheProperty & cachePropertyTag & put + cacheProperty & cachePropertyIndex & Binary.put + cacheProperty & cachePropertyTag & Binary.put + +instance DeepSeq.NFData CacheProperty + +instance Aeson.ToJSON CacheProperty where + toJSON = + Aeson.genericToJSON + Aeson.defaultOptions + { Aeson.fieldLabelModifier = drop 13 + } diff --git a/library/Octane/Type/Frame.hs b/library/Octane/Type/Frame.hs --- a/library/Octane/Type/Frame.hs +++ b/library/Octane/Type/Frame.hs @@ -1,57 +1,16 @@ -{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} module Octane.Type.Frame (Frame(..)) where -import qualified Data.Binary.Bits.Get as Bits -import qualified Data.Binary.Bits.Put as Bits -import qualified Data.Word as Word -import Octane.Core -import Octane.Type.Primitive.Float32LE -import Octane.Type.Replication +import qualified Control.DeepSeq as DeepSeq +import qualified Data.ByteString as BS +import qualified GHC.Generics as Generics +import qualified Octane.Type.Replication as Replication data Frame = Frame - { frameTime :: Float32LE - , frameDelta :: Float32LE - , frameReplications :: [Replication] - } deriving (Eq, Generic, NFData, Show) - -instance BinaryBit Frame where - getBits _ = do - time <- Bits.getWord32be 32 - delta <- Bits.getWord32be 32 - replications <- getReplications - return Frame - { frameTime = wordToFloat time - , frameDelta = wordToFloat delta - , frameReplications = replications - } - - putBits _ frame = do - frame & frameTime & floatToWord & Bits.putWord32be 32 - frame & frameDelta & floatToWord & Bits.putWord32be 32 - frame & frameReplications & putReplications - -wordToFloat :: Word.Word32 -> Float32LE -wordToFloat _ = Float32LE 0 -- TODO - -floatToWord :: Float32LE -> Word.Word32 -floatToWord _ = 0 -- TODO - -getReplications :: BitGet [Replication] -getReplications = do - hasReplication <- Bits.getBool - if hasReplication - then do - replication <- getBits undefined - replications <- getReplications - return (replication : replications) - else return [] + { frameTime :: BS.ByteString + , frameDelta :: BS.ByteString + , frameReplications :: [Replication.Replication] + } deriving (Eq,Generics.Generic,Show) -putReplications :: [Replication] -> BitPut () -putReplications replications = case replications of - [] -> Bits.putBool False - replication : rest -> do - Bits.putBool True - putBits undefined replication - putReplications rest +instance DeepSeq.NFData Frame diff --git a/library/Octane/Type/KeyFrame.hs b/library/Octane/Type/KeyFrame.hs --- a/library/Octane/Type/KeyFrame.hs +++ b/library/Octane/Type/KeyFrame.hs @@ -1,33 +1,36 @@ -{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} module Octane.Type.KeyFrame (KeyFrame(..)) where -import Octane.Core -import Octane.Type.Primitive.Float32LE -import Octane.Type.Primitive.Word32LE +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson.Types as Aeson +import qualified Data.Binary as Binary +import Data.Function ((&)) +import qualified GHC.Generics as Generics +import qualified Octane.Type.Primitive.Float32LE as Float32LE +import qualified Octane.Type.Primitive.Word32LE as Word32LE -- | A key frame. Each key frame has the time since the beginning of the match, -- | the frame it corresponds to, and that frame's bit position in the network -- | stream. data KeyFrame = KeyFrame - { keyFrameTime :: Float32LE - , keyFrameFrame :: Word32LE - , keyFramePosition :: Word32LE - } deriving (Eq, Generic, NFData, Show) - -instance Binary KeyFrame where - get = do - time <- get - frame <- get - position <- get - return KeyFrame - { keyFrameTime = time - , keyFrameFrame = frame - , keyFramePosition = position - } + { keyFrameTime :: Float32LE.Float32LE + , keyFrameFrame :: Word32LE.Word32LE + , keyFramePosition :: Word32LE.Word32LE + } deriving (Eq,Generics.Generic,Show) +instance Binary.Binary KeyFrame where + get = KeyFrame <$> Binary.get <*> Binary.get <*> Binary.get put keyFrame = do - keyFrame & keyFrameTime & put - keyFrame & keyFrameFrame & put - keyFrame & keyFramePosition & put + keyFrame & keyFrameTime & Binary.put + keyFrame & keyFrameFrame & Binary.put + keyFrame & keyFramePosition & Binary.put + +instance DeepSeq.NFData KeyFrame + +instance Aeson.ToJSON KeyFrame where + toJSON = + Aeson.genericToJSON + Aeson.defaultOptions + { Aeson.fieldLabelModifier = drop 8 + } diff --git a/library/Octane/Type/Mark.hs b/library/Octane/Type/Mark.hs --- a/library/Octane/Type/Mark.hs +++ b/library/Octane/Type/Mark.hs @@ -1,28 +1,33 @@ -{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} module Octane.Type.Mark (Mark(..)) where -import Octane.Core -import Octane.Type.Primitive.PCString -import Octane.Type.Primitive.Word32LE +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson.Types as Aeson +import qualified Data.Binary as Binary +import Data.Function ((&)) +import qualified GHC.Generics as Generics +import qualified Octane.Type.Primitive.PCString as PCString +import qualified Octane.Type.Primitive.Word32LE as Word32LE -- | A tick mark on the replay. The only thing that creates tick marks are -- | goals. data Mark = Mark - { markLabel :: PCString - , markFrame :: Word32LE - } deriving (Eq, Generic, NFData, Show) - -instance Binary Mark where - get = do - label <- get - frame <- get - return Mark - { markLabel = label - , markFrame = frame - } + { markLabel :: PCString.PCString + , markFrame :: Word32LE.Word32LE + } deriving (Eq,Generics.Generic,Show) +instance Binary.Binary Mark where + get = Mark <$> Binary.get <*> Binary.get put mark = do - mark & markLabel & put - mark & markFrame & put + mark & markLabel & Binary.put + mark & markFrame & Binary.put + +instance DeepSeq.NFData Mark + +instance Aeson.ToJSON Mark where + toJSON = + Aeson.genericToJSON + Aeson.defaultOptions + { Aeson.fieldLabelModifier = drop 4 + } diff --git a/library/Octane/Type/Message.hs b/library/Octane/Type/Message.hs --- a/library/Octane/Type/Message.hs +++ b/library/Octane/Type/Message.hs @@ -1,31 +1,34 @@ -{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} module Octane.Type.Message (Message(..)) where -import Octane.Core -import Octane.Type.Primitive.PCString -import Octane.Type.Primitive.Word32LE +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson.Types as Aeson +import qualified Data.Binary as Binary +import Data.Function ((&)) +import qualified GHC.Generics as Generics +import qualified Octane.Type.Primitive.PCString as PCString +import qualified Octane.Type.Primitive.Word32LE as Word32LE -- | A debugging message. Replays do not have any of these anymore. data Message = Message - { messageFrame :: Word32LE - , messageName :: PCString - , messageContent :: PCString - } deriving (Eq, Generic, NFData, Show) - -instance Binary Message where - get = do - frame <- get - name <- get - content <- get - return Message - { messageFrame = frame - , messageName = name - , messageContent = content - } + { messageFrame :: Word32LE.Word32LE + , messageName :: PCString.PCString + , messageContent :: PCString.PCString + } deriving (Eq,Generics.Generic,Show) +instance Binary.Binary Message where + get = Message <$> Binary.get <*> Binary.get <*> Binary.get put message = do - message & messageFrame & put - message & messageName & put - message & messageContent & put + message & messageFrame & Binary.put + message & messageName & Binary.put + message & messageContent & Binary.put + +instance DeepSeq.NFData Message + +instance Aeson.ToJSON Message where + toJSON = + Aeson.genericToJSON + Aeson.defaultOptions + { Aeson.fieldLabelModifier = drop 7 + } diff --git a/library/Octane/Type/Primitive.hs b/library/Octane/Type/Primitive.hs --- a/library/Octane/Type/Primitive.hs +++ b/library/Octane/Type/Primitive.hs @@ -1,19 +1,1 @@ -module Octane.Type.Primitive - ( module Octane.Type.Primitive.Boolean - , module Octane.Type.Primitive.Dictionary - , module Octane.Type.Primitive.Float32LE - , module Octane.Type.Primitive.List - , module Octane.Type.Primitive.PCString - , module Octane.Type.Primitive.Stream - , module Octane.Type.Primitive.Word32LE - , module Octane.Type.Primitive.Word64LE - ) where - -import Octane.Type.Primitive.Boolean -import Octane.Type.Primitive.Dictionary -import Octane.Type.Primitive.Float32LE -import Octane.Type.Primitive.List -import Octane.Type.Primitive.PCString -import Octane.Type.Primitive.Stream -import Octane.Type.Primitive.Word32LE -import Octane.Type.Primitive.Word64LE +{-# OPTIONS_GHC -F -pgmF autoexporter #-} diff --git a/library/Octane/Type/Primitive/Boolean.hs b/library/Octane/Type/Primitive/Boolean.hs --- a/library/Octane/Type/Primitive/Boolean.hs +++ b/library/Octane/Type/Primitive/Boolean.hs @@ -1,22 +1,30 @@ {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Octane.Type.Primitive.Boolean (Boolean(..)) where +import qualified Control.DeepSeq as DeepSeq +import qualified Control.Newtype as Newtype +import qualified Data.Aeson as Aeson import qualified Data.Binary as Binary -import Octane.Core +import Data.Function ((&)) +import qualified GHC.Generics as Generics -- | A boolean value, stored in the first bit of a byte. -newtype Boolean = Boolean - { getBoolean :: Bool - } deriving (Eq, Generic, NFData, Show) +newtype Boolean = + Boolean Bool + deriving (Eq,Generics.Generic,Show) -instance Binary Boolean where +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 + then fail ("invalid Boolean value " ++ show boolean) + else boolean & fromIntegral & toEnum & Newtype.pack & return + put boolean = do + boolean & Newtype.unpack & fromEnum & fromIntegral & Binary.putWord8 - put (Boolean boolean) = do - boolean & fromEnum & fromIntegral & Binary.putWord8 +instance Newtype.Newtype Boolean + +instance DeepSeq.NFData Boolean + +instance Aeson.ToJSON Boolean diff --git a/library/Octane/Type/Primitive/Dictionary.hs b/library/Octane/Type/Primitive/Dictionary.hs --- a/library/Octane/Type/Primitive/Dictionary.hs +++ b/library/Octane/Type/Primitive/Dictionary.hs @@ -1,45 +1,62 @@ {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} module Octane.Type.Primitive.Dictionary (Dictionary(..)) where +import qualified Control.DeepSeq as DeepSeq +import qualified Control.Newtype as Newtype +import qualified Data.Aeson as Aeson +import qualified Data.Binary as Binary +import Data.Function ((&)) import qualified Data.Map as Map -import Octane.Core -import Octane.Type.Primitive.PCString +import qualified GHC.Generics as Generics +import qualified Octane.Type.Primitive.PCString as PCString -- | A dictionary that maps strings to values. The dictionary is terminated by -- | the key "None". -newtype Dictionary a = Dictionary - { getDictionary :: Map PCString a - } deriving (Eq, Generic, NFData, Show) +newtype Dictionary a = + Dictionary (Map.Map PCString.PCString a) + deriving (Eq,Generics.Generic,Show) -instance (Binary a) => Binary (Dictionary a) where +instance (Binary.Binary a) => Binary.Binary (Dictionary a) where get = do element <- getElement if Map.null element - then do - element & Dictionary & return - else do - Dictionary elements <- get - elements & Map.union element & Dictionary & return + then do + element & Newtype.pack & return + else do + Dictionary elements <- Binary.get + elements & Map.union element & Newtype.pack & return + put dictionary = do + dictionary & Newtype.unpack & Map.assocs & mapM_ putElement + noneKey & Binary.put - put (Dictionary elements) = do - elements & Map.assocs & mapM_ putElement - "None" & PCString & put +instance Newtype.Newtype (Dictionary a) -getElement :: (Binary a) => Get (Map PCString a) +instance (DeepSeq.NFData a) => DeepSeq.NFData (Dictionary a) + +instance (Aeson.ToJSON a) => Aeson.ToJSON (Dictionary a) where + toJSON dictionary = + dictionary & Newtype.unpack & Map.mapKeys Newtype.unpack & Aeson.toJSON + +getElement + :: (Binary.Binary a) + => Binary.Get (Map.Map PCString.PCString a) getElement = do - key <- get - if key == PCString "None" - then do - return Map.empty - else do - value <- get - return (Map.singleton key value) + key <- Binary.get + if key == noneKey + then do + return Map.empty + else do + value <- Binary.get + value & Map.singleton key & return +putElement + :: (Binary.Binary a) + => (PCString.PCString, a) -> Binary.Put +putElement (key,value) = do + Binary.put key + Binary.put value -putElement :: (Binary a) => (PCString, a) -> Put -putElement (key, value) = do - key & put - value & put +noneKey :: PCString.PCString +noneKey = "None" diff --git a/library/Octane/Type/Primitive/Float32LE.hs b/library/Octane/Type/Primitive/Float32LE.hs --- a/library/Octane/Type/Primitive/Float32LE.hs +++ b/library/Octane/Type/Primitive/Float32LE.hs @@ -1,20 +1,29 @@ {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Octane.Type.Primitive.Float32LE (Float32LE(..)) where +import qualified Control.DeepSeq as DeepSeq +import qualified Control.Newtype as Newtype +import qualified Data.Aeson as Aeson +import qualified Data.Binary as Binary import qualified Data.Binary.IEEE754 as IEEE754 -import Octane.Core +import Data.Function ((&)) +import qualified GHC.Generics as Generics -- | A 32-bit little-endian float. -newtype Float32LE = Float32LE - { getFloat32LE :: Float - } deriving (Eq, Generic, NFData, Show) +newtype Float32LE = + Float32LE Float + deriving (Eq,Generics.Generic,Show) -instance Binary Float32LE where +instance Binary.Binary Float32LE where get = do float <- IEEE754.getFloat32le - float & Float32LE & return + float & Newtype.pack & return + put float = do + float & Newtype.unpack & IEEE754.putFloat32le - put (Float32LE float) = do - float & IEEE754.putFloat32le +instance Newtype.Newtype Float32LE + +instance DeepSeq.NFData Float32LE + +instance Aeson.ToJSON Float32LE diff --git a/library/Octane/Type/Primitive/List.hs b/library/Octane/Type/Primitive/List.hs --- a/library/Octane/Type/Primitive/List.hs +++ b/library/Octane/Type/Primitive/List.hs @@ -1,23 +1,33 @@ {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Octane.Type.Primitive.List (List(..)) where +import qualified Control.DeepSeq as DeepSeq import qualified Control.Monad as Monad -import Octane.Core -import Octane.Type.Primitive.Word32LE +import qualified Control.Newtype as Newtype +import qualified Data.Aeson as Aeson +import qualified Data.Binary as Binary +import Data.Function ((&)) +import qualified GHC.Generics as Generics +import qualified Octane.Type.Primitive.Word32LE as Word32LE -- | A length-prefixed list. -newtype List a = List - { getList :: [a] - } deriving (Eq, Generic, NFData, Show) +newtype List a = + List [a] + deriving (Eq,Generics.Generic,Show) -instance (Binary a) => Binary (List a) where +instance (Binary.Binary a) => Binary.Binary (List a) where get = do - (Word32LE size) <- get - elements <- Monad.replicateM (fromIntegral size) get - elements & List & return + (Word32LE.Word32LE size) <- Binary.get + elements <- Monad.replicateM (fromIntegral size) Binary.get + elements & Newtype.pack & return + put list = do + list & Newtype.unpack & length & fromIntegral & Word32LE.Word32LE & + Binary.put + list & Newtype.unpack & mapM_ Binary.put - put (List list) = do - list & length & fromIntegral & Word32LE & put - list & mapM_ put +instance Newtype.Newtype (List a) + +instance (DeepSeq.NFData a) => DeepSeq.NFData (List a) + +instance (Aeson.ToJSON a) => Aeson.ToJSON (List a) diff --git a/library/Octane/Type/Primitive/PCString.hs b/library/Octane/Type/Primitive/PCString.hs --- a/library/Octane/Type/Primitive/PCString.hs +++ b/library/Octane/Type/Primitive/PCString.hs @@ -1,47 +1,63 @@ {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Octane.Type.Primitive.PCString (PCString(..)) where +import qualified Control.DeepSeq as DeepSeq +import qualified Control.Newtype as Newtype +import qualified Data.Aeson as Aeson +import qualified Data.Binary as Binary import qualified Data.Binary.Get as Binary 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 Octane.Core -import Octane.Type.Primitive.Word32LE +import qualified GHC.Generics as Generics +import qualified Octane.Type.Primitive.Word32LE as Word32LE -- | A length-prefixed null-terminated string. -newtype PCString = PCString - { getPCString :: Text - } deriving (Eq, Generic, NFData, Ord, Show) +newtype PCString = + PCString Text.Text + deriving (Eq,Generics.Generic,Ord,Show) -instance Binary PCString where +instance Binary.Binary PCString where get = do - (Word32LE size) <- get - string <- if size == 0 - then fail ("invalid PCString size " ++ show size) - else if size < 0 + (Word32LE.Word32LE size) <- Binary.get + 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 & Newtype.pack & return + put string = do + let cString = string & Newtype.unpack & flip Text.snoc '\NUL' + let size = cString & Text.length & fromIntegral + if Text.all Char.isLatin1 cString then do - let actualSize = 2 * negate size - bytes <- Binary.getByteString (fromIntegral actualSize) - bytes & Encoding.decodeUtf16LE & return + size & Word32LE.Word32LE & Binary.put + cString & encodeLatin1 & Binary.putByteString else do - bytes <- Binary.getByteString (fromIntegral size) - bytes & Encoding.decodeLatin1 & return - string & Text.dropEnd 1 & PCString & return + size & negate & Word32LE.Word32LE & Binary.put + cString & Encoding.encodeUtf16LE & Binary.putByteString - put (PCString string) = do - let cString = Text.snoc string '\NUL' - let size = cString & Text.length & fromIntegral - if Text.all Char.isLatin1 cString - then do - size & Word32LE & put - cString & encodeLatin1 & Binary.putByteString - else do - size & negate & Word32LE & put - cString & Encoding.encodeUtf16LE & Binary.putByteString +instance String.IsString PCString where + fromString string = string & Text.pack & Newtype.pack -encodeLatin1 :: Text -> ByteString +instance Newtype.Newtype PCString + +instance DeepSeq.NFData PCString + +instance Aeson.ToJSON PCString + +encodeLatin1 :: Text.Text -> BS.ByteString encodeLatin1 text = text & Text.unpack & BS8.pack diff --git a/library/Octane/Type/Primitive/Stream.hs b/library/Octane/Type/Primitive/Stream.hs --- a/library/Octane/Type/Primitive/Stream.hs +++ b/library/Octane/Type/Primitive/Stream.hs @@ -1,39 +1,53 @@ {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Octane.Type.Primitive.Stream (Stream(..)) where +import qualified Control.DeepSeq as DeepSeq +import qualified Control.Newtype as Newtype +import qualified Data.Aeson as Aeson +import qualified Data.Binary as Binary import qualified Data.Binary.Get as Binary 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 Octane.Core -import Octane.Type.Primitive.Word32LE +import qualified GHC.Generics as Generics +import qualified Octane.Type.Primitive.Word32LE as Word32LE -newtype Stream = Stream - { getStream :: ByteString - } deriving (Eq, Generic, NFData, Show) +newtype Stream = + Stream BS.ByteString + deriving (Eq,Generics.Generic,Show) -instance Binary Stream where +instance Binary.Binary Stream where get = do - size <- get - content <- size & getWord32LE & fromIntegral & Binary.getByteString - content & BS.map reverseBits & Stream & return - + Word32LE.Word32LE size <- Binary.get + content <- size & fromIntegral & Binary.getByteString + content & BS.map reverseBits & Newtype.pack & return put stream = do - let content = getStream stream - let size = BS.length content - size & fromIntegral & Word32LE & put + let content = Newtype.unpack stream + content & BS.length & fromIntegral & Word32LE.Word32LE & Binary.put content & BS.map reverseBits & Binary.putByteString +instance Newtype.Newtype Stream + +instance DeepSeq.NFData Stream + +instance Aeson.ToJSON Stream where + toJSON stream = + let size = stream & Newtype.unpack & BS.length + bytes = + if size == 1 + then "byte" + else "bytes" + in Aeson.toJSON (unwords ["Stream:", show size, bytes, "..."]) + reverseBits :: Word.Word8 -> Word.Word8 reverseBits word = - (if Bits.testBit word 0 then 128 else 0) Bits..|. - (if Bits.testBit word 1 then 64 else 0) Bits..|. - (if Bits.testBit word 2 then 32 else 0) Bits..|. - (if Bits.testBit word 3 then 16 else 0) Bits..|. - (if Bits.testBit word 4 then 8 else 0) Bits..|. - (if Bits.testBit word 5 then 4 else 0) Bits..|. - (if Bits.testBit word 6 then 2 else 0) Bits..|. - (if Bits.testBit word 7 then 1 else 0) + 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 diff --git a/library/Octane/Type/Primitive/Word32LE.hs b/library/Octane/Type/Primitive/Word32LE.hs --- a/library/Octane/Type/Primitive/Word32LE.hs +++ b/library/Octane/Type/Primitive/Word32LE.hs @@ -1,21 +1,31 @@ {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Octane.Type.Primitive.Word32LE (Word32LE(..)) where +import qualified Control.DeepSeq as DeepSeq +import qualified Control.Newtype as Newtype +import qualified Data.Aeson as Aeson +import qualified Data.Binary as Binary import qualified Data.Binary.Get as Binary import qualified Data.Binary.Put as Binary -import Octane.Core +import Data.Function ((&)) +import qualified Data.Word as Word +import qualified GHC.Generics as Generics -- | A 32-bit little-endian integer. -newtype Word32LE = Word32LE - { getWord32LE :: Word32 - } deriving (Eq, Generic, NFData, Show) +newtype Word32LE = + Word32LE Word.Word32 + deriving (Eq,Generics.Generic,Show) -instance Binary Word32LE where +instance Binary.Binary Word32LE where get = do - int <- Binary.getWord32le - int & fromIntegral & Word32LE & return + word <- Binary.getWord32le + word & fromIntegral & Newtype.pack & return + put word = do + word & Newtype.unpack & fromIntegral & Binary.putWord32le - put (Word32LE int) = do - int & fromIntegral & Binary.putWord32le +instance Newtype.Newtype Word32LE + +instance DeepSeq.NFData Word32LE + +instance Aeson.ToJSON Word32LE diff --git a/library/Octane/Type/Primitive/Word64LE.hs b/library/Octane/Type/Primitive/Word64LE.hs --- a/library/Octane/Type/Primitive/Word64LE.hs +++ b/library/Octane/Type/Primitive/Word64LE.hs @@ -1,21 +1,31 @@ {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Octane.Type.Primitive.Word64LE (Word64LE(..)) where +import qualified Control.DeepSeq as DeepSeq +import qualified Control.Newtype as Newtype +import qualified Data.Aeson as Aeson +import qualified Data.Binary as Binary import qualified Data.Binary.Get as Binary import qualified Data.Binary.Put as Binary -import Octane.Core +import Data.Function ((&)) +import qualified Data.Word as Word +import qualified GHC.Generics as Generics -- | A 64-bit little-endian integer. -newtype Word64LE = Word64LE - { getWord64LE :: Word64 - } deriving (Eq, Generic, NFData, Show) +newtype Word64LE = + Word64LE Word.Word64 + deriving (Eq,Generics.Generic,Show) -instance Binary Word64LE where +instance Binary.Binary Word64LE where get = do - int <- Binary.getWord64le - int & fromIntegral & Word64LE & return + word <- Binary.getWord64le + word & fromIntegral & Newtype.pack & return + put word = do + word & Newtype.unpack & fromIntegral & Binary.putWord64le - put (Word64LE int) = do - int & fromIntegral & Binary.putWord64le +instance Newtype.Newtype Word64LE + +instance DeepSeq.NFData Word64LE + +instance Aeson.ToJSON Word64LE diff --git a/library/Octane/Type/Property.hs b/library/Octane/Type/Property.hs --- a/library/Octane/Type/Property.hs +++ b/library/Octane/Type/Property.hs @@ -1,105 +1,158 @@ -{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} module Octane.Type.Property (Property(..)) where -import Octane.Core -import Octane.Type.Primitive.Boolean -import Octane.Type.Primitive.Dictionary -import Octane.Type.Primitive.Float32LE -import Octane.Type.Primitive.List -import Octane.Type.Primitive.PCString -import Octane.Type.Primitive.Word32LE -import Octane.Type.Primitive.Word64LE +import qualified Control.DeepSeq as DeepSeq +import qualified Control.Newtype as Newtype +import qualified Data.Aeson.Types as Aeson +import qualified Data.Binary as Binary +import Data.Function ((&)) +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.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 data Property - = ArrayProperty Word64LE (List (Dictionary Property)) - | BoolProperty Word64LE Boolean - | ByteProperty Word64LE (PCString, PCString) - | FloatProperty Word64LE Float32LE - | IntProperty Word64LE Word32LE - | NameProperty Word64LE PCString - | QWordProperty Word64LE Word64LE - | StrProperty Word64LE PCString - deriving (Eq, Generic, NFData, Show) + = ArrayProperty Word64LE.Word64LE + (List.List (Dictionary.Dictionary Property)) + | BoolProperty Word64LE.Word64LE + 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 + deriving (Eq,Generics.Generic,Show) -instance Binary Property where +instance Binary.Binary Property where get = do - kind <- get - case getPCString kind of - "ArrayProperty" -> do - size <- get - value <- get - ArrayProperty size value & return - "BoolProperty" -> do - size <- get - value <- get - BoolProperty size value & return - "ByteProperty" -> do - size <- get - key <- get - value <- get - ByteProperty size (key, value) & return - "FloatProperty" -> do - size <- get - value <- case getWord64LE size of - 4 -> get - x -> fail ("unknown FloatProperty size " ++ show x) - FloatProperty size value & return - "IntProperty" -> do - size <- get - value <- case getWord64LE size of - 4 -> get - x -> fail ("unknown IntProperty size " ++ show x) - IntProperty size value & return - "NameProperty" -> do - size <- get - value <- get - NameProperty size value & return - "QWordProperty" -> do - size <- get - value <- case getWord64LE size of - 8 -> get - x -> fail ("unknown QWordProperty size " ++ show x) - QWordProperty size value & return - "StrProperty" -> do - size <- get - value <- get - StrProperty size value & return - x -> fail ("unknown property type " ++ show x) + kind <- Binary.get + case kind of + _ | kind == arrayProperty -> do + size <- Binary.get + value <- Binary.get + value & ArrayProperty size & return + _ | kind == boolProperty -> do + size <- Binary.get + value <- Binary.get + value & BoolProperty size & return + _ | kind == byteProperty -> do + size <- Binary.get + key <- Binary.get + value <- Binary.get + (key, value) & ByteProperty size & return + _ | kind == floatProperty -> do + size <- Binary.get + value <- + case Newtype.unpack size of + 4 -> Binary.get + x -> fail ("unknown FloatProperty size " ++ show x) + value & FloatProperty size & return + _ | kind == intProperty -> do + size <- Binary.get + value <- + case Newtype.unpack size of + 4 -> Binary.get + x -> fail ("unknown IntProperty size " ++ show x) + value & IntProperty size & return + _ | kind == nameProperty -> do + size <- Binary.get + value <- Binary.get + value & NameProperty size & return + _ | kind == qWordProperty -> do + size <- Binary.get + value <- + case Newtype.unpack size of + 8 -> Binary.get + x -> fail ("unknown QWordProperty size " ++ show x) + value & QWordProperty size & return + _ | kind == strProperty -> do + size <- Binary.get + value <- Binary.get + value & StrProperty size & return + _ -> fail ("unknown property type " ++ show (Newtype.unpack kind)) + put property = + case property of + ArrayProperty size value -> do + Binary.put arrayProperty + Binary.put size + Binary.put value + BoolProperty size value -> do + Binary.put boolProperty + Binary.put size + Binary.put value + ByteProperty size (key,value) -> do + Binary.put byteProperty + Binary.put size + Binary.put key + Binary.put value + FloatProperty size value -> do + Binary.put floatProperty + Binary.put size + Binary.put value + IntProperty size value -> do + Binary.put intProperty + Binary.put size + Binary.put value + NameProperty size value -> do + Binary.put nameProperty + Binary.put size + Binary.put value + QWordProperty size value -> do + Binary.put qWordProperty + Binary.put size + Binary.put value + StrProperty size value -> do + Binary.put strProperty + Binary.put size + Binary.put value - put property = case property of - ArrayProperty size value -> do - "ArrayProperty" & PCString & put - size & put - value & put - BoolProperty size value -> do - "BoolProperty" & PCString & put - size & put - value & put - ByteProperty size (key, value) -> do - "ByteProperty" & PCString & put - size & put - key & put - value & put - FloatProperty size value -> do - "FloatProperty" & PCString & put - size & put - value & put - IntProperty size value -> do - "IntProperty" & PCString & put - size & put - value & put - NameProperty size value -> do - "NameProperty" & PCString & put - size & put - value & put - QWordProperty size value -> do - "QWordProperty" & PCString & put - size & put - value & put - StrProperty size value -> do - "StrProperty" & PCString & put - size & put - value & put +instance DeepSeq.NFData Property + +instance Aeson.ToJSON Property where + toJSON property = + case property of + ArrayProperty _ x -> Aeson.toJSON x + BoolProperty _ x -> Aeson.toJSON x + ByteProperty _ (_,x) -> Aeson.toJSON x + FloatProperty _ x -> Aeson.toJSON x + IntProperty _ x -> Aeson.toJSON x + NameProperty _ x -> Aeson.toJSON x + QWordProperty _ x -> Aeson.toJSON x + StrProperty _ x -> Aeson.toJSON x + +arrayProperty :: PCString.PCString +arrayProperty = "ArrayProperty" + +boolProperty :: PCString.PCString +boolProperty = "BoolProperty" + +byteProperty :: PCString.PCString +byteProperty = "ByteProperty" + +floatProperty :: PCString.PCString +floatProperty = "FloatProperty" + +intProperty :: PCString.PCString +intProperty = "IntProperty" + +nameProperty :: PCString.PCString +nameProperty = "NameProperty" + +qWordProperty :: PCString.PCString +qWordProperty = "QWordProperty" + +strProperty :: PCString.PCString +strProperty = "StrProperty" diff --git a/library/Octane/Type/Replay.hs b/library/Octane/Type/Replay.hs --- a/library/Octane/Type/Replay.hs +++ b/library/Octane/Type/Replay.hs @@ -1,99 +1,87 @@ -{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} module Octane.Type.Replay (Replay(..)) where -import Octane.Core -import Octane.Type.Actor -import Octane.Type.CacheItem -import Octane.Type.KeyFrame -import Octane.Type.Mark -import Octane.Type.Message -import Octane.Type.Primitive.Dictionary -import Octane.Type.Primitive.List -import Octane.Type.Primitive.PCString -import Octane.Type.Primitive.Stream -import Octane.Type.Primitive.Word32LE -import Octane.Type.Property +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson.Types as Aeson +import qualified Data.Binary as Binary +import Data.Function ((&)) +import qualified GHC.Generics as Generics +import qualified Octane.Type.Actor as Actor +import qualified Octane.Type.CacheItem as CacheItem +import qualified Octane.Type.KeyFrame as KeyFrame +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.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.Property as Property data Replay = Replay - { replaySize1 :: Word32LE - , replayCRC1 :: Word32LE - , replayVersion1 :: Word32LE - , replayVersion2 :: Word32LE - , replayLabel :: PCString - , replayProperties :: Dictionary Property - , replaySize2 :: Word32LE - , replayCRC2 :: Word32LE - , replayEffects :: List PCString - , replayKeyFrames :: List KeyFrame - , replayStream :: Stream - , replayMessages :: List Message - , replayMarks :: List Mark - , replayPackages :: List PCString - , replayObjects :: List PCString - , replayNames :: List PCString - , replayActors :: List Actor - , replayCacheItems :: List CacheItem - } deriving (Eq, Generic, NFData, Show) - -instance Binary Replay where - get = do - size1 <- get - crc1 <- get - version1 <- get - version2 <- get - label <- get - properties <- get - size2 <- get - crc2 <- get - effects <- get - keyFrames <- get - stream <- get - messages <- get - marks <- get - packages <- get - objects <- get - names <- get - actors <- get - cacheItems <- get - return Replay - { replaySize1 = size1 - , replayCRC1 = crc1 - , replayVersion1 = version1 - , replayVersion2 = version2 - , replayLabel = label - , replayProperties = properties - , replaySize2 = size2 - , replayCRC2 = crc2 - , replayEffects = effects - , replayKeyFrames = keyFrames - , replayStream = stream - , replayMessages = messages - , replayMarks = marks - , replayPackages = packages - , replayObjects = objects - , replayNames = names - , replayActors = actors - , replayCacheItems = cacheItems - } + { replaySize1 :: Word32LE.Word32LE + , replayCRC1 :: Word32LE.Word32LE + , replayVersion1 :: Word32LE.Word32LE + , replayVersion2 :: Word32LE.Word32LE + , replayLabel :: PCString.PCString + , replayProperties :: Dictionary.Dictionary Property.Property + , replaySize2 :: Word32LE.Word32LE + , replayCRC2 :: Word32LE.Word32LE + , replayLevels :: List.List PCString.PCString + , replayKeyFrames :: List.List KeyFrame.KeyFrame + , replayStream :: Stream.Stream + , replayMessages :: List.List Message.Message + , replayMarks :: List.List Mark.Mark + , replayPackages :: List.List PCString.PCString + , replayObjects :: List.List PCString.PCString + , replayNames :: List.List PCString.PCString + , replayActors :: List.List Actor.Actor + , replayCacheItems :: List.List CacheItem.CacheItem + } 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 put replay = do - replay & replaySize1 & put - replay & replayCRC1 & put - replay & replayVersion1 & put - replay & replayVersion2 & put - replay & replayLabel & put - replay & replayProperties & put - replay & replaySize2 & put - replay & replayCRC2 & put - replay & replayEffects & put - replay & replayKeyFrames & put - replay & replayStream & put - replay & replayMessages & put - replay & replayMarks & put - replay & replayPackages & put - replay & replayObjects & put - replay & replayNames & put - replay & replayActors & put - replay & replayCacheItems & put + replay & replaySize1 & Binary.put + replay & replayCRC1 & Binary.put + replay & replayVersion1 & Binary.put + replay & replayVersion2 & Binary.put + replay & replayLabel & Binary.put + replay & replayProperties & Binary.put + replay & replaySize2 & Binary.put + replay & replayCRC2 & Binary.put + replay & replayLevels & Binary.put + replay & replayKeyFrames & Binary.put + replay & replayStream & Binary.put + replay & replayMessages & Binary.put + replay & replayMarks & Binary.put + replay & replayPackages & Binary.put + replay & replayObjects & Binary.put + replay & replayNames & Binary.put + replay & replayActors & Binary.put + replay & replayCacheItems & Binary.put + +instance DeepSeq.NFData Replay + +instance Aeson.ToJSON Replay where + toJSON = + Aeson.genericToJSON + Aeson.defaultOptions + { Aeson.fieldLabelModifier = drop 6 + } diff --git a/library/Octane/Type/Replication.hs b/library/Octane/Type/Replication.hs --- a/library/Octane/Type/Replication.hs +++ b/library/Octane/Type/Replication.hs @@ -1,19 +1,15 @@ -{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} module Octane.Type.Replication (Replication(..)) where -import Octane.Core +import qualified Control.DeepSeq as DeepSeq +import qualified Data.ByteString as BS +import qualified GHC.Generics as Generics data Replication = Replication - { - } deriving (Eq, Generic, NFData, Show) - -instance BinaryBit Replication where - getBits _ = do - return Replication - { - } + { replicationActorId :: BS.ByteString + , replicationIsOpen :: Bool + , replicationIsNew :: Maybe Bool + } deriving (Eq,Generics.Generic,Show) - putBits _ _ = do - return () +instance DeepSeq.NFData Replication diff --git a/library/Octane/Version.hs b/library/Octane/Version.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Version.hs @@ -0,0 +1,3 @@ +module Octane.Version (module Paths_octane) where + +import Paths_octane (version) diff --git a/octane.cabal b/octane.cabal --- a/octane.cabal +++ b/octane.cabal @@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: octane -version: 0.4.10 +version: 0.4.16 synopsis: Parse Rocket League replays. description: Octane parses Rocket League replays. category: Game @@ -16,6 +16,7 @@ extra-source-files: CHANGELOG.md + LICENSE.md package.yaml README.md stack.yaml @@ -29,17 +30,22 @@ library ghc-options: -Wall build-depends: - base ==4.8.* + aeson ==0.11.* + , aeson-pretty ==0.7.* + , autoexporter ==0.1.* + , base ==4.8.* , binary ==0.7.* , binary-bits ==0.5.* , bytestring ==0.10.* , containers ==0.5.* , data-binary-ieee754 ==0.4.* , deepseq ==1.4.* + , newtype-generics ==0.4.* , text ==1.2.* exposed-modules: Octane Octane.Main + Octane.Parser Octane.Type Octane.Type.Actor Octane.Type.CacheItem @@ -60,8 +66,9 @@ Octane.Type.Property Octane.Type.Replay Octane.Type.Replication + Octane.Version other-modules: - Octane.Core + Paths_octane default-language: Haskell2010 executable octane @@ -83,18 +90,16 @@ build-depends: base , binary - , binary-bits , bytestring , containers , octane - , tasty >=0.10 && <0.12 + , tasty ==0.11.* , tasty-hspec ==1.1.* other-modules: Octane.MainSpec Octane.Type.ActorSpec Octane.Type.CacheItemSpec Octane.Type.CachePropertySpec - Octane.Type.FrameSpec Octane.Type.KeyFrameSpec Octane.Type.MarkSpec Octane.Type.MessageSpec @@ -122,7 +127,6 @@ build-depends: base , binary - , binary-bits , bytestring , containers , criterion ==1.1.* @@ -132,7 +136,6 @@ Octane.Type.ActorBench Octane.Type.CacheItemBench Octane.Type.CachePropertyBench - Octane.Type.FrameBench Octane.Type.KeyFrameBench Octane.Type.MarkBench Octane.Type.MessageBench diff --git a/package.yaml b/package.yaml --- a/package.yaml +++ b/package.yaml @@ -3,7 +3,6 @@ dependencies: - base - binary - - binary-bits - bytestring - containers - criterion ==1.1.* @@ -29,6 +28,7 @@ source-dirs: executable extra-source-files: - CHANGELOG.md +- LICENSE.md - package.yaml - README.md - stack.yaml @@ -36,6 +36,9 @@ github: tfausak/octane library: dependencies: + - aeson ==0.11.* + - aeson-pretty ==0.7.* + - autoexporter ==0.1.* - base ==4.8.* - binary ==0.7.* - binary-bits ==0.5.* @@ -43,9 +46,9 @@ - containers ==0.5.* - data-binary-ieee754 ==0.4.* - deepseq ==1.4.* + - newtype-generics ==0.4.* - text ==1.2.* - other-modules: - - Octane.Core + other-modules: Paths_octane source-dirs: library license: MIT maintainer: Taylor Fausak @@ -56,11 +59,10 @@ dependencies: - base - binary - - binary-bits - bytestring - containers - octane - - tasty >=0.10 && <0.12 + - tasty ==0.11.* - tasty-hspec ==1.1.* ghc-options: - -rtsopts @@ -68,4 +70,4 @@ - -with-rtsopts=-N main: TestSuite.hs source-dirs: test-suite -version: '0.4.10' +version: '0.4.16' diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -1,3 +1,3 @@ install-ghc: true require-stack-version: ! '>=1.0.4' -resolver: nightly-2016-03-24 +resolver: nightly-2016-04-06 diff --git a/test-suite/Octane/Type/ActorSpec.hs b/test-suite/Octane/Type/ActorSpec.hs --- a/test-suite/Octane/Type/ActorSpec.hs +++ b/test-suite/Octane/Type/ActorSpec.hs @@ -2,11 +2,12 @@ module Octane.Type.ActorSpec (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 -import Octane -import Test.Tasty.Hspec spec :: Spec spec = describe "Actor" $ do diff --git a/test-suite/Octane/Type/CacheItemSpec.hs b/test-suite/Octane/Type/CacheItemSpec.hs --- a/test-suite/Octane/Type/CacheItemSpec.hs +++ b/test-suite/Octane/Type/CacheItemSpec.hs @@ -2,11 +2,12 @@ module Octane.Type.CacheItemSpec (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 -import Octane -import Test.Tasty.Hspec spec :: Spec spec = describe "CacheItem" $ do diff --git a/test-suite/Octane/Type/CachePropertySpec.hs b/test-suite/Octane/Type/CachePropertySpec.hs --- a/test-suite/Octane/Type/CachePropertySpec.hs +++ b/test-suite/Octane/Type/CachePropertySpec.hs @@ -2,11 +2,12 @@ module Octane.Type.CachePropertySpec (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 -import Octane -import Test.Tasty.Hspec spec :: Spec spec = describe "CacheProperty" $ do diff --git a/test-suite/Octane/Type/FrameSpec.hs b/test-suite/Octane/Type/FrameSpec.hs deleted file mode 100644 --- a/test-suite/Octane/Type/FrameSpec.hs +++ /dev/null @@ -1,41 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Octane.Type.FrameSpec (spec) where - -import qualified Data.Binary.Bits as Bits -import qualified Data.Binary.Bits.Get as Bits -import qualified Data.Binary.Bits.Put as Bits -import qualified Data.Binary.Get as Binary -import qualified Data.Binary.Put as Binary -import qualified Data.ByteString.Lazy as BSL -import Octane -import Test.Tasty.Hspec - -spec :: Spec -spec = describe "Frame" $ do - it "can be decoded" $ do - shouldBe - (decodeFrame "\ - \\0\0\0\0\ - \\0\0\0\0\ - \\0") - (Right ("", 9, Frame - (Float32LE 0.0) - (Float32LE 0.0) - [])) - it "can be encoded" $ do - shouldBe - (encodeFrame (Frame - (Float32LE 0.0) - (Float32LE 0.0) - [])) - "\ - \\0\0\0\0\ - \\0\0\0\0\ - \\0" - -decodeFrame :: BSL.ByteString -> Either (BSL.ByteString, Binary.ByteOffset, String) (BSL.ByteString, Binary.ByteOffset, Frame) -decodeFrame bytes = Binary.runGetOrFail (Bits.runBitGet (Bits.getBits undefined)) bytes - -encodeFrame :: Frame -> BSL.ByteString -encodeFrame frame = Binary.runPut (Bits.runBitPut (Bits.putBits undefined frame)) diff --git a/test-suite/Octane/Type/KeyFrameSpec.hs b/test-suite/Octane/Type/KeyFrameSpec.hs --- a/test-suite/Octane/Type/KeyFrameSpec.hs +++ b/test-suite/Octane/Type/KeyFrameSpec.hs @@ -2,11 +2,12 @@ module Octane.Type.KeyFrameSpec (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 -import Octane -import Test.Tasty.Hspec spec :: Spec spec = describe "KeyFrame" $ do diff --git a/test-suite/Octane/Type/MarkSpec.hs b/test-suite/Octane/Type/MarkSpec.hs --- a/test-suite/Octane/Type/MarkSpec.hs +++ b/test-suite/Octane/Type/MarkSpec.hs @@ -2,11 +2,12 @@ module Octane.Type.MarkSpec (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 -import Octane -import Test.Tasty.Hspec spec :: Spec spec = describe "Mark" $ do diff --git a/test-suite/Octane/Type/MessageSpec.hs b/test-suite/Octane/Type/MessageSpec.hs --- a/test-suite/Octane/Type/MessageSpec.hs +++ b/test-suite/Octane/Type/MessageSpec.hs @@ -2,11 +2,12 @@ module Octane.Type.MessageSpec (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 -import Octane -import Test.Tasty.Hspec spec :: Spec spec = describe "Message" $ do diff --git a/test-suite/Octane/Type/Primitive/BooleanSpec.hs b/test-suite/Octane/Type/Primitive/BooleanSpec.hs --- a/test-suite/Octane/Type/Primitive/BooleanSpec.hs +++ b/test-suite/Octane/Type/Primitive/BooleanSpec.hs @@ -2,11 +2,12 @@ module Octane.Type.Primitive.BooleanSpec (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 -import Octane -import Test.Tasty.Hspec spec :: Spec spec = describe "Boolean" $ do diff --git a/test-suite/Octane/Type/Primitive/DictionarySpec.hs b/test-suite/Octane/Type/Primitive/DictionarySpec.hs --- a/test-suite/Octane/Type/Primitive/DictionarySpec.hs +++ b/test-suite/Octane/Type/Primitive/DictionarySpec.hs @@ -2,12 +2,13 @@ module Octane.Type.Primitive.DictionarySpec (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 import qualified Data.Map as Map -import Octane -import Test.Tasty.Hspec spec :: Spec spec = describe "Dictionary" $ do diff --git a/test-suite/Octane/Type/Primitive/Float32LESpec.hs b/test-suite/Octane/Type/Primitive/Float32LESpec.hs --- a/test-suite/Octane/Type/Primitive/Float32LESpec.hs +++ b/test-suite/Octane/Type/Primitive/Float32LESpec.hs @@ -2,11 +2,12 @@ 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 -import Octane -import Test.Tasty.Hspec spec :: Spec spec = describe "Float32LE" $ do diff --git a/test-suite/Octane/Type/Primitive/ListSpec.hs b/test-suite/Octane/Type/Primitive/ListSpec.hs --- a/test-suite/Octane/Type/Primitive/ListSpec.hs +++ b/test-suite/Octane/Type/Primitive/ListSpec.hs @@ -2,11 +2,12 @@ module Octane.Type.Primitive.ListSpec (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 -import Octane -import Test.Tasty.Hspec spec :: Spec spec = describe "List" $ do diff --git a/test-suite/Octane/Type/Primitive/PCStringSpec.hs b/test-suite/Octane/Type/Primitive/PCStringSpec.hs --- a/test-suite/Octane/Type/Primitive/PCStringSpec.hs +++ b/test-suite/Octane/Type/Primitive/PCStringSpec.hs @@ -2,11 +2,12 @@ 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 -import Octane -import Test.Tasty.Hspec spec :: Spec spec = describe "PCString" $ do diff --git a/test-suite/Octane/Type/Primitive/StreamSpec.hs b/test-suite/Octane/Type/Primitive/StreamSpec.hs --- a/test-suite/Octane/Type/Primitive/StreamSpec.hs +++ b/test-suite/Octane/Type/Primitive/StreamSpec.hs @@ -2,11 +2,12 @@ module Octane.Type.Primitive.StreamSpec (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 -import Octane -import Test.Tasty.Hspec spec :: Spec spec = describe "Stream" $ do diff --git a/test-suite/Octane/Type/Primitive/Word32LESpec.hs b/test-suite/Octane/Type/Primitive/Word32LESpec.hs --- a/test-suite/Octane/Type/Primitive/Word32LESpec.hs +++ b/test-suite/Octane/Type/Primitive/Word32LESpec.hs @@ -2,11 +2,12 @@ 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 -import Octane -import Test.Tasty.Hspec spec :: Spec spec = describe "Word32LE" $ do diff --git a/test-suite/Octane/Type/Primitive/Word64LESpec.hs b/test-suite/Octane/Type/Primitive/Word64LESpec.hs --- a/test-suite/Octane/Type/Primitive/Word64LESpec.hs +++ b/test-suite/Octane/Type/Primitive/Word64LESpec.hs @@ -2,11 +2,12 @@ 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 -import Octane -import Test.Tasty.Hspec spec :: Spec spec = describe "Word64LE" $ do diff --git a/test-suite/Octane/Type/PrimitiveSpec.hs b/test-suite/Octane/Type/PrimitiveSpec.hs --- a/test-suite/Octane/Type/PrimitiveSpec.hs +++ b/test-suite/Octane/Type/PrimitiveSpec.hs @@ -1,5 +1,7 @@ module Octane.Type.PrimitiveSpec (spec) where +import Test.Tasty.Hspec + import qualified Octane.Type.Primitive.BooleanSpec import qualified Octane.Type.Primitive.DictionarySpec import qualified Octane.Type.Primitive.Float32LESpec @@ -8,7 +10,6 @@ import qualified Octane.Type.Primitive.StreamSpec import qualified Octane.Type.Primitive.Word32LESpec import qualified Octane.Type.Primitive.Word64LESpec -import Test.Tasty.Hspec spec :: Spec spec = describe "Primitive" $ do diff --git a/test-suite/Octane/Type/PropertySpec.hs b/test-suite/Octane/Type/PropertySpec.hs --- a/test-suite/Octane/Type/PropertySpec.hs +++ b/test-suite/Octane/Type/PropertySpec.hs @@ -2,12 +2,13 @@ module Octane.Type.PropertySpec (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 import qualified Data.Map as Map -import Octane -import Test.Tasty.Hspec spec :: Spec spec = describe "Property" $ do diff --git a/test-suite/Octane/Type/ReplaySpec.hs b/test-suite/Octane/Type/ReplaySpec.hs --- a/test-suite/Octane/Type/ReplaySpec.hs +++ b/test-suite/Octane/Type/ReplaySpec.hs @@ -2,12 +2,13 @@ module Octane.Type.ReplaySpec (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 import qualified Data.Map as Map -import Octane -import Test.Tasty.Hspec spec :: Spec spec = describe "Replay" $ do diff --git a/test-suite/Octane/TypeSpec.hs b/test-suite/Octane/TypeSpec.hs --- a/test-suite/Octane/TypeSpec.hs +++ b/test-suite/Octane/TypeSpec.hs @@ -1,23 +1,22 @@ module Octane.TypeSpec (spec) where +import Test.Tasty.Hspec + import qualified Octane.Type.ActorSpec import qualified Octane.Type.CacheItemSpec import qualified Octane.Type.CachePropertySpec -import qualified Octane.Type.FrameSpec import qualified Octane.Type.KeyFrameSpec import qualified Octane.Type.MarkSpec import qualified Octane.Type.MessageSpec import qualified Octane.Type.PrimitiveSpec import qualified Octane.Type.PropertySpec import qualified Octane.Type.ReplaySpec -import Test.Tasty.Hspec spec :: Spec spec = describe "Type" $ do Octane.Type.ActorSpec.spec Octane.Type.CacheItemSpec.spec Octane.Type.CachePropertySpec.spec - Octane.Type.FrameSpec.spec Octane.Type.KeyFrameSpec.spec Octane.Type.MarkSpec.spec Octane.Type.MessageSpec.spec diff --git a/test-suite/OctaneSpec.hs b/test-suite/OctaneSpec.hs --- a/test-suite/OctaneSpec.hs +++ b/test-suite/OctaneSpec.hs @@ -1,8 +1,9 @@ module OctaneSpec (spec) where +import Test.Tasty.Hspec + import qualified Octane.MainSpec import qualified Octane.TypeSpec -import Test.Tasty.Hspec spec :: Spec spec = describe "Octane" $ do diff --git a/test-suite/TestSuite.hs b/test-suite/TestSuite.hs --- a/test-suite/TestSuite.hs +++ b/test-suite/TestSuite.hs @@ -1,6 +1,7 @@ +import Test.Tasty.Hspec + import qualified OctaneSpec import qualified Test.Tasty -import Test.Tasty.Hspec main :: IO () main = do