flat 0.2.2 → 0.3

raw patch · 17 files changed

+344/−168 lines, 17 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +7/−0
• README.md +4/−4
• flat.cabal +9/−7
• src/Data/ByteString/Convert.hs +24/−0
• src/Data/Flat/Bits.hs +23/−8
• src/Data/Flat/Decoder.hs +9/−0
• src/Data/Flat/Decoder/Prim.hs +181/−31
• src/Data/Flat/Decoder/Types.hs +5/−5
• src/Data/Flat/Encoder.hs +3/−2
• src/Data/Flat/Filler.hs +4/−2
• src/Data/Flat/Instances.hs +1/−1
• src/Data/Flat/Run.hs +20/−36
• stack.yaml +1/−23
• stack801.yaml +1/−22
• stack802.yaml +1/−23
• test/Spec.hs +48/−3
• test/Test/Data/Values.hs +3/−1

@@ -0,0 +1,7 @@+Significant and compatibility-breaking changes.++Version 0.3:+	- Removed 'flatStrict' and 'unflatStrict' (use 'flat' and 'unflat' instead that also encode/decode strictly)+	- `unflatWith` now takes a decoder for the unpadded value (previously it expected a padded decoder) and decodes the padded value+	- Added some decoding primitives+	- Added Data.ByteString.Convert

