flat 0.3 → 0.3.2

raw patch · 18 files changed

+325/−151 lines, 18 filesdep +doctestdep +filemanipdep +quickcheck-instancesdep −cpudep −derivedep −transformersdep ~arraydep ~basedep ~bytestringPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: doctest, filemanip, quickcheck-instances, semigroups

Dependencies removed: cpu, derive, transformers

Dependency ranges changed: array, base, bytestring, containers, deepseq, dlist, flat, ghc-prim, mono-traversable, pretty, primitive, tasty, tasty-hunit, tasty-quickcheck, text, vector

API changes (from Hackage documentation)

Files

• CHANGELOG +4/−0
• README.md +11/−6
• flat.cabal +52/−37
• src/Data/Flat/Decoder/Prim.hs +3/−4
• src/Data/Flat/Encoder.hs +1/−1
• src/Data/Flat/Encoder/Strict.hs +6/−1
• src/Data/Flat/Instances.hs +4/−2
• src/Data/Flat/Memory.hs +69/−37
• src/System/Endian.hs +35/−0
• stack.yaml +3/−4
• stack801.yaml +0/−1
• stack802.yaml +0/−1
• test/DocSpec.hs +15/−0
• test/Spec.hs +10/−13
• test/Test/Data.hs +82/−12
• test/Test/Data/Arbitrary.hs +16/−17
• test/Test/Data/Flat.hs +2/−4
• test/Test/Data/Values.hs +12/−11

