flat 0.5.2 → 0.6

raw patch · 23 files changed

+482/−272 lines, 23 filesdep ~semigroupsPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: semigroups

API changes (from Hackage documentation)

Files

• CHANGELOG +6/−0
• README.md +2/−1
• flat.cabal +48/−30
• src/Flat.hs +5/−3
• src/Flat/AsBin.hs +120/−0
• src/Flat/AsSize.hs +65/−0
• src/Flat/Class.hs +0/−17
• src/Flat/Decoder/Prim.hs +31/−4
• src/Flat/Decoder/Run.hs +11/−8
• src/Flat/Instances/Mono.hs +6/−0
• src/Flat/Memory.hs +26/−24
• src/Flat/Repr.hs +0/−62
• src/Flat/Run.hs +21/−10
• src/Flat/Tutorial.hs +13/−2
• src/Flat/Types.hs +0/−1
• stack.yaml +1/−0
• test/Big.hs +89/−0
• test/DocTest/Flat/AsBin.hs +18/−0
• test/DocTest/Flat/AsSize.hs +17/−0
• test/DocTest/Flat/Decoder/Prim.hs +1/−1
• test/DocTest/Flat/Repr.hs +0/−15
• test/DocTests.hs +2/−19
• test/FlatRepr.hs +0/−75

@@ -1,5 +1,11 @@ Significant and compatibility-breaking changes. ++Version 0.6:+    - [**breaking**] Renamed Repr to AsBin and SizeOf to AsSize+    - Faster AsBin implementation +    - Fixed AsSize implementation (SizeOf worked only for types with custom size implementation and returned max size, not actual size)+ Version 0.5.2:     - Fixed https://github.com/Quid2/flat/issues/28 that could cause an undetected overflow when decoding out of range Int/Word values     - Added UTF16Text and Data.ByteString.Short support for ghcjs

@@ -78,10 +78,11 @@  Tested with: -* [GHC](https://www.haskell.org/ghc/) 7.10.3 to 9.4.2 (x64)+* [GHC](https://www.haskell.org/ghc/) 7.10.3 to 9.4.3 (x64)   * [GHCJS](https://github.com/ghcjs/ghcjs) version 8.6.0.1 (GHC 8.6.2) +   ### Known Bugs and Infelicities

@@ -1,16 +1,29 @@ cabal-version:      >=1.10 name:               flat-version:            0.5.2+version:            0.6 homepage:           http://quid2.org synopsis:           Principled and efficient bit-oriented binary serialization.-description:        Reference implementation of `flat`, a principled and efficient binary serialization format.+description:+  Reference implementation of `flat`, a principled and efficient binary serialization format.+ category:           Data,Parsing,Serialization license:            BSD3 license-file:       LICENSE copyright:          Copyright: (c) 2016-2022 Pasqualino `Titto` Assini maintainer:         tittoassini@gmail.com author:             Pasqualino `Titto` Assini-tested-with:        GHC ==7.10.3 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.4 || ==9.4.2+tested-with:+  GHC ==7.10.3+   || ==8.0.2+   || ==8.2.2+   || ==8.4.4+   || ==8.6.5+   || ==8.8.4+   || ==8.10.7+   || ==9.0.2+   || ==9.2.4+   || ==9.4.3+ build-type:         Simple extra-source-files:   stack.yaml@@ -27,6 +40,8 @@     Data.FloatCast     Data.ZigZag     Flat+    Flat.AsBin+    Flat.AsSize     Flat.Bits     Flat.Class     Flat.Decoder@@ -56,7 +71,6 @@     Flat.Instances.Vector     Flat.Memory     Flat.Run-    Flat.Repr     Flat.Tutorial     Flat.Types @@ -84,11 +98,12 @@   ghc-options:     -Wall -O2 -funbox-strict-fields -fno-warn-orphans     -fno-warn-name-shadowing-    -- -Werror -    -- Stan options-    -- -fwrite-ide-info -hiedir=.hie+  -- -Werror +  -- Stan options+  -- -fwrite-ide-info -hiedir=.hie+   if impl(eta -any)     build-depends:         array                 ==0.5.2.0@@ -120,32 +135,34 @@       , deepseq               >=1.4       , dlist                 >=0.6       , ghc-prim+      , list-t                >1       , mono-traversable       , pretty                >=1.1.2       , primitive       , text       , unordered-containers       , vector-      , list-t > 1-  +   if impl(ghc <8)-    build-depends: -      semigroups < 0.19-      , hashable              >=1.2.4.0  && <=1.2.7.0-  else -    build-depends: hashable >= 1.4.0.1+    build-depends:+        hashable    >=1.2.4.0 && <=1.2.7.0+      , semigroups  >=0       && <0.19 +  else+    build-depends: hashable >=1.4.0.1+ test-suite spec   type:             exitcode-stdio-1.0   main-is:          Spec.hs   cpp-options:      -DLIST_BIT -DTEST_DECBITS    -- if impl(ghc <8.6)-  cpp-options: -DENUM_LARGE +  cpp-options:      -DENUM_LARGE    -- -DETA_VERSION -Dghcjs_HOST_OS -  ghc-options: -O0+  ghc-options:      -O0+   if impl(ghc >8)     ghc-options:       -Wno-unused-top-binds -Wno-type-defaults -Wno-missing-signatures@@ -173,7 +190,7 @@     , text    if impl(ghc <8)-    build-depends: semigroups < 0.19+    build-depends: semigroups <0.19    if impl(eta -any)     build-depends:@@ -196,9 +213,9 @@       , deepseq       , filepath       , mono-traversable+      , QuickCheck        >=2.14.2       , tasty       , text-      , QuickCheck >= 2.14.2   -- dynamic doctests and generation of static doctests -- Usable only with recent versions of ghc (no ghcjs or eta)@@ -211,10 +228,10 @@ --   build-depends: --       base --     , directory---     , doctest    ==0.16.3.1---     , filemanip  >=0.3.6.3+--     , doctest     ==0.16.3.1+--     , filemanip   >=0.3.6.3+--     , QuickCheck  >=2.14.2 --     , text---     , QuickCheck >= 2.14.2   -- static doctests (faster, useful for test coverage and to test ghcjs and eta) test-suite doc-static@@ -225,22 +242,23 @@     DocTest     DocTest.Data.FloatCast     DocTest.Data.ZigZag+    DocTest.Flat.AsBin+    DocTest.Flat.AsSize     DocTest.Flat.Bits     DocTest.Flat.Decoder.Prim+    DocTest.Flat.Encoder.Prim     DocTest.Flat.Endian-    DocTest.Flat.Repr     DocTest.Flat.Instances.Array     DocTest.Flat.Instances.Base     DocTest.Flat.Instances.ByteString     DocTest.Flat.Instances.Containers     DocTest.Flat.Instances.DList+    DocTest.Flat.Instances.Extra     DocTest.Flat.Instances.Mono     DocTest.Flat.Instances.Text     DocTest.Flat.Instances.Unordered     DocTest.Flat.Instances.Vector     DocTest.Flat.Tutorial-    DocTest.Flat.Encoder.Prim-    DocTest.Flat.Instances.Extra    default-language: Haskell2010   build-depends:@@ -251,31 +269,31 @@     , dlist     , flat     , pretty+    , QuickCheck            >=2.14.2     , tasty     , tasty-hunit     , tasty-quickcheck     , text     , unordered-containers     , vector-    , QuickCheck >= 2.14.2     if impl(ghc <8)     build-depends: semigroups <0.19 --- Test for Flat.Repr-test-suite repr+-- Test for Flat.AsBin Flat.AsSize and listTDecoder+test-suite big   type:             exitcode-stdio-1.0-  main-is:          FlatRepr.hs+  main-is:          Big.hs   hs-source-dirs:   test   default-language: Haskell2010   build-depends:       base     , bytestring     , flat-    , timeit     , list-t+    , timeit -  ghc-options: -rtsopts+  ghc-options:      -rtsopts  -- test-suite text --   type:             exitcode-stdio-1.0

@@ -11,9 +11,11 @@   ) where +import           Flat.AsBin     as X+import           Flat.AsSize    as X import           Flat.Class import           Flat.Decoder import           Flat.Filler-import           Flat.Instances                as X-import           Flat.Run                      as X-import           Flat.Types                     ( )+import           Flat.Instances as X+import           Flat.Run       as X+import           Flat.Types     ()

