BitSyntax 0.3 → 0.3.2

raw patch · 2 files changed

+29/−22 lines, 2 filesdep +bytestringdep +haskell98

Dependencies added: bytestring, haskell98

Files

• BitSyntax.cabal +12/−9
• Data/BitSyntax.hs +17/−13

@@ -1,10 +1,13 @@-Name: BitSyntax-Version: 0.3-License: BSD3-Author: Adam Langley-Homepage: http://www.imperialviolet.org/bitsyntax-Stability: experimental-Synopsis: A module to aid in the (de)serialisation of binary data-Build-Depends: base, QuickCheck, template-haskell+Name:            BitSyntax+Version:         0.3.2+License:         BSD3+Author:          Adam Langley+Homepage:        http://www.imperialviolet.org/bitsyntax+Stability:       experimental+Synopsis:        A module to aid in the (de)serialisation of binary data+Build-Depends:   base, haskell98, QuickCheck, template-haskell, bytestring+Build-Type:      Simple Exposed-modules: Data.BitSyntax-Extensions: ForeignFunctionInterface+Extensions:      ForeignFunctionInterface+ghc-options:         -Wall -optl-Wl,-s+ghc-prof-options:    -prof -auto-all

@@ -60,19 +60,15 @@   -- declaration for Data.BitSyntax.decodeU16)   decodeU8, decodeU16, decodeU32, decodeU16LE, decodeU32LE) where -import Language.Haskell.TH import Language.Haskell.TH.Lib import Language.Haskell.TH.Syntax  import qualified Data.ByteString as BS-import Data.Word-import Data.Bits-import Data.Char (chr, ord)+import Data.Char (ord) import Control.Monad-import Test.QuickCheck+import Test.QuickCheck (Arbitrary(), arbitrary, Gen())  import Foreign-import Foreign.C  foreign import ccall unsafe "htonl" htonl :: Word32 -> Word32 foreign import ccall unsafe "htons" htons :: Word16 -> Word16@@ -165,6 +161,7 @@     bitsWritten = min (8 - used) size     used' = used + bitsWritten +bits :: BitBlock -> BS.ByteString bits (U8 v) = BS.pack [((fromIntegral v) :: Word8)] bits (U16 v) = getBytes ((htons $ fromIntegral v) :: Word16) bits (U32 v) = getBytes ((htonl $ fromIntegral v) :: Word32)@@ -245,7 +242,7 @@   where     (values, _, _) = foldl unpackBits ([], 0, BS.unpack bitdata) sizes     bytesize = (sum sizes) `shiftR` 3-    (bitdata, rest) = BS.splitAt (fromIntegral bytesize) bs+    (bitdata, _) = BS.splitAt (fromIntegral bytesize) bs  unpackBits :: ([Integer], Integer, [Word8]) -> Integer -> ([Integer], Integer, [Word8]) unpackBits state size = unpackBitsInner 0 state size@@ -296,7 +293,7 @@   return (LetS [dec1] : stmts, restname, valname : tuplenames)  readElement state@(_, _, tuplenames) (Ignore n) = do-  (a, b, c) <- readElement state n+  (a, b, _) <- readElement state n   return (a, b, tuplenames)  readElement (stmts, inputname, tuplenames) LengthPrefixed = do@@ -347,7 +344,7 @@   let decodefunc = case size of                      1 -> 'decodeU8                      2 -> 'decodeU16-                     4 -> 'decodeU32+                     _ -> 'decodeU32 -- Default to 32   decodeHelper state (VarE decodefunc) size  readElement state (UnsignedLE size) = do@@ -356,7 +353,7 @@   --    a = BitSyntax.decodeU8LE aval   let decodefunc = case size of                      2 -> 'decodeU16LE-                     4 -> 'decodeU32LE+                     _ -> 'decodeU32LE -- Default to 4   decodeHelper state (VarE decodefunc) size  readElement state (PackedBits sizes) =@@ -367,6 +364,9 @@                             (ListE $ map (LitE . IntegerL) sizes))                       ((sum sizes) `shiftR` 3) +decodeHelper :: ([Stmt], Name, [Name])      -> Exp+                                            -> Integer+                                            -> Q ([Stmt], Name, [Name]) decodeHelper (stmts, inputname, tuplenames) decodefunc size = do   valname <- newName "val"   restname <- newName "rest"@@ -382,7 +382,9 @@    return (LetS [dec1, dec2] : stmts, restname, tuplename : tuplenames) +decGetName :: Dec -> Name decGetName (ValD (VarP name) _ _) = name+decGetName _                      = undefined -- Error!  bitSyn :: [ReadType] -> Q Exp bitSyn elements = do@@ -393,7 +395,7 @@   -- Tests-+prop_bitPacking :: [(Int, Int)] -> Bool prop_bitPacking fields =   prevalues == (map fromIntegral postvalues) ||   any (< 1) (map fst fields) ||@@ -409,14 +411,16 @@  instance Arbitrary Word16 where   arbitrary = (arbitrary :: Gen Int) >>= return . fromIntegral-  coarbitrary = error "not implemented" instance Arbitrary Word32 where   arbitrary = (arbitrary :: Gen Int) >>= return . fromIntegral-  coarbitrary = error "not implemented"  -- | This only works on little-endian machines as it checks that the foreign --   functions (htonl and htons) match the native ones+prop_nativeByteShuffle32 :: Word32 -> Bool prop_nativeByteShuffle32 x = endianSwitch32 x == htonl x+prop_nativeByteShuffle16 :: Word16 -> Bool prop_nativeByteShuffle16 x = endianSwitch16 x == htons x+prop_littleEndian16 :: Word16 -> Bool prop_littleEndian16 x = littleEndian16 x == x+prop_littleEndian32 :: Word32 -> Bool prop_littleEndian32 x = littleEndian32 x == x