flat 0.4.4 → 0.5

raw patch · 47 files changed

+1333/−752 lines, 47 filesdep +list-tdep +timeitdep −quickcheck-instancesdep ~QuickCheckdep ~basedep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependencies added: list-t, timeit

Dependencies removed: quickcheck-instances

Dependency ranges changed: QuickCheck, base, bytestring, hashable, semigroups

API changes (from Hackage documentation)

Files

• CHANGELOG +12/−0
• README.md +94/−14
• flat.cabal +81/−130
• src/Data/FloatCast.hs +10/−7
• src/Data/ZigZag.hs +47/−24
• src/Flat/Bits.hs +51/−42
• src/Flat/Class.hs +117/−72
• src/Flat/Decoder.hs +3/−2
• src/Flat/Decoder/Prim.hs +61/−36
• src/Flat/Decoder/Run.hs +68/−0
• src/Flat/Decoder/Strict.hs +38/−19
• src/Flat/Decoder/Types.hs +27/−46
• src/Flat/Encoder.hs +2/−2
• src/Flat/Encoder/Prim.hs +137/−25
• src/Flat/Encoder/Size.hs +10/−10
• src/Flat/Encoder/Strict.hs +52/−21
• src/Flat/Encoder/Types.hs +1/−1
• src/Flat/Endian.hs +3/−1
• src/Flat/Filler.hs +20/−10
• src/Flat/Instances/Base.hs +112/−104
• src/Flat/Instances/DList.hs +3/−3
• src/Flat/Instances/Extra.hs +20/−0
• src/Flat/Instances/Mono.hs +62/−28
• src/Flat/Instances/Test.hs +27/−23
• src/Flat/Instances/Text.hs +1/−1
• src/Flat/Memory.hs +14/−8
• src/Flat/Repr.hs +62/−0
• src/Flat/Run.hs +20/−20
• src/Flat/Tutorial.hs +0/−56
• stack-6.35.yaml +0/−13
• stack-9.21.yaml +0/−13
• stack.yaml +38/−5
• test/DocTest/Data/FloatCast.hs +1/−1
• test/DocTest/Data/ZigZag.hs +3/−2
• test/DocTest/Flat/Bits.hs +2/−2
• test/DocTest/Flat/Decoder/Prim.hs +3/−1
• test/DocTest/Flat/Encoder/Prim.hs +14/−0
• test/DocTest/Flat/Endian.hs +1/−1
• test/DocTest/Flat/Instances/Base.hs +2/−1
• test/DocTest/Flat/Instances/Extra.hs +10/−0
• test/DocTest/Flat/Instances/Mono.hs +1/−1
• test/DocTest/Flat/Repr.hs +15/−0
• test/DocTests.hs +4/−1
• test/FlatRepr.hs +75/−0
• test/Spec.hs +4/−2
• test/Test/Data/Arbitrary.hs +2/−2
• test/Test/Data/Flat.hs +3/−2

@@ -1,5 +1,17 @@ Significant and compatibility-breaking changes. +Version 0.5:+    - Compatibility with ghc 9.0.2 & 9.2.4 & 9.4.2+    - Compatibility with text-2.0+    - Fixed https://github.com/Quid2/flat/issues/23 that could cause an encoding failure for non byte aligned Arrays +    - Fixed https://github.com/Quid2/flat/pull/26 that could cause the decoder to read beyond the end of the decoding buffer (causing a SEGFAULT on ghcjs)+    - Merged https://github.com/Quid2/flat/pull/22 - fails correctly on invalid UTF-8 text +    - Added a few ways to partially or incrementally decode values, see Flat.Repr and Flat.Decoder.Run.listTDecoder+    - Moved strictDecoder from Flat.Decoder.Types to Flat.Decoder+    - Removed Flat instance for Semigroup.Option from Flat.Instances.Base+    - Moved overlapping/specialised Flat instance for [Char] to Flat.Instances.Extra+    - Added a few extra functions+ Version 0.4.4: 	- Added instances for Identity, Monoid.Dual/All/Any/Sum/Product/Alt, Semigroup.Min/Max/First/Last/Option  

