diff --git a/library/PtrPoker/ByteString.hs b/library/PtrPoker/ByteString.hs --- a/library/PtrPoker/ByteString.hs +++ b/library/PtrPoker/ByteString.hs @@ -5,15 +5,14 @@ import Data.ByteString import qualified Data.ByteString.Builder as Builder import qualified Data.ByteString.Builder.Extra as Builder -import Data.ByteString.Builder.Prim import qualified Data.ByteString.Builder.Scientific as ScientificBuilder import Data.ByteString.Internal import qualified Data.ByteString.Lazy as Lazy -import qualified Data.Text.Encoding as TextEncoding import qualified PtrPoker.Ffi as Ffi import PtrPoker.Prelude hiding (empty) import qualified PtrPoker.Text as Text +builderWithStrategy :: Builder.AllocationStrategy -> Builder.Builder -> ByteString builderWithStrategy strategy builder = builder & Builder.toLazyByteStringWith strategy Lazy.empty diff --git a/library/PtrPoker/Ffi.hs b/library/PtrPoker/Ffi.hs --- a/library/PtrPoker/Ffi.hs +++ b/library/PtrPoker/Ffi.hs @@ -3,7 +3,6 @@ module PtrPoker.Ffi where import Foreign.C -import GHC.Base (ByteArray#, MutableByteArray#) import PtrPoker.Prelude foreign import ccall unsafe "static int_dec" diff --git a/library/PtrPoker/IO/Prim.hs b/library/PtrPoker/IO/Prim.hs --- a/library/PtrPoker/IO/Prim.hs +++ b/library/PtrPoker/IO/Prim.hs @@ -3,7 +3,6 @@ module PtrPoker.IO.Prim where import PtrPoker.Prelude -import qualified PtrPoker.UncheckedShifting as UncheckedShifting {-# INLINE pokeStorable #-} pokeStorable :: Storable a => Ptr Word8 -> a -> IO () @@ -27,130 +26,70 @@ pokeBEWord16 :: Ptr Word8 -> Word16 -> IO () #ifdef WORDS_BIGENDIAN pokeBEWord16 = - {-# SCC "pokeBEWord16" #-} + {-# SCC "pokeBEWord16" #-} pokeStorable #else -pokeBEWord16 ptr value = - {-# SCC "pokeBEWord16" #-} - do - pokeStorable ptr (fromIntegral (UncheckedShifting.shiftr_w16 value 8) :: Word8) - pokeByteOff ptr 1 (fromIntegral value :: Word8) +pokeBEWord16 ptr = + {-# SCC "pokeBEWord16" #-} + pokeStorable ptr . byteSwap16 #endif {-# INLINE pokeBEWord32 #-} pokeBEWord32 :: Ptr Word8 -> Word32 -> IO () #ifdef WORDS_BIGENDIAN pokeBEWord32 = - {-# SCC "pokeBEWord32" #-} + {-# SCC "pokeBEWord32" #-} pokeStorable #else -pokeBEWord32 ptr value = - {-# SCC "pokeBEWord32" #-} - do - pokeStorable ptr (fromIntegral (UncheckedShifting.shiftr_w32 value 24) :: Word8) - pokeByteOff ptr 1 (fromIntegral (UncheckedShifting.shiftr_w32 value 16) :: Word8) - pokeByteOff ptr 2 (fromIntegral (UncheckedShifting.shiftr_w32 value 8) :: Word8) - pokeByteOff ptr 3 (fromIntegral value :: Word8) +pokeBEWord32 ptr = + {-# SCC "pokeBEWord32" #-} + pokeStorable ptr . byteSwap32 #endif {-# INLINE pokeBEWord64 #-} pokeBEWord64 :: Ptr Word8 -> Word64 -> IO () #ifdef WORDS_BIGENDIAN pokeBEWord64 = - {-# SCC "pokeBEWord64" #-} + {-# SCC "pokeBEWord64" #-} pokeStorable #else -#if WORD_SIZE_IN_BITS < 64 --- --- To avoid expensive 64 bit shifts on 32 bit machines, we cast to --- Word32, and write that --- -pokeBEWord64 ptr value = - {-# SCC "pokeBEWord64" #-} - do - pokeBEWord32 ptr (fromIntegral (UncheckedShifting.shiftr_w64 value 32)) - pokeBEWord32 (plusPtr ptr 4) (fromIntegral value) -#else -pokeBEWord64 ptr value = - {-# SCC "pokeBEWord64" #-} - do - pokeStorable ptr (fromIntegral (UncheckedShifting.shiftr_w64 value 56) :: Word8) - pokeByteOff ptr 1 (fromIntegral (UncheckedShifting.shiftr_w64 value 48) :: Word8) - pokeByteOff ptr 2 (fromIntegral (UncheckedShifting.shiftr_w64 value 40) :: Word8) - pokeByteOff ptr 3 (fromIntegral (UncheckedShifting.shiftr_w64 value 32) :: Word8) - pokeByteOff ptr 4 (fromIntegral (UncheckedShifting.shiftr_w64 value 24) :: Word8) - pokeByteOff ptr 5 (fromIntegral (UncheckedShifting.shiftr_w64 value 16) :: Word8) - pokeByteOff ptr 6 (fromIntegral (UncheckedShifting.shiftr_w64 value 8) :: Word8) - pokeByteOff ptr 7 (fromIntegral value :: Word8) -#endif +pokeBEWord64 ptr = + {-# SCC "pokeBEWord64" #-} + pokeStorable ptr . byteSwap64 #endif {-# INLINE pokeLEWord16 #-} pokeLEWord16 :: Ptr Word8 -> Word16 -> IO () #ifdef WORDS_BIGENDIAN -pokeLEWord16 p w = - {-# SCC "pokeLEWord16" #-} - do - pokeWord8 p (fromIntegral w) - pokeWord8Off p 1 (fromIntegral (UncheckedShifting.shiftr_w16 w 8)) +pokeLEWord16 ptr = + {-# SCC "pokeLEWord16" #-} + pokeStorable ptr . byteSwap16 #else pokeLEWord16 = - {-# SCC "pokeLEWord16" #-} + {-# SCC "pokeLEWord16" #-} pokeStorable #endif {-# INLINE pokeLEWord32 #-} pokeLEWord32 :: Ptr Word8 -> Word32 -> IO () #ifdef WORDS_BIGENDIAN -pokeLEWord32 p w = +pokeLEWord32 ptr = {-# SCC "pokeLEWord32" #-} - do - pokeWord8 p (fromIntegral w) - pokeWord8Off p 1 (fromIntegral (UncheckedShifting.shiftr_w32 w 8)) - pokeWord8Off p 2 (fromIntegral (UncheckedShifting.shiftr_w32 w 16)) - pokeWord8Off p 3 (fromIntegral (UncheckedShifting.shiftr_w32 w 24)) + pokeStorable ptr . byteSwap32 #else pokeLEWord32 = - {-# SCC "pokeLEWord32" #-} + {-# SCC "pokeLEWord32" #-} pokeStorable #endif {-# INLINE pokeLEWord64 #-} pokeLEWord64 :: Ptr Word8 -> Word64 -> IO () #ifdef WORDS_BIGENDIAN -#if WORD_SIZE_IN_BITS < 64 --- --- To avoid expensive 64 bit shifts on 32 bit machines, we cast to --- Word32, and write that --- -pokeLEWord64 p w = - {-# SCC "pokeLEWord64" #-} - do - let b = fromIntegral (UncheckedShifting.shiftr_w64 w 32) :: Word32 - a = fromIntegral w :: Word32 - pokeWord8 p (fromIntegral a) - pokeWord8Off p 1 (fromIntegral (UncheckedShifting.shiftr_w32 a 8)) - pokeWord8Off p 2 (fromIntegral (UncheckedShifting.shiftr_w32 a 16)) - pokeWord8Off p 3 (fromIntegral (UncheckedShifting.shiftr_w32 a 24)) - pokeWord8Off p 4 (fromIntegral b) - pokeWord8Off p 5 (fromIntegral (UncheckedShifting.shiftr_w32 b 8)) - pokeWord8Off p 6 (fromIntegral (UncheckedShifting.shiftr_w32 b 16)) - pokeWord8Off p 7 (fromIntegral (UncheckedShifting.shiftr_w32 b 24)) -#else -pokeLEWord64 p w = - {-# SCC "pokeLEWord64" #-} - do - pokeWord8 p (fromIntegral w) - pokeWord8Off p 1 (fromIntegral (UncheckedShifting.shiftr_w64 w 8)) - pokeWord8Off p 2 (fromIntegral (UncheckedShifting.shiftr_w64 w 16)) - pokeWord8Off p 3 (fromIntegral (UncheckedShifting.shiftr_w64 w 24)) - pokeWord8Off p 4 (fromIntegral (UncheckedShifting.shiftr_w64 w 32)) - pokeWord8Off p 5 (fromIntegral (UncheckedShifting.shiftr_w64 w 40)) - pokeWord8Off p 6 (fromIntegral (UncheckedShifting.shiftr_w64 w 48)) - pokeWord8Off p 7 (fromIntegral (UncheckedShifting.shiftr_w64 w 56)) -#endif +pokeLEWord64 ptr = + {-# SCC "pokeLEWord64" #-} + pokeStorable ptr . byteSwap64 #else pokeLEWord64 = - {-# SCC "pokeLEWord64" #-} + {-# SCC "pokeLEWord64" #-} pokeStorable #endif diff --git a/library/PtrPoker/Poke.hs b/library/PtrPoker/Poke.hs --- a/library/PtrPoker/Poke.hs +++ b/library/PtrPoker/Poke.hs @@ -2,8 +2,6 @@ module PtrPoker.Poke where -import qualified Data.Text.Array as TextArray -import qualified Data.Text.Internal as TextInternal import qualified PtrPoker.Ffi as Ffi import qualified PtrPoker.IO.ByteString as ByteStringIO import qualified PtrPoker.IO.Prim as PrimIO diff --git a/library/PtrPoker/UncheckedShifting.hs b/library/PtrPoker/UncheckedShifting.hs deleted file mode 100644 --- a/library/PtrPoker/UncheckedShifting.hs +++ /dev/null @@ -1,92 +0,0 @@ -{-# LANGUAGE CPP #-} - --- | --- Copyright : (c) 2010 Simon Meier --- --- Original serialization code from 'Data.Binary.Builder': --- (c) Lennart Kolmodin, Ross Patterson --- --- License : BSD3-style --- --- Utilty module defining unchecked shifts. --- --- These functions are undefined when the amount being shifted by is --- greater than the size in bits of a machine Int#.- -module PtrPoker.UncheckedShifting - ( shiftr_w16, - shiftr_w32, - shiftr_w64, - shiftr_w, - caseWordSize_32_64, - ) -where - -#if !defined(__HADDOCK__) -import GHC.Base -import GHC.Word (Word32(..),Word16(..),Word64(..)) - -#if WORD_SIZE_IN_BITS < 64 && __GLASGOW_HASKELL__ >= 608 -import GHC.Word (uncheckedShiftRL64#) -#endif -#else -import Data.Word -#endif - -import Foreign -import Prelude - ------------------------------------------------------------------------- --- Unchecked shifts - --- | Right-shift of a 'Word16'. -{-# INLINE shiftr_w16 #-} -shiftr_w16 :: Word16 -> Int -> Word16 - --- | Right-shift of a 'Word32'. -{-# INLINE shiftr_w32 #-} -shiftr_w32 :: Word32 -> Int -> Word32 - --- | Right-shift of a 'Word64'. -{-# INLINE shiftr_w64 #-} -shiftr_w64 :: Word64 -> Int -> Word64 - --- | Right-shift of a 'Word'. -{-# INLINE shiftr_w #-} -shiftr_w :: Word -> Int -> Word -#if WORD_SIZE_IN_BITS < 64 -shiftr_w w s = fromIntegral $ (`shiftr_w32` s) $ fromIntegral w -#else -shiftr_w w s = fromIntegral $ (`shiftr_w64` s) $ fromIntegral w -#endif - -#if !defined(__HADDOCK__) -#if __GLASGOW_HASKELL__ >= 902 -shiftr_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftRLWord16#` i) -shiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRLWord32#` i) -#else -shiftr_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftRL#` i) -shiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRL#` i) -#endif - -#if WORD_SIZE_IN_BITS < 64 -shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL64#` i) -#else -shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL#` i) -#endif - -#else -shiftr_w16 = shiftR -shiftr_w32 = shiftR -shiftr_w64 = shiftR -#endif - --- | Select an implementation depending on the bit-size of 'Word's. --- Currently, it produces a runtime failure if the bitsize is different. --- This is detected by the testsuite. -{-# INLINE caseWordSize_32_64 #-} -caseWordSize_32_64 :: a -> a -> a -caseWordSize_32_64 f32 f64 = - case finiteBitSize (undefined :: Word) of - 32 -> f32 - 64 -> f64 - s -> error $ "caseWordSize_32_64: unsupported Word bit-size " ++ show s diff --git a/library/PtrPoker/Write.hs b/library/PtrPoker/Write.hs --- a/library/PtrPoker/Write.hs +++ b/library/PtrPoker/Write.hs @@ -4,8 +4,6 @@ import qualified Data.ByteString.Internal as ByteString import qualified PtrPoker.ByteString as ByteString import qualified PtrPoker.Ffi as Ffi -import qualified PtrPoker.IO.ByteString as ByteStringIO -import qualified PtrPoker.IO.Prim as PrimIO import qualified PtrPoker.Poke as Poke import PtrPoker.Prelude hiding (concat) import qualified PtrPoker.Size as Size diff --git a/ptr-poker.cabal b/ptr-poker.cabal --- a/ptr-poker.cabal +++ b/ptr-poker.cabal @@ -1,28 +1,70 @@ -name: ptr-poker -version: 0.1.2.8 -synopsis: Pointer poking action construction and composition toolkit -homepage: https://github.com/nikita-volkov/ptr-poker -bug-reports: https://github.com/nikita-volkov/ptr-poker/issues -author: Nikita Volkov -maintainer: Nikita Volkov -copyright: (c) 2020 Nikita Volkov -license: MIT -license-file: LICENSE -build-type: Simple -cabal-version: >=1.10 +cabal-version: 3.0 +name: ptr-poker +version: 0.1.2.9 +synopsis: Pointer poking action construction and composition toolkit +homepage: https://github.com/nikita-volkov/ptr-poker +bug-reports: https://github.com/nikita-volkov/ptr-poker/issues +author: Nikita Volkov +maintainer: Nikita Volkov +copyright: (c) 2020 Nikita Volkov +license: MIT +license-file: LICENSE source-repository head - type: git + type: git location: git://github.com/nikita-volkov/ptr-poker.git +common base-settings + default-language: Haskell2010 + default-extensions: + NoImplicitPrelude + NoMonomorphismRestriction + BangPatterns + ConstraintKinds + DataKinds + DefaultSignatures + DeriveDataTypeable + DeriveFoldable + DeriveFunctor + DeriveGeneric + DeriveTraversable + EmptyDataDecls + FlexibleContexts + FlexibleInstances + FunctionalDependencies + GADTs + GeneralizedNewtypeDeriving + InstanceSigs + LambdaCase + LiberalTypeSynonyms + MagicHash + MultiParamTypeClasses + MultiWayIf + OverloadedStrings + ParallelListComp + PatternGuards + QuasiQuotes + RankNTypes + RecordWildCards + ScopedTypeVariables + StandaloneDeriving + StrictData + TemplateHaskell + TupleSections + TypeApplications + TypeFamilies + TypeOperators + UnboxedTuples + ViewPatterns + library - hs-source-dirs: library - default-extensions: BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, InstanceSigs, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, StrictData, TemplateHaskell, TupleSections, TypeApplications, TypeFamilies, TypeOperators, UnboxedTuples, ViewPatterns - default-language: Haskell2010 + import: base-settings + hs-source-dirs: library exposed-modules: PtrPoker.Poke - PtrPoker.Write PtrPoker.Size + PtrPoker.Write + other-modules: PtrPoker.ByteString PtrPoker.Ffi @@ -30,38 +72,39 @@ PtrPoker.IO.Prim PtrPoker.Prelude PtrPoker.Text - PtrPoker.UncheckedShifting + c-sources: cbits/dtoa.c cbits/int_encoding.c cbits/itoa.c cbits/text.c + build-depends: - base >=4.11 && <5, - bytestring >=0.10 && <0.12, - scientific >=0.3.6.2 && <0.4, - text >=1 && <3 + , base >=4.11 && <5 + , bytestring >=0.10 && <0.12 + , scientific >=0.3.6.2 && <0.4 + , text >=1 && <3 test-suite test - type: exitcode-stdio-1.0 + import: base-settings + type: exitcode-stdio-1.0 hs-source-dirs: test - default-extensions: BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, InstanceSigs, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, StrictData, TemplateHaskell, TupleSections, TypeApplications, TypeFamilies, TypeOperators, UnboxedTuples, ViewPatterns - default-language: Haskell2010 - main-is: Main.hs + main-is: Main.hs build-depends: - hedgehog >=1.0.3 && <2, - numeric-limits >=0.1 && <0.2, - ptr-poker, - rerebase >=1.10.0.1 && <2 + , hedgehog >=1.0.3 && <2 + , isomorphism-class >=0.1.0.7 && <0.2 + , numeric-limits >=0.1 && <0.2 + , ptr-poker + , rerebase >=1.10.0.1 && <2 benchmark bench - type: exitcode-stdio-1.0 - hs-source-dirs: bench - main-is: Main.hs - ghc-options: -O2 -threaded "-with-rtsopts=-N" - default-extensions: BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, InstanceSigs, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, StrictData, TemplateHaskell, TupleSections, TypeApplications, TypeFamilies, TypeOperators, UnboxedTuples, ViewPatterns + import: base-settings + type: exitcode-stdio-1.0 + hs-source-dirs: bench + main-is: Main.hs + ghc-options: -O2 -threaded -with-rtsopts=-N default-language: Haskell2010 build-depends: - gauge >=0.2.5 && <0.3, - ptr-poker, - rerebase >=1.10.0.1 && <2 + , gauge >=0.2.5 && <0.3 + , ptr-poker + , rerebase >=1.10.0.1 && <2 diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -1,11 +1,15 @@ +{-# OPTIONS_GHC -Wno-missing-signatures #-} + module Main where +import qualified Data.ByteString.Builder as ByteStringBuilder import qualified Data.ByteString.Char8 as Char8ByteString import qualified Data.Text.Encoding as Text import Hedgehog import qualified Hedgehog.Gen as Gen import Hedgehog.Main import qualified Hedgehog.Range as Range +import IsomorphismClass import qualified Numeric.Limits as NumericLimits import qualified PtrPoker.Size as Size import qualified PtrPoker.Write as Write @@ -15,56 +19,50 @@ defaultMain $ pure $ checkParallel $ $$(discover) prop_word64Size = - withTests 999 $ - property $ do - a <- forAll (Gen.word64 (Range.exponential minBound maxBound)) - Size.word64AsciiDec a - === length (show a) + property $ do + a <- forAll (Gen.word64 (Range.exponential minBound maxBound)) + Size.word64AsciiDec a + === length (show a) prop_int64Size = - withTests 999 $ - property $ do - a <- forAll (Gen.int64 (Range.exponential minBound maxBound)) - Size.int64AsciiDec a - === length (show a) + property $ do + a <- forAll (Gen.int64 (Range.exponential minBound maxBound)) + Size.int64AsciiDec a + === length (show a) prop_wordAsciiDec = - withTests 999 $ - property $ do - a <- forAll (Gen.word (Range.exponential minBound maxBound)) - let string = - Char8ByteString.unpack (Write.writeToByteString (Write.wordAsciiDec a)) - annotate string - read string === a + property $ do + a <- forAll (Gen.word (Range.exponential minBound maxBound)) + let string = + Char8ByteString.unpack (Write.writeToByteString (Write.wordAsciiDec a)) + annotate string + read string === a prop_intAsciiDec = - withTests 999 $ - property $ do - a <- forAll (Gen.int (Range.exponential minBound maxBound)) - let string = - Char8ByteString.unpack (Write.writeToByteString (Write.intAsciiDec a)) - annotate string - read string === a + property $ do + a <- forAll (Gen.int (Range.exponential minBound maxBound)) + let string = + Char8ByteString.unpack (Write.writeToByteString (Write.intAsciiDec a)) + annotate string + read string === a prop_doubleAsciiDec = - withTests 999 $ - property $ do - a <- forAll realFloatGen - let string = - Char8ByteString.unpack (Write.writeToByteString (Write.doubleAsciiDec a)) - annotate string - if isNaN a - then string === "NaN" - else read string === a + property $ do + a <- forAll realFloatGen + let string = + Char8ByteString.unpack (Write.writeToByteString (Write.doubleAsciiDec a)) + annotate string + if isNaN a + then string === "NaN" + else read string === a prop_realZeroNonRealDoubleAsciiDec = - withTests 999 $ - property $ do - a <- forAll realRealFloatGen - let string = - Char8ByteString.unpack (Write.writeToByteString (Write.zeroNonRealDoubleAsciiDec a)) - annotate string - read string === a + property $ do + a <- forAll realRealFloatGen + let string = + Char8ByteString.unpack (Write.writeToByteString (Write.zeroNonRealDoubleAsciiDec a)) + annotate string + read string === a prop_nonRealZeroNonRealDoubleAsciiDec = withTests 99 $ @@ -73,35 +71,109 @@ let string = Char8ByteString.unpack (Write.writeToByteString (Write.zeroNonRealDoubleAsciiDec a)) annotate string - read string === 0 + read @Integer string === 0 prop_sizeOfTextUtf8 = - withTests 999 $ - property $ do - a <- forAll (Gen.text (Range.exponential 0 9999) (Gen.choice [Gen.ascii, Gen.unicode])) - Size.textUtf8 a - === Char8ByteString.length (Text.encodeUtf8 a) + property $ do + a <- forAll (Gen.text (Range.exponential 0 9999) (Gen.choice [Gen.ascii, Gen.unicode])) + Size.textUtf8 a + === Char8ByteString.length (Text.encodeUtf8 a) prop_sizeOfTextASCII = - withTests 999 $ - property $ do - a <- forAll (Gen.text (Range.exponential 0 9999) Gen.ascii) - Size.textUtf8 a - === Char8ByteString.length (Text.encodeUtf8 a) + property $ do + a <- forAll (Gen.text (Range.exponential 0 9999) Gen.ascii) + Size.textUtf8 a + === Char8ByteString.length (Text.encodeUtf8 a) prop_textASCII = - withTests 999 $ - property $ do - a <- forAll (Gen.text (Range.exponential 0 9999) Gen.ascii) - Write.writeToByteString (Write.textUtf8 a) - === Text.encodeUtf8 a + property $ do + a <- forAll (Gen.text (Range.exponential 0 9999) Gen.ascii) + Write.writeToByteString (Write.textUtf8 a) + === Text.encodeUtf8 a prop_textUtf8 = - withTests 999 $ - property $ do - a <- forAll (Gen.text (Range.exponential 0 9999) (Gen.choice [Gen.ascii, Gen.unicode])) - Write.writeToByteString (Write.textUtf8 a) - === Text.encodeUtf8 a + property $ do + a <- forAll (Gen.text (Range.exponential 0 9999) (Gen.choice [Gen.ascii, Gen.unicode])) + Write.writeToByteString (Write.textUtf8 a) + === Text.encodeUtf8 a + +prop_word8 = + property $ do + a <- forAll (Gen.word8 Range.constantBounded) + Write.writeToByteString (Write.word8 a) + === to (ByteStringBuilder.word8 a) + +prop_lWord16 = + property $ do + a <- forAll (Gen.word16 Range.constantBounded) + Write.writeToByteString (Write.lWord16 a) + === to (ByteStringBuilder.word16LE a) + +prop_bWord16 = + property $ do + a <- forAll (Gen.word16 Range.constantBounded) + Write.writeToByteString (Write.bWord16 a) + === to (ByteStringBuilder.word16BE a) + +prop_lWord32 = + property $ do + a <- forAll (Gen.word32 Range.constantBounded) + Write.writeToByteString (Write.lWord32 a) + === to (ByteStringBuilder.word32LE a) + +prop_bWord32 = + property $ do + a <- forAll (Gen.word32 Range.constantBounded) + Write.writeToByteString (Write.bWord32 a) + === to (ByteStringBuilder.word32BE a) + +prop_lWord64 = + property $ do + a <- forAll (Gen.word64 Range.constantBounded) + Write.writeToByteString (Write.lWord64 a) + === to (ByteStringBuilder.word64LE a) + +prop_bWord64 = + property $ do + a <- forAll (Gen.word64 Range.constantBounded) + Write.writeToByteString (Write.bWord64 a) + === to (ByteStringBuilder.word64BE a) + +prop_lInt16 = + property $ do + a <- forAll (Gen.int16 Range.constantBounded) + Write.writeToByteString (Write.lInt16 a) + === to (ByteStringBuilder.int16LE a) + +prop_bInt16 = + property $ do + a <- forAll (Gen.int16 Range.constantBounded) + Write.writeToByteString (Write.bInt16 a) + === to (ByteStringBuilder.int16BE a) + +prop_lInt32 = + property $ do + a <- forAll (Gen.int32 Range.constantBounded) + Write.writeToByteString (Write.lInt32 a) + === to (ByteStringBuilder.int32LE a) + +prop_bInt32 = + property $ do + a <- forAll (Gen.int32 Range.constantBounded) + Write.writeToByteString (Write.bInt32 a) + === to (ByteStringBuilder.int32BE a) + +prop_lInt64 = + property $ do + a <- forAll (Gen.int64 Range.constantBounded) + Write.writeToByteString (Write.lInt64 a) + === to (ByteStringBuilder.int64LE a) + +prop_bInt64 = + property $ do + a <- forAll (Gen.int64 Range.constantBounded) + Write.writeToByteString (Write.bInt64 a) + === to (ByteStringBuilder.int64BE a) -- * Gens