@@ -31,10 +31,10 @@ data List a = Nil | Cons a (List a) deriving (Show,Generic,Flat) ``` -For encoding, use `flat`, for decoding, use `unflat` (or equivalently: `flatStrict` and `unflatStrict`):+For encoding, use `flat`, for decoding, use `unflat`:  ```haskell-unflatStrict . flat $ Cons North (Cons South Nil) :: Decoded (List Direction)+unflat . flat $ Cons North (Cons South Nil) :: Decoded (List Direction) -> Right (Cons North (Cons South Nil)) ``` @@ -119,9 +119,9 @@  * Encoding: `store` and `flat` are usually faster  * Decoding: `store`, `cereal` and `flat` are usually faster - One thing that is not shown by the benchmarks is that, if the serialized data is to be transferred over a network, the total total transfer time (encoding time + transmission time + decoding time) is usually dominated by the transmission time and that's where the smaller binaries produced by flat give it a significant advantage.+ One thing that is not shown by the benchmarks is that, if the serialized data is to be transferred over a network, the total transfer time (encoding time + transmission time + decoding time) is usually dominated by the transmission time and that's where the smaller binaries produced by flat give it a significant advantage. - Consider for example the Cars dataset. As you can see in the following comparison with `store`, the overall top performer for encoding/decoding speed, the total transfer time is actually significantly lower for `flat` for all except the highest transmission speeds.+ Consider for example the Cars dataset. As you can see in the following comparison with `store`, the overall top performer for encoding/decoding speed, the transfer time is actually significantly lower for `flat` for all except the highest transmission speeds.  ||Store|Flat| |---|---|---|

@@ -1,22 +1,23 @@ name: flat-version: 0.2.2+version: 0.3 synopsis: Principled and efficient bit-oriented binary serialization. description: See the <http://github.com/tittoassini/flat online tutorial>. homepage: http://github.com/tittoassini/flat-copyright: Copyright: (c) 2016 Pasqualino `Titto` Assini-author: Pasqualino `Titto` Assini-license: BSD3-license-file: LICENSE-maintainer: tittoassini@gmail.com+license:             BSD3+license-file:        LICENSE+author:              Pasqualino `Titto` Assini+maintainer:          tittoassini@gmail.com+copyright:           Copyright: (c) 2016 Pasqualino `Titto` Assini category: Data,Parsing,Serialization cabal-version: >=1.10 build-type: Simple-tested-with: GHC ==7.10.3 GHC ==8.0.2+Tested-With: GHC == 7.10.3 GHC == 8.0.1 GHC == 8.0.2 extra-source-files:     stack.yaml     stack801.yaml     stack802.yaml     README.md+    CHANGELOG  source-repository head     type: git@@ -24,6 +25,7 @@  library     exposed-modules:+        Data.ByteString.Convert         Data.Flat.Bits         Data.Flat.Class         Data.Flat.Decoder

@@ -0,0 +1,24 @@+{-# LANGUAGE FlexibleInstances #-}+-- |Convert to/from strict ByteStrings+module Data.ByteString.Convert (AsByteString(..)) where++import qualified Data.ByteString      as B+import qualified Data.ByteString.Lazy as L+import           Data.Word++class AsByteString a where+  toByteString :: a -> B.ByteString+  fromByteString :: B.ByteString -> a++instance AsByteString B.ByteString where+  toByteString = id+  fromByteString = id++instance AsByteString L.ByteString where+  toByteString = L.toStrict+  fromByteString = L.fromStrict++instance AsByteString [Word8] where+  toByteString = B.pack+  fromByteString = B.unpack+

@@ -4,15 +4,22 @@ {-# LANGUAGE TypeSynonymInstances #-}  -- |Utilities to represent and display bit sequences-module Data.Flat.Bits (Bits, toBools, bits, paddedBits, asBytes) where+module Data.Flat.Bits (+    Bits,+    toBools,+    fromBools,+    bits,+    paddedBits,+    asBytes,+    asBits,+    ) where  import           Data.Bits                      hiding (Bits)-import qualified Data.ByteString           as L-import           Data.Flat.Decoder+import qualified Data.ByteString                as B import           Data.Flat.Class+import           Data.Flat.Decoder import           Data.Flat.Filler import           Data.Flat.Run--- import           Data.Int import qualified Data.Vector.Unboxed            as V import           Data.Word import           Text.PrettyPrint.HughesPJClass@@ -23,19 +30,27 @@ toBools :: Bits -> [Bool] toBools = V.toList +fromBools :: [Bool] -> Bits+fromBools = V.fromList+ -- |The sequence of bits corresponding to the serialization of the passed value (without any final byte padding) bits :: forall a. Flat a => a -> Bits bits v = let lbs = flat v              Right (PostAligned _ f) = unflatRaw lbs :: Decoded (PostAligned a)-         in takeBits (8 * L.length lbs - fillerLength f) lbs+         in takeBits (8 * B.length lbs - fillerLength f) lbs  -- |The sequence of bits corresponding to the byte-padded serialization of the passed value paddedBits :: forall a. Flat a => a -> Bits paddedBits v = let lbs = flat v-               in takeBits (8 * L.length lbs) lbs+               in takeBits (8 * B.length lbs) lbs -takeBits :: Int -> L.ByteString -> V.Vector Bool-takeBits numBits lbs  = V.generate (fromIntegral numBits) (\n -> let (bb,b) = n `divMod` 8 in testBit (L.index lbs (fromIntegral bb)) (7-b))+takeBits :: Int -> B.ByteString -> Bits+takeBits numBits lbs  = V.generate (fromIntegral numBits) (\n -> let (bb,b) = n `divMod` 8 in testBit (B.index lbs (fromIntegral bb)) (7-b))++-- | asBits (5::Word8)+-- | > [False,False,False,False,False,True,False,True]+asBits :: FiniteBits a => a -> Bits+asBits w = let s = finiteBitSize w in V.generate s (testBit w . (s-1-))  -- |Convert a sequence of bits to the corresponding list of bytes asBytes :: Bits -> [Word8]

@@ -29,6 +29,15 @@     dInt32,     dInt64,     dInt,+    dBE8,+    dBE16,+    dBE32,+    dBE64,+    dBEBits8,+    dBEBits16,+    dBEBits32,+    dBEBits64,+    dropBits,     ) where  import Data.Flat.Decoder.Prim

@@ -1,17 +1,25 @@ {-# LANGUAGE BangPatterns        #-}-{-# LANGUAGE DeriveGeneric       #-} {-# LANGUAGE MagicHash           #-} {-# LANGUAGE ScopedTypeVariables #-} -- |Strict Decoder Primitives module Data.Flat.Decoder.Prim (     dBool,     dWord8,+    dBE8,+    dBE16,+    dBE32,+    dBE64,+    dBEBits8,+    dBEBits16,+    dBEBits32,+    dBEBits64,+    dropBits,     dFloat,     dDouble,     getChunksInfo,     dByteString_,     dLazyByteString_,-    dByteArray_+    dByteArray_,     ) where  import           Control.Monad@@ -24,9 +32,29 @@ import           Foreign import           System.Endian +{-# INLINE ensureBits #-}+-- |Ensure that the specified number of bits is available+ensureBits :: Ptr Word8 -> S -> Int -> IO ()+ensureBits endPtr s n = when ((endPtr `minusPtr` currPtr s) * 8 - usedBits s < n) $ notEnoughSpace endPtr s++{-# INLINE dropBits #-}+-- |Drop the specified number of bits+dropBits :: Int -> Get ()+dropBits n+  | n > 0 = Get $ \endPtr s -> do+      ensureBits endPtr s n+      return $ GetResult (dropBits_ s n) ()+  | n == 0 = return ()+  | otherwise = error $ unwords ["dropBits",show n]++dropBits_ :: S -> Int -> S+dropBits_ s n = let (bytes,bits) = (n+usedBits s) `divMod` 8+                in S {currPtr=currPtr s `plusPtr` bytes,usedBits=bits}+ {-# INLINE dBool #-}+-- |Decode a boolean dBool :: Get Bool-dBool = Get $ \endPtr s -> +dBool = Get $ \endPtr s ->   if currPtr s >= endPtr     then notEnoughSpace endPtr s     else do@@ -38,63 +66,185 @@                   else s { usedBits = usedBits s + 1 }       return $ GetResult s' b -{-# INLINE dWord8  #-}+{-# INLINE dBEBits8  #-}+-- |Return the n most significant bits (up to maximum of 8)+-- The bits are returned right shifted.+--+-- >>> unflatWith (dBEBits8 3) [128+64+32+1::Word8]+-- Right 7+dBEBits8 :: Int -> Get Word8+dBEBits8 n = Get $ \endPtr s -> do+      ensureBits endPtr s n+      take8 s n++{-# INLINE dBEBits16  #-}+-- |Return the n most significant bits (up to maximum of 16)+-- The bits are returned right shifted.+dBEBits16 :: Int -> Get Word16+dBEBits16 n = Get $ \endPtr s -> do+      ensureBits endPtr s n+      takeN n s++{-# INLINE dBEBits32  #-}+-- |Return the n most significant bits (up to maximum of 8)+-- The bits are returned right shifted.+dBEBits32 :: Int -> Get Word32+dBEBits32 n = Get $ \endPtr s -> do+      ensureBits endPtr s n+      takeN n s++{-# INLINE dBEBits64  #-}+-- |Return the n most significant bits (up to maximum of 8)+-- The bits are returned right shifted.+dBEBits64 :: Int -> Get Word64+dBEBits64 n = Get $ \endPtr s -> do+      ensureBits endPtr s n+      takeN n s++-- {-# INLINE take8 #-}+-- take8 :: Int -> S -> IO (GetResult Word8)+-- take8 n s+--   | n == 0 = return $ GetResult s 0++--   -- all bits in the same byte+--   | n <= 8 - usedBits s = do+--       w <- peek (currPtr s)+--       let (bytes,bits) = (n+usedBits s) `divMod` 8+--       return $ GetResult (S {currPtr=currPtr s `plusPtr` bytes,usedBits=bits}) ((w `unsafeShiftL` usedBits s) `unsafeShiftR` (8 - n))++--   -- two different bytes+--   | n <= 8 = do+--       w::Word16 <- toBE16 <$> peek (castPtr $ currPtr s)+--       return $ GetResult (S {currPtr=currPtr s `plusPtr` 1,usedBits=(usedBits s + n) `mod` 8}) (fromIntegral $ (w `unsafeShiftL` usedBits s) `unsafeShiftR` (16 - n))++--   | otherwise = error $ unwords ["take8: cannot take",show n,"bits"]++{-# INLINE take8 #-}+take8 :: S -> Int -> IO (GetResult Word8)+take8 s n = GetResult (dropBits_ s n) <$> read8 s n++{-# INLINE read8 #-}+read8 :: S -> Int -> IO Word8+read8 s n | n >=0 && n <=8 =+            if n <= 8 - usedBits s+            then do  -- all bits in the same byte+              w <- peek (currPtr s)+              return $ (w `unsafeShiftL` usedBits s) `unsafeShiftR` (8 - n)+            else do -- two different bytes+              w::Word16 <- toBE16 <$> peek (castPtr $ currPtr s)+              return $ fromIntegral $ (w `unsafeShiftL` usedBits s) `unsafeShiftR` (16 - n)+          | otherwise = error $ unwords ["read8: cannot read",show n,"bits"]++{-# INLINE takeN #-}+takeN :: (Num a, Bits a) => Int -> S -> IO (GetResult a)+takeN n s = read s 0 (n - (n `min` 8)) n+   where+     read s r sh n | n <=0 = return $ GetResult s r+                   | otherwise = do+                     let m = n `min` 8+                     GetResult s' b <- take8 s m+                     read s' (r .|. (fromIntegral b `unsafeShiftL` sh)) ((sh-8) `max` 0) (n-8)++-- takeN n = Get $ \endPtr s -> do+--   ensureBits endPtr s n+--   let (bytes,bits) = (n+usedBits s) `divMod` 8+--   r <- case bytes of+--     0 -> do+--       w <- peek (currPtr s)+--       return . fromIntegral $ ((w `unsafeShiftL` usedBits s) `unsafeShiftR` (8 - n))+--     1 -> do+--       w::Word16 <- toBE16 <$> peek (castPtr $ currPtr s)+--       return $ fromIntegral $ (w `unsafeShiftL` usedBits s) `unsafeShiftR` (16 - n)+--     2 -> do+--       let r = 0+--       w1 <- fromIntegral <$> r8 s+--       w2 <- fromIntegral <$> r16 s+--       w1 +--   return $ GetResult (S {currPtr=currPtr s `plusPtr` bytes,usedBits=bits}) r++-- r8 s = peek (currPtr s)+-- r16 s = toBE16 <$> peek (castPtr $ currPtr s)++-- |Return the 8 most significant bits (same as dBE8) dWord8 :: Get Word8-dWord8 = Get $ \endPtr s -> do+dWord8 = dBE8++{-# INLINE dBE8  #-}+-- |Return the 8 most significant bits+dBE8 :: Get Word8+dBE8 = Get $ \endPtr s -> do       ensureBits endPtr s 8+      !w1 <- peek (currPtr s)       !w <- if usedBits s == 0-            then peek (currPtr s)+            then return w1             else do-                   !w1 <- peek (currPtr s)                    !w2 <- peek (currPtr s `plusPtr` 1)                    return $ (w1 `unsafeShiftL` usedBits s) .|. (w2 `unsafeShiftR` (8-usedBits s))       return $ GetResult (s {currPtr=currPtr s `plusPtr` 1}) w -{-# INLINE ensureBits #-}-ensureBits :: Ptr Word8 -> S -> Int -> IO ()-ensureBits endPtr s n = when ((endPtr `minusPtr` currPtr s) * 8 - usedBits s < n) $ notEnoughSpace endPtr s---- {-# INLINE incBits #-}--- incBits :: Int -> S -> S--- incBits 1 s = if usedBits s == 7---            then s {currPtr=currPtr s `plusPtr` 1,usedBits=0}---            else s {usedBits=usedBits s+1}---- incBits 8 s = s {currPtr=currPtr s `plusPtr` 1}+{-# INLINE dBE16 #-}+-- |Return the 16 most significant bits+dBE16 :: Get Word16+dBE16 = Get $ \endPtr s -> do+  ensureBits endPtr s 16+  !w1 <- toBE16 <$> peek (castPtr $ currPtr s)+  !w <- if usedBits s == 0+        then return w1+        else do+           !(w2::Word8) <- peek (currPtr s `plusPtr` 2)+           return $ w1 `unsafeShiftL` usedBits s  .|. fromIntegral (w2 `unsafeShiftR` (8-usedBits s))+  return $ GetResult (s {currPtr=currPtr s `plusPtr` 2}) w -{-# INLINE dFloat #-}-dFloat :: Get Float-dFloat = Get $ \endPtr s -> do+{-# INLINE dBE32 #-}+-- |Return the 32 most significant bits+dBE32 :: Get Word32+dBE32 = Get $ \endPtr s -> do   ensureBits endPtr s 32+  !w1 <- toBE32 <$> peek (castPtr $ currPtr s)   !w <- if usedBits s == 0-        then toBE32 <$> peek (castPtr $ currPtr s)+        then return w1         else do-           !w1 <- toBE32 <$> peek (castPtr $ currPtr s)            !(w2::Word8) <- peek (currPtr s `plusPtr` 4)            return $ w1 `unsafeShiftL` usedBits s  .|. fromIntegral (w2 `unsafeShiftR` (8-usedBits s))-  return $ GetResult (s {currPtr=currPtr s `plusPtr` 4}) (wordToFloat w)+  return $ GetResult (s {currPtr=currPtr s `plusPtr` 4}) w -{-# INLINE dDouble #-}-dDouble :: Get Double-dDouble = Get $ \endPtr s -> do+{-# INLINE dBE64 #-}+-- |Return the 64 most significant bits+dBE64 :: Get Word64+dBE64 = Get $ \endPtr s -> do   ensureBits endPtr s 64+  !w1 <- toBE64 <$> peek (castPtr $ currPtr s)   !w <- if usedBits s == 0-        then toBE64 <$> peek (castPtr $ currPtr s)+        then return w1         else do-           !w1 <- toBE64 <$> peek (castPtr $ currPtr s)            !(w2::Word8) <- peek (currPtr s `plusPtr` 8)            return $ w1 `unsafeShiftL` usedBits s  .|. fromIntegral (w2 `unsafeShiftR` (8-usedBits s))-  return $ GetResult (s {currPtr=currPtr s `plusPtr` 8}) (wordToDouble w)+  return $ GetResult (s {currPtr=currPtr s `plusPtr` 8}) w +{-# INLINE dFloat #-}+-- |Decode a Float+dFloat :: Get Float+dFloat = wordToFloat <$> dBE32++{-# INLINE dDouble #-}+-- |Decode a Double+dDouble :: Get Double+dDouble = wordToDouble <$> dBE64++-- |Decode a Lazy ByteString dLazyByteString_ :: Get L.ByteString dLazyByteString_ = L.fromStrict <$> dByteString_ +-- |Decode a ByteString dByteString_ :: Get B.ByteString dByteString_ = chunksToByteString <$> getChunksInfo +-- |Decode a ByteArray and its length dByteArray_ :: Get (ByteArray,Int) dByteArray_ = chunksToByteArray <$> getChunksInfo +-- |Decode an Array (a list of chunks up to 255 bytes long)+-- returning the pointer to the first data byte and a list of chunk sizes getChunksInfo :: Get (Ptr Word8, [Int]) getChunksInfo = Get $ \endPtr s -> do @@ -107,6 +257,6 @@               ensureBits endPtr s ((n+1)*8)               getChunks (srcPtr `plusPtr` (n+1)) (l . (n:)) -   when (usedBits s /=0) $ badEncoding endPtr s+   when (usedBits s /=0) $ badEncoding endPtr s "usedBits /= 0"    (currPtr',ns) <- getChunks (currPtr s) id    return $ GetResult (s {currPtr=currPtr'}) (currPtr s `plusPtr` 1,ns)

@@ -93,8 +93,8 @@         runGet (f x') end s'     {-# INLINE (>>=) #-} -    -- fail = getException-    -- {-# INLINE fail #-}+    fail msg = Get $ \end s -> badEncoding end s msg+    {-# INLINE fail #-}  -- |Decoder state data S =@@ -111,7 +111,7 @@ -- |An exception during decoding data DecodeException = NotEnoughSpace Env                      | TooMuchSpace Env-                     | BadEncoding Env+                     | BadEncoding Env String   deriving (Show,Eq,Ord)  type Env = (Ptr Word8,S)@@ -122,8 +122,8 @@ tooMuchSpace :: Ptr Word8 -> S -> IO a tooMuchSpace endPtr s = throwIO $ TooMuchSpace (endPtr,s) -badEncoding :: Ptr Word8 -> S -> IO a-badEncoding endPtr s = throwIO $ BadEncoding (endPtr,s)+badEncoding :: Ptr Word8 -> S -> String -> IO a+badEncoding endPtr s msg = throwIO $ BadEncoding (endPtr,s) msg  instance Exception DecodeException 

@@ -55,8 +55,9 @@     sShortBytes,     sUTF16,     sFillerMax,-    sBool-    ,sUTF8Max,eUTF8+    sBool,+    sUTF8Max,+    eUTF8,     ) where  import           Data.Flat.Encoder.Prim

@@ -51,8 +51,10 @@ preAligned :: a -> PreAligned a preAligned = PreAligned FillerEnd -postAlignedDecoder :: Get a -> Get (PostAligned a)+-- postAlignedDecoder :: Get a -> Get (PostAligned a)+postAlignedDecoder :: Get b -> Get b postAlignedDecoder dec = do   v <- dec   _::Filler <- decode-  return (postAligned v)+  -- return (postAligned v)+  return v

@@ -181,7 +181,7 @@ -- |Calculate size of an instance of IsMap {-# INLINE sizeMap #-} sizeMap :: (Flat (ContainerKey r), Flat (MapValue r), IsMap r) => Size r-sizeMap m acc = F.foldl' (\acc (k,v) -> size k (size v (acc + 1))) (acc+1) . mapToList $ m+sizeMap m acc = F.foldl' (\acc' (k,v) -> size k (size v (acc' + 1))) (acc+1) . mapToList $ m  {-# INLINE encodeMap #-} -- |Encode an instance of IsMap, as a list

@@ -1,59 +1,43 @@-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances         #-} -- |Encoding and decoding functions module Data.Flat.Run (     flat,-    flatStrict,+    flatRaw,     unflat,-    unflatStrict,     unflatWith,     unflatRaw,-    --unflatRawWith,+    unflatRawWith,     ) where -import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString         as B+import           Data.ByteString.Convert import           Data.Flat.Class import           Data.Flat.Decoder-import qualified Data.Flat.Encoder    as E+import qualified Data.Flat.Encoder       as E import           Data.Flat.Filler --- |Strictly encode padded value.-flatStrict :: Flat a => a -> B.ByteString-flatStrict = flat- -- |Encode padded value.-flat :: (FlatRaw (PostAligned a) c, Flat a) => a -> c+flat :: Flat a => a -> B.ByteString flat = flatRaw . postAligned -unflatStrict :: Flat a => B.ByteString -> Decoded a-unflatStrict = unflat- -- |Decode padded value.-unflat :: (FlatRaw (PostAligned a) b, Flat a) => b -> Decoded a+unflat :: (Flat a,AsByteString b) => b -> Decoded a unflat = unflatWith decode --- |Decode padded value, using the provided decoder.-unflatWith :: FlatRaw (PostAligned a) b => Get (PostAligned a) -> b -> Decoded a-unflatWith dec bs = postValue <$> unflatRawWith dec bs+-- |Decode padded value, using the provided unpadded decoder.+unflatWith :: AsByteString b => Get a -> b -> Decoded a+unflatWith dec = unflatRawWith (postAlignedDecoder dec) --- |Decode (unpadded) value.-unflatRaw :: (FlatRaw a b, Flat a) => b -> Decoded a+-- |Decode unpadded value.+unflatRaw :: (Flat a,AsByteString b) => b -> Decoded a unflatRaw = unflatRawWith decode -class FlatRaw a b where-  -- |Encode (unpadded) value-  flatRaw :: Flat a => a -> b--  -- |Unflat (unpadded) value, using provided decoder-  unflatRawWith :: Get a -> b -> Decoded a--instance Flat a => FlatRaw a B.ByteString where-  flatRaw a = E.strictEncoder (getSize a) (encode a)--  unflatRawWith = strictDecoder+-- |Unflat unpadded value, using provided decoder+unflatRawWith :: AsByteString b => Get a -> b -> Decoded a+unflatRawWith dec = strictDecoder dec . toByteString -instance Flat a => FlatRaw a L.ByteString where-  flatRaw = L.fromStrict . flatRaw-  unflatRawWith dec = unflatRawWith dec . L.toStrict+-- |Encode unpadded value+flatRaw :: (Flat a, AsByteString b) => a -> b+flatRaw a = fromByteString $ E.strictEncoder (getSize a) (encode a)

@@ -1,26 +1,4 @@-# pvp-bounds: lower--flags:-  binary-serialise-cbor:-    newtime15: true-extra-package-dbs: []-packages:-- '.'--- location:-    git: https://github.com/well-typed/binary-serialise-cbor-    commit: 5e2f20c0a2d8fd750f431af9a17ba116a6f31cf0-  extra-dep: true+resolver: lts-6.31 -# ghc-7.10.3-resolver: lts-6.30 extra-deps: - mono-traversable-1.0.2-- store-0.4.1-- store-core-0.4-- binary-0.8.5.1-- cereal-0.5.4.0-- th-utilities-0.2.0.1-- criterion-1.1.4.0-- optparse-applicative-0.13.0.0-

@@ -1,22 +1,1 @@-flags:-  binary-serialise-cbor:-    newtime15: true--extra-package-dbs: []--packages:-- '.'--- location:-    git: https://github.com/well-typed/binary-serialise-cbor-    commit: 5e2f20c0a2d8fd750f431af9a17ba116a6f31cf0-  extra-dep: true- -# 8.0.1-resolver: lts-7.20-extra-deps:-- store-0.4.1-- store-core-0.4-- binary-0.8.5.1-- criterion-1.1.4.0-- optparse-applicative-0.13.2.0+resolver: lts-7.21

@@ -1,23 +1,1 @@-flags:-  binary-serialise-cbor:-    newtime15: true--extra-package-dbs: []--packages:-- '.'--- location:-    git: https://github.com/well-typed/binary-serialise-cbor-    commit: 5e2f20c0a2d8fd750f431af9a17ba116a6f31cf0-  extra-dep: true- -# 8.0.2 - doesn't compile heavily mutually recursive data types.-# low performance on certain tests as encoder RULES are not applied-resolver: lts-8.5-extra-deps:-- store-0.4.1-- store-core-0.4-- binary-0.8.5.1-- derive-2.6.2- +resolver: lts-8.13

@@ -10,6 +10,7 @@ -- | Tests for the flat module module Main where +import           Data.Bits import qualified Data.ByteString       as B import qualified Data.ByteString.Lazy  as L import qualified Data.ByteString.Short as SBS@@ -18,6 +19,7 @@ import           Data.Either import           Data.Flat import           Data.Flat.Bits+import           Data.Flat.Decoder import           Data.Int import           Data.List import qualified Data.Map              as M@@ -204,6 +206,29 @@   ,s (-0.15625::Float)  [0b10111110,0b00100000,0,0]   ,s (-0.15625::Double) [0b10111111,0b11000100,0,0,0,0,0,0]   ,s (-123.2325E-23::Double) [0b10111011,0b10010111,0b01000111,0b00101000,0b01110101,0b01111011,0b01000111,0b10111010]+  ,dec ((,,,) <$> dropBits 13 <*> dBool <*> dBool <*> dBool) [0b10111110,0b10011010] ((),False,True,False)+  ,dec ((,,,) <$> dropBits 1 <*> dBE16 <*> dBool <*> dropBits 6) [0b11000000+                                                                 ,0b00000001+                                                                 ,0b01000000] ((),2^15+2,True,())+  ,dec ((,,,) <$> dropBits 1 <*> dBE32 <*> dBool <*> dropBits 6) [0b11000000+                                                                 ,0b00000000+                                                                 ,0b00000000+                                                                 ,0b00000001+                                                                 ,0b01000000] ((),2^31+2,True,())+  ,dec ((,,,) <$> dropBits 1 <*> dBE64 <*> dBool <*> dropBits 6) [0b11000000+                                                                 ,0b00000000+                                                                 ,0b00000000+                                                                 ,0b00000000+                                                                 ,0b00000000+                                                                 ,0b00000000+                                                                 ,0b00000000+                                                                 ,0b00000001+                                                                 ,0b01000000] ((),2^63+2,True,())++  ,decBitsN dBEBits8+  ,decBitsN dBEBits16+  ,decBitsN dBEBits32+  ,decBitsN dBEBits64   ,map trip [maxBound::Word16]   ,map trip [maxBound::Word32]   ,map trip [maxBound::Word64]@@ -248,7 +273,7 @@    -- Long LazyStrings can have internal sections shorter than 255    --,s (L.pack $ csb 600) (bsl s600)   ,[trip [1..100::Int16]]-  ,[trip unicodeText,trip unicodeTextUTF8T,trip unicodeTextUTF16T]+  ,[trip asciiStrT,trip "维护和平正",trip (T.pack "abc"),trip unicodeText,trip unicodeTextUTF8T,trip unicodeTextUTF16T]   ,[trip longBS,trip longLBS,trip longSBS]   ,[trip longSeq]   ,[trip mapV]@@ -301,6 +326,26 @@       s v e = [testCase (unwords ["flat raw",sshow v]) $ serRaw v @?= e]               --,testCase (unwords ["unflat raw",sshow v]) $ desRaw e @?= Right v] +      dec decOp v e = [testCase (unwords ["decode",sshow v]) $ unflatRawWith decOp (B.pack v) @?= Right e]++      decBitsN :: forall a. (Num a,FiniteBits a,Show a,Flat a) => (Int -> Get a) -> [TestTree]+      decBitsN dec = let s = finiteBitSize (undefined::a)+                     in [decBits_ dec v n pre | n <- [0 .. s], v <- [0::a ,1+2^(s - 2)+2^(s - 5) ,fromIntegral $ (2^s::Integer) - 1],pre <- [0,1,7]]++      -- why Flat a?+      decBits_ :: forall a. (FiniteBits a,Show a,Flat a) => (Int -> Get a) -> a -> Int -> Int -> TestTree+      decBits_ deco v n pre =+        let vs = B.pack . asBytes . fromBools $ replicate pre False ++ toBools (asBits v)+            len = B.length vs+            s = finiteBitSize (undefined::a)+            dec = do+              dropBits pre+              r <- deco n+              dropBits (len*8-n-pre)+              return r+            e = v `shiftR` (s - n)+        in testCase (unwords ["take",show n,"bits from",show v,"of size",show s,"with prefix",show pre]) $ unflatRawWith dec vs @?= Right e+       -- Aligned values unflat to the original value, modulo the added filler.       a v e = [testCase (unwords ["flat",sshow v]) $ ser v @?= e               ,testCase (unwords ["unflat",sshow v]) $ let Right v' = des e in v @?= v']@@ -320,10 +365,10 @@ uc = map ord "\x4444\x5555\x10001\xD800"  ser :: Flat a => a -> [Word8]-ser = L.unpack . flat+ser = B.unpack . flat  des :: Flat a => [Word8] -> Decoded a-des = unflat . L.pack+des = unflat  serRaw :: Flat a => a -> [Word8] -- serRaw = B.unpack . flatRaw

@@ -179,11 +179,13 @@  unicodeStrT = ("unicodeStr",unicodeStr) -unicodeStr = longS uniSS+unicodeStr = notLongS uniSS  uniSS = "\x1F600\&\x1F600\&\x1F600\&I promessi sposi è un celebre romanzo storico di Alessandro Manzoni, ritenuto il più famoso e il più letto tra quelli scritti in lingua italiana[1].维护和平正义 开创美好未来——习近平主席在纪念中国人民抗日战争暨世界反法西斯战争胜利70周年大会上重要讲话在国际社会引起热烈反响"  longS =  take 1000000 . concat . repeat++notLongS =  take 1000 . concat . repeat  arr0 = ("[Bool]",map (odd . ord) $ unicodeStr :: [Bool])