@@ -1,21 +1,66 @@ -[![Build Status](https://travis-ci.org/Quid2/flat.svg?branch=master)](https://travis-ci.org/Quid2/flat)+![Build Status](https://github.com/Quid2/flat/actions/workflows/haskell-ci.yml/badge.svg)+ [![Hackage version](https://img.shields.io/hackage/v/flat.svg)](http://hackage.haskell.org/package/flat)-[![Stackage Nightly](http://stackage.org/package/flat/badge/nightly)](http://stackage.org/nightly/package/model)-[![Stackage LTS](http://stackage.org/package/flat/badge/lts)](http://stackage.org/lts/package/model) +[![Stackage LTS 16](http://stackage.org/package/flat/badge/lts-16)](http://stackage.org/lts/package/flat)+[![Stackage LTS 18](http://stackage.org/package/flat/badge/lts-18)](http://stackage.org/lts/package/flat)+[![Stackage LTS 19](http://stackage.org/package/flat/badge/lts-19)](http://stackage.org/lts/package/flat)+[![Stackage Nightly](http://stackage.org/package/flat/badge/nightly)](http://stackage.org/nightly/package/flat) -Haskell implementation of [Flat](http://quid2.org/docs/Flat.pdf), a principled, language-independent and efficient binary data format.+Haskell implementation of [Flat](http://quid2.org/docs/Flat.pdf), a principled, portable and compact binary data format ([specs](http://quid2.org)). ++### How To Use It For Fun and Profit++```haskell+{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}+```++```haskell+import Flat+```++++```haskell+data Direction = North | South | Center | East | West deriving (Show,Generic,Flat)+```++Use **flat** to encode: ++```haskell+flat $ [North,South]+-> "\149"+```+++and **unflat** to decode:++```haskell+unflat (flat $ [North,South]) :: Decoded [Direction]+-> Right [ North , South ]+```+++And thanks to Flat's bit-encoding, this little list fits in a single byte (rather than the five that would be required by a traditional byte encoding):++```haskell+flatBits $ [North,South]+-> "10010101"+```+++ ### Performance  For some hard data, see this [comparison of the major haskell serialisation libraries](https://github.com/haskell-perf/serialization).  Briefly:- * Transfer time (serialisation time + transport time on the network + deserialisation at the receiving end): `flat` is usually faster for all but the highest network speeds  * Size: `flat` produces significantly smaller binaries than all other libraries (3/4 times usually)- * Serialization: `store`, `persist` and `flat` are faster- * Deserialization: `store`, `flat`, `persist` and `cereal` are faster+ * Serialization time: `store`, `persist` and `flat` are faster+ * Deserialization time: `store`, `flat`, `persist` and `cereal` are faster+ * Transfer time (serialisation time + transport time on the network + deserialisation at the receiving end): `flat` is usually faster for all but the highest network speeds  ### Documentation @@ -25,22 +70,57 @@  * [Flat Format Specification](http://quid2.org/docs/Flat.pdf) + ### Installation  Get the latest stable version from [hackage](https://hackage.haskell.org/package/flat). -### Other Stuff You Might Like+### Compatibility -#### [ZM - Language independent, reproducible, absolute types](https://github.com/Quid2/zm)+Tested with: -To decode `flat` encoded data you need to know the type of the serialised data.+* [GHC](https://www.haskell.org/ghc/) 7.10.3 to 9.4.2 (x64) -This is ok for applications that do not require long-term storage and that do not operate in open distributed systems. -For those who do, you might want to supplement `flat` with something like [ZM](https://github.com/Quid2/zm).+* [GHCJS](https://github.com/ghcjs/ghcjs) -#### Ports for other languages+  * Note: versions of `flat` prior to 0.33 encode `Double` values incorrectly when they are not aligned with a byte boundary. -[TypeScript-JavaScript](https://github.com/Quid2/ts) and [Purescript](https://www.purescript.org/) ports are under development. ++### Known Bugs and Infelicities++* Data types with more than 512 constructors are currently unsupported++* Longish compilation times++  * `flat` relies more than other serialisation libraries on extensive inlining for its good performance, this unfortunately leads to longer compilation times. ++    If you have many data types or very large ones this might become an issue.++    A couple of good practices that will eliminate or mitigate this problem are:++      * During development, turn optimisations off (`stack --fast` or `-O0` in the cabal file).++      * Keep your serialisation code in a separate module or modules.++* See also the [full list of open issues](https://github.com/Quid2/flat/issues).++### Ports for other languages++[Rust](https://www.rust-lang.org/) and [TypeScript-JavaScript](https://github.com/Quid2/ts) ports are under development.++ Get in touch if you would like to help porting `flat` to other languages.++### Acknowledgements++`flat` reuses ideas and readapts code from various packages, mainly: `store`, `binary-bits` and `binary` and includes bug fixes from a number of contributors.++### Other Stuff You Might Like++To decode `flat` encoded data you need to know the type of the serialised data.++This is ok for applications that do not require long-term storage and that do not operate in open distributed systems.++For those who do, you might want to supplement `flat` with [ZM - Language independent, reproducible, absolute types](https://github.com/Quid2/zm).

@@ -1,25 +1,19 @@ cabal-version:      >=1.10 name:               flat-version:            0.4.4+version:            0.5+homepage:           http://quid2.org+synopsis:           Principled and efficient bit-oriented binary serialization.+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-2020 Pasqualino `Titto` Assini+copyright:          Copyright: (c) 2016-2022 Pasqualino `Titto` Assini maintainer:         tittoassini@gmail.com author:             Pasqualino `Titto` Assini-tested-with:-  GHC ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.3--homepage:           http://quid2.org-synopsis:           Principled and efficient bit-oriented binary serialization.-description:-  Reference implementation of `flat`, a principled and efficient binary serialization format.--category:           Data,Parsing,Serialization+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 build-type:         Simple extra-source-files:   stack.yaml-  stack-6.35.yaml-  stack-9.21.yaml   README.md   CHANGELOG @@ -37,6 +31,7 @@     Flat.Class     Flat.Decoder     Flat.Decoder.Prim+    Flat.Decoder.Run     Flat.Decoder.Strict     Flat.Decoder.Types     Flat.Encoder@@ -52,6 +47,7 @@     Flat.Instances.ByteString     Flat.Instances.Containers     Flat.Instances.DList+    Flat.Instances.Extra     Flat.Instances.Mono     Flat.Instances.Test     Flat.Instances.Text@@ -60,6 +56,7 @@     Flat.Instances.Vector     Flat.Memory     Flat.Run+    Flat.Repr     Flat.Tutorial     Flat.Types @@ -87,8 +84,10 @@   ghc-options:     -Wall -O2 -funbox-strict-fields -fno-warn-orphans     -fno-warn-name-shadowing+    -- -Werror -  --  -Werror+    -- Stan options+    -- -fwrite-ide-info -hiedir=.hie    if impl(eta -any)     build-depends:@@ -121,30 +120,60 @@       , deepseq               >=1.4       , dlist                 >=0.6       , ghc-prim-      , hashable       , mono-traversable       , pretty                >=1.1.2       , primitive-      , semigroups       , 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.2 --- , base                  >=4.8.2.0 && <5--- if impl(ghc <8.2)---   build-depends: semigroups >=0.8.4 && <0.17 +-- test-suite ref+--   type:             exitcode-stdio-1.0+--   main-is:          Reference.hs+--   hs-source-dirs:   test+--   other-modules:+--     Test.Data+--     Test.Data.Arbitrary+--     Test.Data.Flat+--     Test.Data.Values+--     Test.Data2+--     Test.Data2.Flat+--     Test.E+--     Test.E.Arbitrary+--     Test.E.Flat++--   default-language: Haskell2010+--   build-depends:+--       base+--     , flat+--     , zm+--     , ghc-prim+--     , quickcheck-text+--     , tasty-hunit+--     , tasty-quickcheck+--     , text++ 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+  -- if impl(ghc <8.6)+  cpp-options: -DENUM_LARGE     -- -DETA_VERSION -Dghcjs_HOST_OS -  -- ghc-options: -O1 +  ghc-options: -O0   if impl(ghc >8)     ghc-options:       -Wno-unused-top-binds -Wno-type-defaults -Wno-missing-signatures@@ -172,7 +201,7 @@     , text    if impl(ghc <8)-    build-depends: semigroups+    build-depends: semigroups < 0.19    if impl(eta -any)     build-depends:@@ -195,12 +224,13 @@       , deepseq       , filepath       , mono-traversable-      , QuickCheck       , tasty       , text+      , QuickCheck >= 2.14.2  --- dynamic doctests and generation of static doctests--- Usable only with recent versions of ghc (no ghcjs or eta)+-- -- dynamic doctests and generation of static doctests+-- -- Usable only with recent versions of ghc (no ghcjs or eta)+ -- test-suite doc --   type:             exitcode-stdio-1.0 --   main-is:          DocSpec.hs@@ -212,8 +242,10 @@ --     , doctest    ==0.16.3.1 --     , filemanip  >=0.3.6.3 --     , text+--     , QuickCheck >= 2.14.2   -- static doctests (faster, useful for test coverage and to test ghcjs and eta)+ test-suite doc-static   type:             exitcode-stdio-1.0   main-is:          DocTests.hs@@ -225,6 +257,7 @@     DocTest.Flat.Bits     DocTest.Flat.Decoder.Prim     DocTest.Flat.Endian+    DocTest.Flat.Repr     DocTest.Flat.Instances.Array     DocTest.Flat.Instances.Base     DocTest.Flat.Instances.ByteString@@ -235,6 +268,8 @@     DocTest.Flat.Instances.Unordered     DocTest.Flat.Instances.Vector     DocTest.Flat.Tutorial+    DocTest.Flat.Encoder.Prim+    DocTest.Flat.Instances.Extra    default-language: Haskell2010   build-depends:@@ -245,126 +280,42 @@     , dlist     , flat     , pretty-    , quickcheck-instances     , tasty     , tasty-hunit     , tasty-quickcheck     , text     , unordered-containers     , vector+    , QuickCheck >= 2.14.2  -  -- >=0.3.22-  --, QuickCheck >= 2.13.2 && < 3-  --, hashable >= 1.2.6.1 && < 1.4   if impl(ghc <8)-    build-depends: semigroups+    build-depends: semigroups <0.19 ---ghc-options: -Wno-unused-top-binds -Wno-type-defaults+-- Test for Flat.Repr+test-suite repr+  type:             exitcode-stdio-1.0+  main-is:          FlatRepr.hs+  hs-source-dirs:   test+  default-language: Haskell2010+  build-depends:+      base+    , bytestring+    , flat+    , timeit+    , list-t --- Additional development time tests and benchmarks--- test-suite core---   type:             exitcode-stdio-1.0---   main-is:          Core.hs---   hs-source-dirs:   test---   default-language: Haskell2010---   ghc-options:      -O2---   other-modules:---   other-modules:---     Test.Data---     Test.Data.Values---     Test.Data2---     Test.Data2.Flat---     Test.E---     Test.E.Flat---     Test.Data.Flat---   build-depends:---       base---     , benchpress---     , bytestring---     , containers---     , deepseq---     , flat---     , text---     ,inspection-testing+  ghc-options: -rtsopts --- executable listTest---   main-is:          ListTest.hs+-- test-suite ghcjs-cons+--   type:             exitcode-stdio-1.0+--   main-is:          Cons.hs --   hs-source-dirs:   test --   default-language: Haskell2010 --   build-depends: --       base --     , flat---     , text---     , time---- benchmark microBench---   type:             exitcode-stdio-1.0---   main-is:          Micro.hs---   hs-source-dirs:   benchmarks test---   other-modules:---     Common---     Test.Data---     Test.Data.Values---     Test.Data2---     Test.Data2.Flat---     Test.E---     Test.E.Flat---     Test.Data.Flat----   default-language: Haskell2010---   build-depends:---       base---     , benchpress --     , bytestring---     , containers---     , deepseq---     , flat---     , text---- benchmark miniBench---   type:             exitcode-stdio-1.0---   main-is:          Mini.hs---   hs-source-dirs:   benchmarks test---   other-modules:---     Report---     Test.Data---     Test.Data.Values---     Test.Data2---     Test.Data2.Flat---     Test.E---     Test.E.Flat---     Test.Data.Flat----   default-language: Haskell2010---   ghc-options:      -O2---   build-depends:---       base---     , flat---     , text+--     , jsaddle ---   if impl(eta -any)---     build-depends:---         bytestring         ==0.10.8.2---       , containers         ==0.5.9.1---       , criterion          ==1.5.1.0---       , deepseq            ==1.4.3.0---       , directory          ==1.3.1.0---       , filepath           ==1.4.1.1---       , mono-traversable   ==1.0.1---       , process            ==1.6.2.0---       , statistics         ==0.14.0.2---       , text               ==1.2.3.0---       , vector-algorithms  ==0.7.0.1+--   ghc-options: -rtsopts ---   else---     build-depends:---         bytestring---       , containers---       , criterion---       , deepseq---       , directory---       , filepath---       , mono-traversable---       , process---       , statistics---       , text

@@ -36,9 +36,11 @@   --- | Reinterpret-casts a `Word32` to a `Float`.-{-|++{- | Reinterpret-casts a `Word32` to a `Float`.+ prop> \f -> wordToFloat (floatToWord f ) == f++++ OK, passed 100 tests.  >>> floatToWord (-0.15625) 3189768192@@ -62,9 +64,11 @@ -- >>> import Numeric (showHex) -- >>> import Data.Word --- | Reinterpret-casts a `Double` to a `Word64`. {-|+Reinterpret-casts a `Double` to a `Word64`.+ prop> \f -> wordToDouble (doubleToWord f ) == f++++ OK, passed 100 tests.  >>> showHex (doubleToWord 1.0000000000000004) "" "3ff0000000000002"@@ -89,10 +93,9 @@ wordToDouble x = runST (cast x) -- wordToDouble x = runST (cast $ fix64 x) -{- | ->>> runST (cast (0xF0F1F2F3F4F5F6F7::Word64)) == (0xF0F1F2F3F4F5F6F7::Word64)-True--}+-- | +-- >>> runST (cast (0xF0F1F2F3F4F5F6F7::Word64)) == (0xF0F1F2F3F4F5F6F7::Word64)+-- True cast   :: (MArray (STUArray s) a (ST s), MArray (STUArray s) b (ST s)) => a -> ST s b cast x = newArray (0 :: Int, 0) x >>= castSTUArray >>= flip readArray 0

@@ -1,35 +1,36 @@-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE DefaultSignatures      #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE MultiParamTypeClasses  #-}+{-# LANGUAGE ScopedTypeVariables    #-}+ -- |<https://gist.github.com/mfuerstenau/ba870a29e16536fdbaba ZigZag encoding> of signed integrals.-module Data.ZigZag-  ( ZigZag(..)-  )-where+module Data.ZigZag (ZigZag(..)) where -import           Data.Word-import           Data.Int-import           Data.Bits-import           Numeric.Natural+import           Data.Bits       (Bits (shiftL, shiftR, xor, (.&.)),+                                  FiniteBits (finiteBitSize))+import           Data.Int        (Int16, Int32, Int64, Int8)+import           Data.Word       (Word16, Word32, Word64, Word8)+import           Numeric.Natural (Natural)  -- $setup -- >>> :set -XNegativeLiterals -XScopedTypeVariables -XFlexibleContexts -- >>> import Data.Word -- >>> import Data.Int -- >>> import Numeric.Natural--- >>> import Test.QuickCheck.Instances.Natural+-- >>> import Test.QuickCheck.Arbitrary+-- >>> instance Arbitrary Natural where arbitrary = arbitrarySizedNatural; shrink    = shrinkIntegral  {-| Convert between a signed integral and the corresponding ZigZag encoded unsigned integral (e.g. between Int8 and Word8 or Integral and Natural). -Invalid conversions produce a type error:+Allow conversion only between compatible types, invalid conversions produce a type error: -zigZag (-1::Int64) :: Word32 +@+zigZag (-1::Int64) :: Word32 ... ... Couldn't match type ... ...-+@ >>> zigZag (0::Int8) 0 @@ -64,41 +65,63 @@ [0,-1,1,-2,2,-3,3]  prop> \(f::Integer) -> zagZig (zigZag f) == f++++ OK, passed 100 tests.  prop> \(f::Natural) -> zigZag (zagZig f) == f++++ OK, passed 100 tests.  prop> \(f::Int8) -> zagZig (zigZag f) == f++++ OK, passed 100 tests.+ prop> \(f::Word8) -> zigZag (zagZig f) == f++++ OK, passed 100 tests.+ prop> \(s::Int8) -> zigZag s == fromIntegral (zigZag (fromIntegral s :: Integer))++++ OK, passed 100 tests.+ prop> \(u::Word8) -> zagZig u == fromIntegral (zagZig (fromIntegral u :: Natural))++++ OK, passed 100 tests.  prop> \(f::Int64) -> zagZig (zigZag f) == f++++ OK, passed 100 tests.+ prop> \(f::Word64) -> zigZag (zagZig f) == f++++ OK, passed 100 tests.+ prop> \(s::Int64) -> zigZag s == fromIntegral (zigZag (fromIntegral s :: Integer))++++ OK, passed 100 tests.+ prop> \(u::Word64) -> zagZig u == fromIntegral (zagZig (fromIntegral u :: Natural))++++ OK, passed 100 tests. -}---- Allow conversion only between compatible types-class (Integral signed,Integral unsigned) => ZigZag signed unsigned | unsigned -> signed,signed -> unsigned where+class (Integral signed, Integral unsigned)+  => ZigZag signed unsigned | unsigned -> signed, signed -> unsigned where   zigZag :: signed -> unsigned   default zigZag :: FiniteBits signed => signed -> unsigned-  zigZag s = fromIntegral ((s `shiftL` 1) `xor` (s `shiftR` (finiteBitSize s - 1)))-  {-# INLINE zigZag #-}+  zigZag s = fromIntegral+    ((s `shiftL` 1) `xor` (s `shiftR` (finiteBitSize s - 1))) +  {-# INLINE zigZag #-}   zagZig :: unsigned -> signed   default zagZig :: (Bits unsigned) => unsigned -> signed-  zagZig u = fromIntegral ((u `shiftR` 1) `xor` (negate (u .&. 1)))+  zagZig u = fromIntegral ((u `shiftR` 1) `xor` negate (u .&. 1))    -- default zagZig :: (Bits signed) => unsigned -> signed   -- zagZig u = let (s::signed) = fromIntegral u in ((s `shiftR` 1) `xor` (negate (s .&. 1)))   {-# INLINE zagZig #-}  instance ZigZag Int8 Word8+ instance ZigZag Int16 Word16+ instance ZigZag Int32 Word32+ instance ZigZag Int64 Word64+ instance ZigZag Integer Natural where-  zigZag x | x >= 0    = fromIntegral $ x `shiftL` 1-           | otherwise = fromIntegral $ negate (x `shiftL` 1) - 1-  zagZig u =-    let s = fromIntegral u in ((s `shiftR` 1) `xor` (negate (s .&. 1)))+  zigZag x+    | x >= 0 = fromIntegral $ x `shiftL` 1+    | otherwise = fromIntegral $ negate (x `shiftL` 1) - 1++  zagZig u = let s = fromIntegral u+             in ((s `shiftR` 1) `xor` negate (s .&. 1))

@@ -1,29 +1,34 @@ {-# LANGUAGE FlexibleInstances    #-} {-# LANGUAGE RankNTypes           #-} {-# LANGUAGE ScopedTypeVariables  #-}-{-# LANGUAGE TypeSynonymInstances #-} + -- |Utilities to represent and display bit sequences-module Flat.Bits-  ( Bits-  , toBools-  , fromBools-  , bits-  , paddedBits-  , asBytes-  , asBits-  )-where+module Flat.Bits (+    Bits,+    toBools,+    fromBools,+    bits,+    paddedBits,+    asBytes,+    asBits,+    takeBits,+    takeAllBits,+) where+-- TODO: AsBits Class? -import           Data.Bits               hiding ( Bits )-import qualified Data.ByteString               as B-import           Flat.Class-import           Flat.Decoder-import           Flat.Filler-import           Flat.Run-import qualified Data.Vector.Unboxed           as V-import           Data.Word-import           Text.PrettyPrint.HughesPJClass+import           Data.Bits                      (FiniteBits (finiteBitSize),+                                                 testBit)+import qualified Data.ByteString                as B+import qualified Data.Vector.Unboxed            as V+import           Data.Word                      (Word8)+import           Flat.Class                     (Flat)+import           Flat.Decoder                   (Decoded)+import           Flat.Filler                    (PostAligned (PostAligned),+                                                 fillerLength)+import           Flat.Run                       (flat, unflatRaw)+import           Text.PrettyPrint.HughesPJClass (Doc, Pretty (pPrint), hsep,+                                                 text)  -- |A sequence of bits type Bits = V.Vector Bool@@ -34,37 +39,43 @@ fromBools :: [Bool] -> Bits fromBools = V.fromList --- $setup--- >>> import Data.Word--- >>> import Flat.Instances.Base--- >>> import Flat.Instances.Test+{- $setup+>>> import Data.Word+>>> import Flat.Instances.Base+>>> import Flat.Instances.Test(tst,prettyShow)+-}  {- |The sequence of bits corresponding to the serialization of the passed value (without any final byte padding)  >>> bits True [True] -}-bits :: forall a . Flat a => a -> Bits+bits :: forall a. Flat a => a -> Bits bits v =-  let lbs                     = flat v-      Right (PostAligned _ f) = unflatRaw lbs :: Decoded (PostAligned a)-  in  takeBits (8 * B.length lbs - fillerLength f) lbs+    let lbs = flat v+    in case unflatRaw lbs :: Decoded (PostAligned a) of +            Right (PostAligned _ f) -> takeBits (8 * B.length lbs - fillerLength f) lbs+            Left _ -> error "incorrect coding or decoding, please inform the maintainer of this package"  {- |The sequence of bits corresponding to the byte-padded serialization of the passed value  >>> paddedBits True [True,False,False,False,False,False,False,True] -}-paddedBits :: forall a . Flat a => a -> Bits-paddedBits v = let lbs = flat v in takeBits (8 * B.length lbs) lbs+paddedBits :: forall a. Flat a => a -> Bits+paddedBits v = let lbs = flat v in takeAllBits lbs +takeAllBits :: B.ByteString -> Bits+takeAllBits lbs= takeBits (8 * B.length lbs) lbs+ 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)-  )+takeBits numBits lbs =+    V.generate+        (fromIntegral numBits)+        ( \n ->+            let (bb, b) = n `divMod` 8+             in testBit (B.index lbs (fromIntegral bb)) (7 - b)+        )  {- |Convert an integral value to its equivalent bit representation @@ -75,7 +86,7 @@ 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 $ asBits (256+3::Word16) [1,3] -}@@ -84,8 +95,7 @@  -- |Convert to the corresponding value (most significant bit first) byteVal :: [Bool] -> Word8-byteVal = sum . map (\(e, b) -> if b then e else 0) . zip-  [ 2 ^ n | n <- [7 :: Int, 6 .. 0] ]+byteVal = sum . zipWith (\ e b -> (if b then e else 0)) ([2 ^ n | n <- [7 :: Int, 6 .. 0]])  -- |Split a list in groups of 8 elements or less bytes :: [t] -> [[t]]@@ -97,9 +107,8 @@ "00000001 00000011" -} instance Pretty Bits where-  pPrint = hsep . map prettyBits . bytes . V.toList+    pPrint = hsep . map prettyBits . bytes . V.toList  prettyBits :: Foldable t => t Bool -> Doc prettyBits l =-  text . take (length l) . concatMap (\b -> if b then "1" else "0") $ l-+    text . take (length l) . concatMap (\b -> if b then "1" else "0") $ l

@@ -5,14 +5,12 @@ {-# LANGUAGE DefaultSignatures         #-} {-# LANGUAGE FlexibleContexts          #-} {-# LANGUAGE FlexibleInstances         #-}-{-# LANGUAGE KindSignatures            #-} {-# LANGUAGE MultiParamTypeClasses     #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE ScopedTypeVariables       #-} {-# LANGUAGE Trustworthy               #-} {-# LANGUAGE TypeFamilies              #-} {-# LANGUAGE TypeOperators             #-}-{-# LANGUAGE TypeSynonymInstances      #-} {-# LANGUAGE UndecidableInstances      #-}  -- |Generics-based generation of Flat instances@@ -22,17 +20,31 @@     Flat(..)   , getSize   , module GHC.Generics+  , GFlatEncode,GFlatDecode,GFlatSize+  , SizeOf(..)   ) where -import           Data.Bits-import           Flat.Decoder-import           Flat.Encoder-import           Data.Word+import           Data.Bits          (Bits (unsafeShiftL, (.|.)))+import           Data.Word          (Word16)+import           Flat.Decoder.Prim  (ConsState (..), consBits, consBool,+                                     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-import           Prelude           hiding (mempty)--- import Data.Proxy+import           GHC.TypeLits       (Nat, type (+), type (<=))+import           Prelude            hiding (mempty)++#if MIN_VERSION_base(4,9,0)+import           Data.Kind+#endif++#if ! MIN_VERSION_base(4,11,0)+import           Data.Semigroup     ((<>))+#endif++ -- External and Internal inlining #define INL 2 -- Internal inlining@@ -41,7 +53,7 @@ -- #define INL 0  #if INL == 1-import           GHC.Exts          (inline)+import           GHC.Exts           (inline) #endif  -- import           Data.Proxy@@ -50,23 +62,32 @@ getSize :: Flat a => a -> NumBits getSize a = size a 0 --- |Class of types that can be encoded/decoded+{-| Class of types that can be encoded/decoded++Encoding a value involves three steps:++* calculate the maximum size of the serialised value, using `size`++* preallocate a buffer of the required size++* encode the value in the buffer, using `encode`+-} class Flat a where     -- |Return the encoding corrresponding to the value     encode :: a -> Encoding-    default encode :: (Generic a, GEncode (Rep a)) => a -> Encoding+    default encode :: (Generic a, GFlatEncode (Rep a)) => a -> Encoding     encode = gencode . from      -- |Decode a value     decode :: Get a-    default decode :: (Generic a, GDecode (Rep a)) => Get a+    default decode :: (Generic a, GFlatDecode (Rep a)) => Get a     decode = to `fmap` gget      -- |Add maximum size in bits of the value to the total count-    -- -    --  Used to calculated maximum buffer size before encoding +    --+    --  Used to calculated maximum buffer size before encoding     size :: a -> NumBits -> NumBits-    default size :: (Generic a, GSize (Rep a)) => a -> NumBits -> NumBits+    default size :: (Generic a, GFlatSize (Rep a)) => a -> NumBits -> NumBits     size !x !n = gsize n $ from x  #if INL>=2@@ -82,29 +103,44 @@     {-# 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 GEncode f where gencode :: f a -> Encoding+class GFlatEncode f where gencode :: f a -> Encoding -instance {-# OVERLAPPABLE #-} GEncode f => GEncode (M1 i c f) where+instance {-# OVERLAPPABLE #-} GFlatEncode f => GFlatEncode (M1 i c f) where       gencode = gencode . unM1       {-# INLINE gencode #-}    -- Special case, single constructor datatype-instance {-# OVERLAPPING #-} GEncode a => GEncode (D1 i (C1 c a)) where+instance {-# OVERLAPPING #-} GFlatEncode a => GFlatEncode (D1 i (C1 c a)) where       gencode = gencode . unM1 . unM1       {-# INLINE gencode #-}    -- Type without constructors-instance GEncode V1 where+instance GFlatEncode V1 where       gencode = unused       {-# INLINE gencode #-}    -- Constructor without arguments-instance GEncode U1 where+instance GFlatEncode U1 where       gencode U1 = mempty       {-# INLINE gencode #-} -instance Flat a => GEncode (K1 i a) where+instance Flat a => GFlatEncode (K1 i a) where       {-# INLINE gencode #-} #if INL == 1       gencode x = inline encode (unK1 x)@@ -112,56 +148,56 @@       gencode = encode . unK1 #endif -instance (GEncode a, GEncode b) => GEncode (a :*: b) where+instance (GFlatEncode a, GFlatEncode b) => GFlatEncode (a :*: b) where       --gencode (!x :*: (!y)) = gencode x <++> gencode y       gencode (x :*: y) = gencode x <> gencode y       {-# INLINE gencode #-} -instance (NumConstructors (a :+: b) <= 512,GEncodeSum (a :+: b)) => GEncode (a :+: b) where--- instance (GEncodeSum (a :+: b)) => GEncode (a :+: b) where+instance (NumConstructors (a :+: b) <= 512,GFlatEncodeSum (a :+: b)) => GFlatEncode (a :+: b) where+-- instance (GFlatEncodeSum (a :+: b)) => GFlatEncode (a :+: b) where       gencode = gencodeSum 0 0       {-# INLINE gencode #-}  -- Constructor Encoding-class GEncodeSum f where+class GFlatEncodeSum f where   gencodeSum :: Word16 -> NumBits -> f a -> Encoding -instance (GEncodeSum a, GEncodeSum b) => GEncodeSum (a :+: b) where+instance (GFlatEncodeSum a, GFlatEncodeSum b) => GFlatEncodeSum (a :+: b) where   gencodeSum !code !numBits s = case s of-                           L1 !x -> gencodeSum ((code `unsafeShiftL` 1)) (numBits+1) x+                           L1 !x -> gencodeSum (code `unsafeShiftL` 1) (numBits+1) x                            R1 !x -> gencodeSum ((code `unsafeShiftL` 1) .|. 1) (numBits+1) x   {-# INLINE  gencodeSum #-} -instance GEncode a => GEncodeSum (C1 c a) where+instance GFlatEncode a => GFlatEncodeSum (C1 c a) where   gencodeSum !code !numBits x = eBits16 numBits code <> gencode x   {-# INLINE  gencodeSum #-}  -- |Generic Decoding-class GDecode f where+class GFlatDecode f where   gget :: Get (f t)  -- |Metadata (constructor name, etc)-instance GDecode a => GDecode (M1 i c a) where+instance GFlatDecode a => GFlatDecode (M1 i c a) where     gget = M1 <$> gget     {-# INLINE  gget #-}  -- |Type without constructors-instance GDecode V1 where+instance GFlatDecode V1 where     gget = unused     {-# INLINE  gget #-}  -- |Constructor without arguments-instance GDecode U1 where+instance GFlatDecode U1 where     gget = pure U1     {-# INLINE  gget #-}  -- |Product: constructor with parameters-instance (GDecode a, GDecode b) => GDecode (a :*: b) where+instance (GFlatDecode a, GFlatDecode b) => GFlatDecode (a :*: b) where   gget = (:*:) <$> gget <*> gget   {-# INLINE gget #-}  -- |Constants, additional parameters, and rank-1 recursion-instance Flat a => GDecode (K1 i a) where+instance Flat a => GFlatDecode (K1 i a) where #if INL == 1   gget = K1 <$> inline decode #else@@ -198,12 +234,12 @@ #define DEC_BOOL  #ifdef DEC_BOOLG-instance (GDecode a, GDecode b) => GDecode (a :+: b)+instance (GFlatDecode a, GFlatDecode b) => GFlatDecode (a :+: b) #endif  #ifdef DEC_BOOLC -- Special case for data types with two constructors-instance {-# OVERLAPPING #-} (GDecode a,GDecode b) => GDecode (C1 m1 a :+: C1 m2 b)+instance {-# OVERLAPPING #-} (GFlatDecode a,GFlatDecode b) => GFlatDecode (C1 m1 a :+: C1 m2 b) #endif  #ifdef DEC_BOOL@@ -219,22 +255,22 @@ #ifdef DEC_CONS -- | Data types with up to 512 constructors -- Uses a custom constructor decoding state--- instance {-# OVERLAPPABLE #-} (GDecodeSum (a :+: b),GDecode a, GDecode b) => GDecode (a :+: b) where-instance {-# OVERLAPPABLE #-} (NumConstructors (a :+: b) <= 512, GDecodeSum (a :+: b)) => GDecode (a :+: b) where+-- instance {-# OVERLAPPABLE #-} (GFlatDecodeSum (a :+: b),GFlatDecode a, GFlatDecode b) => GFlatDecode (a :+: b) where+instance {-# OVERLAPPABLE #-} (NumConstructors (a :+: b) <= 512, GFlatDecodeSum (a :+: b)) => GFlatDecode (a :+: b) where   gget = do     cs <- consOpen     getSum cs   {-# INLINE gget #-}  -- |Constructor Decoder-class GDecodeSum f where+class GFlatDecodeSum f where     getSum :: ConsState -> Get (f a)  #ifdef DEC_CONS48  -- Decode constructors in groups of 2 or 3 bits -- Significantly reduce instance compilation time and slightly improve execution times-instance {-# OVERLAPPING #-} (GDecodeSum n1,GDecodeSum n2,GDecodeSum n3,GDecodeSum n4) => GDecodeSum ((n1 :+: n2) :+: (n3 :+: n4)) -- where -- getSum = undefined+instance {-# OVERLAPPING #-} (GFlatDecodeSum n1,GFlatDecodeSum n2,GFlatDecodeSum n3,GFlatDecodeSum n4) => GFlatDecodeSum ((n1 :+: n2) :+: (n3 :+: n4)) -- where -- getSum = undefined       where           getSum cs = do             -- error "DECODE4"@@ -246,7 +282,7 @@               _ -> R1 . R1 <$> getSum cs'           {-# INLINE getSum #-} -instance {-# OVERLAPPING #-} (GDecodeSum n1,GDecodeSum n2,GDecodeSum n3,GDecodeSum n4,GDecodeSum n5,GDecodeSum n6,GDecodeSum n7,GDecodeSum n8) => GDecodeSum (((n1 :+: n2) :+: (n3 :+: n4)) :+: ((n5 :+: n6) :+: (n7 :+: n8))) -- where -- getSum cs = undefined+instance {-# OVERLAPPING #-} (GFlatDecodeSum n1,GFlatDecodeSum n2,GFlatDecodeSum n3,GFlatDecodeSum n4,GFlatDecodeSum n5,GFlatDecodeSum n6,GFlatDecodeSum n7,GFlatDecodeSum n8) => GFlatDecodeSum (((n1 :+: n2) :+: (n3 :+: n4)) :+: ((n5 :+: n6) :+: (n7 :+: n8))) -- where -- getSum cs = undefined      where       getSum cs = do         --error "DECODE8"@@ -262,9 +298,9 @@           _ -> R1 . R1 . R1 <$> getSum cs'       {-# INLINE getSum #-} -instance {-# OVERLAPPABLE #-} (GDecodeSum a, GDecodeSum b) => GDecodeSum (a :+: b) where+instance {-# OVERLAPPABLE #-} (GFlatDecodeSum a, GFlatDecodeSum b) => GFlatDecodeSum (a :+: b) where #else-instance (GDecodeSum a, GDecodeSum b) => GDecodeSum (a :+: b) where+instance (GFlatDecodeSum a, GFlatDecodeSum b) => GFlatDecodeSum (a :+: b) where #endif    getSum cs = do@@ -273,13 +309,13 @@   {-# INLINE getSum #-}  -instance GDecode a => GDecodeSum (C1 c a) where+instance GFlatDecode a => GFlatDecodeSum (C1 c a) where     getSum (ConsState _ usedBits) = consClose usedBits >> gget     {-# INLINE getSum #-} #endif  #ifdef DEC_BOOL48-instance {-# OVERLAPPING #-} (GDecode n1,GDecode n2,GDecode n3,GDecode n4) => GDecode ((n1 :+: n2) :+: (n3 :+: n4)) -- where -- gget = undefined+instance {-# OVERLAPPING #-} (GFlatDecode n1,GFlatDecode n2,GFlatDecode n3,GFlatDecode n4) => GFlatDecode ((n1 :+: n2) :+: (n3 :+: n4)) -- where -- gget = undefined   where       gget = do         -- error "DECODE4"@@ -291,7 +327,7 @@           _ -> R1 <$> R1 <$> gget       {-# INLINE gget #-} -instance {-# OVERLAPPING #-} (GDecode n1,GDecode n2,GDecode n3,GDecode n4,GDecode n5,GDecode n6,GDecode n7,GDecode n8) => GDecode (((n1 :+: n2) :+: (n3 :+: n4)) :+: ((n5 :+: n6) :+: (n7 :+: n8))) -- where -- gget = undefined+instance {-# OVERLAPPING #-} (GFlatDecode n1,GFlatDecode n2,GFlatDecode n3,GFlatDecode n4,GFlatDecode n5,GFlatDecode n6,GFlatDecode n7,GFlatDecode n8) => GFlatDecode (((n1 :+: n2) :+: (n3 :+: n4)) :+: ((n5 :+: n6) :+: (n7 :+: n8))) -- where -- gget = undefined  where   gget = do     --error "DECODE8"@@ -310,25 +346,25 @@  -- |Calculate the number of bits required for the serialisation of a value -- Implemented as a function that adds the maximum size to a running total-class GSize f where gsize :: NumBits -> f a -> NumBits+class GFlatSize f where gsize :: NumBits -> f a -> NumBits  -- |Skip metadata-instance GSize f => GSize (M1 i c f) where+instance GFlatSize f => GFlatSize (M1 i c f) where     gsize !n = gsize n . unM1     {-# INLINE gsize #-}  -- |Type without constructors-instance GSize V1 where+instance GFlatSize V1 where     gsize !n _ = n     {-# INLINE gsize #-}  -- |Constructor without arguments-instance GSize U1 where+instance GFlatSize U1 where     gsize !n _ = n     {-# INLINE gsize #-}  -- |Skip metadata-instance Flat a => GSize (K1 i a) where+instance Flat a => GFlatSize (K1 i a) where #if INL == 1   gsize !n x = inline size (unK1 x) n #else@@ -336,8 +372,8 @@ #endif   {-# INLINE gsize #-} -instance (GSize a, GSize b) => GSize (a :*: b) where-    gsize !n (x :*: y) = +instance (GFlatSize a, GFlatSize b) => GFlatSize (a :*: b) where+    gsize !n (x :*: y) =       let !n' = gsize n x       in gsize n' y       -- gsize (gsize n x) y@@ -352,56 +388,56 @@ -- #define SIZ_MAX_PROX  #ifdef SIZ_ADD-instance (GSizeSum (a :+: b)) => GSize (a :+: b) where+instance (GFlatSizeSum (a :+: b)) => GFlatSize (a :+: b) where   gsize !n = gsizeSum n #endif  #ifdef SIZ_NUM-instance (GSizeSum (a :+: b)) => GSize (a :+: b) where+instance (GFlatSizeSum (a :+: b)) => GFlatSize (a :+: b) where   gsize !n x = n + gsizeSum 0 x #endif  #ifdef SIZ_MAX-instance (GSizeNxt (a :+: b),GSizeMax (a:+:b)) => GSize (a :+: b) where+instance (GFlatSizeNxt (a :+: b),GFlatSizeMax (a:+:b)) => GFlatSize (a :+: b) where   gsize !n x = gsizeNxt (gsizeMax x + n) x   {-# INLINE gsize #-}  -- |Calculate the maximum size of a class constructor (that might be one bit more than the size of some of its constructors) #ifdef SIZ_MAX_VAL-class GSizeMax (f :: * -> *) where gsizeMax :: f a ->  NumBits+class GFlatSizeMax (f :: * -> *) where gsizeMax :: f a ->  NumBits -instance (GSizeMax f, GSizeMax g) => GSizeMax (f :+: g) where+instance (GFlatSizeMax f, GFlatSizeMax g) => GFlatSizeMax (f :+: g) where     gsizeMax _ = 1 + max (gsizeMax (undefined::f a )) (gsizeMax (undefined::g a))     {-# INLINE gsizeMax #-} -instance (GSize a) => GSizeMax (C1 c a) where+instance (GFlatSize a) => GFlatSizeMax (C1 c a) where     {-# INLINE gsizeMax #-}     gsizeMax _ = 0 #endif  #ifdef SIZ_MAX_PROX--- instance (GSizeNxt (a :+: b),GSizeMax (a:+:b)) => GSize (a :+: b) where+-- instance (GFlatSizeNxt (a :+: b),GFlatSizeMax (a:+:b)) => GFlatSize (a :+: b) where --   gsize !n x = gsizeNxt (gsizeMax x + n) x --   {-# INLINE gsize #-}   -- -- |Calculate size in bits of constructor--- class KnownNat n => GSizeMax (n :: Nat) (f :: * -> *) where gsizeMax :: f a -> Proxy n -> NumBits+-- class KnownNat n => GFlatSizeMax (n :: Nat) (f :: * -> *) where gsizeMax :: f a -> Proxy n -> NumBits --- instance (GSizeMax (n + 1) a, GSizeMax (n + 1) b, KnownNat n) => GSizeMax n (a :+: b) where+-- instance (GFlatSizeMax (n + 1) a, GFlatSizeMax (n + 1) b, KnownNat n) => GFlatSizeMax n (a :+: b) where --     gsizeMax !n x _ = case x of --                         L1 !l -> gsizeMax n l (Proxy :: Proxy (n+1)) --                         R1 !r -> gsizeMax n r (Proxy :: Proxy (n+1)) --     {-# INLINE gsizeMax #-} --- instance (GSize a, KnownNat n) => GSizeMax n (C1 c a) where+-- instance (GFlatSize a, KnownNat n) => GFlatSizeMax n (C1 c a) where --     {-# INLINE gsizeMax #-} --     gsizeMax !n !x _ = gsize (constructorSize + n) x --       where --         constructorSize :: NumBits --         constructorSize = fromInteger (natVal (Proxy :: Proxy n)) --- class KnownNat (ConsSize f) => GSizeMax (f :: * -> *) where+-- class KnownNat (ConsSize f) => GFlatSizeMax (f :: * -> *) where --   gsizeMax :: f a ->  NumBits --   gsizeMax _ = fromInteger (natVal (Proxy :: Proxy (ConsSize f))) @@ -418,37 +454,46 @@ #endif  -- |Calculate the size of a value, not taking in account its constructor-class GSizeNxt (f :: * -> *) where gsizeNxt :: NumBits -> f a ->  NumBits+class GFlatSizeNxt (f :: * -> *) where gsizeNxt :: NumBits -> f a ->  NumBits -instance (GSizeNxt a, GSizeNxt b) => GSizeNxt (a :+: b) where+instance (GFlatSizeNxt a, GFlatSizeNxt b) => GFlatSizeNxt (a :+: b) where     gsizeNxt n x = case x of                         L1 !l-> gsizeNxt n l                         R1 !r-> gsizeNxt n r     {-# INLINE gsizeNxt #-} -instance (GSize a) => GSizeNxt (C1 c a) where+instance (GFlatSize a) => GFlatSizeNxt (C1 c a) where     {-# INLINE gsizeNxt #-}     gsizeNxt !n !x = gsize n x #endif  -- |Calculate size in bits of constructor -- vs proxy implementation: similar compilation time but much better run times (at least for Tree N, -70%)-class GSizeSum (f :: * -> *) where gsizeSum :: NumBits -> f a ->  NumBits+#if MIN_VERSION_base(4,9,0)+class GFlatSizeSum (f :: Type -> Type) where+#else+class GFlatSizeSum (f :: * -> *) where+#endif+    gsizeSum :: NumBits -> f a ->  NumBits -instance (GSizeSum a, GSizeSum b)-         => GSizeSum (a :+: b) where+instance (GFlatSizeSum a, GFlatSizeSum b)+         => GFlatSizeSum (a :+: b) where     gsizeSum !n x = case x of                         L1 !l-> gsizeSum (n+1) l                         R1 !r-> gsizeSum (n+1) r     {-# INLINE gsizeSum #-} -instance (GSize a) => GSizeSum (C1 c a) where+instance (GFlatSize a) => GFlatSizeSum (C1 c a) where     {-# INLINE gsizeSum #-}     gsizeSum !n !x = gsize n x   -- |Calculate number of constructors+#if MIN_VERSION_base(4,9,0)+type family NumConstructors (a :: Type -> Type) :: Nat where+#else type family NumConstructors (a :: * -> *) :: Nat where+#endif   NumConstructors (C1 c a) = 1   NumConstructors (x :+: y) = NumConstructors x + NumConstructors y 

@@ -1,8 +1,8 @@-{-# LANGUAGE CPP          #-}+{-# LANGUAGE CPP #-} -- |Strict Decoder module Flat.Decoder (     strictDecoder,-    -- strictDecoderPart,+    listTDecoder,     Decoded,     DecodeException(..),     Get,@@ -46,5 +46,6 @@     ) where  import           Flat.Decoder.Prim+import           Flat.Decoder.Run import           Flat.Decoder.Strict import           Flat.Decoder.Types

@@ -25,21 +25,33 @@     ConsState(..),consOpen,consClose,consBool,consBits     ) where -import           Control.Monad-import qualified Data.ByteString         as B-import qualified Data.ByteString.Lazy    as L-import           Flat.Decoder.Types-import           Flat.Endian-import           Flat.Memory-import           Data.FloatCast-import           Data.Word-import           Foreign+import           Control.Monad        (when)+import qualified Data.ByteString      as B+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.Endian          (toBE16, toBE32, toBE64)+import           Flat.Memory          (ByteArray, chunksToByteArray,+                                       chunksToByteString, minusPtr)+import           Foreign              (Bits (unsafeShiftL, unsafeShiftR, (.&.), (.|.)),+                                       FiniteBits (finiteBitSize), Ptr,+                                       Storable (peek), castPtr, plusPtr,+                                       ptrToIntPtr) +#ifdef ghcjs_HOST_OS+import           Foreign              (shift)+#else+#endif+ -- $setup -- >>> :set -XBinaryLiterals -- >>> import Data.Word -- >>> import Data.Int -- >>> import Flat.Run+-- >>> import Flat.Bits+-- >>> import Text.PrettyPrint.HughesPJClass (Pretty (pPrint))  {- |A special state, optimised for constructor decoding. @@ -59,14 +71,14 @@ consOpen :: Get ConsState consOpen = Get $ \endPtr s -> do   let u = usedBits s-  w <- case compare (currPtr s) endPtr of-    LT -> do -- two different bytes-      w16::Word16 <- toBE16 <$> peek (castPtr $ currPtr s)-      return $ fromIntegral w16 `unsafeShiftL` (u+(wordSize-16))-    EQ -> do-        w8 :: Word8 <- peek (currPtr s)-        return $ fromIntegral w8 `unsafeShiftL` (u+(wordSize-8))-    GT -> notEnoughSpace endPtr s+  let d = ptrToIntPtr endPtr - ptrToIntPtr (currPtr s)+  w <-  if d > 1 then do -- two different bytes+          w16::Word16 <- toBE16 <$> peek (castPtr $ currPtr s)+          return $ fromIntegral w16 `unsafeShiftL` (u+(wordSize-16))+        else  if d == 1 then do -- single last byte left+                w8 :: Word8 <- peek (currPtr s)+                return $ fromIntegral w8 `unsafeShiftL` (u+(wordSize-8))+              else notEnoughSpace endPtr s   return $ GetResult s (ConsState w 0)  -- |Switch back to normal decoding@@ -98,7 +110,7 @@ -- consBool (ConsState w usedBits) = (ConsState (w `unsafeShiftL` 1) (1+usedBits),0 /= 32768 .&. w)  -- |Decode from 1 to 3 bits--- +-- -- It could read more bits that are available, but it doesn't matter, errors will be checked in consClose. consBits :: ConsState -> Int -> (ConsState, Word) consBits cs 3 = consBits_ cs 3 7@@ -162,9 +174,9 @@   --   bits = n' .|. 7   in S {currPtr=currPtr s `plusPtr` bytes,usedBits=bits} -{-# INLINE dBool #-} --- Inlining dBool Massively increases compilation time and decreases run time by a third--- TODO: test dBool inlining for 8.8.3+{-# INLINE dBool #-}+-- Inlining dBool massively increases compilation time but decreases run time by a third+-- TODO: test dBool inlining for ghc >= 8.8.4 -- |Decode a boolean dBool :: Get Bool dBool = Get $ \endPtr s ->@@ -186,6 +198,9 @@  >>> unflatWith (dBEBits8 3) [0b11100001::Word8] == Right 0b00000111 True++>>> unflatWith (dBEBits8 9) [0b11100001::Word8,0b11111111]+Left (BadOp "read8: cannot read 9 bits") -} dBEBits8 :: Int -> Get Word8 dBEBits8 n = Get $ \endPtr s -> do@@ -193,15 +208,25 @@       take8 s n  {-# INLINE dBEBits16  #-}--- |Return the n most significant bits (up to maximum of 16)--- The bits are returned right shifted.+{- | Return the n most significant bits (up to maximum of 16)++The bits are returned right shifted:++>>> pPrint . asBits <$> unflatWith (dBEBits16 11) [0b10110111::Word8,0b11100001]+Right 00000101 10111111++If more than 16 bits are requested, only the last 16 are returned:++>>> pPrint . asBits <$> unflatWith (dBEBits16 19) [0b00000000::Word8,0b11111111,0b11100001]+Right 00000111 11111111+-} 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)+-- |Return the n most significant bits (up to maximum of 32) -- The bits are returned right shifted. dBEBits32 :: Int -> Get Word32 dBEBits32 n = Get $ \endPtr s -> do@@ -209,7 +234,7 @@       takeN n s  {-# INLINE dBEBits64  #-}--- |Return the n most significant bits (up to maximum of 8)+-- |Return the n most significant bits (up to maximum of 64) -- The bits are returned right shifted. dBEBits64 :: Int -> Get Word64 dBEBits64 n = Get $ \endPtr s -> do@@ -241,15 +266,15 @@   where     --{-# 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) `shR` (8 - n)-            else do -- two different bytes-              w::Word16 <- toBE16 <$> peek (castPtr $ currPtr s)-              return $ fromIntegral $ (w `unsafeShiftL` usedBits s) `shR` (16 - n)-          | otherwise = error $ unwords ["read8: cannot read",show n,"bits"]+    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) `shR` (8 - n)+                    else do -- two different bytes+                      w::Word16 <- toBE16 <$> peek (castPtr $ currPtr s)+                      return $ fromIntegral $ (w `unsafeShiftL` usedBits s) `shR` (16 - n)+                | otherwise = badOp $ unwords ["read8: cannot read",show n,"bits"]     -- {-# INLINE dropBits8 #-}     -- -- Assume n <= 8     dropBits8 :: S -> Int -> S@@ -399,9 +424,9 @@ -- >>> shR (0b1111111111111111::Word16) 3 == 0b0001111111111111 -- True --- >>> shR (-1::Int16) 3 +-- >>> shR (-1::Int16) 3 -- -1--- -}  +-- -} {-# INLINE shR #-} shR :: Bits a => a -> Int -> a #ifdef ghcjs_HOST_OS

@@ -0,0 +1,68 @@+module Flat.Decoder.Run(strictDecoder,listTDecoder) where++import           Control.Exception        (Exception, try)+import qualified Data.ByteString          as B+import qualified Data.ByteString.Internal as BS+import           Flat.Decoder.Prim        (dBool)+import           Flat.Decoder.Types       (DecodeException, Get (runGet),+                                           GetResult (..), S (S), tooMuchSpace)+import           Foreign                  (Ptr, plusPtr, withForeignPtr)+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 ->+    if ptr' /= endPtr || o' /= 0+      then tooMuchSpace endPtr s'+      else return a++strictDecoder_ ::+     Exception e+  => Get a1+  -> BS.ByteString+  -> (GetResult a1 -> Ptr b -> IO a)+  -> Either e a+strictDecoder_ get (BS.PS base off len) check =+  unsafePerformIO . try $+  withForeignPtr base $ \base0 ->+    let ptr = base0 `plusPtr` off+        endPtr = ptr `plusPtr` len+     in do res <- runGet get endPtr (S ptr 0)+           check res endPtr+{-# NOINLINE strictDecoder_ #-}+++-- strictRawDecoder :: Exception e => Get t -> B.ByteString -> Either e (t,B.ByteString, NumBits)+-- strictRawDecoder get (BS.PS base off len) = unsafePerformIO . try $+--   withForeignPtr base $ \base0 ->+--     let ptr = base0 `plusPtr` off+--         endPtr = ptr `plusPtr` len+--     in do+--       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.++@since 0.5+-}+listTDecoder :: Get a -> BS.ByteString -> IO (ListT IO a)+listTDecoder get (BS.PS base off len) =+    withForeignPtr base $ \base0 -> do+        let ptr = base0 `plusPtr` off+            endPtr = ptr `plusPtr` len+            s = S ptr 0+            go s = do+                GetResult s' b <- runGet dBool endPtr s+                if b+                    then do+                        GetResult s'' a <- runGet get endPtr s'+                        return $ Just (a, ListT $ go s'')+                    else return Nothing+        return $ ListT (go s)

@@ -32,16 +32,19 @@ import qualified Data.ByteString                as B import qualified Data.ByteString.Lazy           as L import qualified Data.ByteString.Short          as SBS+#if !MIN_VERSION_bytestring(0,11,0) import qualified Data.ByteString.Short.Internal as SBS+#endif+import           Control.Monad                  (unless) import qualified Data.DList                     as DL-import           Flat.Decoder.Prim-import           Flat.Decoder.Types import           Data.Int import           Data.Primitive.ByteArray import qualified Data.Text                      as T import qualified Data.Text.Encoding             as T+import           Flat.Decoder.Prim+import           Flat.Decoder.Types -#if! defined(ghcjs_HOST_OS) && ! defined (ETA_VERSION)+#if! defined(ghcjs_HOST_OS) && ! defined (ETA_VERSION) && ! MIN_VERSION_text(2,0,0) import qualified Data.Text.Array                as TA import qualified Data.Text.Internal             as T #endif@@ -49,8 +52,7 @@ import           Data.Word import           Data.ZigZag import           GHC.Base                       (unsafeChr)-import           Numeric.Natural-+import           Numeric.Natural                (Natural) #include "MachDeps.h"  {-# INLINE decodeListWith #-}@@ -93,6 +95,7 @@ {-# INLINE dInt #-} dWord :: Get Word dInt :: Get Int+ #if WORD_SIZE_IN_BITS == 64 dWord = (fromIntegral :: Word64 -> Word) <$> dWord64 @@ -105,6 +108,13 @@ #error expected WORD_SIZE_IN_BITS to be 32 or 64 #endif +++++++ {-# INLINE dInt8 #-} dInt8 :: Get Int8 dInt8 = zagZig <$> dWord8@@ -162,7 +172,7 @@ charStep !shl !cont !n = do   !tw <- fromIntegral <$> dWord8   let !w = tw .&. 127-  let !v = n .|. (w `shift` shl)+  let !v = n .|. w `shift` shl   if tw == w     then return $ unsafeChr v     else cont v@@ -172,21 +182,21 @@ lastCharStep !shl !n = do   !tw <- fromIntegral <$> dWord8   let !w = tw .&. 127-  let !v = n .|. (w `shift` shl)+  let !v = n .|. w `shift` shl   if tw == w     then if v > 0x10FFFF            then charErr v            else return $ unsafeChr v     else charErr v- where -  charErr v = fail $ concat ["Unexpected extra byte or non unicode char", show v]+ where+  charErr v = fail $ "Unexpected extra byte or non unicode char" ++ show v  {-# INLINE wordStep #-} wordStep :: (Bits a, Num a) => Int -> (a -> Get a) -> a -> Get a wordStep shl k n = do   tw <- fromIntegral <$> dWord8   let w = tw .&. 127-  let v = n .|. (w `shift` shl)+  let v = n .|. w `shift` shl   if tw == w     then return v     --else oneShot k v@@ -197,14 +207,14 @@ lastStep shl n = do   tw <- fromIntegral <$> dWord8   let w = tw .&. 127-  let v = n .|. (w `shift` shl)+  let v = n .|. w `shift` shl   if tw == w     then if countLeadingZeros w < shl            then wordErr v            else return v     else wordErr v- where -   wordErr v = fail $ concat ["Unexpected extra byte in unsigned integer", show v]+ where+   wordErr v = fail $ "Unexpected extra byte in unsigned integer" ++ show v  -- {-# INLINE dUnsigned #-} dUnsigned :: (Num b, Bits b) => Get b@@ -223,7 +233,7 @@ dUnsigned_ shl n = do   tw <- dWord8   let w = tw .&. 127-  let v = n .|. (fromIntegral w `shift` shl)+  let v = n .|. fromIntegral w `shift` shl   if tw == w     then return (v, shl)     else dUnsigned_ (shl + 7) v@@ -234,23 +244,28 @@ dUTF16 :: Get T.Text dUTF16 = do   _ <- dFiller+#if MIN_VERSION_text(2,0,0)   -- Checked decoding-  -- T.decodeUtf16LE <$> dByteString_+  T.decodeUtf16LE <$> dByteString_+#else   -- Unchecked decoding   (ByteArray array, lengthInBytes) <- dByteArray_   return (T.Text (TA.Array array) 0 (lengthInBytes `div` 2)) #endif+#endif+ dUTF8 :: Get T.Text dUTF8 = do   _ <- dFiller-  T.decodeUtf8 <$> dByteString_+  bs <- dByteString_+  case T.decodeUtf8' bs of+    Right t -> pure t+    Left e  -> fail $ "Input contains invalid UTF-8 data" ++ show e  dFiller :: Get () dFiller = do   tag <- dBool-  case tag of-    False -> dFiller-    True  -> return ()+  unless tag dFiller  dLazyByteString :: Get L.ByteString dLazyByteString = dFiller >> dLazyByteString_@@ -265,3 +280,7 @@  dByteString :: Get B.ByteString dByteString = dFiller >> dByteString_++++

@@ -4,9 +4,8 @@  -- |Strict Decoder Types module Flat.Decoder.Types-  ( strictDecoder-  -- , strictDecoderPart-  , Get(..)+  (+    Get(..)   , S(..)   , GetResult(..)   , Decoded@@ -14,61 +13,40 @@   , notEnoughSpace   , tooMuchSpace   , badEncoding+  , badOp   ) where -import           Control.DeepSeq-import           Control.Exception-import qualified Data.ByteString          as B-import qualified Data.ByteString.Internal as BS-import           Data.Word-import           Foreign-import           System.IO.Unsafe+import           Control.DeepSeq    (NFData (..))+import           Control.Exception  (Exception, throwIO)+import           Data.Word          (Word8)+import           Foreign            (Ptr)+ #if MIN_VERSION_base(4,9,0)-import qualified Control.Monad.Fail       as Fail+import qualified Control.Monad.Fail as Fail #endif +{- |+A decoder. -strictDecoder :: Get a -> B.ByteString -> Either DecodeException a-strictDecoder get bs =-  strictDecoder_ get bs $ \(GetResult s'@(S ptr' o') a) endPtr ->-    if ptr' /= endPtr || o' /= 0-      then tooMuchSpace endPtr s'-      else return a+Given: --- strictDecoderPart :: Get a -> B.ByteString -> Either DecodeException a--- strictDecoderPart get bs =---   strictDecoder_ get bs $ \(GetResult _ a) _ -> return a+* end of input buffer -strictDecoder_ ::-     Exception e-  => Get a1-  -> BS.ByteString-  -> (GetResult a1 -> Ptr b -> IO a)-  -> Either e a-strictDecoder_ get (BS.PS base off len) check =-  unsafePerformIO . try $-  withForeignPtr base $ \base0 ->-    let ptr = base0 `plusPtr` off-        endPtr = ptr `plusPtr` len-     in do res <- runGet get endPtr (S ptr 0)-           check res endPtr+* current position in input buffer --- strictRawDecoder :: Exception e => Get t -> B.ByteString -> Either e (t,B.ByteString, NumBits)--- strictRawDecoder get (BS.PS base off len) = unsafePerformIO . try $---   withForeignPtr base $ \base0 ->---     let ptr = base0 `plusPtr` off---         endPtr = ptr `plusPtr` len---     in do---       GetResult (S ptr' o') a <- runGet get endPtr (S ptr 0)---       return (a, BS.PS base (ptr' `minusPtr` base0) (endPtr `minusPtr` ptr'), o')+Returns: +* decoded value --- |Decoder monad+* new position in input buffer+-} newtype Get a =   Get-    { runGet :: -      Ptr Word8 -> S -> IO (GetResult a)-    } -- deriving (Functor)+    { runGet ::+      Ptr Word8+      -> S+      -> IO (GetResult a)+    }  -- Seems to give better performance than the derived version instance Functor Get where@@ -112,7 +90,6 @@   {-# INLINE (>>=) #-} #if !(MIN_VERSION_base(4,13,0))   fail = failGet-                 -- base < 4.13 #endif  #if MIN_VERSION_base(4,9,0)@@ -143,6 +120,7 @@   = NotEnoughSpace Env   | TooMuchSpace Env   | BadEncoding Env String+  | BadOp String   deriving (Show, Eq, Ord)  type Env = (Ptr Word8, S)@@ -155,5 +133,8 @@  badEncoding :: Ptr Word8 -> S -> String -> IO a badEncoding endPtr s msg = throwIO $ BadEncoding (endPtr, s) msg++badOp :: String -> IO a+badOp msg = throwIO $ BadOp msg  instance Exception DecodeException

@@ -70,10 +70,10 @@ #endif     ) where -import           Flat.Encoder.Prim+import Flat.Encoder.Prim ( eTrueF, eFalseF ) import           Flat.Encoder.Size(arrayBits) import           Flat.Encoder.Strict-import           Flat.Encoder.Types+import Flat.Encoder.Types ( NumBits, Size )  #if ! MIN_VERSION_base(4,11,0) import           Data.Semigroup((<>))

@@ -3,12 +3,12 @@ {-# LANGUAGE MagicHash           #-} {-# LANGUAGE MultiWayIf          #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TupleSections       #-}-{-# LANGUAGE UnboxedTuples       #-}  -- |Encoding Primitives module Flat.Encoder.Prim-  ( eBits16F+  (+    -- Primitives whose name starts with 'e' encode a value in place+    eBits16F   , eBitsF   , eFloatF   , eDoubleF@@ -36,8 +36,12 @@   , eBoolF   , eTrueF   , eFalseF+   , varWordF++  , updateWord8   , w7l+     -- * Exported for testing only   , eWord32BEF   , eWord64BEF@@ -51,16 +55,20 @@ import qualified Data.ByteString.Lazy.Internal  as L import qualified Data.ByteString.Short.Internal as SBS import           Data.Char+import           Data.FloatCast+import           Data.Primitive.ByteArray+import qualified Data.Text                      as T import           Flat.Encoder.Types import           Flat.Endian import           Flat.Memory import           Flat.Types-import           Data.FloatCast-import           Data.Primitive.ByteArray-import qualified Data.Text                      as T-#if! defined(ghcjs_HOST_OS) && ! defined (ETA_VERSION)++#if! defined(ghcjs_HOST_OS) && ! defined (ETA_VERSION) && ! MIN_VERSION_text(2,0,0) import qualified Data.Text.Array                as TA import qualified Data.Text.Internal             as TI+-- import           Data.FloatCast+-- import           Data.Primitive.ByteArray+-- import qualified Data.Text                      as T #endif import qualified Data.Text.Encoding             as TE import           Data.ZigZag@@ -69,6 +77,14 @@ #include "MachDeps.h" -- traceShowId :: a -> a -- traceShowId = id++-- $setup+-- >>> import Flat.Instances.Test+-- >>> import Flat.Bits+-- >>> import Flat.Encoder.Strict+-- >>> import Control.Monad+-- >>> let enc e = prettyShow $ encBits 256 (Encoding e)+ {-# INLINE eFloatF #-} eFloatF :: Float -> Prim eFloatF = eWord32BEF . floatToWord@@ -93,6 +109,7 @@ eWordF :: Word -> Prim {-# INLINE eIntF #-} eIntF :: Int -> Prim+ #if WORD_SIZE_IN_BITS == 64 eWordF = eWord64F . (fromIntegral :: Word -> Word64) @@ -104,6 +121,7 @@ #else #error expected WORD_SIZE_IN_BITS to be 32 or 64 #endif+ {-# INLINE eInt8F #-} eInt8F :: Int8 -> Prim eInt8F = eWord8F . zigZag@@ -154,11 +172,16 @@   | o == 0 = foldM pokeWord' op vs >>= \op' -> return (S op' 0 0)   | otherwise = foldM (flip eWord8F) s vs +{-+>>> enc $ \s0 -> eTrueF s0 >>= \s1 -> eWord8F 0 s1 >>= \s2 -> eTrueF s2+"10000000 01"+-}+ {-# INLINE eWord8F #-} eWord8F :: Word8 -> Prim eWord8F t s@(S op _ o)   | o == 0 = pokeWord op t-  | otherwise = pokeByteUnaligned t s+  | otherwise = eByteUnaligned t s  {-# INLINE eWord32E #-} eWord32E :: (Word32 -> Word32) -> Word32 -> Prim@@ -191,8 +214,8 @@ {-# INLINE varWordF #-} varWordF :: (Bits t, Integral t) => t -> Prim varWordF t s@(S _ _ o)-  | o == 0 = varWord pokeByteAligned t s-  | otherwise = varWord pokeByteUnaligned t s+  | o == 0 = varWord eByteAligned t s+  | otherwise = varWord eByteUnaligned t s  {-# INLINE varWord #-} varWord :: (Bits t, Integral t) => (Word8 -> Prim) -> t -> Prim@@ -229,20 +252,26 @@ low7 t = fromIntegral t .&. 0x7F  -- | Encode text as UTF8 and encode the result as an array of bytes+--  -- PROB: encodeUtf8 calls a C primitive, not compatible with GHCJS (fixed in latest versions of GHCJS?) eUTF8F :: T.Text -> Prim eUTF8F = eBytesF . TE.encodeUtf8 --- PROB: Not compatible with GHCJS or ETA (that is big endian and writes contents in reverse order) -- | Encode text as UTF16 and encode the result as an array of bytes--- Efficient, as Text is already internally encoded as UTF16.+-- +-- PROB: Not compatible with GHCJS or ETA (that is big endian and writes contents in reverse order) #if ! defined(ghcjs_HOST_OS) && ! defined (ETA_VERSION)+ eUTF16F :: T.Text -> Prim+#if MIN_VERSION_text(2,0,0)+eUTF16F = eBytesF . TE.encodeUtf16LE+#else eUTF16F t = eFillerF >=> eUTF16F_ t   where-    eUTF16F_ !(TI.Text (TA.Array array) w16Off w16Len) s =+    eUTF16F_ (TI.Text (TA.Array array) w16Off w16Len) s =       writeArray array (2 * w16Off) (2 * w16Len) (nextPtr s) #endif+#endif  -- |Encode a Lazy ByteString eLazyBytesF :: L.ByteString -> Prim@@ -257,10 +286,10 @@ {-# INLINE eShortBytesF #-} eShortBytesF :: SBS.ShortByteString -> Prim eShortBytesF bs = eFillerF >=> eShortBytesF_ bs--eShortBytesF_ :: SBS.ShortByteString -> Prim-eShortBytesF_ bs@(SBS.SBS arr) =-  \(S op _ 0) -> writeArray arr 0 (SBS.length bs) op+  where+    eShortBytesF_ :: SBS.ShortByteString -> Prim+    eShortBytesF_ bs@(SBS.SBS arr) (S op _ 0) = writeArray arr 0 (SBS.length bs) op+    eShortBytesF_ _ _ = error "impossible"  -- data Array a = Array0 | Array1 a ... | Array255 ... writeArray :: ByteArray# -> Int -> Int -> Ptr Word8 -> IO S@@ -329,8 +358,7 @@ -} -- {-# NOINLINE eBitsF_ #-} eBitsF_ :: NumBits -> Word8 -> Prim-eBitsF_ n t =-  \(S op w o) ->+eBitsF_ n t (S op w o) =     let o' = o + n -- used bits         f = 8 - o' -- remaining free bits      in if | f > 0 -> return $ S op (w .|. (t `unsafeShiftL` f)) o'@@ -345,18 +373,30 @@ eBoolF False = eFalseF eBoolF True  = eTrueF +-- | >>> enc eTrueF+-- "1" {-# INLINE eTrueF #-} eTrueF :: Prim eTrueF (S op w o)   | o == 7 = pokeWord op (w .|. 1)   | otherwise = return (S op (w .|. 128 `unsafeShiftR` o) (o + 1)) +-- | >>> enc eFalseF+-- "0" {-# INLINE eFalseF #-} eFalseF :: Prim eFalseF (S op w o)   | o == 7 = pokeWord op w   | otherwise = return (S op w (o + 1)) +{- |++>>> enc $ eTrueF >=> eFillerF+"10000001"++>>> enc eFillerF+"00000001"+-} {-# INLINE eFillerF #-} eFillerF :: Prim eFillerF (S op w _) = pokeWord op (w .|. 1)@@ -365,15 +405,87 @@ -- TODO TEST -- poke16 :: Word16 -> Prim -- poke16 t (S op w o) | o == 0 = poke op w >> skipBytes op 2-{-# INLINE pokeByteUnaligned #-}-pokeByteUnaligned :: Word8 -> Prim-pokeByteUnaligned t (S op w o) =+{-+To be used only when usedBits /= 0++>>> enc (eFalseF >=> eFalseF >=> eByteUnaligned 255)+"00111111 11"+-}+{-# INLINE eByteUnaligned #-}+eByteUnaligned :: Word8 -> Prim+eByteUnaligned t (S op w o) =   poke op (w .|. (t `unsafeShiftR` o)) >>   return (S (plusPtr op 1) (t `unsafeShiftL` (8 - o)) o) -{-# INLINE pokeByteAligned #-}-pokeByteAligned :: Word8 -> Prim-pokeByteAligned t (S op _ _) = pokeWord op t+{- To be used only when usedBits = 0++>>> enc (eFalseF >=> eFalseF >=> eFalseF >=> eByteAligned 255)+"11111111"+-}+{-# INLINE eByteAligned #-}+eByteAligned :: Word8 -> Prim+eByteAligned t (S op _ _) = pokeWord op t++{-|+>>> enc $ \s-> eWord8F 0 s >>= updateWord8 255 s+"11111111"++>>> enc $ \s0 -> eTrueF s0 >>= \s1 -> eWord8F 255 s1 >>= eWord8F 255 >>= updateWord8 0 s1+"10000000 01111111 1"++>>> enc $ \s0 -> eFalseF s0 >>= \s1 -> eWord8F 0 s1 >>= updateWord8 255 s1+"01111111 1"++>>> enc $ \s0 -> eFalseF s0 >>= \s1 -> eWord8F 0 s1 >>= updateWord8 255 s1 >>= eFalseF+"01111111 10"++>>> enc $ \s0 -> eTrueF s0 >>= \s1 -> eWord8F 255 s1 >>= eTrueF >>= updateWord8 0 s1 >>= eTrueF+"10000000 011"++@since 0.5+-}+updateWord8 :: Word8 -> S -> Prim+updateWord8 t mem s = do+  uncache s+  pokeWord8 t mem+  cache s++uncache :: S -> IO ()+uncache s = poke (nextPtr s) (currByte s)++cache :: Prim+cache s = do+  w <- (mask s .&.) <$> peek (nextPtr s)+  return $ s {currByte = w}++mask :: S -> Word8+mask s = 255 `unsafeShiftL` (8 - usedBits s)++{-# INLINE pokeWord8 #-}+pokeWord8 :: Word8 -> S -> IO ()+pokeWord8 t  (S op _ 0) = poke op t+pokeWord8 t  (S op w o) = do+        poke op (w .|. (t `unsafeShiftR` o))+        let op' :: Ptr Word8 = plusPtr op 1+        v :: Word8 <- peek op'+        poke op' (t `unsafeShiftL` (8 - o) .|. ((v `unsafeShiftL` o) `unsafeShiftR` o))++-- | o == 0 = pokeByteAligned t s+-- | otherwise = pokeByteUnaligned t s+--   where+-- {-# INLINE pokeByteUnaligned #-}+-- pokeByteUnaligned :: Word8 -> S -> IO ()+-- pokeByteUnaligned t (S op w o) = do+--   let op' = plusPtr op 1+--   poke op (w .|. (t `unsafeShiftR` o))+--   v :: Word8 <- peek op'+--   poke op' (t `unsafeShiftL` (8 - o) .|. ((v `unsafeShiftL` o) `unsafeShiftR` o))++-- {-# INLINE pokeByteAligned #-}+-- pokeByteAligned :: Word8 -> S -> IO ()+-- pokeByteAligned t (S op _ _) = poke op t++-- FIX: not really pokes  {-# INLINE pokeWord #-} pokeWord :: Storable a => Ptr a -> a -> IO S

@@ -1,18 +1,18 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP          #-}+{-# LANGUAGE CPP #-} --- |Primitives to calculate the encoding size of a value+-- |Primitives to calculate the maximum size in bits of the encoding of a value module Flat.Encoder.Size where -import           Data.Bits+import           Data.Bits                      (Bits) import qualified Data.ByteString                as B import qualified Data.ByteString.Lazy           as L import qualified Data.ByteString.Short.Internal as SBS-import           Data.Char-import           Flat.Encoder.Prim         (w7l)-import           Flat.Encoder.Types-import           Flat.Types+import           Data.Char                      (ord) import qualified Data.Text                      as T+import           Flat.Encoder.Prim              (w7l)+import           Flat.Types                     (Int16, Int32, Int64, Natural,+                                                 NumBits, Text, Word16, Word32,+                                                 Word64) #ifndef ghcjs_HOST_OS import qualified Data.Text.Internal             as TI #endif@@ -119,7 +119,7 @@  --sUTF8 :: T.Text -> NumBits --sUTF8 t = fold--- Wildly pessimistic but fast+-- TOFIX: Wildly pessimistic and also slow as T.length is O(n) {-# INLINE sUTF8Max #-} sUTF8Max :: Text -> NumBits sUTF8Max = blobBits . (4 *) . T.length@@ -149,7 +149,7 @@ -- 4 {-# INLINE textBytes #-} textBytes :: T.Text -> Int-textBytes !(TI.Text _ _ w16Len) = w16Len * 2+textBytes (TI.Text _ _ w16Len) = w16Len * 2 #endif  {-# INLINE bitsToBytes #-}

@@ -1,30 +1,32 @@ {-# LANGUAGE BangPatterns              #-} {-# LANGUAGE CPP                       #-} {-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE RecordWildCards           #-} {-# LANGUAGE ScopedTypeVariables       #-}  -- |Strict encoder module Flat.Encoder.Strict where -import qualified Data.ByteString         as B-import qualified Data.ByteString.Lazy    as L+import           Control.Monad        (when)+import qualified Data.ByteString      as B+import qualified Data.ByteString.Lazy as L+import           Data.Foldable import           Flat.Encoder.Prim-import qualified Flat.Encoder.Size  as S+import qualified Flat.Encoder.Size    as S import           Flat.Encoder.Types import           Flat.Memory import           Flat.Types-import           Data.Foldable  -- import           Data.Semigroup -- import           Data.Semigroup          (Semigroup (..))  #if !MIN_VERSION_base(4,11,0)-import           Data.Semigroup          (Semigroup (..))+import           Data.Semigroup       (Semigroup (..)) #endif  #ifdef ETA_VERSION -- import Data.Function(trampoline)-import           GHC.IO                  (trampolineIO)+import           GHC.IO               (trampolineIO) trampolineEncoding :: Encoding -> Encoding trampolineEncoding (Encoding op) = Encoding (\s -> trampolineIO (op s)) #else@@ -34,13 +36,28 @@  -- |Strict encoder strictEncoder :: NumBits -> Encoding -> B.ByteString-strictEncoder numBits (Encoding op) =-  let bufSize = S.bitsToBytes numBits-   in fst $-      unsafeCreateUptoN' bufSize $ \ptr -> do-        (S ptr' 0 0) <- op (S ptr 0 0)-        return (ptr' `minusPtr` ptr, ())+strictEncoder numBits enc =+  let (bs,numBitsUsed) = strictEncoderPartial numBits enc+      bitsInLastByte = numBitsUsed `mod` 8+  in if bitsInLastByte /=0+      then error $ unwords ["encoder: did not end on byte boundary, bits used in last byte=",show  bitsInLastByte]+      else bs +numEncodedBits :: Int -> Encoding -> NumBits+numEncodedBits numBits enc =snd $ strictEncoderPartial numBits enc++strictEncoderPartial ::+  Int                        -- ^ the maximum size in bits of the encoding+  -> Encoding                -- ^ the encoder+  -> (B.ByteString, NumBits) -- ^ the encoded bytestring + the actual number of encoded bits+strictEncoderPartial numBits (Encoding op)+  = let bufSize = S.bitsToBytes numBits+    in unsafeCreateUptoN' bufSize $ \ptr -> do+        S{..} <- op (S ptr 0 0)+        let numBitsUsed = nextPtr `minusPtr` ptr * 8 + usedBits+        when (numBitsUsed > numBits) $ error $ unwords ["encoder: size mismatch, expected <=",show numBits,"actual=",show numBitsUsed,"bits"]+        return (nextPtr `minusPtr` ptr,numBitsUsed)+ newtype Encoding =   Encoding     { run :: Prim@@ -51,20 +68,27 @@  instance Semigroup Encoding where   {-# INLINE (<>) #-}-  (<>) = mappend+  (<>) = encodingAppend  instance Monoid Encoding where   {-# INLINE mempty #-}   mempty = Encoding return++#if !(MIN_VERSION_base(4,11,0))   {-# INLINE mappend #-}-  -- mappend (Encoding f) (Encoding g) = Encoding (f >=> g)-  mappend (Encoding f) (Encoding g) = Encoding m+  mappend = encodingAppend+#endif++  {-# INLINE mconcat #-}+  mconcat = foldl' mappend mempty++{-# INLINE encodingAppend #-}+encodingAppend :: Encoding -> Encoding -> Encoding+encodingAppend (Encoding f) (Encoding g) = Encoding m     where       m s@(S !_ !_ !_) = do         !s1 <- f s         g s1-  {-# INLINE mconcat #-}-  mconcat = foldl' mappend mempty  -- PROB: GHC 8.02 won't always apply the rules leading to poor execution times (e.g. with lists) -- TODO: check with newest GHC versions@@ -76,9 +100,13 @@  {-# NOINLINE encodersS #-} encodersS :: [Encoding] -> Encoding--- without the explicit parameter the rules won't fire+-- Without the explicit parameter the rules won't fire! encodersS ws = foldl' mappend mempty ws +sizeListWith :: (Foldable t1, Num t2) => (t3 -> t2 -> t2) -> t1 t3 -> t2 -> t2+sizeListWith size l sz = foldl' (\s e -> size e (s + 1)) (sz + 1) l+{-# INLINE sizeListWith #-}+ -- encodersS ws = error $ unwords ["encodersS CALLED",show ws] {-# INLINE encodeListWith #-} -- |Encode as a List@@ -87,7 +115,7 @@   where     go []     = eFalse     go (x:xs) = eTrue <> enc x <> go xs- + -- {-# INLINE encodeList #-} -- encodeList :: (Foldable t, Flat a) => t a -> Encoding -- encodeList l = F.foldl' (\acc a -> acc <> eTrue <> encode a) mempty l <> eFalse@@ -101,12 +129,15 @@ encodeArrayWith f ws = Encoding $ go ws   where     go l s = do+      -- write a placeholder for the number of elements in current block       s' <- eWord8F 0 s-      (n, s'', l) <- gol l 0 s'-      _ <- eWord8F n s+      (n, sn, l) <- gol l 0 s'+      -- update actual number of elements+      s'' <- updateWord8 n s sn       if null l         then eWord8F 0 s''         else go l s''+    -- encode up to 255 elements and returns (numberOfWrittenElements,elementsLeftToWrite,currentState)     gol [] !n !s = return (n, s, [])     gol l@(x:xs) !n !s       | n == 255 = return (255, s, l)

@@ -9,7 +9,7 @@ import           Flat.Types import           GHC.Ptr         (Ptr (..)) --- |Calculate the size (in bits) of the encoding of a value+-- |Add the maximum size in bits of the encoding of value a to a NumBits type Size a = a -> NumBits -> NumBits  -- |Strict encoder state

@@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} -- | Endian utilities+--  -- Exported for testing purposes, but not meant to be used outside this package. module Flat.Endian     (@@ -12,7 +13,8 @@  #include "MachDeps.h" -import Data.Word+import           Data.Word (Word16, Word32, Word64, byteSwap16, byteSwap32,+                            byteSwap64)  -- #ifdef ghcjs_HOST_OS -- import Data.Bits

@@ -1,7 +1,7 @@ {-# LANGUAGE DeriveAnyClass      #-} {-# LANGUAGE DeriveGeneric       #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE CPP       #-}+{-# LANGUAGE CPP #-}  -- |Pre-value and post-value byte alignments module Flat.Filler (@@ -11,18 +11,20 @@     preAligned,     PostAligned(..),     postAligned,+    preAlignedDecoder,     postAlignedDecoder     ) where -import           Flat.Class-import           Flat.Encoder-import           Flat.Decoder-import           Control.DeepSeq-import           Data.Typeable+import Flat.Class ( Generic, Flat(..) )+import Flat.Encoder.Strict ( eFiller, sFillerMax )+import Flat.Decoder.Types ( Get )+import Control.DeepSeq ( NFData )+import Data.Typeable ( Typeable )  -- |A meaningless sequence of 0 bits terminated with a 1 bit (easier to implement than the reverse)--- Useful to align an encoded value at byte/word boundaries.-data Filler = FillerBit Filler+-- +-- Used to align encoded values at byte/word boundaries.+data Filler = FillerBit !Filler             | FillerEnd   deriving (Show, Eq, Ord, Typeable, Generic, NFData) @@ -33,6 +35,7 @@   -- use generated decode  -- |A Post aligned value, a value followed by a filler+--  -- Useful to complete the encoding of a top-level value data PostAligned a = PostAligned { postValue :: a, postFiller :: Filler } #ifdef ETA_VERSION    @@ -48,6 +51,7 @@   -- |A Pre aligned value, a value preceded by a filler+--  -- Useful to prealign ByteArrays, Texts and any structure that can be encoded more efficiently when byte aligned.   data PreAligned a = PreAligned { preFiller :: Filler, preValue :: a }   deriving (Show, Eq, Ord, Typeable, Generic, NFData, Flat)@@ -65,11 +69,17 @@ preAligned :: a -> PreAligned a preAligned = PreAligned FillerEnd --- postAlignedDecoder :: Get a -> Get (PostAligned a) -- |Decode a value assuming that is PostAligned postAlignedDecoder :: Get b -> Get b postAlignedDecoder dec = do   v <- dec   _::Filler <- decode-  -- return (postAligned v)   return v++-- |Decode a value assuming that is PreAligned+-- +-- @since 0.5+preAlignedDecoder :: Get b -> Get b+preAlignedDecoder dec = do+  _::Filler <- decode+  dec

@@ -1,44 +1,48 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleInstances ,StandaloneDeriving #-}+{-# LANGUAGE CPP                #-}+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE FlexibleInstances  #-}+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE StandaloneDeriving #-}+ -- | Flat instances for the base library-module Flat.Instances.Base() where+module Flat.Instances.Base () where -import Data.Bool-import Data.Char-import Data.Fixed-import Flat.Instances.Util-import Data.Complex(Complex(..))-import Data.Ratio-import Prelude hiding ( mempty )-import           Control.Monad                  ( liftM2 )+import           Control.Monad         (liftM2)+import           Data.Bool+import           Data.Char+import           Data.Complex          (Complex (..))+import           Data.Fixed -- #if MIN_VERSION_base(4,9,0)-import qualified Data.List.NonEmpty as B+import qualified Data.List.NonEmpty    as B -- #endif  #if ! MIN_VERSION_base(4,8,0)-import Control.Applicative-import Data.Monoid (mempty)+import           Control.Applicative+import           Data.Monoid           (mempty) #endif  #if MIN_VERSION_base(4,9,0)-import qualified Data.Semigroup     as Semigroup+import qualified Data.Semigroup        as Semigroup #endif -import qualified Data.Monoid as Monoid+import qualified Data.Monoid           as Monoid+import           Data.Ratio+import           Flat.Instances.Util+import           Prelude               hiding (mempty) -#if !MIN_VERSION_base(4,11,0)-import Data.Monoid ((<>))-#endif+-- #if !MIN_VERSION_base(4,9,0)+-- import           Data.Monoid           ((<>))+-- #endif -#if MIN_VERSION_base(4,8,0)-import Data.Functor.Identity (Identity (..))+#if MIN_VERSION_base(4,9,0)+import           Data.Functor.Identity (Identity (..)) #endif -#if !MIN_VERSION_base(4,9,0)-deriving instance Generic (Complex a)-#endif+-- #if !MIN_VERSION_base(4,9,0)+-- deriving instance Generic (Complex a)+-- #endif +{- ORMOLU_DISABLE -} -- $setup -- >>> :set -XNegativeLiterals -- >>> import Flat.Instances.Test@@ -52,8 +56,35 @@ -- >>> import Data.Monoid -- >>> import qualified Data.List.NonEmpty as B -- >>> let test = tstBits+-- >>> let y = 33+{- ORMOLU_ENABLE -} +-- >>> y++-- | @since 0.4.4 #if MIN_VERSION_base(4,8,0)+instance Flat Monoid.All where+    encode (Monoid.All a) = encode a+    size (Monoid.All a) = size a+    decode = Monoid.All <$> decode++{- |++>>> let w = Just (11::Word8); a = Alt w <> Alt (Just 24) in tst a == tst w+True++>>> let w = Just (11::Word8); a = Alt Nothing <> Alt w in tst a == tst w+True++@since 0.4.4+-}+instance Flat (f a) => Flat (Monoid.Alt f a) where+    encode (Monoid.Alt a) = encode a+    size (Monoid.Alt a) = size a+    decode = Monoid.Alt <$> decode+#endif++#if MIN_VERSION_base(4,9,0) -- | @since 0.4.4 instance Flat a => Flat (Identity a) where     encode (Identity a) = encode a@@ -68,12 +99,6 @@     decode = Monoid.Dual <$> decode  -- | @since 0.4.4-instance Flat Monoid.All where-    encode (Monoid.All a) = encode a-    size (Monoid.All a) = size a-    decode = Monoid.All <$> decode---- | @since 0.4.4 instance Flat Monoid.Any where     encode (Monoid.Any a) = encode a     size (Monoid.Any a) = size a@@ -92,20 +117,6 @@     decode = Monoid.Product <$> decode  #if MIN_VERSION_base(4,9,0)-{- |->>> let w = Just (11::Word8); a = Alt w <> Alt (Just 24) in tst a == tst w -True-->>> let w = Just (11::Word8); a = Alt Nothing <> Alt w in tst a == tst w -True--@since 0.4.4--}-instance Flat (f a) => Flat (Monoid.Alt f a) where-    encode (Monoid.Alt a) = encode a-    size (Monoid.Alt a) = size a-    decode = Monoid.Alt <$> decode- -- | @since 0.4.4 instance Flat a => Flat (Semigroup.Min a) where     encode (Semigroup.Min a) = encode a@@ -129,12 +140,6 @@     encode (Semigroup.Last a) = encode a     size (Semigroup.Last a) = size a     decode = Semigroup.Last <$> decode---- | @since 0.4.4-instance Flat a => Flat (Semigroup.Option a) where-    encode (Semigroup.Option a) = encode a-    size (Semigroup.Option a) = size a-    decode = Semigroup.Option <$> decode #endif  {- |@@ -150,7 +155,7 @@      decode = pure () -{-|+{- | One bit is plenty for a Bool.  >>> test False@@ -166,10 +171,10 @@      decode = dBool -{-|+{- | Char's are mapped to Word32 and then encoded. -For ascii characters, the encoding is standard ascii. +For ascii characters, the encoding is standard ascii.  >>> test 'a' (True,8,"01100001")@@ -203,16 +208,16 @@ -} instance Flat a => Flat (Maybe a) -{-|+{- | >>> test (Left False::Either Bool ()) (True,2,"00")  >>> test (Right ()::Either Bool ()) (True,1,"1") -}-instance ( Flat a, Flat b ) => Flat (Either a b)+instance (Flat a, Flat b) => Flat (Either a b) -{-|+{- | >>> test (MkFixed 123 :: Fixed E0) (True,16,"11110110 00000001") @@ -272,11 +277,11 @@         | V127 @ -Values between as 0 and 127 fit in a single byte. +Values between as 0 and 127 fit in a single byte.  127 (0b1111111) is represented as Elem V127 and encoded as: Elem=0 127=1111111 ->>> test (127::Word) +>>> test (127::Word) (True,8,"01111111")  254 (0b11111110) is represented as Cons V126 (Elem V1) (254=128+126) and encoded as: Cons=1 V126=1111110 (Elem=0 V1=0000001):@@ -302,7 +307,7 @@     decode = dWord  {- |-Naturals are encoded just as the fixed size Words. +Naturals are encoded just as the fixed size Words.  >>> test (0::Natural) (True,8,"00000000")@@ -317,7 +322,6 @@      decode = dNatural - instance Flat Word16 where     encode = eWord16 @@ -339,7 +343,6 @@      size = sWord64 - {- | Integer, Int, Int16, Int32 and Int64 are defined as the <https://developers.google.com/protocol-buffers/docs/encoding#signed-integers ZigZag> encoded version of the equivalent unsigned Word: @@ -382,7 +385,7 @@     decode = dInt  {- |-Integers are encoded just as the fixed size Ints. +Integers are encoded just as the fixed size Ints.  >>> test (0::Integer) (True,8,"00000000")@@ -412,7 +415,7 @@      decode = dInteger -{-|+{- | >>> test (0::Int8) (True,8,"00000000") @@ -490,7 +493,6 @@      decode = dInt64 - {- | Floats are encoded as standard IEEE binary32 values: @@ -532,35 +534,44 @@      decode = dDouble -{-|+{- | >>> test (4 :+ 2 :: Complex Word8) (True,16,"00000100 00000010") -} instance Flat a => Flat (Complex a) -{-|+{- | Ratios are encoded as tuples of (numerator,denominator)  >>> test (3%4::Ratio Word8) (True,16,"00000011 00000100") -}-instance ( Integral a, Flat a ) => Flat (Ratio a) where-    size a = size ( numerator a, denominator a )+instance (Integral a, Flat a) => Flat (Ratio a) where+    size a = size (numerator a, denominator a) -    encode a = encode ( numerator a, denominator a )+    encode a = encode (numerator a, denominator a)      -- decode = uncurry (%) <$> decode     decode = liftM2 (%) decode decode -{-|+{- | >>> test ([]::[Bool]) (True,1,"0")  >>> test [False,False] (True,5,"10100")++This instance and other similar ones are declared as @OVERLAPPABLE@, because for better encoding/decoding+performance it can be useful to declare instances of concrete types, such as @[Char]@ (not provided out of the box). -}-instance {-# OVERLAPPABLE #-}Flat a => Flat [ a ]+instance {-# OVERLAPPABLE #-} Flat a => Flat [a] +{-+>>> import Weigh+>>> flat [1..10::Int]+-}++ -- Generic list instance (stack overflows with ETA, see https://github.com/typelead/eta/issues/901) -- where --size [] n = n+1@@ -578,27 +589,17 @@ -- trampolineIO = id -- #endif -{- |-For better encoding/decoding performance, it is useful to declare instances of concrete list types, such as [Char].-->>> test ""-(True,1,"0")-->>> test "aaa"-(True,28,"10110000 11011000 01101100 0010")--}-instance {-# OVERLAPPING #-}Flat [ Char ]-- -- #if MIN_VERSION_base(4,9,0)-{-|++{- | >>> test (B.fromList [True]) (True,2,"10")  >>> test (B.fromList [False,False]) (True,4,"0100") -}-instance {-# OVERLAPPABLE #-}Flat a => Flat (B.NonEmpty a)+instance {-# OVERLAPPABLE #-} Flat a => Flat (B.NonEmpty a)+ -- #endif  {- |@@ -620,26 +621,33 @@ -}  -- Not sure if these should be OVERLAPPABLE-instance {-# OVERLAPPABLE #-}( Flat a, Flat b ) => Flat ( a, b )--instance {-# OVERLAPPABLE #-}( Flat a, Flat b, Flat c ) => Flat ( a, b, c )--instance {-# OVERLAPPABLE #-}( Flat a, Flat b, Flat c, Flat d )-    => Flat ( a, b, c, d )+instance {-# OVERLAPPABLE #-} (Flat a, Flat b) => Flat (a, b) -instance {-# OVERLAPPABLE #-}( Flat a, Flat b, Flat c, Flat d, Flat e )-    => Flat ( a, b, c, d, e )+instance {-# OVERLAPPABLE #-} (Flat a, Flat b, Flat c) => Flat (a, b, c) -instance {-# OVERLAPPABLE #-}( Flat a, Flat b, Flat c, Flat d, Flat e, Flat f )-    => Flat ( a, b, c, d, e, f )+instance+    {-# OVERLAPPABLE #-}+    (Flat a, Flat b, Flat c, Flat d) =>+    Flat (a, b, c, d) -instance {-# OVERLAPPABLE #-}( Flat a-                             , Flat b-                             , Flat c-                             , Flat d-                             , Flat e-                             , Flat f-                             , Flat g-                             ) => Flat ( a, b, c, d, e, f, g )+instance+    {-# OVERLAPPABLE #-}+    (Flat a, Flat b, Flat c, Flat d, Flat e) =>+    Flat (a, b, c, d, e) +instance+    {-# OVERLAPPABLE #-}+    (Flat a, Flat b, Flat c, Flat d, Flat e, Flat f) =>+    Flat (a, b, c, d, e, f) +instance+    {-# OVERLAPPABLE #-}+    ( Flat a+    , Flat b+    , Flat c+    , Flat d+    , Flat e+    , Flat f+    , Flat g+    ) =>+    Flat (a, b, c, d, e, f, g)

@@ -2,9 +2,9 @@   () where -import           Flat.Class-import           Flat.Instances.Mono-import           Data.DList+import           Data.DList          (DList, fromList, toList)+import           Flat.Class          (Flat (..))+import           Flat.Instances.Mono (decodeList, encodeList, sizeList)  -- $setup -- >>> import Flat.Instances.Test

@@ -0,0 +1,20 @@+{-# LANGUAGE FlexibleInstances #-}+module Flat.Instances.Extra where++import           Flat.Instances.Base ()+import Flat.Class ( Flat )++-- $setup+-- >>> import Flat.Instances.Test++{- |+For better encoding/decoding performance, it is useful to declare instances of concrete list types, such as [Char].++>>> tstBits ""+(True,1,"0")++>>> tstBits "aaa"+(True,28,"10110000 11011000 01101100 0010")+-}+instance {-# OVERLAPPING #-} Flat [Char]+

@@ -1,5 +1,7 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances,UndecidableInstances ,NoMonomorphismRestriction #-}+{-# LANGUAGE FlexibleContexts          #-}+{-# LANGUAGE FlexibleInstances         #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE UndecidableInstances      #-} module Flat.Instances.Mono   ( sizeSequence   , encodeSequence@@ -20,24 +22,20 @@   ) where -import           Data.MonoTraversable           ( Element-                                                , ofoldl'-                                                , otoList-                                                --, olength-                                                , MonoFoldable-                                                )-import           Data.Sequences                 ( IsSequence )-import qualified Data.Sequences                as S import           Data.Containers+import qualified Data.Foldable        as F+import           Data.MonoTraversable (Element, MonoFoldable, ofoldl', otoList)+import           Data.Sequences       (IsSequence)+import qualified Data.Sequences       as S import           Flat.Instances.Util-import qualified Data.Foldable                 as F --- $setup--- >>> import Flat.Instances.Base()--- >>> import Flat.Instances.Test--- >>> import Data.Word    --- >>> import qualified Data.Set--- >>> import qualified Data.Map+{- $setup+>>> import Flat.Instances.Base()+>>> import Flat.Instances.Test+>>> import Data.Word+>>> import qualified Data.Set+>>> import qualified Data.Map+-}  {-| Sequences are defined as Arrays:@@ -55,23 +53,55 @@ List a ≡  Nil         | Cons a (List a) -The AsList/AsArray wrappers can be used to serialise sequences as Lists or Arrays+In practice, this means that the list elements will be prefixed with a 1 bit and followed by a final 0 bit. ->>> tst $ AsArray ([]::[()])-(True,8,[0])+The AsList/AsArray wrappers can be used to serialise sequences as Lists or Arrays. ->>> tst $ AsArray [11::Word8,22,33]-(True,40,[3,11,22,33,0])+Let's see some examples. ->>> tst $ AsList ([]::[()])-(True,1,[0])+>>> flatBits $ AsList [True,True,True]+"1111110" +So we have Cons True (11) repeated three times, followed by a final Nil (0).++The list encoding is the default one for lists so AsList is in this case unnecessary:++>>> flatBits $ [True,True,True]+"1111110"++We can force a list to be encoded as an Array with AsArray:++>>> flatBits $ AsArray [True,True,True]+"00000011 11100000 000"++We have the initial block with a count of 3 (3 == 00000011) followed by the elements True True True (111) and then the final block of 0 elements ("00000 000").++>>> flatBits $ [AsArray [True,True,True]]+"10000001 11110000 00000"++>>> flatBits $ (True,True,True,AsArray $ replicate 7 True)+"11100000 11111111 11000000 00"++>>> flatBits $ AsArray ([]::[()])+"00000000"++>>> flatBits $ AsList ([]::[()])+"0"+ >>> tst (AsList [11::Word8,22,33]) (True,28,[133,197,164,32])  >>> tst (AsSet (Data.Set.fromList [11::Word8,22,33])) (True,28,[133,197,164,32]) +>>> tst [AsArray [1..3], AsArray [4..8]]+(True,99,[129,129,2,3,0,65,66,2,131,3,132,0,0])++>>> tst $ [AsArray [(1::Word8)..3], AsArray [4..8]]+(True,99,[129,128,129,1,128,65,65,1,65,129,194,0,0])++>>> tst $ [AsArray [(1::Int)..3]]+(True,42,[129,129,2,3,0,0]) -} newtype AsArray a =   AsArray@@ -83,9 +113,13 @@   encode (AsArray a) = encodeSequence a   decode = AsArray <$> decodeSequence --- |Calculate size of an instance of IsSequence as the sum:--- * of the size of all the elements--- * plus the size of the array constructors (1 byte every 255 elements plus one final byte)+{- |+Calculate size of an instance of IsSequence as the sum:++* of the size of all the elements++* plus the size of the array constructors (1 byte every 255 elements plus one final byte)+-} sizeSequence   :: (IsSequence mono, Flat (Element mono)) => mono -> NumBits -> NumBits sizeSequence s acc =@@ -145,7 +179,7 @@   decode = AsSet <$> decodeSet  sizeSet :: (IsSet set, Flat (Element set)) => Size set-sizeSet l acc = ofoldl' (\acc e -> size e (acc + 1)) (acc + 1) $ l+sizeSet l acc = ofoldl' (\acc e -> size e (acc + 1)) (acc + 1) l {-# INLINE sizeSet #-}  encodeSet :: (IsSet set, Flat (Element set)) => set -> Encoding

@@ -1,36 +1,36 @@ -- | doctest utilities-module Flat.Instances.Test-  ( tst-  , tstBits-  , asList-  , flatBits-  , allBits-  , prettyShow-  , module Data.Word-  )-where+module Flat.Instances.Test (+    tst,+    tstBits,+    asList,+    flatBits,+    allBits,+    encBits,+    prettyShow,+    module Data.Word,+) where -import           Flat.Class                     ( Flat(..) )-import           Flat.Run                       ( flat-                                                , unflat-                                                )-import           Flat.Bits                      ( bits-                                                , asBytes-                                                , paddedBits-                                                )-import           Flat.Types                     ( NumBits )+import           Control.Monad                  ((>=>)) import           Data.Word-import           Text.PrettyPrint.HughesPJClass ( prettyShow )+import           Flat.Bits                      (Bits, asBytes, bits,+                                                 paddedBits, takeBits)+import           Flat.Class                     (Flat (..))+import           Flat.Encoder.Prim              (eFillerF)+import           Flat.Encoder.Strict            (Encoding (Encoding),+                                                 numEncodedBits, strictEncoder)+import           Flat.Run                       (flat, unflat)+import           Flat.Types                     (NumBits)+import           Text.PrettyPrint.HughesPJClass (prettyShow) --- |Returns: result of flat/unflat test, encoding size in bits, byte encoding+-- | Returns: result of flat/unflat test, encoding size in bits, byte encoding tst :: (Eq a, Flat a) => a -> (Bool, NumBits, [Word8]) tst v = (unflat (flat v) == Right v, size v 0, showBytes v) --- |Returns: result of flat/unflat test, encoding size in bits, bits encoding+-- | Returns: result of flat/unflat test, encoding size in bits, bits encoding tstBits :: (Eq a, Flat a) => a -> (Bool, NumBits, String) tstBits v = (unflat (flat v) == Right v, Flat.Class.size v 0, flatBits v) --- |Test that container is serialised as a List+-- | Test that container is serialised as a List asList :: (Eq a1, Eq a2, Flat a1, Flat a2) => (a2 -> a1) -> a2 -> Bool asList f l = tst (f l) == tst l @@ -39,6 +39,10 @@  allBits :: Flat a => a -> String allBits = prettyShow . paddedBits++-- |@since 0.5+encBits :: NumBits -> Encoding -> Bits+encBits maxNumBits e@(Encoding enc) = takeBits (numEncodedBits maxNumBits e) (strictEncoder maxNumBits (Encoding $ enc >=> eFillerF))  showBytes :: Flat a => a -> [Word8] showBytes = asBytes . bits

@@ -39,7 +39,7 @@ (True,120,[1,12,240,144,141,136,240,144,141,136,240,144,141,136,0]) #endif -Strict and Lazy Text has the same encoding:+Strict and Lazy Text have the same encoding:  >>> tst (T.pack "abc") == tst (TL.pack "abc") True

@@ -5,7 +5,7 @@ {- | Memory access primitives. -Includes code from the store-core package.+Includes code from the [store-core](https://hackage.haskell.org/package/store-core) package. -} module Flat.Memory   ( chunksToByteString@@ -15,10 +15,11 @@   , pokeByteString   , unsafeCreateUptoN'   , minusPtr+  --, peekByteString   ) where -import           Control.Monad+import Control.Monad ( foldM_, when ) import           Control.Monad.Primitive        ( PrimMonad(..) ) import qualified Data.ByteString.Internal      as BS import           Data.Primitive.ByteArray       ( MutableByteArray(..)@@ -27,7 +28,7 @@                                                 , newByteArray                                                 , unsafeFreezeByteArray                                                 )-import           Foreign                 hiding ( void )+import Foreign ( Word8, Ptr, withForeignPtr, minusPtr, plusPtr ) import           GHC.Prim                       ( copyAddrToByteArray#                                                 , copyByteArrayToAddr#                                                 )@@ -35,7 +36,7 @@ import           GHC.Types                      ( IO(..)                                                 , Int(..)                                                 )-import           System.IO.Unsafe+import System.IO.Unsafe ( unsafeDupablePerformIO, unsafePerformIO ) import qualified Data.ByteString               as B  unsafeCreateUptoN' :: Int -> (Ptr Word8 -> IO (Int, a)) -> (BS.ByteString, a)@@ -64,6 +65,11 @@       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++-- |Copy ByteArray to given pointer, returns new pointer pokeByteArray :: ByteArray# -> Int -> Int -> Ptr Word8 -> IO (Ptr Word8) pokeByteArray sourceArr sourceOffset len dest = do   copyByteArrayToAddr sourceArr sourceOffset dest len@@ -71,19 +77,18 @@   return dest' {-# INLINE pokeByteArray #-} + -- | Wrapper around @copyByteArrayToAddr#@ primop.+-- -- Copied from the store-core package copyByteArrayToAddr :: ByteArray# -> Int -> Ptr a -> Int -> IO () copyByteArrayToAddr arr (I# offset) (Ptr addr) (I# len) =   IO (\s -> (# copyByteArrayToAddr# arr offset addr len s, () #)) {-# INLINE copyByteArrayToAddr #-} --- toByteString :: Ptr Word8 -> Int -> BS.ByteString--- toByteString sourcePtr sourceLength = BS.unsafeCreate sourceLength $ \destPointer -> BS.memcpy destPointer sourcePtr sourceLength- chunksToByteString :: (Ptr Word8, [Int]) -> BS.ByteString chunksToByteString (sourcePtr0, lens) =-  BS.unsafeCreate (sum lens) $ \destPtr0 -> void $ foldM+  BS.unsafeCreate (sum lens) $ \destPtr0 -> foldM_     (\(destPtr, sourcePtr) sourceLength ->       BS.memcpy destPtr sourcePtr sourceLength         >> return@@ -110,6 +115,7 @@   -- | Wrapper around @copyAddrToByteArray#@ primop.+--  -- Copied from the store-core package copyAddrToByteArray   :: Ptr a -> MutableByteArray (PrimState IO) -> Int -> Int -> IO ()

@@ -0,0 +1,62 @@+{-# 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,7 +1,8 @@-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+ -- |Encoding and decoding functions module Flat.Run (     flat,@@ -10,21 +11,21 @@     unflatWith,     unflatRaw,     unflatRawWith,-    ) where+) where -import qualified Data.ByteString         as B-import           Data.ByteString.Convert-import           Flat.Class-import           Flat.Decoder-import qualified Flat.Encoder       as E-import           Flat.Filler+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)  -- |Encode padded value. flat :: Flat a => a -> B.ByteString flat = flatRaw . postAligned  -- |Decode padded value.-unflat :: (Flat a,AsByteString b) => b -> Decoded a+unflat :: (Flat a, AsByteString b) => b -> Decoded a unflat = unflatWith decode  -- |Decode padded value, using the provided unpadded decoder.@@ -32,7 +33,7 @@ unflatWith dec = unflatRawWith (postAlignedDecoder dec)  -- |Decode unpadded value.-unflatRaw :: (Flat a,AsByteString b) => b -> Decoded a+unflatRaw :: (Flat a, AsByteString b) => b -> Decoded a unflatRaw = unflatRawWith decode  -- |Unflat unpadded value, using provided decoder@@ -41,16 +42,18 @@  -- |Encode unpadded value flatRaw :: (Flat a, AsByteString b) => a -> b-flatRaw a = fromByteString $ -    E.strictEncoder -        (getSize a) -#ifdef ETA_VERSION    +flatRaw a =+    fromByteString $+        E.strictEncoder+            (getSize a)++#ifdef ETA_VERSION         (E.trampolineEncoding (encode a)) #else         (encode a) #endif --- #ifdef ETA_VERSION    +-- #ifdef ETA_VERSION --   deriving (Show, Eq, Ord, Typeable, Generic, NFData)  -- instance Flat a => Flat (PostAligned a) where@@ -59,6 +62,3 @@ -- #else --   deriving (Show, Eq, Ord, Typeable, Generic, NFData,Flat) -- #endif---

@@ -100,62 +100,6 @@  >>> flatBits $ Just True "11"--== Compatibility-#compatibility#--=== <https://www.haskell.org/ghc/ GHC>--* x32 and x64: 7.10.3, 8.0.2, 8.2.2, 8.4.4, 8.6.5, 8.8.3.--* <https://en.wikipedia.org/wiki/ARM7 ARM7-armv7hf> and <https://en.wikipedia.org/wiki/ARM_architecture#AArch64_features ARM8-aaarch64>: 8.0.2. --=== <https://github.com/ghcjs/ghcjs GHCJS>--* @ghcjs-8.4.0.1@.--NOTE: Some tests are not run for @ghcjs@ as they are related to unsupported features such as UTF16 encoding of Text and short <https://hackage.haskell.org/package/bytestring/docs/Data-ByteString-Short.html ByteString>.--For details of what tests are skipped search @test/Spec.hs@ for @ghcjs_HOST_OS@.--NOTE: Some older versions of @ghcjs@ and versions of @flat@ prior to 0.33 encoded @Double@ values incorrectly when not aligned with a byte boundary.--=== <https://eta-lang.org/ ETA>--It builds (with @etlas 1.5.0.0@ and @eta-0.8.6b2@) and passes the @doctest-static@ test but it won't complete the main @spec@ test probably because of a recursive iteration issue, see <https://github.com/typelead/eta/issues/901>.--Support for @eta@ is not currently being actively mantained.--== Known Bugs and Infelicities-#known-bugs-and-infelicities#--=== Longish compilation times--Relies more than other serialisation libraries on extensive inlining for its good performance, this unfortunately leads to longer compilation times.--If you have many data types or very large ones this might become an issue.--A couple of good practices that will eliminate or mitigate this problem are:---   During development, turn optimisations off (@stack --fast@ or @-O0@-    in the cabal file).---   Keep your serialisation code in a separate module(s).--=== Data types with more than 512 constructors are currently unsupported--This limit could be easily extended, shout if you need it.--=== Other--<https://github.com/Quid2/flat/issues Full list of open issues>.--== Acknowledgements-#acknowledgements#--@flat@ reuses ideas and readapts code from various packages, mainly:-@store@, @binary-bits@ and @binary@ and includes contributions from-Justus Sagemüller. -}  

@@ -1,13 +0,0 @@-resolver: lts-6.35--packages:-  - .--allow-newer: true--extra-deps:-  - quickcheck-instances-0.3.22-  - QuickCheck-2.13.2-  - splitmix-0.0.2-  - time-compat-1.9.3-  - hashable-1.2.6.1

@@ -1,13 +0,0 @@-resolver: lts-9.21--packages:-  - .--allow-newer: true--extra-deps:-  - quickcheck-instances-0.3.22-  - QuickCheck-2.13.2-  - splitmix-0.0.2-  - time-compat-1.9.3-  - hashable-1.2.6.1

@@ -1,10 +1,43 @@-resolver: lts-14.27+# For ghc 7.10.3, use cabal instead +# Supported stack versions++# resolver: lts-9.21 # ghc 8.0.2++# resolver: lts-11.22 # ghc 8.2.2++# resolver: lts-12.26 # ghc 8.4.4++# resolver: lts-14.27 # ghc 8.6.5++# resolver: lts-16.31 # ghc 8.8.4++resolver: lts-18.28 # ghc 8.10.7++# resolver: lts-19.26 # ghc 9.0.2++# resolver: nightly-2022-09-30 # ghc 9.2.4+ packages:   - .-#  - ../EXTERNAL/doctest +  # for test only+  # - ../EXTERNAL/doctest+ extra-deps:-  # Modified doctest, used to generate static tests-  # - git: https://github.com/tittoassini/doctest-  #   commit: c9cdbe4eee086cb8aa46e96532160320dd367f09+  # Modified doctest, used to generate static tests (run by doc-static)+  - git: https://github.com/tittoassini/doctest+    commit: 3954e94449901764e28cfed1c35490af970e9b01++  # - hashable-1.4.0.2@sha256:0cddd0229d1aac305ea0404409c0bbfab81f075817bd74b8b2929eff58333e55,5005++  # for ghcjs-cons+  # - jsaddle-0.9.8.2@sha256:e8c003801eb9364fcd6b1e0cda34f072a537bcfa767e6eb8c626836dae77ba04,4419+  # - ref-tf-0.4.0.2@sha256:69de3550250e0cd69f45d080359cb314a9487c915024349c75b78732bbee9332,1134++  # for text-2.0:+  # - text-2.0+  # - Cabal-3.6.3.0@sha256:ff97c442b0c679c1c9876acd15f73ac4f602b973c45bde42b43ec28265ee48f4,12459+  # - parsec-3.1.15.0@sha256:a162d4cc8884014ba35192545cad293af0529fe11497aad8834bbaaa3dfffc26,4429++allow-newer: true

@@ -8,4 +8,4 @@ import Data.Word  tests :: IO TestTree-tests = testGroup "Data.FloatCast" <$> sequence [  DocTest.testProp "src/Data/FloatCast.hs:41" ( \f -> wordToFloat (floatToWord f ) == f ),  DocTest.test "src/Data/FloatCast.hs:43" "[ExpectedLine [LineChunk \"3189768192\"]]" (DocTest.asPrint( floatToWord (-0.15625) )),  DocTest.test "src/Data/FloatCast.hs:46" "[ExpectedLine [LineChunk \"-0.15625\"]]" (DocTest.asPrint( wordToFloat 3189768192 )),  DocTest.test "src/Data/FloatCast.hs:49" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( floatToWord (-5.828125) == 0xC0BA8000 )),  DocTest.testProp "src/Data/FloatCast.hs:67" ( \f -> wordToDouble (doubleToWord f ) == f ),  DocTest.test "src/Data/FloatCast.hs:69" "[ExpectedLine [LineChunk \"\\\"3ff0000000000002\\\"\"]]" (DocTest.asPrint( showHex (doubleToWord 1.0000000000000004) "" )),  DocTest.test "src/Data/FloatCast.hs:72" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( doubleToWord 1.0000000000000004 == 0x3FF0000000000002 )),  DocTest.test "src/Data/FloatCast.hs:75" "[ExpectedLine [LineChunk \"\\\"bfc4000000000000\\\"\"]]" (DocTest.asPrint( showHex (doubleToWord (-0.15625)) "" )),  DocTest.test "src/Data/FloatCast.hs:78" "[ExpectedLine [LineChunk \"-0.15625\"]]" (DocTest.asPrint( wordToDouble 0xbfc4000000000000 )),  DocTest.test "src/Data/FloatCast.hs:93" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( runST (cast (0xF0F1F2F3F4F5F6F7::Word64)) == (0xF0F1F2F3F4F5F6F7::Word64) ))]+tests = testGroup "Data.FloatCast" <$> sequence [  DocTest.testProp "src/Data/FloatCast.hs:42" ( \f -> wordToFloat (floatToWord f ) == f ),  DocTest.test "src/Data/FloatCast.hs:45" "[ExpectedLine [LineChunk \"3189768192\"]]" (DocTest.asPrint( floatToWord (-0.15625) )),  DocTest.test "src/Data/FloatCast.hs:48" "[ExpectedLine [LineChunk \"-0.15625\"]]" (DocTest.asPrint( wordToFloat 3189768192 )),  DocTest.test "src/Data/FloatCast.hs:51" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( floatToWord (-5.828125) == 0xC0BA8000 )),  DocTest.testProp "src/Data/FloatCast.hs:70" ( \f -> wordToDouble (doubleToWord f ) == f ),  DocTest.test "src/Data/FloatCast.hs:73" "[ExpectedLine [LineChunk \"\\\"3ff0000000000002\\\"\"]]" (DocTest.asPrint( showHex (doubleToWord 1.0000000000000004) "" )),  DocTest.test "src/Data/FloatCast.hs:76" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( doubleToWord 1.0000000000000004 == 0x3FF0000000000002 )),  DocTest.test "src/Data/FloatCast.hs:79" "[ExpectedLine [LineChunk \"\\\"bfc4000000000000\\\"\"]]" (DocTest.asPrint( showHex (doubleToWord (-0.15625)) "" )),  DocTest.test "src/Data/FloatCast.hs:82" "[ExpectedLine [LineChunk \"-0.15625\"]]" (DocTest.asPrint( wordToDouble 0xbfc4000000000000 )),  DocTest.test "src/Data/FloatCast.hs:97" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( runST (cast (0xF0F1F2F3F4F5F6F7::Word64)) == (0xF0F1F2F3F4F5F6F7::Word64) ))]

@@ -8,7 +8,8 @@ import Data.Word import Data.Int import Numeric.Natural-import Test.QuickCheck.Instances.Natural+import Test.QuickCheck.Arbitrary+instance Arbitrary Natural where arbitrary = arbitrarySizedNatural; shrink    = shrinkIntegral  tests :: IO TestTree-tests = testGroup "Data.ZigZag" <$> sequence [  DocTest.testProp "src/Data/ZigZag.hs:66" ( \(f::Integer) -> zagZig (zigZag f) == f ),  DocTest.testProp "src/Data/ZigZag.hs:68" ( \(f::Natural) -> zigZag (zagZig f) == f ),  DocTest.testProp "src/Data/ZigZag.hs:70" ( \(f::Int8) -> zagZig (zigZag f) == f ),  DocTest.testProp "src/Data/ZigZag.hs:71" ( \(f::Word8) -> zigZag (zagZig f) == f ),  DocTest.testProp "src/Data/ZigZag.hs:72" ( \(s::Int8) -> zigZag s == fromIntegral (zigZag (fromIntegral s :: Integer)) ),  DocTest.testProp "src/Data/ZigZag.hs:73" ( \(u::Word8) -> zagZig u == fromIntegral (zagZig (fromIntegral u :: Natural)) ),  DocTest.testProp "src/Data/ZigZag.hs:75" ( \(f::Int64) -> zagZig (zigZag f) == f ),  DocTest.testProp "src/Data/ZigZag.hs:76" ( \(f::Word64) -> zigZag (zagZig f) == f ),  DocTest.testProp "src/Data/ZigZag.hs:77" ( \(s::Int64) -> zigZag s == fromIntegral (zigZag (fromIntegral s :: Integer)) ),  DocTest.testProp "src/Data/ZigZag.hs:78" ( \(u::Word64) -> zagZig u == fromIntegral (zagZig (fromIntegral u :: Natural)) ),  DocTest.test "src/Data/ZigZag.hs:33" "[ExpectedLine [LineChunk \"0\"]]" (DocTest.asPrint( zigZag (0::Int8) )),  DocTest.test "src/Data/ZigZag.hs:36" "[ExpectedLine [LineChunk \"1\"]]" (DocTest.asPrint( zigZag (-1::Int16) )),  DocTest.test "src/Data/ZigZag.hs:39" "[ExpectedLine [LineChunk \"2\"]]" (DocTest.asPrint( zigZag (1::Int32) )),  DocTest.test "src/Data/ZigZag.hs:42" "[ExpectedLine [LineChunk \"3\"]]" (DocTest.asPrint( zigZag (-2::Int16) )),  DocTest.test "src/Data/ZigZag.hs:45" "[ExpectedLine [LineChunk \"99\"]]" (DocTest.asPrint( zigZag (-50::Integer) )),  DocTest.test "src/Data/ZigZag.hs:48" "[ExpectedLine [LineChunk \"100\"]]" (DocTest.asPrint( zigZag (50::Integer) )),  DocTest.test "src/Data/ZigZag.hs:51" "[ExpectedLine [LineChunk \"128\"]]" (DocTest.asPrint( zigZag (64::Integer) )),  DocTest.test "src/Data/ZigZag.hs:54" "[ExpectedLine [LineChunk \"511\"]]" (DocTest.asPrint( zigZag (-256::Integer) )),  DocTest.test "src/Data/ZigZag.hs:57" "[ExpectedLine [LineChunk \"512\"]]" (DocTest.asPrint( zigZag (256::Integer) )),  DocTest.test "src/Data/ZigZag.hs:60" "[ExpectedLine [LineChunk \"[5,3,1,0,2,4,6]\"]]" (DocTest.asPrint( map zigZag [-3..3::Integer] )),  DocTest.test "src/Data/ZigZag.hs:63" "[ExpectedLine [LineChunk \"[0,-1,1,-2,2,-3,3]\"]]" (DocTest.asPrint( map zagZig [0..6::Word8] ))]+tests = testGroup "Data.ZigZag" <$> sequence [  DocTest.testProp "src/Data/ZigZag.hs:67" ( \(f::Integer) -> zagZig (zigZag f) == f ),  DocTest.testProp "src/Data/ZigZag.hs:70" ( \(f::Natural) -> zigZag (zagZig f) == f ),  DocTest.testProp "src/Data/ZigZag.hs:73" ( \(f::Int8) -> zagZig (zigZag f) == f ),  DocTest.testProp "src/Data/ZigZag.hs:76" ( \(f::Word8) -> zigZag (zagZig f) == f ),  DocTest.testProp "src/Data/ZigZag.hs:79" ( \(s::Int8) -> zigZag s == fromIntegral (zigZag (fromIntegral s :: Integer)) ),  DocTest.testProp "src/Data/ZigZag.hs:82" ( \(u::Word8) -> zagZig u == fromIntegral (zagZig (fromIntegral u :: Natural)) ),  DocTest.testProp "src/Data/ZigZag.hs:85" ( \(f::Int64) -> zagZig (zigZag f) == f ),  DocTest.testProp "src/Data/ZigZag.hs:88" ( \(f::Word64) -> zigZag (zagZig f) == f ),  DocTest.testProp "src/Data/ZigZag.hs:91" ( \(s::Int64) -> zigZag s == fromIntegral (zigZag (fromIntegral s :: Integer)) ),  DocTest.testProp "src/Data/ZigZag.hs:94" ( \(u::Word64) -> zagZig u == fromIntegral (zagZig (fromIntegral u :: Natural)) ),  DocTest.test "src/Data/ZigZag.hs:34" "[ExpectedLine [LineChunk \"0\"]]" (DocTest.asPrint( zigZag (0::Int8) )),  DocTest.test "src/Data/ZigZag.hs:37" "[ExpectedLine [LineChunk \"1\"]]" (DocTest.asPrint( zigZag (-1::Int16) )),  DocTest.test "src/Data/ZigZag.hs:40" "[ExpectedLine [LineChunk \"2\"]]" (DocTest.asPrint( zigZag (1::Int32) )),  DocTest.test "src/Data/ZigZag.hs:43" "[ExpectedLine [LineChunk \"3\"]]" (DocTest.asPrint( zigZag (-2::Int16) )),  DocTest.test "src/Data/ZigZag.hs:46" "[ExpectedLine [LineChunk \"99\"]]" (DocTest.asPrint( zigZag (-50::Integer) )),  DocTest.test "src/Data/ZigZag.hs:49" "[ExpectedLine [LineChunk \"100\"]]" (DocTest.asPrint( zigZag (50::Integer) )),  DocTest.test "src/Data/ZigZag.hs:52" "[ExpectedLine [LineChunk \"128\"]]" (DocTest.asPrint( zigZag (64::Integer) )),  DocTest.test "src/Data/ZigZag.hs:55" "[ExpectedLine [LineChunk \"511\"]]" (DocTest.asPrint( zigZag (-256::Integer) )),  DocTest.test "src/Data/ZigZag.hs:58" "[ExpectedLine [LineChunk \"512\"]]" (DocTest.asPrint( zigZag (256::Integer) )),  DocTest.test "src/Data/ZigZag.hs:61" "[ExpectedLine [LineChunk \"[5,3,1,0,2,4,6]\"]]" (DocTest.asPrint( map zigZag [-3..3::Integer] )),  DocTest.test "src/Data/ZigZag.hs:64" "[ExpectedLine [LineChunk \"[0,-1,1,-2,2,-3,3]\"]]" (DocTest.asPrint( map zagZig [0..6::Word8] ))]

@@ -6,7 +6,7 @@ import Flat.Bits import Data.Word import Flat.Instances.Base-import Flat.Instances.Test+import Flat.Instances.Test(tst,prettyShow)  tests :: IO TestTree-tests = testGroup "Flat.Bits" <$> sequence [  DocTest.test "src/Flat/Bits.hs:44" "[ExpectedLine [LineChunk \"[True]\"]]" (DocTest.asPrint( bits True )),  DocTest.test "src/Flat/Bits.hs:55" "[ExpectedLine [LineChunk \"[True,False,False,False,False,False,False,True]\"]]" (DocTest.asPrint( paddedBits True )),  DocTest.test "src/Flat/Bits.hs:71" "[ExpectedLine [LineChunk \"[False,False,False,False,False,True,False,True]\"]]" (DocTest.asPrint( asBits (5::Word8) )),  DocTest.test "src/Flat/Bits.hs:79" "[ExpectedLine [LineChunk \"[1,3]\"]]" (DocTest.asPrint( asBytes $ asBits (256+3::Word16) )),  DocTest.test "src/Flat/Bits.hs:96" "[ExpectedLine [LineChunk \"\\\"00000001 00000011\\\"\"]]" (DocTest.asPrint( prettyShow $ asBits (256+3::Word16) ))]+tests = testGroup "Flat.Bits" <$> sequence [  DocTest.test "src/Flat/Bits.hs:50" "[ExpectedLine [LineChunk \"[True]\"]]" (DocTest.asPrint( bits True )),  DocTest.test "src/Flat/Bits.hs:62" "[ExpectedLine [LineChunk \"[True,False,False,False,False,False,False,True]\"]]" (DocTest.asPrint( paddedBits True )),  DocTest.test "src/Flat/Bits.hs:82" "[ExpectedLine [LineChunk \"[False,False,False,False,False,True,False,True]\"]]" (DocTest.asPrint( asBits (5::Word8) )),  DocTest.test "src/Flat/Bits.hs:90" "[ExpectedLine [LineChunk \"[1,3]\"]]" (DocTest.asPrint( asBytes $ asBits (256+3::Word16) )),  DocTest.test "src/Flat/Bits.hs:106" "[ExpectedLine [LineChunk \"\\\"00000001 00000011\\\"\"]]" (DocTest.asPrint( prettyShow $ asBits (256+3::Word16) ))]

@@ -8,6 +8,8 @@ import Data.Word import Data.Int import Flat.Run+import Flat.Bits+import Text.PrettyPrint.HughesPJClass (Pretty (pPrint))  tests :: IO TestTree-tests = testGroup "Flat.Decoder.Prim" <$> sequence [  DocTest.test "src/Flat/Decoder/Prim.hs:187" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( unflatWith (dBEBits8 3) [0b11100001::Word8] == Right 0b00000111 ))]+tests = testGroup "Flat.Decoder.Prim" <$> sequence [  DocTest.test "src/Flat/Decoder/Prim.hs:199" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( unflatWith (dBEBits8 3) [0b11100001::Word8] == Right 0b00000111 )),  DocTest.test "src/Flat/Decoder/Prim.hs:202" "[ExpectedLine [LineChunk \"Left (BadOp \\\"read8: cannot read 9 bits\\\")\"]]" (DocTest.asPrint( unflatWith (dBEBits8 9) [0b11100001::Word8,0b11111111] )),  DocTest.test "src/Flat/Decoder/Prim.hs:215" "[ExpectedLine [LineChunk \"Right 00000101 10111111\"]]" (DocTest.asPrint( pPrint . asBits <$> unflatWith (dBEBits16 11) [0b10110111::Word8,0b11100001] )),  DocTest.test "src/Flat/Decoder/Prim.hs:220" "[ExpectedLine [LineChunk \"Right 00000111 11111111\"]]" (DocTest.asPrint( pPrint . asBits <$> unflatWith (dBEBits16 19) [0b00000000::Word8,0b11111111,0b11100001] ))]

@@ -0,0 +1,14 @@++{-# LANGUAGE NoMonomorphismRestriction, ExtendedDefaultRules#-}+module DocTest.Flat.Encoder.Prim where+import qualified DocTest+import Test.Tasty(TestTree,testGroup)+import Flat.Encoder.Prim+import Flat.Instances.Test+import Flat.Bits+import Flat.Encoder.Strict+import Control.Monad+enc e = prettyShow $ encBits 256 (Encoding e)++tests :: IO TestTree+tests = testGroup "Flat.Encoder.Prim" <$> sequence [  DocTest.test "src/Flat/Encoder/Prim.hs:376" "[ExpectedLine [LineChunk \"\\\"1\\\"\"]]" (DocTest.asPrint( enc eTrueF )),  DocTest.test "src/Flat/Encoder/Prim.hs:384" "[ExpectedLine [LineChunk \"\\\"0\\\"\"]]" (DocTest.asPrint( enc eFalseF )),  DocTest.test "src/Flat/Encoder/Prim.hs:394" "[ExpectedLine [LineChunk \"\\\"10000001\\\"\"]]" (DocTest.asPrint( enc $ eTrueF >=> eFillerF )),  DocTest.test "src/Flat/Encoder/Prim.hs:397" "[ExpectedLine [LineChunk \"\\\"00000001\\\"\"]]" (DocTest.asPrint( enc eFillerF )),  DocTest.test "src/Flat/Encoder/Prim.hs:430" "[ExpectedLine [LineChunk \"\\\"11111111\\\"\"]]" (DocTest.asPrint( enc $ \s-> eWord8F 0 s >>= updateWord8 255 s )),  DocTest.test "src/Flat/Encoder/Prim.hs:433" "[ExpectedLine [LineChunk \"\\\"10000000 01111111 1\\\"\"]]" (DocTest.asPrint( enc $ \s0 -> eTrueF s0 >>= \s1 -> eWord8F 255 s1 >>= eWord8F 255 >>= updateWord8 0 s1 )),  DocTest.test "src/Flat/Encoder/Prim.hs:436" "[ExpectedLine [LineChunk \"\\\"01111111 1\\\"\"]]" (DocTest.asPrint( enc $ \s0 -> eFalseF s0 >>= \s1 -> eWord8F 0 s1 >>= updateWord8 255 s1 )),  DocTest.test "src/Flat/Encoder/Prim.hs:439" "[ExpectedLine [LineChunk \"\\\"01111111 10\\\"\"]]" (DocTest.asPrint( enc $ \s0 -> eFalseF s0 >>= \s1 -> eWord8F 0 s1 >>= updateWord8 255 s1 >>= eFalseF )),  DocTest.test "src/Flat/Encoder/Prim.hs:442" "[ExpectedLine [LineChunk \"\\\"10000000 011\\\"\"]]" (DocTest.asPrint( enc $ \s0 -> eTrueF s0 >>= \s1 -> eWord8F 255 s1 >>= eTrueF >>= updateWord8 0 s1 >>= eTrueF ))]

@@ -7,4 +7,4 @@ import Numeric (showHex)  tests :: IO TestTree-tests = testGroup "Flat.Endian" <$> sequence [  DocTest.test "src/Flat/Endian.hs:36" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( toBE64 0xF0F1F2F3F4F5F6F7 == if isBigEndian then 0xF0F1F2F3F4F5F6F7 else 0xF7F6F5F4F3F2F1F0 )),  DocTest.test "src/Flat/Endian.hs:49" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( toBE32 0xF0F1F2F3 == if isBigEndian then 0xF0F1F2F3 else 0xF3F2F1F0 )),  DocTest.test "src/Flat/Endian.hs:62" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( toBE16 0xF0F1 == if isBigEndian then 0xF0F1 else 0xF1F0 ))]+tests = testGroup "Flat.Endian" <$> sequence [  DocTest.test "src/Flat/Endian.hs:38" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( toBE64 0xF0F1F2F3F4F5F6F7 == if isBigEndian then 0xF0F1F2F3F4F5F6F7 else 0xF7F6F5F4F3F2F1F0 )),  DocTest.test "src/Flat/Endian.hs:51" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( toBE32 0xF0F1F2F3 == if isBigEndian then 0xF0F1F2F3 else 0xF3F2F1F0 )),  DocTest.test "src/Flat/Endian.hs:64" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( toBE16 0xF0F1 == if isBigEndian then 0xF0F1 else 0xF1F0 ))]

@@ -16,6 +16,7 @@ import Data.Monoid import qualified Data.List.NonEmpty as B test = tstBits+y = 33  tests :: IO TestTree-tests = testGroup "Flat.Instances.Base" <$> sequence [  DocTest.test "src/Flat/Instances/Base.hs:96" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( let w = Just (11::Word8); a = Alt w <> Alt (Just 24) in tst a == tst w )),  DocTest.test "src/Flat/Instances/Base.hs:99" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( let w = Just (11::Word8); a = Alt Nothing <> Alt w in tst a == tst w )),  DocTest.test "src/Flat/Instances/Base.hs:143" "[ExpectedLine [LineChunk \"(True,0,\\\"\\\")\"]]" (DocTest.asPrint( test () )),  DocTest.test "src/Flat/Instances/Base.hs:156" "[ExpectedLine [LineChunk \"(True,1,\\\"0\\\")\"]]" (DocTest.asPrint( test False )),  DocTest.test "src/Flat/Instances/Base.hs:159" "[ExpectedLine [LineChunk \"(True,1,\\\"1\\\")\"]]" (DocTest.asPrint( test True )),  DocTest.test "src/Flat/Instances/Base.hs:174" "[ExpectedLine [LineChunk \"(True,8,\\\"01100001\\\")\"]]" (DocTest.asPrint( test 'a' )),  DocTest.test "src/Flat/Instances/Base.hs:179" "[ExpectedLine [LineChunk \"(True,16,\\\"11001000 00000001\\\")\"]]" (DocTest.asPrint( test 'È' )),  DocTest.test "src/Flat/Instances/Base.hs:182" "[ExpectedLine [LineChunk \"(True,24,\\\"10001101 10011100 00000001\\\")\"]]" (DocTest.asPrint( test '不' )),  DocTest.test "src/Flat/Instances/Base.hs:198" "[ExpectedLine [LineChunk \"(True,1,\\\"0\\\")\"]]" (DocTest.asPrint( test (Nothing::Maybe Bool) )),  DocTest.test "src/Flat/Instances/Base.hs:201" "[ExpectedLine [LineChunk \"(True,2,\\\"10\\\")\"]]" (DocTest.asPrint( test (Just False::Maybe Bool) )),  DocTest.test "src/Flat/Instances/Base.hs:207" "[ExpectedLine [LineChunk \"(True,2,\\\"00\\\")\"]]" (DocTest.asPrint( test (Left False::Either Bool ()) )),  DocTest.test "src/Flat/Instances/Base.hs:210" "[ExpectedLine [LineChunk \"(True,1,\\\"1\\\")\"]]" (DocTest.asPrint( test (Right ()::Either Bool ()) )),  DocTest.test "src/Flat/Instances/Base.hs:216" "[ExpectedLine [LineChunk \"(True,16,\\\"11110110 00000001\\\")\"]]" (DocTest.asPrint( test (MkFixed 123 :: Fixed E0) )),  DocTest.test "src/Flat/Instances/Base.hs:219" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( test (MkFixed 123 :: Fixed E0) == test (MkFixed 123 :: Fixed E2) )),  DocTest.test "src/Flat/Instances/Base.hs:232" "[ExpectedLine [LineChunk \"(True,8,\\\"00000000\\\")\"]]" (DocTest.asPrint( test (0::Word8) )),  DocTest.test "src/Flat/Instances/Base.hs:235" "[ExpectedLine [LineChunk \"(True,8,\\\"11111111\\\")\"]]" (DocTest.asPrint( test (255::Word8) )),  DocTest.test "src/Flat/Instances/Base.hs:279" "[ExpectedLine [LineChunk \"(True,8,\\\"01111111\\\")\"]]" (DocTest.asPrint( test (127::Word) )),  DocTest.test "src/Flat/Instances/Base.hs:284" "[ExpectedLine [LineChunk \"(True,16,\\\"11111110 00000001\\\")\"]]" (DocTest.asPrint( test (254::Word) )),  DocTest.test "src/Flat/Instances/Base.hs:289" "[ExpectedLine [LineChunk \"(True,24,\\\"10000000 10000000 00000010\\\")\"]]" (DocTest.asPrint( test (32768::Word32) )),  DocTest.test "src/Flat/Instances/Base.hs:294" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( all (test (3::Word) ==) [test (3::Word16),test (3::Word32),test (3::Word64)] )),  DocTest.test "src/Flat/Instances/Base.hs:307" "[ExpectedLine [LineChunk \"(True,8,\\\"00000000\\\")\"]]" (DocTest.asPrint( test (0::Natural) )),  DocTest.test "src/Flat/Instances/Base.hs:310" "[ExpectedLine [LineChunk \"(True,144,\\\"10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 00000010\\\")\"]]" (DocTest.asPrint( test (2^120::Natural) )),  DocTest.test "src/Flat/Instances/Base.hs:362" "[ExpectedLine [LineChunk \"(True,8,\\\"00000000\\\")\"]]" (DocTest.asPrint( test (0::Int) )),  DocTest.test "src/Flat/Instances/Base.hs:365" "[ExpectedLine [LineChunk \"(True,8,\\\"00000001\\\")\"]]" (DocTest.asPrint( test (-1::Int) )),  DocTest.test "src/Flat/Instances/Base.hs:368" "[ExpectedLine [LineChunk \"(True,8,\\\"00000010\\\")\"]]" (DocTest.asPrint( test (1::Int) )),  DocTest.test "src/Flat/Instances/Base.hs:371" "[ExpectedLine [LineChunk \"(True,8,\\\"00000011\\\")\"]]" (DocTest.asPrint( test (-2::Int) )),  DocTest.test "src/Flat/Instances/Base.hs:374" "[ExpectedLine [LineChunk \"(True,8,\\\"00000100\\\")\"]]" (DocTest.asPrint( test (2::Int) )),  DocTest.test "src/Flat/Instances/Base.hs:387" "[ExpectedLine [LineChunk \"(True,8,\\\"00000000\\\")\"]]" (DocTest.asPrint( test (0::Integer) )),  DocTest.test "src/Flat/Instances/Base.hs:390" "[ExpectedLine [LineChunk \"(True,8,\\\"00000001\\\")\"]]" (DocTest.asPrint( test (-1::Integer) )),  DocTest.test "src/Flat/Instances/Base.hs:393" "[ExpectedLine [LineChunk \"(True,8,\\\"00000010\\\")\"]]" (DocTest.asPrint( test (1::Integer) )),  DocTest.test "src/Flat/Instances/Base.hs:396" "[ExpectedLine [LineChunk \"(True,8,\\\"00011111\\\")\"]]" (DocTest.asPrint( test (-(2^4)::Integer) )),  DocTest.test "src/Flat/Instances/Base.hs:399" "[ExpectedLine [LineChunk \"(True,8,\\\"00100000\\\")\"]]" (DocTest.asPrint( test (2^4::Integer) )),  DocTest.test "src/Flat/Instances/Base.hs:402" "[ExpectedLine [LineChunk \"(True,144,\\\"11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 00000011\\\")\"]]" (DocTest.asPrint( test (-(2^120)::Integer) )),  DocTest.test "src/Flat/Instances/Base.hs:405" "[ExpectedLine [LineChunk \"(True,144,\\\"10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 00000100\\\")\"]]" (DocTest.asPrint( test (2^120::Integer) )),  DocTest.test "src/Flat/Instances/Base.hs:416" "[ExpectedLine [LineChunk \"(True,8,\\\"00000000\\\")\"]]" (DocTest.asPrint( test (0::Int8) )),  DocTest.test "src/Flat/Instances/Base.hs:419" "[ExpectedLine [LineChunk \"(True,8,\\\"11111110\\\")\"]]" (DocTest.asPrint( test (127::Int8) )),  DocTest.test "src/Flat/Instances/Base.hs:422" "[ExpectedLine [LineChunk \"(True,8,\\\"11111111\\\")\"]]" (DocTest.asPrint( test (-128::Int8) )),  DocTest.test "src/Flat/Instances/Base.hs:433" "[ExpectedLine [LineChunk \"(True,8,\\\"00000000\\\")\"]]" (DocTest.asPrint( test (0::Int16) )),  DocTest.test "src/Flat/Instances/Base.hs:436" "[ExpectedLine [LineChunk \"(True,8,\\\"00000010\\\")\"]]" (DocTest.asPrint( test (1::Int16) )),  DocTest.test "src/Flat/Instances/Base.hs:439" "[ExpectedLine [LineChunk \"(True,8,\\\"00000001\\\")\"]]" (DocTest.asPrint( test (-1::Int16) )),  DocTest.test "src/Flat/Instances/Base.hs:442" "[ExpectedLine [LineChunk \"(True,24,\\\"11111111 11111111 00000011\\\")\"]]" (DocTest.asPrint( test (minBound::Int16) )),  DocTest.test "src/Flat/Instances/Base.hs:447" "[ExpectedLine [LineChunk \"(True,24,\\\"11111110 11111111 00000011\\\")\"]]" (DocTest.asPrint( test (maxBound::Int16) )),  DocTest.test "src/Flat/Instances/Base.hs:460" "[ExpectedLine [LineChunk \"(True,8,\\\"00000000\\\")\"]]" (DocTest.asPrint( test (0::Int32) )),  DocTest.test "src/Flat/Instances/Base.hs:463" "[ExpectedLine [LineChunk \"(True,40,\\\"11111111 11111111 11111111 11111111 00001111\\\")\"]]" (DocTest.asPrint( test (minBound::Int32) )),  DocTest.test "src/Flat/Instances/Base.hs:466" "[ExpectedLine [LineChunk \"(True,40,\\\"11111110 11111111 11111111 11111111 00001111\\\")\"]]" (DocTest.asPrint( test (maxBound::Int32) )),  DocTest.test "src/Flat/Instances/Base.hs:477" "[ExpectedLine [LineChunk \"(True,8,\\\"00000000\\\")\"]]" (DocTest.asPrint( test (0::Int64) )),  DocTest.test "src/Flat/Instances/Base.hs:480" "[ExpectedLine [LineChunk \"(True,80,\\\"11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 00000001\\\")\"]]" (DocTest.asPrint( test (minBound::Int64) )),  DocTest.test "src/Flat/Instances/Base.hs:483" "[ExpectedLine [LineChunk \"(True,80,\\\"11111110 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 00000001\\\")\"]]" (DocTest.asPrint( test (maxBound::Int64) )),  DocTest.test "src/Flat/Instances/Base.hs:503" "[ExpectedLine [LineChunk \"(True,32,\\\"00000000 00000000 00000000 00000000\\\")\"]]" (DocTest.asPrint( test (0::Float) )),  DocTest.test "src/Flat/Instances/Base.hs:506" "[ExpectedLine [LineChunk \"(True,32,\\\"00000000 00000000 00000000 00000001\\\")\"]]" (DocTest.asPrint( test (1.4012984643E-45::Float) )),  DocTest.test "src/Flat/Instances/Base.hs:509" "[ExpectedLine [LineChunk \"(True,32,\\\"00000000 01111111 11111111 11111111\\\")\"]]" (DocTest.asPrint( test (1.1754942107E-38::Float) )),  DocTest.test "src/Flat/Instances/Base.hs:536" "[ExpectedLine [LineChunk \"(True,16,\\\"00000100 00000010\\\")\"]]" (DocTest.asPrint( test (4 :+ 2 :: Complex Word8) )),  DocTest.test "src/Flat/Instances/Base.hs:544" "[ExpectedLine [LineChunk \"(True,16,\\\"00000011 00000100\\\")\"]]" (DocTest.asPrint( test (3%4::Ratio Word8) )),  DocTest.test "src/Flat/Instances/Base.hs:556" "[ExpectedLine [LineChunk \"(True,1,\\\"0\\\")\"]]" (DocTest.asPrint( test ([]::[Bool]) )),  DocTest.test "src/Flat/Instances/Base.hs:559" "[ExpectedLine [LineChunk \"(True,5,\\\"10100\\\")\"]]" (DocTest.asPrint( test [False,False] )),  DocTest.test "src/Flat/Instances/Base.hs:584" "[ExpectedLine [LineChunk \"(True,1,\\\"0\\\")\"]]" (DocTest.asPrint( test "" )),  DocTest.test "src/Flat/Instances/Base.hs:587" "[ExpectedLine [LineChunk \"(True,28,\\\"10110000 11011000 01101100 0010\\\")\"]]" (DocTest.asPrint( test "aaa" )),  DocTest.test "src/Flat/Instances/Base.hs:595" "[ExpectedLine [LineChunk \"(True,2,\\\"10\\\")\"]]" (DocTest.asPrint( test (B.fromList [True]) )),  DocTest.test "src/Flat/Instances/Base.hs:598" "[ExpectedLine [LineChunk \"(True,4,\\\"0100\\\")\"]]" (DocTest.asPrint( test (B.fromList [False,False]) )),  DocTest.test "src/Flat/Instances/Base.hs:607" "[ExpectedLine [LineChunk \"(True,1,\\\"0\\\")\"]]" (DocTest.asPrint( test (False,()) )),  DocTest.test "src/Flat/Instances/Base.hs:610" "[ExpectedLine [LineChunk \"(True,0,\\\"\\\")\"]]" (DocTest.asPrint( test ((),()) )),  DocTest.test "src/Flat/Instances/Base.hs:615" "[ExpectedLine [LineChunk \"(True,7,\\\"0111011\\\")\"]]" (DocTest.asPrint( test (False,True,True,True,False,True,True) ))]+tests = testGroup "Flat.Instances.Base" <$> sequence [  DocTest.test "src/Flat/Instances/Base.hs:73" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( let w = Just (11::Word8); a = Alt w <> Alt (Just 24) in tst a == tst w )),  DocTest.test "src/Flat/Instances/Base.hs:76" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( let w = Just (11::Word8); a = Alt Nothing <> Alt w in tst a == tst w )),  DocTest.test "src/Flat/Instances/Base.hs:148" "[ExpectedLine [LineChunk \"(True,0,\\\"\\\")\"]]" (DocTest.asPrint( test () )),  DocTest.test "src/Flat/Instances/Base.hs:161" "[ExpectedLine [LineChunk \"(True,1,\\\"0\\\")\"]]" (DocTest.asPrint( test False )),  DocTest.test "src/Flat/Instances/Base.hs:164" "[ExpectedLine [LineChunk \"(True,1,\\\"1\\\")\"]]" (DocTest.asPrint( test True )),  DocTest.test "src/Flat/Instances/Base.hs:179" "[ExpectedLine [LineChunk \"(True,8,\\\"01100001\\\")\"]]" (DocTest.asPrint( test 'a' )),  DocTest.test "src/Flat/Instances/Base.hs:184" "[ExpectedLine [LineChunk \"(True,16,\\\"11001000 00000001\\\")\"]]" (DocTest.asPrint( test 'È' )),  DocTest.test "src/Flat/Instances/Base.hs:187" "[ExpectedLine [LineChunk \"(True,24,\\\"10001101 10011100 00000001\\\")\"]]" (DocTest.asPrint( test '不' )),  DocTest.test "src/Flat/Instances/Base.hs:203" "[ExpectedLine [LineChunk \"(True,1,\\\"0\\\")\"]]" (DocTest.asPrint( test (Nothing::Maybe Bool) )),  DocTest.test "src/Flat/Instances/Base.hs:206" "[ExpectedLine [LineChunk \"(True,2,\\\"10\\\")\"]]" (DocTest.asPrint( test (Just False::Maybe Bool) )),  DocTest.test "src/Flat/Instances/Base.hs:212" "[ExpectedLine [LineChunk \"(True,2,\\\"00\\\")\"]]" (DocTest.asPrint( test (Left False::Either Bool ()) )),  DocTest.test "src/Flat/Instances/Base.hs:215" "[ExpectedLine [LineChunk \"(True,1,\\\"1\\\")\"]]" (DocTest.asPrint( test (Right ()::Either Bool ()) )),  DocTest.test "src/Flat/Instances/Base.hs:221" "[ExpectedLine [LineChunk \"(True,16,\\\"11110110 00000001\\\")\"]]" (DocTest.asPrint( test (MkFixed 123 :: Fixed E0) )),  DocTest.test "src/Flat/Instances/Base.hs:224" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( test (MkFixed 123 :: Fixed E0) == test (MkFixed 123 :: Fixed E2) )),  DocTest.test "src/Flat/Instances/Base.hs:237" "[ExpectedLine [LineChunk \"(True,8,\\\"00000000\\\")\"]]" (DocTest.asPrint( test (0::Word8) )),  DocTest.test "src/Flat/Instances/Base.hs:240" "[ExpectedLine [LineChunk \"(True,8,\\\"11111111\\\")\"]]" (DocTest.asPrint( test (255::Word8) )),  DocTest.test "src/Flat/Instances/Base.hs:284" "[ExpectedLine [LineChunk \"(True,8,\\\"01111111\\\")\"]]" (DocTest.asPrint( test (127::Word) )),  DocTest.test "src/Flat/Instances/Base.hs:289" "[ExpectedLine [LineChunk \"(True,16,\\\"11111110 00000001\\\")\"]]" (DocTest.asPrint( test (254::Word) )),  DocTest.test "src/Flat/Instances/Base.hs:294" "[ExpectedLine [LineChunk \"(True,24,\\\"10000000 10000000 00000010\\\")\"]]" (DocTest.asPrint( test (32768::Word32) )),  DocTest.test "src/Flat/Instances/Base.hs:299" "[ExpectedLine [LineChunk \"True\"]]" (DocTest.asPrint( all (test (3::Word) ==) [test (3::Word16),test (3::Word32),test (3::Word64)] )),  DocTest.test "src/Flat/Instances/Base.hs:312" "[ExpectedLine [LineChunk \"(True,8,\\\"00000000\\\")\"]]" (DocTest.asPrint( test (0::Natural) )),  DocTest.test "src/Flat/Instances/Base.hs:315" "[ExpectedLine [LineChunk \"(True,144,\\\"10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 00000010\\\")\"]]" (DocTest.asPrint( test (2^120::Natural) )),  DocTest.test "src/Flat/Instances/Base.hs:365" "[ExpectedLine [LineChunk \"(True,8,\\\"00000000\\\")\"]]" (DocTest.asPrint( test (0::Int) )),  DocTest.test "src/Flat/Instances/Base.hs:368" "[ExpectedLine [LineChunk \"(True,8,\\\"00000001\\\")\"]]" (DocTest.asPrint( test (-1::Int) )),  DocTest.test "src/Flat/Instances/Base.hs:371" "[ExpectedLine [LineChunk \"(True,8,\\\"00000010\\\")\"]]" (DocTest.asPrint( test (1::Int) )),  DocTest.test "src/Flat/Instances/Base.hs:374" "[ExpectedLine [LineChunk \"(True,8,\\\"00000011\\\")\"]]" (DocTest.asPrint( test (-2::Int) )),  DocTest.test "src/Flat/Instances/Base.hs:377" "[ExpectedLine [LineChunk \"(True,8,\\\"00000100\\\")\"]]" (DocTest.asPrint( test (2::Int) )),  DocTest.test "src/Flat/Instances/Base.hs:390" "[ExpectedLine [LineChunk \"(True,8,\\\"00000000\\\")\"]]" (DocTest.asPrint( test (0::Integer) )),  DocTest.test "src/Flat/Instances/Base.hs:393" "[ExpectedLine [LineChunk \"(True,8,\\\"00000001\\\")\"]]" (DocTest.asPrint( test (-1::Integer) )),  DocTest.test "src/Flat/Instances/Base.hs:396" "[ExpectedLine [LineChunk \"(True,8,\\\"00000010\\\")\"]]" (DocTest.asPrint( test (1::Integer) )),  DocTest.test "src/Flat/Instances/Base.hs:399" "[ExpectedLine [LineChunk \"(True,8,\\\"00011111\\\")\"]]" (DocTest.asPrint( test (-(2^4)::Integer) )),  DocTest.test "src/Flat/Instances/Base.hs:402" "[ExpectedLine [LineChunk \"(True,8,\\\"00100000\\\")\"]]" (DocTest.asPrint( test (2^4::Integer) )),  DocTest.test "src/Flat/Instances/Base.hs:405" "[ExpectedLine [LineChunk \"(True,144,\\\"11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 00000011\\\")\"]]" (DocTest.asPrint( test (-(2^120)::Integer) )),  DocTest.test "src/Flat/Instances/Base.hs:408" "[ExpectedLine [LineChunk \"(True,144,\\\"10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 00000100\\\")\"]]" (DocTest.asPrint( test (2^120::Integer) )),  DocTest.test "src/Flat/Instances/Base.hs:419" "[ExpectedLine [LineChunk \"(True,8,\\\"00000000\\\")\"]]" (DocTest.asPrint( test (0::Int8) )),  DocTest.test "src/Flat/Instances/Base.hs:422" "[ExpectedLine [LineChunk \"(True,8,\\\"11111110\\\")\"]]" (DocTest.asPrint( test (127::Int8) )),  DocTest.test "src/Flat/Instances/Base.hs:425" "[ExpectedLine [LineChunk \"(True,8,\\\"11111111\\\")\"]]" (DocTest.asPrint( test (-128::Int8) )),  DocTest.test "src/Flat/Instances/Base.hs:436" "[ExpectedLine [LineChunk \"(True,8,\\\"00000000\\\")\"]]" (DocTest.asPrint( test (0::Int16) )),  DocTest.test "src/Flat/Instances/Base.hs:439" "[ExpectedLine [LineChunk \"(True,8,\\\"00000010\\\")\"]]" (DocTest.asPrint( test (1::Int16) )),  DocTest.test "src/Flat/Instances/Base.hs:442" "[ExpectedLine [LineChunk \"(True,8,\\\"00000001\\\")\"]]" (DocTest.asPrint( test (-1::Int16) )),  DocTest.test "src/Flat/Instances/Base.hs:445" "[ExpectedLine [LineChunk \"(True,24,\\\"11111111 11111111 00000011\\\")\"]]" (DocTest.asPrint( test (minBound::Int16) )),  DocTest.test "src/Flat/Instances/Base.hs:450" "[ExpectedLine [LineChunk \"(True,24,\\\"11111110 11111111 00000011\\\")\"]]" (DocTest.asPrint( test (maxBound::Int16) )),  DocTest.test "src/Flat/Instances/Base.hs:463" "[ExpectedLine [LineChunk \"(True,8,\\\"00000000\\\")\"]]" (DocTest.asPrint( test (0::Int32) )),  DocTest.test "src/Flat/Instances/Base.hs:466" "[ExpectedLine [LineChunk \"(True,40,\\\"11111111 11111111 11111111 11111111 00001111\\\")\"]]" (DocTest.asPrint( test (minBound::Int32) )),  DocTest.test "src/Flat/Instances/Base.hs:469" "[ExpectedLine [LineChunk \"(True,40,\\\"11111110 11111111 11111111 11111111 00001111\\\")\"]]" (DocTest.asPrint( test (maxBound::Int32) )),  DocTest.test "src/Flat/Instances/Base.hs:480" "[ExpectedLine [LineChunk \"(True,8,\\\"00000000\\\")\"]]" (DocTest.asPrint( test (0::Int64) )),  DocTest.test "src/Flat/Instances/Base.hs:483" "[ExpectedLine [LineChunk \"(True,80,\\\"11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 00000001\\\")\"]]" (DocTest.asPrint( test (minBound::Int64) )),  DocTest.test "src/Flat/Instances/Base.hs:486" "[ExpectedLine [LineChunk \"(True,80,\\\"11111110 11111111 11111111 11111111 11111111 11111111 11111111 11111111 11111111 00000001\\\")\"]]" (DocTest.asPrint( test (maxBound::Int64) )),  DocTest.test "src/Flat/Instances/Base.hs:505" "[ExpectedLine [LineChunk \"(True,32,\\\"00000000 00000000 00000000 00000000\\\")\"]]" (DocTest.asPrint( test (0::Float) )),  DocTest.test "src/Flat/Instances/Base.hs:508" "[ExpectedLine [LineChunk \"(True,32,\\\"00000000 00000000 00000000 00000001\\\")\"]]" (DocTest.asPrint( test (1.4012984643E-45::Float) )),  DocTest.test "src/Flat/Instances/Base.hs:511" "[ExpectedLine [LineChunk \"(True,32,\\\"00000000 01111111 11111111 11111111\\\")\"]]" (DocTest.asPrint( test (1.1754942107E-38::Float) )),  DocTest.test "src/Flat/Instances/Base.hs:538" "[ExpectedLine [LineChunk \"(True,16,\\\"00000100 00000010\\\")\"]]" (DocTest.asPrint( test (4 :+ 2 :: Complex Word8) )),  DocTest.test "src/Flat/Instances/Base.hs:546" "[ExpectedLine [LineChunk \"(True,16,\\\"00000011 00000100\\\")\"]]" (DocTest.asPrint( test (3%4::Ratio Word8) )),  DocTest.test "src/Flat/Instances/Base.hs:558" "[ExpectedLine [LineChunk \"(True,1,\\\"0\\\")\"]]" (DocTest.asPrint( test ([]::[Bool]) )),  DocTest.test "src/Flat/Instances/Base.hs:561" "[ExpectedLine [LineChunk \"(True,5,\\\"10100\\\")\"]]" (DocTest.asPrint( test [False,False] )),  DocTest.test "src/Flat/Instances/Base.hs:595" "[ExpectedLine [LineChunk \"(True,2,\\\"10\\\")\"]]" (DocTest.asPrint( test (B.fromList [True]) )),  DocTest.test "src/Flat/Instances/Base.hs:598" "[ExpectedLine [LineChunk \"(True,4,\\\"0100\\\")\"]]" (DocTest.asPrint( test (B.fromList [False,False]) )),  DocTest.test "src/Flat/Instances/Base.hs:608" "[ExpectedLine [LineChunk \"(True,1,\\\"0\\\")\"]]" (DocTest.asPrint( test (False,()) )),  DocTest.test "src/Flat/Instances/Base.hs:611" "[ExpectedLine [LineChunk \"(True,0,\\\"\\\")\"]]" (DocTest.asPrint( test ((),()) )),  DocTest.test "src/Flat/Instances/Base.hs:616" "[ExpectedLine [LineChunk \"(True,7,\\\"0111011\\\")\"]]" (DocTest.asPrint( test (False,True,True,True,False,True,True) ))]