@@ -5,3 +5,7 @@ 	- `unflatWith` now takes a decoder for the unpadded value (previously it expected a padded decoder) and decodes the padded value 	- Added some decoding primitives 	- Added Data.ByteString.Convert++Version 0.3.1:+	- Tested with ghc 8.2.1+	- Dropped dependencies on the 'cpu', 'derive' and 'tasty' packages to make it compatible with the Eta compiler (https://github.com/typelead/eta)

@@ -1,5 +1,8 @@ -[![Build Status](https://travis-ci.org/tittoassini/flat.svg?branch=master)](https://travis-ci.org/tittoassini/flat) [![Hackage version](https://img.shields.io/hackage/v/flat.svg)](http://hackage.haskell.org/package/flat)+[![Build Status](https://travis-ci.org/Quid2/flat.svg?branch=master)](https://travis-ci.org/Quid2/flat)+[![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/flat)+[![Stackage LTS](http://stackage.org/package/flat/badge/lts)](http://stackage.org/lts/package/flat)  Haskell implementation of [Flat](http://quid2.org/docs/Flat.pdf), a principled, portable and efficient binary data format ([specs](http://quid2.org)). @@ -39,13 +42,13 @@ ```  -For the decoding to work correctly, you will naturally 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 need to communicate across independently evolving agents. For those who do, you will need to supplement `flat` with something like [typed](https://github.com/tittoassini/typed).+For the decoding to work correctly, you will naturally 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 need to communicate across independently evolving agents. For those who do, you will need to supplement `flat` with something like [zm](https://github.com/Quid2/zm).  #### Define Instances for Abstract/Primitive types   A set of primitives are available to define `Flat` instances for abstract or primitive types. - Instances for some common, primitive or abstract data types (Bool,Words,Int,String,Text,ByteStrings,Tuples, Lists, Sequences, Maps ..) are already defined in [Data.Flat.Instances](https://github.com/tittoassini/flat/blob/master/src/Data/Flat/Instances.hs).+ Instances for some common, primitive or abstract data types (Bool,Words,Int,String,Text,ByteStrings,Tuples, Lists, Sequences, Maps ..) are already defined in [Data.Flat.Instances](https://github.com/Quid2/flat/blob/master/src/Data/Flat/Instances.hs).  #### Optimal Bit-Encoding @@ -121,7 +124,7 @@   One thing that is not shown by the benchmarks is that, if the serialized data is to be transferred over a network, the total transfer time (encoding time + transmission time + decoding time) is usually dominated by the transmission time and that's where the smaller binaries produced by flat give it a significant advantage. - Consider for example the Cars dataset. As you can see in the following comparison with `store`, the overall top performer for encoding/decoding speed, the transfer time is actually significantly lower for `flat` for all except the highest transmission speeds.+ Consider for example the Cars dataset. As you can see in the following comparison with `store`, the overall top performer for encoding/decoding speed, the transfer time is actually significantly lower for `flat` for all except the highest transmission speeds (about 4 times faster at typical ADSL speeds, 2 times faster at 4G-LTE mobile speeds).  ||Store|Flat| |---|---|---|@@ -139,17 +142,19 @@ ### Haskell Compatibility  Tested with:-  * [ghc](https://www.haskell.org/ghc/) 7.10.3, 8.0.1 and 8.0.2 (x64)+  * [ghc](https://www.haskell.org/ghc/) 7.10.3, 8.0.2, 8.2.2, 8.4.2 and 8.4.3 (x64)   * [ghc](https://www.haskell.org/ghc/) 7.10.3/LLVM 3.5.2 (Arm7)   * [ghcjs](https://github.com/ghcjs/ghcjs) +It also seems to be working with [Eta](https://eta-lang.org/) though the full test suite could not be run due to Eta's issues compiling `quickcheck` and `doctest`.+ ### Installation  Get the latest stable version from [hackage](https://hackage.haskell.org/package/flat).  ### Acknowledgements - `flat` reuses ideas and readapts code from various packages, mainly: `store`, `binary-bits` and `binary`.+ `flat` reuses ideas and readapts code from various packages, mainly: `store`, `binary-bits` and `binary` and includes contributions from Justus Sagemüller.  ### Known Bugs and Infelicities 

@@ -1,27 +1,27 @@ name: flat-version: 0.3+version: 0.3.2 synopsis: Principled and efficient bit-oriented binary serialization.-description: See the <http://github.com/tittoassini/flat online tutorial>.-homepage: http://github.com/tittoassini/flat+description: Principled and efficient bit-oriented binary serialization, check the <http://github.com/Quid2/flat online tutorial>.+homepage: http://github.com/Quid2/flat+category: Data,Parsing,Serialization license:             BSD3 license-file:        LICENSE author:              Pasqualino `Titto` Assini maintainer:          tittoassini@gmail.com copyright:           Copyright: (c) 2016 Pasqualino `Titto` Assini-category: Data,Parsing,Serialization cabal-version: >=1.10 build-type: Simple-Tested-With: GHC == 7.10.3 GHC == 8.0.1 GHC == 8.0.2+-- The library (but not its tests) compiles with ETA == 0.7.2 (see https://eta-lang.org/) +Tested-With: GHC == 7.10.3 GHC == 8.0.2 GHC == 8.2.2 GHC == 8.4.2+ extra-source-files:     stack.yaml-    stack801.yaml-    stack802.yaml     README.md     CHANGELOG  source-repository head     type: git-    location: https://github.com/tittoassini/flat+    location: https://github.com/Quid2/flat  library     exposed-modules:@@ -45,21 +45,23 @@         Data.Flat         Data.FloatCast         Data.ZigZag+    other-modules: System.Endian                       build-depends:-        array >=0.5.1.0,-        base >=4.8 && <5,-        bytestring >=0.10.6.0,-        containers >=0.5.6.2,-        cpu >=0.1.2,-        deepseq >=1.4.1.1,-        dlist >=0.7.1.2,-        ghc-prim >=0.3.1,-        mono-traversable >=1.0.1,-        pretty >=1.1.2.0,-        primitive >=0.6.1.0,-        text >=1.2.2.1,-        transformers >=0.4.2.0,-        vector >=0.11.0.0+                  array >= 0.5.1.0 && <0.6,+                  base >=4.8 && <5,+                  bytestring>=0.10.6.0 && < 0.11,+                  containers == 0.5.*,+                  deepseq == 1.4.*,+                  dlist >=0.6 && <0.9,+                  ghc-prim,+                  mono-traversable >=0.10.0.2 && <1.1,+                  pretty >= 1.1.2 && < 1.2,+                  primitive,+                  text,+                  vector+    if impl(ghc < 8.0)+      build-depends: semigroups+     default-language: Haskell2010     default-extensions: CPP     other-extensions: DataKinds DefaultSignatures DeriveAnyClass@@ -70,24 +72,22 @@     hs-source-dirs: src     ghc-options: -O2 -funbox-strict-fields -Wall -fno-warn-orphans -fno-warn-name-shadowing -test-suite flat-test+test-suite spec     type: exitcode-stdio-1.0     main-is: Spec.hs     build-depends:-        base >=4.8 && <5,-        cpu >=0.1.2,-        ghc-prim >=0.3.1.0,-        tasty >=0.11.0.2,-        tasty-hunit >=0.9.2,-        tasty-quickcheck >=0.8.4,-        pretty >=1.1.2.0,-        containers >=0.5.6.2,-        derive >=2.5.26,-        text >=1.2.2.1,-        bytestring >=0.10.6.0,-        deepseq >=1.4.1.1,-        text >=1.2.2.1,-        flat >=0.1.3+                  base >=4.8 && <5+                , ghc-prim+                , tasty >= 0.11+                , tasty-hunit >= 0.8+                , tasty-quickcheck >=0.8.1+                , containers == 0.5.*+                , deepseq == 1.4.*+                , quickcheck-instances>=0.3.12+                , text+                , bytestring+                , flat+     default-language: Haskell2010     hs-source-dirs: test     cpp-options: -DLIST_BIT@@ -98,4 +98,19 @@         Test.Data.Flat         Test.Data2.Flat         Test.Data.Values+    -- if impl(eta)+    --    cpp-options: -DETA_COMPILER +test-suite docs+  default-language:   Haskell2010+  type:               exitcode-stdio-1.0+  main-is:            DocSpec.hs+  build-depends:      base, doctest>=0.11.2 && <0.16,filemanip>=0.3.6.3 && < 0.3.7+  HS-Source-Dirs:     test++-- executable qtest+--   default-language:   Haskell2010+--   main-is:             Test.hs+--   hs-source-dirs:      test+--   build-depends:      base,  flat, time+ 

@@ -1,5 +1,4 @@ {-# LANGUAGE BangPatterns        #-}-{-# LANGUAGE MagicHash           #-} {-# LANGUAGE ScopedTypeVariables #-} -- |Strict Decoder Primitives module Data.Flat.Decoder.Prim (@@ -68,10 +67,10 @@  {-# INLINE dBEBits8  #-} -- |Return the n most significant bits (up to maximum of 8)--- The bits are returned right shifted. ----- >>> unflatWith (dBEBits8 3) [128+64+32+1::Word8]--- Right 7+-- The bits are returned right shifted:+--+-- unflatWith (dBEBits8 3) [128+64+32+1::Word8] == Right 7 dBEBits8 :: Int -> Get Word8 dBEBits8 n = Get $ \endPtr s -> do       ensureBits endPtr s n

@@ -64,4 +64,4 @@ import           Data.Flat.Encoder.Size(arrayBits) import           Data.Flat.Encoder.Strict import           Data.Flat.Encoder.Types-import           Data.Monoid+import           Data.Monoid((<>))

@@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns              #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE ScopedTypeVariables       #-}+ -- |Strict encoder module Data.Flat.Encoder.Strict where @@ -12,7 +13,7 @@ import           Data.Flat.Encoder.Types import           Data.Flat.Types import           Data.Foldable-import           Data.Monoid+import           Data.Semigroup -- (Semigroup(..))  -- |Strict encoder strictEncoder :: NumBits -> Encoding -> B.ByteString@@ -26,6 +27,10 @@ newtype Encoding = Encoding { run :: Prim }  instance Show Encoding where show _ = "Encoding"++instance Semigroup Encoding where+  {-# INLINE (<>) #-}+  (<>) = mappend  instance Monoid Encoding where   {-# INLINE mempty #-}

@@ -1,11 +1,13 @@-{-# LANGUAGE BangPatterns #-}+-- {-# LANGUAGE BangPatterns #-}  {-# LANGUAGE FlexibleContexts          #-} {-# LANGUAGE FlexibleInstances         #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE RankNTypes                #-} {-# LANGUAGE ScopedTypeVariables       #-}-{-# LANGUAGE UndecidableInstances      #-}+-- {-# LANGUAGE UndecidableInstances    #-}+-- {-# LANGUAGE IncoherentInstances    #-}+ -- |Flat Instances for common, primitive and abstract data types for which instances cannot be automatically derived module Data.Flat.Instances (     sizeMap,

@@ -3,26 +3,36 @@ {-# LANGUAGE TypeFamilies  #-} {-# LANGUAGE UnboxedTuples #-} -- |Memory access primitives-module Data.Flat.Memory (-    chunksToByteString,-    chunksToByteArray,-    ByteArray(..),-    pokeByteArray,-    pokeByteString,-    unsafeCreateUptoN',-    minusPtr,-    ) where+module Data.Flat.Memory+  ( chunksToByteString+  , chunksToByteArray+  , ByteArray+  , pokeByteArray+  , pokeByteString+  , unsafeCreateUptoN'+  , minusPtr+  )+where  import           Control.Monad-import           Control.Monad.Primitive  (PrimMonad (..))-import qualified Data.ByteString.Internal as BS-import           Data.Primitive.ByteArray-import           Foreign                  hiding (void)-import           GHC.Prim                 (copyAddrToByteArray#,copyByteArrayToAddr#)-import           GHC.Ptr                  (Ptr (..))-import           GHC.Types                (IO (..), Int (..))+import           Control.Monad.Primitive        ( PrimMonad(..) )+import qualified Data.ByteString.Internal      as BS+import           Data.Primitive.ByteArray       ( MutableByteArray(..)+                                                , ByteArray#+                                                , ByteArray+                                                , newByteArray+                                                , unsafeFreezeByteArray+                                                )+import           Foreign                 hiding ( void )+import           GHC.Prim                       ( copyAddrToByteArray#+                                                , copyByteArrayToAddr#+                                                )+import           GHC.Ptr                        ( Ptr(..) )+import           GHC.Types                      ( IO(..)+                                                , Int(..)+                                                ) import           System.IO.Unsafe-import qualified Data.ByteString                as B+import qualified Data.ByteString               as B  unsafeCreateUptoN' :: Int -> (Ptr Word8 -> IO (Int, a)) -> (BS.ByteString, a) unsafeCreateUptoN' l f = unsafeDupablePerformIO (createUptoN' l f)@@ -30,52 +40,74 @@  createUptoN' :: Int -> (Ptr Word8 -> IO (Int, a)) -> IO (BS.ByteString, a) createUptoN' l f = do-  fp <- BS.mallocByteString l+  fp        <- BS.mallocByteString l   (l', res) <- withForeignPtr fp $ \p -> f p   --print (unwords ["Buffer allocated:",show l,"bytes, used:",show l',"bytes"])-  when (l'> l) $ error (unwords ["Buffer overflow, allocated:",show l,"bytes, used:",show l',"bytes"])+  when (l' > l) $ error+    (unwords+      ["Buffer overflow, allocated:", show l, "bytes, used:", show l', "bytes"]+    )   return (BS.PS fp 0 l', res) -- , minusPtr l') {-# INLINE createUptoN' #-}  -- |Copy bytestring to given pointer, returns new pointer pokeByteString :: B.ByteString -> Ptr Word8 -> IO (Ptr Word8)-pokeByteString (BS.PS foreignPointer sourceOffset sourceLength) destPointer = do-    withForeignPtr foreignPointer $ \sourcePointer ->-      BS.memcpy destPointer (sourcePointer `plusPtr` sourceOffset) sourceLength+pokeByteString (BS.PS foreignPointer sourceOffset sourceLength) destPointer =+  do+    withForeignPtr foreignPointer $ \sourcePointer -> BS.memcpy+      destPointer+      (sourcePointer `plusPtr` sourceOffset)+      sourceLength     return (destPointer `plusPtr` sourceLength)  pokeByteArray :: ByteArray# -> Int -> Int -> Ptr Word8 -> IO (Ptr Word8) pokeByteArray sourceArr sourceOffset len dest = do-        copyByteArrayToAddr sourceArr sourceOffset dest len-        let !dest' = dest `plusPtr` len-        return dest'+  copyByteArrayToAddr sourceArr sourceOffset dest len+  let !dest' = dest `plusPtr` len+  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  #-}+  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 (sourcePtr,lens) =-  BS.unsafeCreate (sum lens) $ \destPtr -> void $ foldM (\(destPtr,sourcePtr) sourceLength -> BS.memcpy destPtr sourcePtr sourceLength >> return (destPtr `plusPtr` sourceLength,sourcePtr `plusPtr` (sourceLength+1))) (destPtr,sourcePtr) lens+chunksToByteString :: (Ptr Word8, [Int]) -> BS.ByteString+chunksToByteString (sourcePtr0, lens) =+  BS.unsafeCreate (sum lens) $ \destPtr0 -> void $ foldM+    (\(destPtr, sourcePtr) sourceLength ->+      BS.memcpy destPtr sourcePtr sourceLength+        >> return+             ( destPtr `plusPtr` sourceLength+             , sourcePtr `plusPtr` (sourceLength + 1)+             )+    )+    (destPtr0, sourcePtr0)+    lens -chunksToByteArray :: (Ptr Word8,[Int]) -> (ByteArray,Int)-chunksToByteArray (sourcePtr,lens) = unsafePerformIO $ do+chunksToByteArray :: (Ptr Word8, [Int]) -> (ByteArray, Int)+chunksToByteArray (sourcePtr0, lens) = unsafePerformIO $ do   let len = sum lens   arr <- newByteArray len-  foldM_ (\(destOff,sourcePtr) sourceLength -> copyAddrToByteArray sourcePtr arr destOff sourceLength >> return (destOff + sourceLength,sourcePtr `plusPtr` (sourceLength+1))) (0,sourcePtr) lens+  foldM_+    (\(destOff, sourcePtr) sourceLength ->+      copyAddrToByteArray sourcePtr arr destOff sourceLength >> return+        (destOff + sourceLength, sourcePtr `plusPtr` (sourceLength + 1))+    )+    (0, sourcePtr0)+    lens   farr <- unsafeFreezeByteArray arr-  return (farr,len)+  return (farr, len)  -- from store-core -- | Wrapper around @copyAddrToByteArray#@ primop.-copyAddrToByteArray :: Ptr a -> MutableByteArray (PrimState IO) -> Int -> Int -> IO ()+copyAddrToByteArray+  :: Ptr a -> MutableByteArray (PrimState IO) -> Int -> Int -> IO () copyAddrToByteArray (Ptr addr) (MutableByteArray arr) (I# offset) (I# len) =-    IO (\s -> (# copyAddrToByteArray# addr arr offset len s, () #))-{-# INLINE copyAddrToByteArray  #-}+  IO (\s -> (#copyAddrToByteArray# addr arr offset len s, ()#))+{-# INLINE copyAddrToByteArray #-}

@@ -0,0 +1,35 @@+{-# LANGUAGE CPP #-}+module System.Endian+    (+    toBE32+    , toBE64+    , toBE16+    ) where++#include "MachDeps.h"++import Data.Word++-- | Convert a 64 bit value in cpu endianess to big endian+toBE64 :: Word64 -> Word64+#ifdef WORDS_BIGENDIAN+toBE64 = id+#else+toBE64 = byteSwap64+#endif++-- | Convert a 32 bit value in cpu endianess to big endian+toBE32 :: Word32 -> Word32+#ifdef WORDS_BIGENDIAN+toBE32 = id+#else+toBE32 = byteSwap32+#endif++-- | Convert a 16 bit value in cpu endianess to big endian+toBE16 :: Word16 -> Word16+#ifdef WORDS_BIGENDIAN+toBE16 = id+#else+toBE16 = byteSwap16+#endif

@@ -1,4 +1,3 @@-resolver: lts-6.31--extra-deps:-- mono-traversable-1.0.2+resolver: lts-9.21+#resolver: lts-11.13+#resolver: nightly-2018-06-16

@@ -1,1 +0,0 @@-resolver: lts-7.21

@@ -1,1 +0,0 @@-resolver: lts-8.13

@@ -0,0 +1,15 @@+module Main where+import           Test.DocTest+import           System.FilePath.Find+import           Data.List                      ( isSuffixOf )++main :: IO ()+-- main = find always ((extension ==? ".hs") &&? exceptFiles ["Data/Convertible/Base.hs","Data/Convertible/Utils.hs","Data/Convertible/Instances/Num.hs"]) "src" >>= doctest+main = find always ((extension ==? ".hs") &&? exceptFiles []) "src" >>= doctest++exceptFiles :: Foldable t => t String -> FindClause Bool+exceptFiles mdls =+      -- let excludes = liftOp (\fp mdls -> not $ any (\mdl -> isSuffixOf mdl (traceShowId fp)) mdls)+      let excludes = liftOp+                (\fp modules -> not $ any (`isSuffixOf` fp) modules)+      in  filePath `excludes` mdls

@@ -15,7 +15,6 @@ import qualified Data.ByteString.Lazy  as L import qualified Data.ByteString.Short as SBS import           Data.Char-import           Data.DeriveTH import           Data.Either import           Data.Flat import           Data.Flat.Bits@@ -29,8 +28,8 @@ import qualified Data.Text             as T import           Data.Word import           Numeric.Natural-import           System.Arch-import           System.Endian+-- import           System.Arch+-- import           System.Endian import           System.Exit import           Test.Data import           Test.Data.Arbitrary@@ -38,16 +37,16 @@ import           Test.Data.Values import           Test.Tasty import           Test.Tasty.HUnit-import           Test.Tasty.QuickCheck as QC+import           Test.Tasty.QuickCheck as QC hiding (getSize)  main = do-  printInfo+  -- printInfo   mainTest -- main = mainShow -printInfo = do-  print getSystemArch-  print getSystemEndianness+-- printInfo = do+--   print getSystemArch+--   print getSystemEndianness  mainShow = do   mapM_ (\_ -> generate (arbitrary :: Gen Int) >>= print) [1..10]@@ -122,9 +121,9 @@   ,sz '经' 24   ,sz (0::Word8) 8   ,sz (1::Word8) 8-  ,concat $ map (uncurry sz) $ ns-  ,concat $ map (uncurry sz) $ nsI-  ,concat $ map (uncurry sz) $ nsII+  ,concatMap (uncurry sz) ns+  ,concatMap (uncurry sz) $ nsI+  ,concatMap (uncurry sz) $ nsII   ,sz (1.1::Float) 32   ,sz (1.1::Double) 64   ,sz "" 1@@ -361,8 +360,6 @@ errDec :: forall a . (Flat a, Eq a, Show a) => Proxy a -> [Word8] -> [TestTree] --errDec _ bs = [testCase "bad decode" $ let ev = (des bs::Decoded a) in ev @?= Left ""] errDec _ bs = [testCase "bad decode" $ let ev = (des bs::Decoded a) in isRight ev @?= False]--uc = map ord "\x4444\x5555\x10001\xD800"  ser :: Flat a => a -> [Word8] ser = B.unpack . flat

@@ -1,23 +1,27 @@-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE DeriveTraversable #-}-{-# LANGUAGE MultiParamTypeClasses ,DeriveGeneric ,DeriveDataTypeable ,ScopedTypeVariables ,GADTs ,NoMonomorphismRestriction ,DeriveGeneric ,DefaultSignatures ,TemplateHaskell ,TypeFamilies ,FlexibleContexts ,FlexibleInstances ,EmptyDataDecls #-}+{-# LANGUAGE ConstraintKinds           #-}+{-# LANGUAGE DeriveDataTypeable        #-}+{-# LANGUAGE DeriveGeneric             #-}+{-# LANGUAGE DeriveTraversable         #-}+{-# LANGUAGE EmptyDataDecls            #-}+{-# LANGUAGE FlexibleContexts          #-}+{-# LANGUAGE FlexibleInstances         #-}+{-# LANGUAGE GADTs                     #-}+{-# LANGUAGE MultiParamTypeClasses     #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE ScopedTypeVariables       #-}+{-# LANGUAGE TypeFamilies              #-} {-  A collection of data types used for testing. -}+ module Test.Data where -import Control.Exception-import           Data.Char+import           Data.Data import           Data.Int import           Data.Word--import           Data.Typeable-import           Data.Data import           GHC.Generics-import           Data.Data-import qualified Test.Data2 as D2-import Data.Foldable-import GHC.Exts hiding (toList)+import qualified Test.Data2                    as D2+import           Test.Tasty.QuickCheck  data Void deriving Generic @@ -203,3 +207,69 @@   ,fuel::String -- constant Petrol   } deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) +-- To generate Arbitrary instances while avoiding a direct dependency on 'derive' (that is not supported by Eta), run in the project directory: derive -a test/Test/Data.hs+{-!+deriving instance Arbitrary N+deriving instance Arbitrary Tree+deriving instance Arbitrary List+deriving instance Arbitrary Unit+deriving instance Arbitrary Un+deriving instance Arbitrary A+deriving instance Arbitrary B+!-}++-- GENERATED START++instance () => Arbitrary N where+        arbitrary+          = do x <- choose (0 :: Int, 4)+               case x of+                   0 -> return One+                   1 -> return Two+                   2 -> return Three+                   3 -> return Four+                   4 -> return Five+                   _ -> error "FATAL ERROR: Arbitrary instance, logic bug"++instance (Arbitrary a) => Arbitrary (Tree a) where+        arbitrary+          = do x <- choose (0 :: Int, 1)+               case x of+                   0 -> do x1 <- arbitrary+                           x2 <- arbitrary+                           return (Node x1 x2)+                   1 -> Leaf <$> arbitrary+                   _ -> error "FATAL ERROR: Arbitrary instance, logic bug"++instance (Arbitrary a) => Arbitrary (List a) where+        arbitrary+          = do x <- choose (0 :: Int, 1)+               case x of+                   0 -> do x1 <- arbitrary+                           x2 <- arbitrary+                           return (C x1 x2)+                   1 -> return N+                   _ -> error "FATAL ERROR: Arbitrary instance, logic bug"++instance () => Arbitrary Unit where+        arbitrary = return Unit++instance () => Arbitrary Un where+        arbitrary+          = Un <$> arbitrary+instance () => Arbitrary A where+        arbitrary+          = do x <- choose (0 :: Int, 1)+               case x of+                   0 -> A <$> arbitrary+                   1 -> AA <$> arbitrary+                   _ -> error "FATAL ERROR: Arbitrary instance, logic bug"++instance () => Arbitrary B where+        arbitrary+          = do x <- choose (0 :: Int, 1)+               case x of+                   0 -> B <$> arbitrary+                   1 -> BB <$> arbitrary+                   _ -> error "FATAL ERROR: Arbitrary instance, logic bug"+-- GENERATED STOP

@@ -1,28 +1,27 @@-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-}+-- {-# LANGUAGE TemplateHaskell #-}+ module Test.Data.Arbitrary where -import qualified Data.ByteString       as B-import qualified Data.ByteString.Lazy  as L-import qualified Data.ByteString.Short as SBS-import           Data.DeriveTH-import qualified Data.Text             as T-import           Test.Data+-- import qualified Data.ByteString           as B+-- import qualified Data.ByteString.Lazy      as L+import qualified Data.ByteString.Short     as SBS+-- import qualified Data.Text                 as T+-- import           Test.Data+-- import           Data.DeriveTH+import           Test.QuickCheck.Instances import           Test.Tasty.QuickCheck+-- import           Test.QuickCheck  -- xxx = generate (arbitrary :: Gen (Large (Int))) +#if !MIN_VERSION_quickcheck_instances(0,3,17) instance Arbitrary SBS.ShortByteString where arbitrary   = fmap SBS.pack arbitrary+#endif -instance Arbitrary B.ByteString where arbitrary   = fmap B.pack arbitrary -instance Arbitrary L.ByteString where arbitrary   = fmap L.pack arbitrary--instance Arbitrary T.Text where arbitrary   = fmap T.pack arbitrary---- instance Arbitrary a => Arbitrary (List a) where arbitrary = fmap l2L arbitrary--derive makeArbitrary ''N-+{-+-- derive makeArbitrary ''N derive makeArbitrary ''Tree  derive makeArbitrary ''List@@ -34,7 +33,7 @@ derive makeArbitrary ''A  derive makeArbitrary ''B+-}  -- instance Arbitrary Word7 where arbitrary  = toEnum <$> choose (0, 127) -- derive makeArbitrary ''ASCII-

@@ -1,6 +1,5 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE UndecidableInstances ,DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts ,FlexibleInstances ,LambdaCase ,StandaloneDeriving #-}++{-# LANGUAGE UndecidableInstances ,DeriveGeneric, FlexibleContexts, FlexibleInstances,StandaloneDeriving #-} module Test.Data.Flat(module Test.Data) where import Data.Flat import Data.Flat.Encoder@@ -8,7 +7,6 @@ import Test.Data import Test.Data2.Flat() import Data.Word---import Data.Flat.Poke import Data.Foldable import Data.Int import GHC.Generics

@@ -1,23 +1,24 @@+{-# LANGUAGE CPP                       #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE NoMonomorphismRestriction #-} module Test.Data.Values where  import           Control.DeepSeq import           Control.Exception-import qualified Data.ByteString      as B-import qualified Data.ByteString.Lazy as L+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           Data.Flat+import           Data.Foldable import           Data.Int import           Data.List-import qualified Data.Text            as T+import qualified Data.Map                       as M+import qualified Data.Sequence                  as Seq+import qualified Data.Text                      as T import           Data.Word import           Test.Data-import qualified Test.Data2           as D2-import qualified Data.ByteString.Short.Internal as SBS-import Data.Foldable-import qualified Data.Sequence as Seq-import qualified Data.Map as M-import Data.Flat+import qualified Test.Data2                     as D2  instance NFData Various instance NFData a => NFData (List a)@@ -187,9 +188,9 @@  notLongS =  take 1000 . concat . repeat -arr0 = ("[Bool]",map (odd . ord) $ unicodeStr :: [Bool])+arr0 = ("[Bool]",map (odd . ord) unicodeStr :: [Bool]) -arr1 = ("[Word]",map (fromIntegral . ord) $ unicodeStr :: [Word])+arr1 = ("[Word]",map (fromIntegral . ord) unicodeStr :: [Word])  arr2 = ("ByteString from String",B.pack . map (fromIntegral . ord) $ unicodeStr) sbs = ("StrictByteString",b2)