bytestring-strict-builder (empty) → 0.4.2
raw patch · 10 files changed
+734/−0 lines, 10 filesdep +basedep +base-preludedep +bytestringsetup-changed
Dependencies added: base, base-prelude, bytestring, bytestring-strict-builder, criterion, quickcheck-instances, rerebase, semigroups, tasty, tasty-hunit, tasty-quickcheck, tasty-smallcheck
Files
- LICENSE +22/−0
- Setup.hs +2/−0
- benchmarks/Main.hs +29/−0
- bytestring-strict-builder.cabal +104/−0
- library/ByteString/StrictBuilder.hs +197/−0
- library/ByteString/StrictBuilder/Population.hs +196/−0
- library/ByteString/StrictBuilder/Population/UncheckedShifting.hs +96/−0
- library/ByteString/StrictBuilder/Prelude.hs +9/−0
- library/ByteString/StrictBuilder/UTF8.hs +49/−0
- tests/Main.hs +30/−0
+ LICENSE view
@@ -0,0 +1,22 @@+Copyright (c) 2015, Nikita Volkov++Permission is hereby granted, free of charge, to any person+obtaining a copy of this software and associated documentation+files (the "Software"), to deal in the Software without+restriction, including without limitation the rights to use,+copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following+conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ benchmarks/Main.hs view
@@ -0,0 +1,29 @@+module Main where++import Prelude+import Criterion.Main+import ByteString.StrictBuilder+++main =+ defaultMain [leftAppends, rightAppends]++leftAppends :: Benchmark+leftAppends =+ bench "leftAppends" $ whnf action $! replicate 1000 $ bytes "abc"+ where+ action bytesList =+ builderBytes builder+ where+ builder =+ foldl' (<>) mempty bytesList++rightAppends :: Benchmark+rightAppends =+ bench "rightAppends" $ whnf action $! replicate 1000 $ bytes "abc"+ where+ action bytesList =+ builderBytes builder+ where+ builder =+ foldr (<>) mempty bytesList
+ bytestring-strict-builder.cabal view
@@ -0,0 +1,104 @@+name:+ bytestring-strict-builder+version:+ 0.4.2+category:+ Text, ByteString, Builders, Serialization+synopsis:+ An efficient strict bytestring builder+description:+ According to + <https://github.com/nikita-volkov/bytestring-builders-benchmark the competition benchmarks>, + this library provides the fastest builder of strict bytestrings. + .+ Practical benchmarks have proven it to be highly performant aswell.+ The encoders from the \"postgresql-binary\" library have shown+ a stable performance improvement by factors of up to 10 after the migration+ from the standard builder to \"bytestring-strict-builder\".+homepage:+ https://github.com/nikita-volkov/bytestring-strict-builder +bug-reports:+ https://github.com/nikita-volkov/bytestring-strict-builder/issues +author:+ Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer:+ Nikita Volkov <nikita.y.volkov@mail.ru>+copyright:+ (c) 2017, Nikita Volkov+license:+ MIT+license-file:+ LICENSE+build-type:+ Simple+cabal-version:+ >=1.10++source-repository head+ type:+ git+ location:+ git://github.com/nikita-volkov/bytestring-strict-builder.git++library+ hs-source-dirs:+ library+ default-extensions:+ Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+ default-language:+ Haskell2010+ exposed-modules:+ ByteString.StrictBuilder+ other-modules:+ ByteString.StrictBuilder.Prelude+ ByteString.StrictBuilder.Population+ ByteString.StrictBuilder.Population.UncheckedShifting+ ByteString.StrictBuilder.UTF8+ build-depends:+ semigroups >= 0.18 && < 0.19,+ bytestring >= 0.10 && < 0.11,+ base-prelude >= 1.2 && < 2,+ base >= 4.6 && < 5++test-suite tests+ type:+ exitcode-stdio-1.0+ hs-source-dirs:+ tests+ main-is:+ Main.hs+ default-extensions:+ Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+ default-language:+ Haskell2010+ build-depends:+ bytestring-strict-builder,+ -- testing:+ tasty == 0.11.*,+ tasty-quickcheck == 0.8.*,+ tasty-smallcheck == 0.8.*,+ tasty-hunit == 0.9.*,+ quickcheck-instances >= 0.3.11 && < 0.4,+ -- general:+ rerebase == 1.*++benchmark benchmarks+ type:+ exitcode-stdio-1.0+ hs-source-dirs:+ benchmarks+ main-is:+ Main.hs+ ghc-options:+ -O2+ -threaded+ "-with-rtsopts=-N"+ -funbox-strict-fields+ default-extensions:+ Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveTraversable, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+ default-language:+ Haskell2010+ build-depends:+ bytestring-strict-builder,+ criterion == 1.1.*,+ rerebase == 1.*
+ library/ByteString/StrictBuilder.hs view
@@ -0,0 +1,197 @@+module ByteString.StrictBuilder+(+ Builder,+ builderBytes,+ builderChunksBuilder,+ builderLength,+ bytes,+ lazyBytes,+ asciiIntegral,+ asciiChar,+ utf8Char,+ storable,+ word8,+ word16BE,+ word32BE,+ word64BE,+ int8,+ int16BE,+ int32BE,+ int64BE,+)+where++import ByteString.StrictBuilder.Prelude+import qualified ByteString.StrictBuilder.Population as A+import qualified Data.ByteString as B+import qualified Data.ByteString.Internal as C+import qualified Data.ByteString.Lazy as F+import qualified Data.ByteString.Builder.Internal as G+import qualified ByteString.StrictBuilder.UTF8 as E+++data Builder =+ Builder !Int !A.Population++instance Monoid Builder where+ {-# INLINE mempty #-}+ mempty =+ Builder 0 mempty+ {-# INLINE mappend #-}+ mappend (Builder leftSize leftPopulation) (Builder rightSize rightPopulation) =+ Builder (leftSize + rightSize) (leftPopulation <> rightPopulation)++instance Semigroup Builder++instance IsString Builder where+ fromString =+ bytes . fromString+++-- *+-------------------------++{-|+Efficiently constructs a strict bytestring.+-}+builderBytes :: Builder -> ByteString+builderBytes (Builder size population) =+ C.unsafeCreate size $ \ptr -> A.populationPtrUpdate population ptr $> ()++{-|+Converts into the standard lazy bytestring builder.+Does so efficiently using the internal APIs of \"bytestring\",+without producing any intermediate representation.+-}+builderChunksBuilder :: Builder -> G.Builder+builderChunksBuilder (Builder size population) =+ G.ensureFree size <> A.populationChunksBuilder population++{-|+/O(1)/. Gets the size of the bytestring that is to be produced.+-}+builderLength :: Builder -> Int+builderLength (Builder size population) =+ size+++-- * Primitives+-------------------------++{-# INLINE bytes #-}+bytes :: ByteString -> Builder+bytes bytes =+ Builder (B.length bytes) (A.bytes bytes)++{-# INLINE lazyBytes #-}+lazyBytes :: F.ByteString -> Builder+lazyBytes =+ F.foldlChunks (\builder -> mappend builder . bytes) mempty++{-# INLINE byte #-}+byte :: Word8 -> Builder+byte =+ word8+++-- * Extras+-------------------------++{-# INLINABLE asciiIntegral #-}+asciiIntegral :: Integral a => a -> Builder+asciiIntegral =+ \case+ 0 ->+ byte 48+ x ->+ bool ((<>) (byte 45)) id (x >= 0) $+ loop mempty $+ abs x+ where+ loop builder remainder =+ case remainder of+ 0 ->+ builder+ _ ->+ case quotRem remainder 10 of+ (quot, rem) ->+ loop (byte (48 + fromIntegral rem) <> builder) quot++{-# INLINE asciiChar #-}+asciiChar :: Char -> Builder+asciiChar =+ byte . fromIntegral . ord++{-# INLINE CONLIKE storable #-}+storable :: Storable a => a -> Builder+storable value =+ Builder size (A.storable size value)+ where+ size =+ sizeOf value++{-# INLINE word8 #-}+word8 :: Word8 -> Builder+word8 =+ Builder 1 . A.word8++{-# INLINE word16BE #-}+word16BE :: Word16 -> Builder+word16BE =+ Builder 2 . A.word16BE++{-# INLINE word32BE #-}+word32BE :: Word32 -> Builder+word32BE =+ Builder 4 . A.word32BE++{-# INLINE word64BE #-}+word64BE :: Word64 -> Builder+word64BE =+ Builder 8 . A.word64BE++{-# INLINE int8 #-}+int8 :: Int8 -> Builder+int8 =+ Builder 1 . A.int8++{-# INLINE int16BE #-}+int16BE :: Int16 -> Builder+int16BE =+ Builder 2 . A.int16BE++{-# INLINE int32BE #-}+int32BE :: Int32 -> Builder+int32BE =+ Builder 4 . A.int32BE++{-# INLINE int64BE #-}+int64BE :: Int64 -> Builder+int64BE =+ Builder 8 . A.int64BE++{-# INLINE utf8Char #-}+utf8Char :: Char -> Builder+utf8Char x =+ E.char x bytes_1 bytes_2 bytes_3 bytes_4++{-# INLINE bytes_1 #-}+bytes_1 :: Word8 -> Builder+bytes_1 b1 =+ Builder 1 (A.bytes_1 b1)++{-# INLINE bytes_2 #-}+bytes_2 :: Word8 -> Word8 -> Builder+bytes_2 b1 b2 =+ Builder 2 (A.bytes_2 b1 b2)++{-# INLINE bytes_3 #-}+bytes_3 :: Word8 -> Word8 -> Word8 -> Builder+bytes_3 b1 b2 b3 =+ Builder 3 (A.bytes_3 b1 b2 b3)++{-# INLINE bytes_4 #-}+bytes_4 :: Word8 -> Word8 -> Word8 -> Word8 -> Builder+bytes_4 b1 b2 b3 b4 =+ Builder 4 (A.bytes_4 b1 b2 b3 b4)+
+ library/ByteString/StrictBuilder/Population.hs view
@@ -0,0 +1,196 @@+{-# LANGUAGE CPP #-}+module ByteString.StrictBuilder.Population where++import ByteString.StrictBuilder.Prelude+import qualified Data.ByteString.Internal as B+import qualified Data.ByteString.Lazy.Internal as C+import qualified Data.ByteString.Builder.Internal as G+import qualified ByteString.StrictBuilder.Population.UncheckedShifting as D+import qualified ByteString.StrictBuilder.UTF8 as E+++newtype Population =+ Population { populationPtrUpdate :: Ptr Word8 -> IO (Ptr Word8) }++instance Monoid Population where+ {-# INLINE mempty #-}+ mempty =+ Population return+ {-# INLINE mappend #-}+ mappend (Population leftPtrUpdate) (Population rightPtrUpdate) =+ Population (leftPtrUpdate >=> rightPtrUpdate)++instance Semigroup Population+++{-|+Turns into the standard lazy bytestring builder.+-}+{-# INLINE populationChunksBuilder #-}+populationChunksBuilder :: Population -> G.Builder+populationChunksBuilder (Population ptrUpdate) =+ G.builder stepUpdate+ where+ stepUpdate :: G.BuildStep a -> G.BuildStep a+ stepUpdate nextStep (G.BufferRange beginningPtr afterPtr) =+ do+ newBeginningPtr <- ptrUpdate beginningPtr+ nextStep $! G.BufferRange newBeginningPtr afterPtr++{-# INLINE followParallelly #-}+followParallelly :: Population -> Int -> Population -> Population+followParallelly (Population followerPtrUpdate) followeeLength (Population followeePtrUpdate) =+ Population ptrUpdate+ where+ ptrUpdate ptr =+ do+ lock <- newEmptyMVar+ forkIO $ do+ followeePtrUpdate ptr+ putMVar lock ()+ followerPtrUpdate (plusPtr ptr followeeLength) <* takeMVar lock++-- |+-- Write the given bytes into the pointer and+-- return a pointer incremented by the amount of written bytes.+{-# INLINE bytes #-}+bytes :: B.ByteString -> Population+bytes (B.PS foreignPointer offset length) =+ Population $ \ptr ->+ withForeignPtr foreignPointer $ \ptr' ->+ B.memcpy ptr (plusPtr ptr' offset) length $> plusPtr ptr length++{-# INLINE storable #-}+storable :: Storable a => Int -> a -> Population+storable size value =+ Population (\ptr -> poke (castPtr ptr) value $> plusPtr ptr size)++{-# INLINE word8 #-}+word8 :: Word8 -> Population+word8 value =+ Population $ \ptr ->+ poke ptr value $> plusPtr ptr 1++{-# INLINE word16BE #-}+word16BE :: Word16 -> Population+#ifdef WORDS_BIGENDIAN+word16BE =+ storable 2+#else+word16BE value =+ Population $ \ptr -> do+ poke ptr (fromIntegral (D.shiftr_w16 value 8) :: Word8)+ pokeByteOff ptr 1 (fromIntegral value :: Word8)+ return (plusPtr ptr 2)+#endif++{-# INLINE word32BE #-}+word32BE :: Word32 -> Population+#ifdef WORDS_BIGENDIAN+word32BE =+ storable 4+#else+word32BE value =+ Population $ \ptr -> do+ poke ptr (fromIntegral (D.shiftr_w32 value 24) :: Word8)+ pokeByteOff ptr 1 (fromIntegral (D.shiftr_w32 value 16) :: Word8)+ pokeByteOff ptr 2 (fromIntegral (D.shiftr_w32 value 8) :: Word8)+ pokeByteOff ptr 3 (fromIntegral value :: Word8)+ return (plusPtr ptr 4)+#endif++{-# INLINE word64BE #-}+word64BE :: Word64 -> Population+#ifdef WORDS_BIGENDIAN+word64BE =+ storable 8+#else+#if WORD_SIZE_IN_BITS < 64+--+-- To avoid expensive 64 bit shifts on 32 bit machines, we cast to+-- Word32, and write that+--+word64BE value =+ word32BE (fromIntegral (D.shiftr_w64 value 32)) <>+ word32BE (fromIntegral value)+#else+word64BE value =+ Population $ \ptr -> do+ poke ptr (fromIntegral (D.shiftr_w64 value 56) :: Word8)+ pokeByteOff ptr 1 (fromIntegral (D.shiftr_w64 value 48) :: Word8)+ pokeByteOff ptr 2 (fromIntegral (D.shiftr_w64 value 40) :: Word8)+ pokeByteOff ptr 3 (fromIntegral (D.shiftr_w64 value 32) :: Word8)+ pokeByteOff ptr 4 (fromIntegral (D.shiftr_w64 value 24) :: Word8)+ pokeByteOff ptr 5 (fromIntegral (D.shiftr_w64 value 16) :: Word8)+ pokeByteOff ptr 6 (fromIntegral (D.shiftr_w64 value 8) :: Word8)+ pokeByteOff ptr 7 (fromIntegral value :: Word8)+ return (plusPtr ptr 8)+#endif+#endif++{-# INLINE int8 #-}+int8 :: Int8 -> Population+int8 =+ word8 . fromIntegral++-- | Encoding 'Int16's in big endian format.+{-# INLINE int16BE #-}+int16BE :: Int16 -> Population+int16BE =+ word16BE . fromIntegral++-- | Encoding 'Int32's in big endian format.+{-# INLINE int32BE #-}+int32BE :: Int32 -> Population+int32BE =+ word32BE . fromIntegral++-- | Encoding 'Int64's in big endian format.+{-# INLINE int64BE #-}+int64BE :: Int64 -> Population+int64BE =+ word64BE . fromIntegral++{-# INLINE bytes_1 #-}+bytes_1 :: Word8 -> Population+bytes_1 byte1 =+ Population $ \ptr -> do+ poke ptr byte1+ return (plusPtr ptr 1)++{-# INLINE bytes_2 #-}+bytes_2 :: Word8 -> Word8 -> Population+bytes_2 byte1 byte2 =+ Population $ \ptr -> do+ poke ptr byte1+ pokeByteOff ptr 1 byte2+ return (plusPtr ptr 2)++{-# INLINE bytes_3 #-}+bytes_3 :: Word8 -> Word8 -> Word8 -> Population+bytes_3 byte1 byte2 byte3 =+ Population $ \ptr -> do+ poke ptr byte1+ pokeByteOff ptr 1 byte2+ pokeByteOff ptr 2 byte3+ return (plusPtr ptr 3)++{-# INLINE bytes_4 #-}+bytes_4 :: Word8 -> Word8 -> Word8 -> Word8 -> Population+bytes_4 byte1 byte2 byte3 byte4 =+ Population $ \ptr -> do+ poke ptr byte1+ pokeByteOff ptr 1 byte2+ pokeByteOff ptr 2 byte3+ pokeByteOff ptr 3 byte4+ return (plusPtr ptr 4)++{-# INLINE utf8UnicodeCodePoint #-}+utf8UnicodeCodePoint :: Int -> Population+utf8UnicodeCodePoint x =+ E.unicodeCodePoint x bytes_1 bytes_2 bytes_3 bytes_4++{-# INLINE utf8Char #-}+utf8Char :: Int -> Population+utf8Char x =+ E.unicodeCodePoint x bytes_1 bytes_2 bytes_3 bytes_4
+ library/ByteString/StrictBuilder/Population/UncheckedShifting.hs view
@@ -0,0 +1,96 @@+{-# 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 ByteString.StrictBuilder.Population.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 Prelude+import Foreign+++------------------------------------------------------------------------+-- 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__)+shiftr_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftRL#` i)+shiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRL#` i)++#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 -- Value to use for 32-bit 'Word's+ -> a -- Value to use for 64-bit 'Word's+ -> a+caseWordSize_32_64 f32 f64 =+#if MIN_VERSION_base(4,7,0)+ case finiteBitSize (undefined :: Word) of+#else+ case bitSize (undefined :: Word) of+#endif+ 32 -> f32+ 64 -> f64+ s -> error $ "caseWordSize_32_64: unsupported Word bit-size " ++ show s
+ library/ByteString/StrictBuilder/Prelude.hs view
@@ -0,0 +1,9 @@+module ByteString.StrictBuilder.Prelude+(+ module Exports,+)+where++import BasePrelude as Exports+import Data.ByteString as Exports (ByteString)+import Data.Semigroup as Exports hiding ((<>), Last(..), First(..))
+ library/ByteString/StrictBuilder/UTF8.hs view
@@ -0,0 +1,49 @@+{- |+Utilities for the UTF-8 encoding.+-}+module ByteString.StrictBuilder.UTF8 where++import ByteString.StrictBuilder.Prelude+++{-|+Church encoding of a UTF8-encoded character.+-}+type UTF8Char =+ forall a.+ (Word8 -> a) ->+ (Word8 -> Word8 -> a) ->+ (Word8 -> Word8 -> Word8 -> a) ->+ (Word8 -> Word8 -> Word8 -> Word8 -> a) ->+ a++{-# INLINE char #-}+char :: Char -> UTF8Char+char =+ unicodeCodePoint . ord++{-# INLINE unicodeCodePoint #-}+unicodeCodePoint :: Int -> UTF8Char+unicodeCodePoint x f1 f2 f3 f4 =+ if x <= 0x7F+ then+ f1 (fromIntegral x)+ else + if x <= 0x07FF+ then+ f2+ (fromIntegral ((x `shiftR` 6) + 0xC0))+ (fromIntegral ((x .&. 0x3F) + 0x80))+ else+ if x <= 0xFFFF+ then+ f3+ (fromIntegral (x `shiftR` 12) + 0xE0)+ (fromIntegral ((x `shiftR` 6) .&. 0x3F) + 0x80)+ (fromIntegral (x .&. 0x3F) + 0x80)+ else+ f4+ (fromIntegral (x `shiftR` 18) + 0xF0)+ (fromIntegral ((x `shiftR` 12) .&. 0x3F) + 0x80)+ (fromIntegral ((x `shiftR` 6) .&. 0x3F) + 0x80)+ (fromIntegral (x .&. 0x3F) + 0x80)
+ tests/Main.hs view
@@ -0,0 +1,30 @@+module Main where++import Prelude+import Test.QuickCheck.Instances+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck+import qualified Data.ByteString as A+import qualified ByteString.StrictBuilder as B+++main =+ defaultMain $+ testGroup "All tests" $+ [+ testProperty "Packing a list of bytes is isomorphic to appending a list of builders" $+ \byteList ->+ A.pack byteList ===+ B.builderBytes (foldMap B.word8 byteList)+ ,+ testProperty "Concatting a list of bytestrings is isomorphic to fold-mapping with builders" $+ \bytesList ->+ mconcat bytesList ===+ B.builderBytes (foldMap B.bytes bytesList)+ ,+ testProperty "Concatting a list of bytestrings is isomorphic to concatting a list of builders" $+ \bytesList ->+ mconcat bytesList ===+ B.builderBytes (mconcat (map B.bytes bytesList))+ ]