@@ -0,0 +1,120 @@+{-# LANGUAGE InstanceSigs              #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE ScopedTypeVariables       #-}++{- | Wrapper type to decode a value to its flat serialisation.++See <../test/Big.hs> for an example of use.++See also 'Flat.Decoder.listTDecoder' and "Flat.AsSize" for other ways to handle large decoded values.++In 0.5.X this type was called @Repr@.++@since 0.6+-}+module Flat.AsBin(AsBin,unbin) where++import qualified Data.ByteString                as B+import           Flat.Bits                      (bits, fromBools, toBools)+import           Flat.Class                     (Flat (..))+import           Flat.Decoder.Prim              (binOf)+import           Flat.Decoder.Types             (Get (Get, runGet),+                                                 GetResult (GetResult),+                                                 S (S, currPtr, usedBits))+import           Flat.Run                       (unflatRawWithOffset)+import           Foreign                        (plusPtr)+import           Text.PrettyPrint.HughesPJClass (Doc, Pretty (pPrint),+                                                 prettyShow, text)++-- $setup+-- >>> :set -XScopedTypeVariables+-- >>> import Flat.Instances.Base+-- >>> import Flat.Instances.Text+-- >>> import Flat.Decoder.Types+-- >>> import Flat.Types+-- >>> import Flat.Run+-- >>> import Data.Word+-- >>> import qualified Data.Text as T+-- >>> import Text.PrettyPrint.HughesPJClass++{- |++When the flat serialisation of a value takes a lot less memory than the value itself, it can be convenient to keep the value in its encoded representation and decode it on demand.++To do so, just decode a value `a` as a `AsBin a`.++Examples:++Encode a list of Ints and then decode it to a list of AsBin Int:++>>> unflat (flat [1::Int .. 3]) :: Decoded ([AsBin Int])+Right [AsBin {repr = "\129A", offsetBits = 1},AsBin {repr = "A ", offsetBits = 2},AsBin {repr = " \193", offsetBits = 3}]++To decode an `AsBin a` to an `a`, use `unbin`:++>>> unbin <$> (unflat (flat 'a') :: Decoded (AsBin Char))+Right 'a'++Keep the values of a list of Ints encoded and decode just one on demand:++>>> let Right l :: Decoded [AsBin Int] = unflat (flat [1..5]) in unbin (l  !! 2)+3++Show exactly how values are encoded:++>>> let Right t :: Decoded (AsBin Bool,AsBin Word8,AsBin Bool) = unflat (flat (False,3:: Word64,True)) in prettyShow t+"(0, _0000001 1, _1)"++Ten bits in total spread over two bytes:++@+0+_0000001 1+         _1+=+00000001 11+@++Tests:++>>> unflat (flat ()) :: Decoded (AsBin ())+Right (AsBin {repr = "", offsetBits = 0})++>>> unflat (flat (False,True)) :: Decoded (Bool,AsBin Bool)+Right (False,AsBin {repr = "A", offsetBits = 1})++>>> unflat (flat (False,False,255 :: Word8)) :: Decoded (Bool,Bool,AsBin Word8)+Right (False,False,AsBin {repr = "?\193", offsetBits = 2})++>>> let Right (b0,b1,rw,b3) :: Decoded (Bool,Bool,AsBin Word8,Bool) = unflat (flat (False,False,255 :: Word8,True)) in (b0,b1,unbin rw,b3)+(False,False,255,True)+-}++data AsBin a = AsBin {+    repr        :: B.ByteString -- ^ Flat encoding of the value (encoding starts after offset bits in the first byte and ends in an unspecified position in the last byte)+    ,offsetBits :: Int -- ^ First byte offset: number of unused most significant bits in the first byte+    } deriving Show++instance Flat a => Pretty (AsBin a) where+    pPrint :: AsBin a -> Doc+    pPrint r = let n = replicate (offsetBits r) in text $ n '_' ++  (drop (offsetBits r) . prettyShow . fromBools . (n False ++) . toBools . bits $ unbin r)++-- | Decode a value+unbin :: Flat a => AsBin a -> a+unbin a =+    case unflatRawWithOffset dec (repr a) (offsetBits a) of+        Right a -> a+        Left e  -> error (show e) -- impossible, as it is a valid encoding+    where+        dec = Get $ \end s -> do+          GetResult s' a <- runGet decode end s+          let s'' = S (currPtr s' `plusPtr` if usedBits s' == 0 then 0 else 1) 0+          return $ GetResult s'' a++instance Flat a => Flat (AsBin a) where+    size = error "unused"++    encode = error "unused"++    decode :: Flat a => Get (AsBin a)+    decode = uncurry AsBin <$> binOf (decode :: Get a)

@@ -0,0 +1,65 @@+{-# LANGUAGE InstanceSigs              #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE ScopedTypeVariables       #-}++{- |+Wrapper type to decode a value to its size in bits.++See also "Flat.AsBin".++In 0.5.X this type was called @SizeOf@.++@since 0.6+-}+module Flat.AsSize(AsSize(..)) where++import           Flat.Class         (Flat (..))+import           Flat.Decoder.Prim  (sizeOf)+import           Flat.Decoder.Types (Get)+import           Flat.Types         (NumBits)++-- $setup+-- >>> :set -XScopedTypeVariables+-- >>> import Flat.Instances.Base+-- >>> import Flat.Instances.Text+-- >>> import Flat.Decoder.Types+-- >>> import Flat.Types+-- >>> import Flat.Run+-- >>> import Data.Word+-- >>> import qualified Data.Text as T++{- |+Useful to skip unnecessary values and to check encoding sizes.++Examples:++Ignore the second and fourth component of a tuple:++>>> let v = flat ('a',"abc",'z',True) in unflat v :: Decoded (Char,AsSize String,Char,AsSize Bool)+Right ('a',AsSize 28,'z',AsSize 1)++Notice the variable size encoding of Words:++>>> unflat (flat (1::Word16,1::Word64)) :: Decoded (AsSize Word16,AsSize Word64)+Right (AsSize 8,AsSize 8)++Text:++>>> unflat (flat (T.pack "",T.pack "a",T.pack "主",UTF8Text $ T.pack "主",UTF16Text $ T.pack "主",UTF16Text $ T.pack "a")) :: Decoded (AsSize T.Text,AsSize T.Text,AsSize T.Text,AsSize UTF8Text,AsSize UTF16Text,AsSize UTF16Text)+Right (AsSize 16,AsSize 32,AsSize 48,AsSize 48,AsSize 40,AsSize 40)++Various encodings:++>>> unflat (flat (False,[T.pack "",T.pack "a",T.pack "主"],'a')) :: Decoded (AsSize Bool,AsSize [T.Text],AsSize Char)+Right (AsSize 1,AsSize 96,AsSize 8)+-}+newtype AsSize a = AsSize NumBits deriving (Eq,Ord,Show)++instance Flat a => Flat (AsSize a) where+    size :: Flat a => AsSize a -> NumBits -> NumBits+    size = error "unused"++    encode = error "unused"++    decode :: Flat a => Get (AsSize a)+    decode = AsSize <$> sizeOf (decode :: Get a)

@@ -21,7 +21,6 @@   , getSize   , module GHC.Generics   , GFlatEncode,GFlatDecode,GFlatSize-  , SizeOf(..)   ) where @@ -31,7 +30,6 @@                                      consClose, consOpen, dBool) import           Flat.Decoder.Types (Get) import           Flat.Encoder       (Encoding, NumBits, eBits16, mempty)-import           GHC.Base           (Any) import           GHC.Generics import           GHC.TypeLits       (Nat, type (+), type (<=)) import           Prelude            hiding (mempty)@@ -102,21 +100,6 @@     {-# NOINLINE decode #-}     {-# NOINLINE encode #-} #endif---- | Skip a value, return its size in bits-skip :: forall a. (GFlatSize (Rep a),GFlatDecode (Rep a)) => Get (SizeOf a)-skip = SizeOf . (gsize 0 :: Rep a Any -> NumBits) <$> (gget :: Get (Rep a Any))-{-# INLINE skip #-}---- | Decode to the size in bits of a value rather than to the value itself (see "Flat.Repr")-newtype SizeOf a = SizeOf NumBits deriving Show--instance (GFlatSize (Rep a),GFlatDecode (Rep a)) => Flat (SizeOf a) where-    size = error "unused"-    encode = error "unused"--    decode = skip-  -- |Generic Encoder class GFlatEncode f where gencode :: f a -> Encoding

@@ -22,7 +22,9 @@     dLazyByteString_,     dByteArray_, -    ConsState(..),consOpen,consClose,consBool,consBits+    ConsState(..),consOpen,consClose,consBool,consBits,++    sizeOf,binOf     ) where  import           Control.Monad        (when)@@ -30,11 +32,13 @@ import qualified Data.ByteString.Lazy as L import           Data.FloatCast       (wordToDouble, wordToFloat) import           Data.Word            (Word16, Word32, Word64, Word8)-import           Flat.Decoder.Types   (Get (Get), GetResult (..), S (..),-                                       badEncoding, badOp, notEnoughSpace)+import           Flat.Decoder.Types   (Get (Get, runGet), GetResult (..),+                                       S (..), badEncoding, badOp,+                                       notEnoughSpace) import           Flat.Endian          (toBE16, toBE32, toBE64) import           Flat.Memory          (ByteArray, chunksToByteArray,-                                       chunksToByteString, minusPtr)+                                       chunksToByteString, minusPtr,+                                       peekByteString) import           Foreign              (Bits (unsafeShiftL, unsafeShiftR, (.&.), (.|.)),                                        FiniteBits (finiteBitSize), Ptr,                                        Storable (peek), castPtr, plusPtr,@@ -410,3 +414,26 @@    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)++{- | Given a value's decoder, returns the size in bits of the encoded value++@since 0.6+-}+sizeOf :: Get a -> Get Int+sizeOf g =+    Get $ \end s -> do+      GetResult s' _ <- runGet g end s+      return $ GetResult s' $ (currPtr s' `minusPtr` currPtr s) * 8 - usedBits s + usedBits s'++{- | Given a value's decoder, returns the value's bit encoding.++The encoding starts at the returned bit position in the return bytestring's first byte+and ends in an unspecified bit position in its final byte++@since 0.6+-}+binOf :: Get a -> Get (B.ByteString,Int)+binOf g =+    Get $ \end s -> do+      GetResult s' _ <- runGet g end s+      return $ GetResult s' (peekByteString (currPtr s) (currPtr s' `minusPtr` currPtr s + if usedBits s' == 0 then 0 else 1),usedBits s)

