packer 0.1.5 → 0.1.6
raw patch · 4 files changed
+148/−63 lines, 4 filesdep +tastydep +tasty-hunitdep +tasty-quickcheckdep −HUnitdep −QuickCheckdep −test-framework
Dependencies added: tasty, tasty-hunit, tasty-quickcheck
Dependencies removed: HUnit, QuickCheck, test-framework, test-framework-hunit, test-framework-quickcheck2
Files
- Data/Packer.hs +22/−0
- Data/Packer/Internal.hs +1/−1
- Tests/Tests.hs +121/−56
- packer.cabal +4/−6
Data/Packer.hs view
@@ -53,9 +53,13 @@ -- * Packing functions , packGetPosition , putWord8+ , putHoleWord8 , putWord16 , putWord16LE , putWord16BE+ , putHoleWord16+ , putHoleWord16LE+ , putHoleWord16BE , putWord32 , putWord32LE , putWord32BE@@ -245,6 +249,10 @@ putWord8 :: Word8 -> Packing () putWord8 w = packCheckAct 1 (\ptr -> poke (castPtr ptr) w) +-- | Put a Word8 Hole+putHoleWord8 :: Packing (Hole Word8)+putHoleWord8 = packHole 1 (\ptr w -> poke (castPtr ptr) w)+ -- | Put a Word16 in the host endianess. -- -- It's recommended to use an explicit endianness (LE or BE)@@ -260,6 +268,20 @@ -- | Put a Word16 serialized in big endian. putWord16BE :: Word16 -> Packing () putWord16BE w = putWord16 (be16Host w)++-- | Put a Word16 Hole+putHoleWord16_ :: (Word16 -> Word16) -> Packing (Hole Word16)+putHoleWord16_ f = packHole 2 (\ptr w -> poke (castPtr ptr) (f w))++putHoleWord16, putHoleWord16BE, putHoleWord16LE :: Packing (Hole Word16)+-- | Put a Word16 Hole in host endian+putHoleWord16 = putHoleWord16_ id++-- | Put a Word16 Hole in big endian+putHoleWord16BE = putHoleWord16_ be16Host++-- | Put a Word16 Hole in little endian+putHoleWord16LE = putHoleWord16_ le16Host -- | Put a Word32 in the host endianess. --
Data/Packer/Internal.hs view
@@ -197,7 +197,7 @@ -- This is useful to skip bytes or when using absolute offsets from a header or some such. unpackSetPosition :: Int -> Unpacking () unpackSetPosition pos = Unpacking $ \(fptr, iniBlock@(Memory iniPtr sz)) _ -> do- when (pos < 0 || pos >= sz) (throwIO $ OutOfBoundUnpacking pos 0)+ when (pos < 0 || pos > sz) (throwIO $ OutOfBoundUnpacking pos 0) return ((), Memory (iniPtr `plusPtr` pos) (sz-pos)) -- | Get the position in the memory block.
Tests/Tests.hs view
@@ -1,12 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} -import Test.Framework (defaultMain, testGroup)-import Test.Framework.Providers.QuickCheck2 (testProperty)-import Test.Framework.Providers.HUnit (testCase)+import Test.Tasty (defaultMain, testGroup) -import Test.QuickCheck-import Test.HUnit+import Test.Tasty.QuickCheck+import Test.Tasty.HUnit import Control.Applicative ((<$>)) import Control.Monad import Control.Exception@@ -77,69 +75,133 @@ , Bytes <$> arbitraryBS ] +putAtom :: DataAtom -> Packing ()+putAtom (W8 w) = putWord8 w+putAtom (W16 w) = putWord16 w+putAtom (W32 w) = putWord32 w+putAtom (W64 w) = putWord64 w+putAtom (W16LE w) = putWord16LE w+putAtom (W32LE w) = putWord32LE w+putAtom (W64LE w) = putWord64LE w+putAtom (W16BE w) = putWord16BE w+putAtom (W32BE w) = putWord32BE w+putAtom (W64BE w) = putWord64BE w+putAtom (F32LE w) = putFloat32LE w+putAtom (F32BE w) = putFloat32BE w+putAtom (F64LE w) = putFloat64LE w+putAtom (F64BE w) = putFloat64BE w+putAtom (Bytes b) = putBytes b++getAtom :: DataAtom -> Unpacking DataAtom+getAtom (W8 _) = W8 <$> getWord8+getAtom (W16 _) = W16 <$> getWord16+getAtom (W32 _) = W32 <$> getWord32+getAtom (W64 _) = W64 <$> getWord64+getAtom (W16LE _) = W16LE <$> getWord16LE+getAtom (W32LE _) = W32LE <$> getWord32LE+getAtom (W64LE _) = W64LE <$> getWord64LE+getAtom (W16BE _) = W16BE <$> getWord16BE+getAtom (W32BE _) = W32BE <$> getWord32BE+getAtom (W64BE _) = W64BE <$> getWord64BE+getAtom (F32LE _) = F32LE <$> getFloat32LE+getAtom (F32BE _) = F32BE <$> getFloat32BE+getAtom (F64LE _) = F64LE <$> getFloat64LE+getAtom (F64BE _) = F64BE <$> getFloat64BE+getAtom (Bytes b) = Bytes <$> getBytes (B.length b)++getAtomLength :: DataAtom -> Int+getAtomLength (W8 _) = 1+getAtomLength (W16 _) = 2+getAtomLength (W16LE _) = 2+getAtomLength (W16BE _) = 2+getAtomLength (W32 _) = 4+getAtomLength (W32LE _) = 4+getAtomLength (W32BE _) = 4+getAtomLength (F32LE _) = 4+getAtomLength (F32BE _) = 4+getAtomLength (W64 _) = 8+getAtomLength (W64LE _) = 8+getAtomLength (W64BE _) = 8+getAtomLength (F64LE _) = 8+getAtomLength (F64BE _) = 8+getAtomLength (Bytes b) = B.length b++test_property_hole_pack_unpack :: DataAtom -> Bool+test_property_hole_pack_unpack a =+ a == r2+ where+ p1 = runPacker a+ r1 = runParser p1+ p2 = runPacker r1+ r2 = runParser p2++ runPacker :: DataAtom -> B.ByteString+ runPacker a = runPacking (getAtomLength a) (packer a)+ runParser :: B.ByteString -> DataAtom+ runParser = runUnpacking (getAtom a)++ packer :: DataAtom -> Packing ()+ packer (W8 w) = putHoleWord8 >>= flip fillHole w+ packer (W16 w) = putHoleWord16 >>= flip fillHole w+ packer (W32 w) = putHoleWord32 >>= flip fillHole w+ packer (W64 w) = putHoleWord64 >>= flip fillHole w+ packer (W16LE w) = putHoleWord16LE >>= flip fillHole w+ packer (W32LE w) = putHoleWord32LE >>= flip fillHole w+ packer (W64LE w) = putHoleWord64LE >>= flip fillHole w+ packer (W16BE w) = putHoleWord16BE >>= flip fillHole w+ packer (W32BE w) = putHoleWord32BE >>= flip fillHole w+ packer (W64BE w) = putHoleWord64BE >>= flip fillHole w+ packer (F32LE w) = putFloat32LE w+ packer (F32BE w) = putFloat32BE w+ packer (F64LE w) = putFloat64LE w+ packer (F64BE w) = putFloat64BE w+ packer (Bytes b) = putBytes b+ instance Arbitrary DataStream where arbitrary = choose (0,2048) >>= \sz -> replicateM sz arbitrary >>= return . DataStream -packDataStream (DataStream atoms) = runPacking (foldl sumLen 0 atoms) (mapM_ process atoms)- where process :: DataAtom -> Packing ()- process (W8 w) = putWord8 w- process (W16 w) = putWord16 w- process (W32 w) = putWord32 w- process (W64 w) = putWord64 w- process (W16LE w) = putWord16LE w- process (W32LE w) = putWord32LE w- process (W64LE w) = putWord64LE w- process (W16BE w) = putWord16BE w- process (W32BE w) = putWord32BE w- process (W64BE w) = putWord64BE w- process (Bytes b) = putBytes b- process (F32LE w) = putFloat32LE w- process (F32BE w) = putFloat32BE w- process (F64LE w) = putFloat64LE w- process (F64BE w) = putFloat64BE w-- sumLen a (W8 _) = a + 1- sumLen a (W16 _) = a + 2- sumLen a (W16LE _) = a + 2- sumLen a (W16BE _) = a + 2- sumLen a (W32 _) = a + 4- sumLen a (W32LE _) = a + 4- sumLen a (W32BE _) = a + 4- sumLen a (F32LE _) = a + 4- sumLen a (F32BE _) = a + 4- sumLen a (F64LE _) = a + 8- sumLen a (F64BE _) = a + 8- sumLen a (W64 _) = a + 8- sumLen a (W64LE _) = a + 8- sumLen a (W64BE _) = a + 8- sumLen a (Bytes b) = a + B.length b+packDataStream (DataStream atoms) = runPacking (foldl sumLen 0 atoms) (mapM_ putAtom atoms)+ where sumLen a at = a + getAtomLength at unpackDataStream :: DataStream -> B.ByteString -> DataStream-unpackDataStream (DataStream atoms) bs = DataStream $ runUnpacking (mapM process atoms) bs- where process :: DataAtom -> Unpacking DataAtom- process (W8 _) = W8 <$> getWord8- process (W16 _) = W16 <$> getWord16- process (W32 _) = W32 <$> getWord32- process (W64 _) = W64 <$> getWord64- process (W16LE _) = W16LE <$> getWord16LE- process (W32LE _) = W32LE <$> getWord32LE- process (W64LE _) = W64LE <$> getWord64LE- process (W16BE _) = W16BE <$> getWord16BE- process (W32BE _) = W32BE <$> getWord32BE- process (W64BE _) = W64BE <$> getWord64BE- process (F32LE _) = F32LE <$> getFloat32LE- process (F32BE _) = F32BE <$> getFloat32BE- process (F64LE _) = F64LE <$> getFloat64LE- process (F64BE _) = F64BE <$> getFloat64BE- process (Bytes b) = Bytes <$> getBytes (B.length b)+unpackDataStream (DataStream atoms) bs = DataStream $ runUnpacking (mapM getAtom atoms) bs +newtype DataBytes = DataBytes B.ByteString+ deriving (Show, Eq)+instance Arbitrary DataBytes where+ arbitrary = DataBytes <$> arbitraryBS++test_property_hole :: DataBytes -> Bool+test_property_hole dbytes =+ dbytes == r2+ where+ p1 = runPacker dbytes+ r1 = runParser p1+ p2 = runPacker r1+ r2 = runParser p2++ runPacker :: DataBytes -> B.ByteString+ runPacker (DataBytes bs) = runPacking (B.length bs + 4) (packer bs)+ runParser :: B.ByteString -> DataBytes+ runParser = runUnpacking parser++ packer :: B.ByteString -> Packing ()+ packer bs = do+ hsize <- putHoleWord32LE+ putBytes bs+ fillHole hsize (fromIntegral $ B.length bs)+ parser :: Unpacking DataBytes+ parser = do+ size <- fromIntegral <$> getWord32LE+ DataBytes <$> getBytes size+ assertException msg filterE act = handleJust filterE (\_ -> return ()) (evaluate act >> assertFailure (msg ++ " didn't raise the proper exception")) main :: IO ()-main = defaultMain+main = defaultMain $ testGroup "packer" [ testGroup "serialization" [ testGroup "basic cases" [ testCase "packing 4 bytes" (runPacking 4 (mapM_ putWord8 [1,2,3,4]) @=? B.pack [1,2,3,4])@@ -151,6 +213,7 @@ (runUnpacking (unpackSetPosition 2) (B.singleton 1))) , testCase "unpacking set pos after" (assertException "unpacking position" (\(OutOfBoundUnpacking _ _) -> Just ()) (runUnpacking (unpackSetPosition (-1)) (B.singleton 1)))+ , testCase "unpacking set pos end" (runUnpacking (unpackSetPosition 0) (B.empty) @=? ()) , testCase "unpacking isolate" (runUnpacking (isolate 2 (getBytes 2) >>= \i -> getWord8 >>= \r -> return (i,r)) (B.pack [1,2,3]) @=? (B.pack [1,2], 3)) , testCase "unpacking isolate out of bounds" $ assertException "unpacking isolate" (\(OutOfBoundUnpacking _ _) -> Just ())@@ -161,5 +224,7 @@ ] , testGroup "endianness cases" $ concatMap toEndianCase endiannessCases , testProperty "unpacking.packing=id" (\ds -> unpackDataStream ds (packDataStream ds) == ds)+ , testProperty "holes" test_property_hole+ , testProperty "holes" test_property_hole_pack_unpack ] ]
packer.cabal view
@@ -1,5 +1,5 @@ Name: packer-Version: 0.1.5+Version: 0.1.6 Description: Fast byte serializer and unserializer License: BSD3 License-file: LICENSE@@ -31,11 +31,9 @@ Main-Is: Tests.hs Build-depends: base >= 4 && < 5 , bytestring- , HUnit- , QuickCheck >= 2- , test-framework >= 0.3.3- , test-framework-quickcheck2 >= 0.2.9- , test-framework-hunit+ , tasty+ , tasty-quickcheck+ , tasty-hunit , packer source-repository head