@@ -0,0 +1,10 @@++{-# LANGUAGE NoMonomorphismRestriction, ExtendedDefaultRules#-}+module DocTest.Flat.Instances.Extra where+import qualified DocTest+import Test.Tasty(TestTree,testGroup)+import Flat.Instances.Extra+import Flat.Instances.Test++tests :: IO TestTree+tests = testGroup "Flat.Instances.Extra" <$> sequence [  DocTest.test "src/Flat/Instances/Extra.hs:13" "[ExpectedLine [LineChunk \"(True,1,\\\"0\\\")\"]]" (DocTest.asPrint( tstBits "" )),  DocTest.test "src/Flat/Instances/Extra.hs:16" "[ExpectedLine [LineChunk \"(True,28,\\\"10110000 11011000 01101100 0010\\\")\"]]" (DocTest.asPrint( tstBits "aaa" ))]

@@ -11,4 +11,4 @@ import qualified Data.Map  tests :: IO TestTree-tests = testGroup "Flat.Instances.Mono" <$> sequence [  DocTest.test "src/Flat/Instances/Mono.hs:60" "[ExpectedLine [LineChunk \"(True,8,[0])\"]]" (DocTest.asPrint( tst $ AsArray ([]::[()]) )),  DocTest.test "src/Flat/Instances/Mono.hs:63" "[ExpectedLine [LineChunk \"(True,40,[3,11,22,33,0])\"]]" (DocTest.asPrint( tst $ AsArray [11::Word8,22,33] )),  DocTest.test "src/Flat/Instances/Mono.hs:66" "[ExpectedLine [LineChunk \"(True,1,[0])\"]]" (DocTest.asPrint( tst $ AsList ([]::[()]) )),  DocTest.test "src/Flat/Instances/Mono.hs:69" "[ExpectedLine [LineChunk \"(True,28,[133,197,164,32])\"]]" (DocTest.asPrint( tst (AsList [11::Word8,22,33]) )),  DocTest.test "src/Flat/Instances/Mono.hs:72" "[ExpectedLine [LineChunk \"(True,28,[133,197,164,32])\"]]" (DocTest.asPrint( tst (AsSet (Data.Set.fromList [11::Word8,22,33])) )),  DocTest.test "src/Flat/Instances/Mono.hs:162" "[ExpectedLine [LineChunk \"(True,1,[0])\"]]" (DocTest.asPrint( tst (AsMap (Data.Map.fromList ([]::[(Word8,())]))) )),  DocTest.test "src/Flat/Instances/Mono.hs:165" "[ExpectedLine [LineChunk \"(True,18,[129,132,128])\"]]" (DocTest.asPrint( tst (AsMap (Data.Map.fromList [(3::Word,9::Word)])) ))]+tests = testGroup "Flat.Instances.Mono" <$> sequence [  DocTest.test "src/Flat/Instances/Mono.hs:62" "[ExpectedLine [LineChunk \"\\\"1111110\\\"\"]]" (DocTest.asPrint( flatBits $ AsList [True,True,True] )),  DocTest.test "src/Flat/Instances/Mono.hs:69" "[ExpectedLine [LineChunk \"\\\"1111110\\\"\"]]" (DocTest.asPrint( flatBits $ [True,True,True] )),  DocTest.test "src/Flat/Instances/Mono.hs:74" "[ExpectedLine [LineChunk \"\\\"00000011 11100000 000\\\"\"]]" (DocTest.asPrint( flatBits $ AsArray [True,True,True] )),  DocTest.test "src/Flat/Instances/Mono.hs:79" "[ExpectedLine [LineChunk \"\\\"10000001 11110000 00000\\\"\"]]" (DocTest.asPrint( flatBits $ [AsArray [True,True,True]] )),  DocTest.test "src/Flat/Instances/Mono.hs:82" "[ExpectedLine [LineChunk \"\\\"11100000 11111111 11000000 00\\\"\"]]" (DocTest.asPrint( flatBits $ (True,True,True,AsArray $ replicate 7 True) )),  DocTest.test "src/Flat/Instances/Mono.hs:85" "[ExpectedLine [LineChunk \"\\\"00000000\\\"\"]]" (DocTest.asPrint( flatBits $ AsArray ([]::[()]) )),  DocTest.test "src/Flat/Instances/Mono.hs:88" "[ExpectedLine [LineChunk \"\\\"0\\\"\"]]" (DocTest.asPrint( flatBits $ AsList ([]::[()]) )),  DocTest.test "src/Flat/Instances/Mono.hs:91" "[ExpectedLine [LineChunk \"(True,28,[133,197,164,32])\"]]" (DocTest.asPrint( tst (AsList [11::Word8,22,33]) )),  DocTest.test "src/Flat/Instances/Mono.hs:94" "[ExpectedLine [LineChunk \"(True,28,[133,197,164,32])\"]]" (DocTest.asPrint( tst (AsSet (Data.Set.fromList [11::Word8,22,33])) )),  DocTest.test "src/Flat/Instances/Mono.hs:97" "[ExpectedLine [LineChunk \"(True,99,[129,129,2,3,0,65,66,2,131,3,132,0,0])\"]]" (DocTest.asPrint( tst [AsArray [1..3], AsArray [4..8]] )),  DocTest.test "src/Flat/Instances/Mono.hs:100" "[ExpectedLine [LineChunk \"(True,99,[129,128,129,1,128,65,65,1,65,129,194,0,0])\"]]" (DocTest.asPrint( tst $ [AsArray [(1::Word8)..3], AsArray [4..8]] )),  DocTest.test "src/Flat/Instances/Mono.hs:103" "[ExpectedLine [LineChunk \"(True,42,[129,129,2,3,0,0])\"]]" (DocTest.asPrint( tst $ [AsArray [(1::Int)..3]] )),  DocTest.test "src/Flat/Instances/Mono.hs:196" "[ExpectedLine [LineChunk \"(True,1,[0])\"]]" (DocTest.asPrint( tst (AsMap (Data.Map.fromList ([]::[(Word8,())]))) )),  DocTest.test "src/Flat/Instances/Mono.hs:199" "[ExpectedLine [LineChunk \"(True,18,[129,132,128])\"]]" (DocTest.asPrint( tst (AsMap (Data.Map.fromList [(3::Word,9::Word)])) ))]

@@ -0,0 +1,15 @@+{-# 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) ))]

@@ -2,19 +2,22 @@ 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 -main = (testGroup "DocTests" <$> sequence [DocTest.Flat.Bits.tests,DocTest.Flat.Instances.Array.tests,DocTest.Flat.Instances.ByteString.tests,DocTest.Flat.Instances.DList.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.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.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

@@ -0,0 +1,75 @@+{-# 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

@@ -26,6 +26,7 @@ import           Data.Int import           Data.Proxy import qualified Data.Sequence as Seq+import           Data.String (fromString) import qualified Data.Text as T import           Data.Word import           Numeric.Natural@@ -260,9 +261,9 @@             dropBits (len * 8 - numBitsToTake - pre)             return r           -- we expect the first numBitsToTake bits of the value-          expectedD @ (Right expected) :: Decoded a = Right+          expectedD@(Right expected) :: Decoded a = Right             $ val `shR` (sz - numBitsToTake) -- ghcjs: shiftR fails, see: https://github.com/ghcjs/ghcjs/issues/706-          actualD @ (Right actual) :: Decoded a = unflatRawWith dec vs+          actualD@(Right actual) :: Decoded a = unflatRawWith dec vs       in testCase            (unwords               [ "take"@@ -420,6 +421,7 @@       errDec (Proxy :: Proxy Bool) [] -- no data     , errDec (Proxy :: Proxy Bool) [128] -- no filler     , errDec (Proxy :: Proxy Bool) [128 + 1, 1, 2, 4, 8] -- additional bytes+    , errDec (Proxy :: Proxy Text) (B.unpack (flat ((fromString "\x80") :: B.ByteString))) -- invalid UTF-8     , encRaw () []     , encRaw ((), (), Unit) []     , encRaw (Unit, 'a', Unit, 'a', Unit, 'a', Unit) [97, 97, 97]

@@ -16,7 +16,7 @@  import Numeric.Natural (Natural) --- #if MIN_VERSION_base(4,9,0) && MIN_VERSION_QuickCheck(2,10,0)+#if MIN_VERSION_base(4,8,0) && MIN_VERSION_QuickCheck(2,10,0) instance Arbitrary a => Arbitrary (BI.NonEmpty a) where   arbitrary = BI.fromList . getNonEmpty <$> (arbitrary :: Gen (NonEmptyList a))   shrink xs = BI.fromList <$> shrink (BI.toList xs)@@ -24,7 +24,7 @@ instance Arbitrary Natural where   arbitrary = arbitrarySizedNatural   shrink    = shrinkIntegral--- #endif+#endif  -- Copied from quickcheck-instances (not used directly as it requires old-time that is incompatible with ghcjs) 

@@ -1,6 +1,5 @@- {-# LANGUAGE UndecidableInstances, DeriveGeneric-             , FlexibleContexts, FlexibleInstances, StandaloneDeriving #-}+             , FlexibleContexts, FlexibleInstances, StandaloneDeriving , CPP #-}  module Test.Data.Flat   ( module Test.Data@@ -33,9 +32,11 @@ -- instance Flat C0 -- instance Flat D0 -- instance Flat E0+#if MIN_VERSION_base(4,9,0) && ! MIN_VERSION_base(4,16,0) deriving instance Generic (a, b, c, d, e, f, g, h)  deriving instance Generic (a, b, c, d, e, f, g, h, i)+#endif  instance {-# OVERLAPPABLE #-}( Flat a                              , Flat b