@@ -10,10 +10,10 @@ import           ListT                    (ListT (..)) import           System.IO.Unsafe         (unsafePerformIO) --- | Given a decoder and an input buffer returns either the decoded value or an error  (if the input buffer is not fully consumed)-strictDecoder :: Get a -> B.ByteString -> Either DecodeException a-strictDecoder get bs =-  strictDecoder_ get bs $ \(GetResult s'@(S ptr' o') a) endPtr ->+-- | Given a decoder and an input buffer returns either the decoded value or an error (if the input buffer is not fully consumed)+strictDecoder :: Get a -> B.ByteString -> Int -> Either DecodeException a+strictDecoder get bs usedBits=+  strictDecoder_ get bs usedBits $ \(GetResult s'@(S ptr' o') a) endPtr ->     if ptr' /= endPtr || o' /= 0       then tooMuchSpace endPtr s'       else return a@@ -22,14 +22,15 @@      Exception e   => Get a1   -> BS.ByteString+  -> Int   -> (GetResult a1 -> Ptr b -> IO a)   -> Either e a-strictDecoder_ get (BS.PS base off len) check =+strictDecoder_ get (BS.PS base off len) usedBits check =   unsafePerformIO . try $   withForeignPtr base $ \base0 ->     let ptr = base0 `plusPtr` off         endPtr = ptr `plusPtr` len-     in do res <- runGet get endPtr (S ptr 0)+     in do res <- runGet get endPtr (S ptr usedBits)            check res endPtr {-# NOINLINE strictDecoder_ #-} @@ -43,12 +44,14 @@ --       GetResult (S ptr' o') a <- runGet get endPtr (S ptr 0) --       return (a, BS.PS base (ptr' `minusPtr` base0) (endPtr `minusPtr` ptr'), o') -{-| +{-| Decode a list of values, one value at a time.  Useful in case that the decoded values takes a lot more memory than the encoded ones. -See test/FlatRepr.hs for a test and an example of use.+See <../test/Big.hs> for a test and an example of use.++See also "Flat.AsBin".  @since 0.5 -}

@@ -168,6 +168,12 @@ decodeList :: (IsSequence b, Flat (Element b)) => Get b decodeList = S.fromList <$> decodeListWith decode +{-|+Sets are saved as lists of values.++>>> tstBits $ AsSet (Data.Set.fromList ([False,True,False]::[Bool]))+(True,5,"10110")+-} newtype AsSet a =   AsSet     { unSet :: a

@@ -15,29 +15,25 @@   , pokeByteString   , unsafeCreateUptoN'   , minusPtr-  --, peekByteString+  , peekByteString   ) where -import Control.Monad ( foldM_, when )-import           Control.Monad.Primitive        ( PrimMonad(..) )-import qualified Data.ByteString.Internal      as BS-import           Data.Primitive.ByteArray       ( MutableByteArray(..)-                                                , ByteArray#-                                                , ByteArray-                                                , newByteArray-                                                , unsafeFreezeByteArray-                                                )-import Foreign ( Word8, Ptr, withForeignPtr, minusPtr, plusPtr )-import           GHC.Prim                       ( copyAddrToByteArray#-                                                , copyByteArrayToAddr#-                                                )-import           GHC.Ptr                        ( Ptr(..) )-import           GHC.Types                      ( IO(..)-                                                , Int(..)-                                                )-import System.IO.Unsafe ( unsafeDupablePerformIO, unsafePerformIO )-import qualified Data.ByteString               as B+import           Control.Monad            (foldM_, when)+import           Control.Monad.Primitive  (PrimMonad (..))+import qualified Data.ByteString          as B+import qualified Data.ByteString.Internal as BS+import           Data.Primitive.ByteArray (ByteArray, ByteArray#,+                                           MutableByteArray (..), newByteArray,+                                           unsafeFreezeByteArray)+import           Foreign                  (Ptr, Word8, minusPtr, plusPtr,+                                           withForeignPtr)+import           GHC.Prim                 (copyAddrToByteArray#,+                                           copyByteArrayToAddr#)+import           GHC.Ptr                  (Ptr (..))+import           GHC.Types                (IO (..), Int (..))+import           System.IO.Unsafe         (unsafeDupablePerformIO,+                                           unsafePerformIO)  unsafeCreateUptoN' :: Int -> (Ptr Word8 -> IO (Int, a)) -> (BS.ByteString, a) unsafeCreateUptoN' l f = unsafeDupablePerformIO (createUptoN' l f)@@ -65,10 +61,16 @@       sourceLength     return (destPointer `plusPtr` sourceLength) --- Create a new bytestring, copying from sourcePtr sourceLength number of bytes--- peekByteString :: Ptr Word8 -> Int -> BS.ByteString--- peekByteString sourcePtr sourceLength = BS.unsafeCreate sourceLength $ \destPointer -> BS.memcpy destPointer sourcePtr sourceLength+{-| Create a new bytestring, copying sourceLen bytes from sourcePtr +@since 0.6+-}+peekByteString ::+  Ptr Word8 -- ^ sourcePtr+  -> Int -- ^ sourceLen+  -> BS.ByteString+peekByteString sourcePtr sourceLength = BS.unsafeCreate sourceLength $ \destPointer -> BS.memcpy destPointer sourcePtr sourceLength+ -- |Copy ByteArray to given pointer, returns new pointer pokeByteArray :: ByteArray# -> Int -> Int -> Ptr Word8 -> IO (Ptr Word8) pokeByteArray sourceArr sourceOffset len dest = do@@ -115,7 +117,7 @@   -- | Wrapper around @copyAddrToByteArray#@ primop.--- +-- -- Copied from the store-core package copyAddrToByteArray   :: Ptr a -> MutableByteArray (PrimState IO) -> Int -> Int -> IO ()

@@ -1,62 +0,0 @@-{-# LANGUAGE InstanceSigs        #-}-{-# LANGUAGE ScopedTypeVariables #-}-module Flat.Repr where--import qualified Data.ByteString    as B-import           Flat.Class         (Flat (..))-import           Flat.Decoder.Types (Get)-import           Flat.Run           (flat, unflat)---- $setup--- >>> :set -XScopedTypeVariables--- >>> import Flat.Instances.Base--- >>> import Flat.Decoder.Types--- >>> import Flat.Types--- >>> import Flat.Run--- >>> import Flat.Class--{- | Flat representation of a value--== Repr -It is occasionally useful to keep a decoded value, or part of it, in its encoded binary representation and decode it later on demand.--To do so, just decode a value `a` to a `Repr a`.--For example, we encode a list of Ints and then decode it to a list of Repr Int:-->>> unflat (flat [1::Int .. 5]) :: Decoded ([Repr Int])-Right [Repr {repr = "\STX\SOH"},Repr {repr = "\EOT\SOH"},Repr {repr = "\ACK\SOH"},Repr {repr = "\b\SOH"},Repr {repr = "\n\SOH"}]--To decode a `Repr a` to an `a`, we use `unrepr`:-->>> let Right l = unflat (flat [1..5]) :: Decoded [Repr Int] in unrepr (l  !! 2)-3--See "test/FlatRepr.hs" for a test and a longer example of use.--== SizeOf-If a decoded value is not required, it can be skipped completely using `SizeOf a`.--For example, to ignore the second and fourth component of the following tuple, it can be decoded as:-->>> let v = flat ('a',"abc",'z',True) in unflat v :: Decoded (Char,SizeOf String,Char,SizeOf Bool)-Right ('a',SizeOf 28,'z',SizeOf 1)--The unused values have not been decoded and instead their size (in bits) is returned.--}--newtype Repr a = Repr {repr :: B.ByteString} deriving Show---- Get the underlying value-unrepr :: Flat a => Repr a -> a-unrepr (Repr bs)=-    case unflat bs of-        Right a -> a-        Left _  -> error "impossible"--instance Flat a => Flat (Repr a) where-    size = error "unused"-    encode = error "unused"--    -- To create the representation we just re 'flat' the parsed value (this could be optimised by copying directly the parsed representation)-    decode = Repr . flat <$> (decode :: Get a)

@@ -1,6 +1,6 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE MultiParamTypeClasses #-}  -- |Encoding and decoding functions@@ -11,14 +11,16 @@     unflatWith,     unflatRaw,     unflatRawWith,+    unflatRawWithOffset, ) where -import qualified Data.ByteString as B-import Data.ByteString.Convert (AsByteString (..))-import Flat.Class (Flat (decode, encode), getSize)-import Flat.Decoder (Decoded, Get, strictDecoder)-import qualified Flat.Encoder as E-import Flat.Filler (postAligned, postAlignedDecoder)+import qualified Data.ByteString         as B+import           Data.ByteString.Convert (AsByteString (..))+import           Flat.Class              (Flat (decode, encode), getSize)+import           Flat.Decoder            (Decoded, Get, strictDecoder)+import           Flat.Encoder            (NumBits)+import qualified Flat.Encoder            as E+import           Flat.Filler             (postAligned, postAlignedDecoder)  -- |Encode padded value. flat :: Flat a => a -> B.ByteString@@ -38,7 +40,16 @@  -- |Unflat unpadded value, using provided decoder unflatRawWith :: AsByteString b => Get a -> b -> Decoded a-unflatRawWith dec = strictDecoder dec . toByteString+unflatRawWith dec bs = unflatRawWithOffset dec bs 0++unflatRawWithOffset :: AsByteString b => Get a -> b -> NumBits -> Decoded a+unflatRawWithOffset dec bs = strictDecoder dec (toByteString bs)++-- unflatRawWith :: AsByteString b => Get a -> b -> Decoded a+-- unflatRawWith dec bs = unflatRawWithOffset dec bs 0++-- unflatRawWithOffset :: AsByteString b => Get a -> b -> Int -> Decoded a+-- unflatRawWithOffset dec bs = strictDecoder dec (toByteString bs)  -- |Encode unpadded value flatRaw :: (Flat a, AsByteString b) => a -> b

@@ -56,7 +56,7 @@ A pecularity of Flat is that it uses an optimal bit-encoding rather than the usual byte-oriented one. -One bit is all we need for a 'Result' or for an empty 'List' value:+One bit is sufficient to encode a 'Result' or an empty 'List':  >>> flatBits Good "1"@@ -64,7 +64,7 @@ >>> flatBits (Nil::List Direction) "0" -Two or three bits suffice for a 'Direction' value:+Two or three bits suffice for a 'Direction':  >>> flatBits South "01"@@ -100,6 +100,17 @@  >>> flatBits $ Just True "11"++=== Wrapper Types++There are a few wrapper types that modify the way encoding and/or decoding occur.++* "Flat.AsBin" and "Flat.AsSize" decode to a value's flat binary representation or size in bits respectively.++* 'Flat.Instances.Mono.AsArray' and 'Flat.Instances.Mono.AsList' encode/decode a sequence as a List or Array respectively, see "Flat.Instances.Mono" for details.++* 'Flat.Instances.Text.UTF8Text' and 'Flat.Instances.Text.UTF16Text' encode/decode a Text as UTF8 or UTF16 respectively.+ -}  

@@ -1,5 +1,4 @@ {-# LANGUAGE FlexibleInstances    #-}-{-# LANGUAGE TypeSynonymInstances #-} -- |Common Types module Flat.Types (     NumBits,

@@ -39,4 +39,5 @@   # - Cabal-3.6.3.0@sha256:ff97c442b0c679c1c9876acd15f73ac4f602b973c45bde42b43ec28265ee48f4,12459   # - parsec-3.1.15.0@sha256:a162d4cc8884014ba35192545cad293af0529fe11497aad8834bbaaa3dfffc26,4429   # - hashable-1.4.1.0@sha256:50b2f002c68fe67730ee7a3cd8607486197dd99b084255005ad51ecd6970a41b,5019+ allow-newer: true

@@ -0,0 +1,89 @@+{-# LANGUAGE ScopedTypeVariables #-}++{-+Test different ways of handlings a data type that has large values and a small encoding.++To run with limited memory: cabal run big -- +RTS  -M2g+-}++module Main where+import qualified Data.ByteString as B+import           Data.List       (foldl')+import           Flat            (Decoded, Flat (..), flat, unflat, unflatWith)+import           Flat.AsBin      (AsBin, unbin)+import           Flat.AsSize+import           Flat.Decoder    (Get, listTDecoder)+import qualified ListT           as L+import           System.TimeIt   (timeIt)++-- Big is a type that has a small encoded representation but a very large in-memory footprint.+-- It is a very large bytestring whose bytes are all set to 0+newtype Big = Big B.ByteString++newBig :: Int -> Big+newBig gigas = Big $ B.replicate (gigas*giga) 0++-- length of Big in gigas+gigas :: Big -> Int+gigas (Big b) = B.length b `div` giga++giga :: Int+giga = 1000000000++instance Show Big where show b = "Big of " ++ show (gigas b) ++ "Gbytes"++instance Flat Big where+    -- The encoded form is just the number of giga zeros (e.g. 5 for 5Giga zeros)+    size big = size (gigas big)+    encode big = encode (gigas big)++    -- The decoded form is massive+    decode = newBig <$> decode++main :: IO ()+main = tbig++tbig = do+    let numOfBigs = 5++    -- A serialised list of Big values+    let bigsFile = flat $ replicate numOfBigs $ newBig 1+    print "Encoding Time"+    timeIt $ print $ B.length bigsFile++    tstAsSize bigsFile++    tstAsBin bigsFile++    tstListT bigsFile++    tstBig bigsFile++-- If we unserialise a list of Bigs and then process them (e.g. print them out) we end up in trouble, too much memory is required.+tstBig :: B.ByteString -> IO ()+tstBig bigsFile = timeIt $ do+    print "Decode to [Big]:"+    let Right (bs :: [Big]) = unflat bigsFile+    mapM_ print bs++-- So instead we unserialise them to a list of their flat representations, to be unflatted on demand later on+tstAsBin :: B.ByteString -> IO ()+tstAsBin bigsFile = timeIt $ do+    print "Decode to [AsBin Big]:"+    let Right (bsR :: [AsBin Big]) = unflat bigsFile+    let bs = map unbin bsR+    mapM_ print bs++tstAsSize :: B.ByteString -> IO ()+tstAsSize bigsFile = timeIt $ do+    print "Decode to [AsSize Big]:"+    let Right (bs :: [AsSize Big]) = unflat bigsFile+    mapM_ print bs++-- Or: we extract one element at the time via a ListT+-- See http://hackage.haskell.org/package/list-t-1.0.4/docs/ListT.html+tstListT :: B.ByteString -> IO ()+tstListT bigsFile = timeIt $ do+    print "Decode to ListT IO Big:"+    stream :: L.ListT IO Big <- listTDecoder decode bigsFile+    L.traverse_ print stream

@@ -0,0 +1,18 @@+{-# LANGUAGE ScopedTypeVariables#-}++{-# LANGUAGE NoMonomorphismRestriction, ExtendedDefaultRules#-}+module DocTest.Flat.AsBin where+import qualified DocTest+import Test.Tasty(TestTree,testGroup)+import Flat.AsBin+import Flat.Instances.Base+import Flat.Instances.Text+import Flat.Decoder.Types+import Flat.Types+import Flat.Run+import Data.Word+import qualified Data.Text as T+import Text.PrettyPrint.HughesPJClass++tests :: IO TestTree+tests = testGroup "Flat.AsBin" <$> sequence [  DocTest.test "src/Flat/AsBin.hs:50" "[ExpectedLine [LineChunk \"Right [AsBin {repr = \\\"\\\\129A\\\", offsetBits = 1},AsBin {repr = \\\"A \\\", offsetBits = 2},AsBin {repr = \\\" \\\\193\\\", offsetBits = 3}]\"]]" (DocTest.asPrint( unflat (flat [1::Int .. 3]) :: Decoded ([AsBin Int]) )),  DocTest.test "src/Flat/AsBin.hs:55" "[ExpectedLine [LineChunk \"Right 'a'\"]]" (DocTest.asPrint( unbin <$> (unflat (flat 'a') :: Decoded (AsBin Char)) )),  DocTest.test "src/Flat/AsBin.hs:60" "[ExpectedLine [LineChunk \"3\"]]" (DocTest.asPrint( let Right l :: Decoded [AsBin Int] = unflat (flat [1..5]) in unbin (l  !! 2) )),  DocTest.test "src/Flat/AsBin.hs:65" "[ExpectedLine [LineChunk \"\\\"(0, _0000001 1, _1)\\\"\"]]" (DocTest.asPrint( let Right t :: Decoded (AsBin Bool,AsBin Word8,AsBin Bool) = unflat (flat (False,3:: Word64,True)) in prettyShow t )),  DocTest.test "src/Flat/AsBin.hs:80" "[ExpectedLine [LineChunk \"Right (AsBin {repr = \\\"\\\", offsetBits = 0})\"]]" (DocTest.asPrint( unflat (flat ()) :: Decoded (AsBin ()) )),  DocTest.test "src/Flat/AsBin.hs:83" "[ExpectedLine [LineChunk \"Right (False,AsBin {repr = \\\"A\\\", offsetBits = 1})\"]]" (DocTest.asPrint( unflat (flat (False,True)) :: Decoded (Bool,AsBin Bool) )),  DocTest.test "src/Flat/AsBin.hs:86" "[ExpectedLine [LineChunk \"Right (False,False,AsBin {repr = \\\"?\\\\193\\\", offsetBits = 2})\"]]" (DocTest.asPrint( unflat (flat (False,False,255 :: Word8)) :: Decoded (Bool,Bool,AsBin Word8) )),  DocTest.test "src/Flat/AsBin.hs:89" "[ExpectedLine [LineChunk \"(False,False,255,True)\"]]" (DocTest.asPrint( let Right (b0,b1,rw,b3) :: Decoded (Bool,Bool,AsBin Word8,Bool) = unflat (flat (False,False,255 :: Word8,True)) in (b0,b1,unbin rw,b3) ))]

@@ -0,0 +1,17 @@+{-# LANGUAGE ScopedTypeVariables#-}++{-# LANGUAGE NoMonomorphismRestriction, ExtendedDefaultRules#-}+module DocTest.Flat.AsSize where+import qualified DocTest+import Test.Tasty(TestTree,testGroup)+import Flat.AsSize+import Flat.Instances.Base+import Flat.Instances.Text+import Flat.Decoder.Types+import Flat.Types+import Flat.Run+import Data.Word+import qualified Data.Text as T++tests :: IO TestTree+tests = testGroup "Flat.AsSize" <$> sequence [  DocTest.test "src/Flat/AsSize.hs:38" "[ExpectedLine [LineChunk \"Right ('a',AsSize 28,'z',AsSize 1)\"]]" (DocTest.asPrint( let v = flat ('a',"abc",'z',True) in unflat v :: Decoded (Char,AsSize String,Char,AsSize Bool) )),  DocTest.test "src/Flat/AsSize.hs:43" "[ExpectedLine [LineChunk \"Right (AsSize 8,AsSize 8)\"]]" (DocTest.asPrint( unflat (flat (1::Word16,1::Word64)) :: Decoded (AsSize Word16,AsSize Word64) )),  DocTest.test "src/Flat/AsSize.hs:48" "[ExpectedLine [LineChunk \"Right (AsSize 16,AsSize 32,AsSize 48,AsSize 48,AsSize 40,AsSize 40)\"]]" (DocTest.asPrint( unflat (flat (T.pack "",T.pack "a",T.pack "主",UTF8Text $ T.pack "主",UTF16Text $ T.pack "主",UTF16Text $ T.pack "a")) :: Decoded (AsSize T.Text,AsSize T.Text,AsSize T.Text,AsSize UTF8Text,AsSize UTF16Text,AsSize UTF16Text) )),  DocTest.test "src/Flat/AsSize.hs:53" "[ExpectedLine [LineChunk \"Right (AsSize 1,AsSize 96,AsSize 8)\"]]" (DocTest.asPrint( unflat (flat (False,[T.pack "",T.pack "a",T.pack "主"],'a')) :: Decoded (AsSize Bool,AsSize [T.Text],AsSize Char) ))]

@@ -12,4 +12,4 @@ import Text.PrettyPrint.HughesPJClass (Pretty (pPrint))  tests :: IO TestTree-tests = testGroup "Flat.Decoder.Prim" <$> sequence [  DocTest.test "src/Flat/Decoder/Prim.hs:194" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( unflatWith (dBEBits8 3) [0b11100001::Word8] == Right 0b00000111 )),  DocTest.test "src/Flat/Decoder/Prim.hs:197" "[ExpectedLine [LineChunk \"Left (BadOp \\\"read8: cannot read 9 bits\\\")\"]]" (DocTest.asPrint( unflatWith (dBEBits8 9) [0b11100001::Word8,0b11111111] )),  DocTest.test "src/Flat/Decoder/Prim.hs:210" "[ExpectedLine [LineChunk \"Right 00000101 10111111\"]]" (DocTest.asPrint( pPrint . asBits <$> unflatWith (dBEBits16 11) [0b10110111::Word8,0b11100001] )),  DocTest.test "src/Flat/Decoder/Prim.hs:215" "[ExpectedLine [LineChunk \"Right 00000111 11111111\"]]" (DocTest.asPrint( pPrint . asBits <$> unflatWith (dBEBits16 19) [0b00000000::Word8,0b11111111,0b11100001] ))]+tests = testGroup "Flat.Decoder.Prim" <$> sequence [  DocTest.test "src/Flat/Decoder/Prim.hs:198" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( unflatWith (dBEBits8 3) [0b11100001::Word8] == Right 0b00000111 )),  DocTest.test "src/Flat/Decoder/Prim.hs:201" "[ExpectedLine [LineChunk \"Left (BadOp \\\"read8: cannot read 9 bits\\\")\"]]" (DocTest.asPrint( unflatWith (dBEBits8 9) [0b11100001::Word8,0b11111111] )),  DocTest.test "src/Flat/Decoder/Prim.hs:214" "[ExpectedLine [LineChunk \"Right 00000101 10111111\"]]" (DocTest.asPrint( pPrint . asBits <$> unflatWith (dBEBits16 11) [0b10110111::Word8,0b11100001] )),  DocTest.test "src/Flat/Decoder/Prim.hs:219" "[ExpectedLine [LineChunk \"Right 00000111 11111111\"]]" (DocTest.asPrint( pPrint . asBits <$> unflatWith (dBEBits16 19) [0b00000000::Word8,0b11111111,0b11100001] ))]

@@ -1,15 +0,0 @@-{-# LANGUAGE ScopedTypeVariables#-}--{-# LANGUAGE NoMonomorphismRestriction, ExtendedDefaultRules#-}-module DocTest.Flat.Repr where-import qualified DocTest-import Test.Tasty(TestTree,testGroup)-import Flat.Repr-import Flat.Instances.Base-import Flat.Decoder.Types-import Flat.Types-import Flat.Run-import Flat.Class--tests :: IO TestTree-tests = testGroup "Flat.Repr" <$> sequence [  DocTest.test "src/Flat/Repr.hs:27" "[ExpectedLine [LineChunk \"Right [Repr {repr = \\\"\\\\STX\\\\SOH\\\"},Repr {repr = \\\"\\\\EOT\\\\SOH\\\"},Repr {repr = \\\"\\\\ACK\\\\SOH\\\"},Repr {repr = \\\"\\\\b\\\\SOH\\\"},Repr {repr = \\\"\\\\n\\\\SOH\\\"}]\"]]" (DocTest.asPrint( unflat (flat [1::Int .. 5]) :: Decoded ([Repr Int]) )),  DocTest.test "src/Flat/Repr.hs:32" "[ExpectedLine [LineChunk \"3\"]]" (DocTest.asPrint( let Right l = unflat (flat [1..5]) :: Decoded [Repr Int] in unrepr (l  !! 2) )),  DocTest.test "src/Flat/Repr.hs:42" "[ExpectedLine [LineChunk \"Right ('a',SizeOf 28,'z',SizeOf 1)\"]]" (DocTest.asPrint( let v = flat ('a',"abc",'z',True) in unflat v :: Decoded (Char,SizeOf String,Char,SizeOf Bool) ))]

@@ -1,23 +1,6 @@ module Main where import           Test.Tasty import           Test.Tasty.HUnit-import qualified DocTest.Flat.Bits-import qualified DocTest.Flat.Repr-import qualified DocTest.Flat.Instances.Array-import qualified DocTest.Flat.Instances.ByteString-import qualified DocTest.Flat.Instances.DList-import qualified DocTest.Flat.Instances.Extra-import qualified DocTest.Flat.Instances.Containers-import qualified DocTest.Flat.Instances.Base-import qualified DocTest.Flat.Instances.Unordered-import qualified DocTest.Flat.Instances.Vector-import qualified DocTest.Flat.Instances.Mono-import qualified DocTest.Flat.Instances.Text-import qualified DocTest.Flat.Encoder.Prim-import qualified DocTest.Flat.Tutorial-import qualified DocTest.Flat.Decoder.Prim-import qualified DocTest.Flat.Endian-import qualified DocTest.Data.ZigZag-import qualified DocTest.Data.FloatCast+import qualified DocTest.Flat.AsBin -main = (testGroup "DocTests" <$> sequence [DocTest.Flat.Bits.tests,DocTest.Flat.Repr.tests,DocTest.Flat.Instances.Array.tests,DocTest.Flat.Instances.ByteString.tests,DocTest.Flat.Instances.DList.tests,DocTest.Flat.Instances.Extra.tests,DocTest.Flat.Instances.Containers.tests,DocTest.Flat.Instances.Base.tests,DocTest.Flat.Instances.Unordered.tests,DocTest.Flat.Instances.Vector.tests,DocTest.Flat.Instances.Mono.tests,DocTest.Flat.Instances.Text.tests,DocTest.Flat.Encoder.Prim.tests,DocTest.Flat.Tutorial.tests,DocTest.Flat.Decoder.Prim.tests,DocTest.Flat.Endian.tests,DocTest.Data.ZigZag.tests,DocTest.Data.FloatCast.tests]) >>= defaultMain+main = (testGroup "DocTests" <$> sequence [DocTest.Flat.AsBin.tests]) >>= defaultMain

@@ -1,75 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}-module Main where-import qualified Data.ByteString as B-import           Data.List       (foldl')-import           Flat            (Decoded, Flat (..), flat, unflat, unflatWith)-import           Flat.Decoder    (Get, listTDecoder)-import           Flat.Repr       (Repr, unrepr)-import qualified ListT           as L-import           System.TimeIt   (timeIt)---- Big is a type that has a small encoded representation but a very large in-memory footprint.--- It is a very large bytestring whose bytes are all set to 0-newtype Big = Big B.ByteString--newBig :: Int -> Big-newBig gigas = Big $ B.replicate (gigas*giga) 0---- length of Big in gigas-gigas :: Big -> Int-gigas (Big b) = B.length b `div` giga--giga :: Int-giga = 1000000000--instance Show Big where show b = "Big of " ++ show (gigas b) ++ "Gbytes"--instance Flat Big where-    -- The encoded form is just the number of giga zeros (e.g. 5 for 5Giga zeros)-    size big = size (gigas big)-    encode big = encode (gigas big)--    -- The decoded form is massive-    decode = newBig <$> decode---- Run this as: cabal run FlatRepr -- +RTS  -M2g-main :: IO ()-main = tbig--tbig = do-    let numOfBigs = 5--    -- A serialised list of Big values-    let bigsFile = flat $ replicate numOfBigs $ newBig 1-    timeIt $ print $ B.length bigsFile--    -- tstSize bigsFile--    tstListT bigsFile--    tstRepr bigsFile--    tstBig bigsFile---- If we unserialise a list of Bigs and then process them (e.g. print them out) we end up in trouble, too much memory is required.-tstBig :: B.ByteString -> IO ()-tstBig bigsFile = timeIt $ do-    print "Decode to [Big]:"-    let Right (bs :: [Big]) = unflat bigsFile-    mapM_ print bs---- So instead we unserialise them to a list of their flat representations, to be unflatted on demand later on-tstRepr :: B.ByteString -> IO ()-tstRepr bigsFile = timeIt $ do-    print "Decode to [FlatRepl Big]:"-    let Right (bsR :: [Repr Big]) = unflat bigsFile-    let bs = map unrepr bsR-    mapM_ print bs---- Or: we extract one element at the time via a ListT--- See http://hackage.haskell.org/package/list-t-1.0.4/docs/ListT.html-tstListT :: B.ByteString -> IO ()-tstListT bigsFile = timeIt $ do-    print "Decode to ListT IO Big:"-    stream :: L.ListT IO Big <- listTDecoder decode bigsFile-    L.traverse_ print stream