packages feed

small-bytearray-builder (empty) → 0.1.0.0

raw patch · 7 files changed

+578/−0 lines, 7 filesdep +QuickCheckdep +basedep +byteslicesetup-changed

Dependencies added: QuickCheck, base, byteslice, primitive, primitive-checked, primitive-offset, run-st, small-bytearray-builder, tasty, tasty-quickcheck, vector

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for small-bytearray-builder++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2019, Andrew Martin++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Andrew Martin nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ small-bytearray-builder.cabal view
@@ -0,0 +1,68 @@+cabal-version: 2.2+name: small-bytearray-builder+version: 0.1.0.0+synopsis: Serialize to a small byte arrays+description:+  This is similar to the builder facilities provided by+  `Data.ByteString.Builder`. It is intended to be used in+  situations where the following apply:+  .+  * An individual entity will be serialized as a small+    number of bytes (less than 512).+  .+  * A large number (more than 32) of entities will be serialized+    one after another without anything between them.+  .+  Unlike builders from the `bytestring` package, these builders+  do not track their state when they run out of space. A builder+  that runs out of space simply aborts and is rerun at the beginning+  of the next chunk. This strategy for building is suitable for most+  CSVs and several line protocols (carbon, InfluxDB, etc.).+  +homepage: https://github.com/andrewthad/small-bytearray-builder+bug-reports: https://github.com/andrewthad/small-bytearray-builder/issues+license: BSD-3-Clause+license-file: LICENSE+author: Andrew Martin+maintainer: andrew.thaddeus@gmail.com+copyright: 2019 Andrew Martin+category: Data+extra-source-files: CHANGELOG.md++flag checked+  manual: True+  description: Add bounds-checking to primitive array operations+  default: False++library+  exposed-modules:+    Data.ByteArray.Builder.Small+    Data.ByteArray.Builder.Small.Unsafe+  build-depends:+    , base >=4.12.0.0 && <5+    , byteslice >=0.1 && <0.2+    , primitive-offset >=0.2 && <0.3+    , run-st >=0.1 && <0.2+    , vector >=0.12.0.3 && <0.13+  if flag(checked)+    build-depends: primitive-checked >= 0.7 && <0.8+  else+    build-depends: primitive >= 0.7 && <0.8+  ghc-options: -Wall -O2+  hs-source-dirs: src+  default-language: Haskell2010++test-suite test+  default-language: Haskell2010+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Main.hs+  build-depends:+    , base >=4.12.0.0 && <5+    , byteslice+    , small-bytearray-builder+    , QuickCheck >=2.13.1 && <2.14+    , tasty-quickcheck >=0.10.1 && <0.11+    , tasty >=1.2.3 && <1.3+    , primitive+    , vector
+ src/Data/ByteArray/Builder/Small.hs view
@@ -0,0 +1,205 @@+{-# language BangPatterns #-}+{-# language DuplicateRecordFields #-}+{-# language LambdaCase #-}+{-# language MagicHash #-}+{-# language RankNTypes #-}+{-# language ScopedTypeVariables #-}+{-# language UnboxedTuples #-}++module Data.ByteArray.Builder.Small+  ( -- * Unsafe Primitives+    Builder(..)+  , construct+    -- * Evaluation+  , run+  , pasteST+  , pasteIO+  , pasteGrowST+  , pasteGrowIO+  , pasteArrayST+  , pasteArrayIO+    -- * Materialized Byte Sequences+  , bytes+  , bytearray+    -- * Numbers+  , word64Dec+  , word64PaddedUpperHex+  , word32PaddedUpperHex+  ) where++import Control.Monad.Primitive+import Control.Monad.ST+import Control.Monad.ST.Run (runByteArrayST)+import Data.Bytes.Types+import Data.Primitive+import GHC.Exts+import GHC.ST+import GHC.Word+import GHC.TypeLits (KnownNat,natVal')+import Data.Primitive.ByteArray.Offset (MutableByteArrayOffset(..))++import qualified Data.Primitive as PM+import qualified Data.Vector as V+import qualified Data.ByteArray.Builder.Small.Unsafe as Unsafe++-- | An unmaterialized sequence of bytes that may be pasted+-- into a mutable byte array.+newtype Builder = Builder+  (forall s. MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #))++instance Semigroup Builder where+  {-# inline (<>) #-}+  Builder f <> Builder g = Builder $ \arr off0 len0 s0 -> case f arr off0 len0 s0 of+    (# s1, r #) -> case r /=# (-1#) of+      1# -> g arr r (len0 +# (off0 -# r)) s1+      _ -> (# s1, (-1#) #)++instance Monoid Builder where+  mempty = Builder $ \_ off0 _ s0 -> (# s0, off0 #)++-- | Run a builder. An accurate size hint is important for good performance.+-- The size hint should be slightly larger than the actual size.+run ::+     Int -- ^ Hint for upper bound on size+  -> Builder -- ^ Builder+  -> ByteArray+run hint b = runByteArrayST $ do+  let go !n = do+        arr <- newByteArray n+        pasteST b (MutableBytes arr 0 n) >>= \case+          Nothing -> go (n + 64)+          Just len -> do+            shrinkMutableByteArray arr len+            unsafeFreezeByteArray arr+  go hint++-- | Variant of 'pasteArrayST' that runs in 'IO'.+pasteArrayIO ::+     MutableBytes RealWorld -- ^ Buffer+  -> (a -> Builder) -- ^ Builder+  -> V.Vector a -- ^ Elements to serialize+  -> IO (V.Vector a, MutableBytes RealWorld) -- ^ Shifted vector, shifted buffer+pasteArrayIO !arr f !xs = stToIO (pasteArrayST arr f xs)++-- | Fold over a vector, applying the builder to each element until+-- the buffer cannot accomodate any more.+pasteArrayST ::+     MutableBytes s -- ^ Buffer+  -> (a -> Builder) -- ^ Builder+  -> V.Vector a -- ^ Elements to serialize+  -> ST s (V.Vector a, MutableBytes s) -- ^ Shifted vector, shifted buffer+pasteArrayST (MutableBytes arr off0 len0) f !xs0 = do+  let go !xs !ixBufA !lenBufA = if V.length xs > 0+        then do+          let a = V.unsafeHead xs+          pasteST (f a) (MutableBytes arr ixBufA lenBufA) >>= \case+            Nothing -> pure (xs,MutableBytes arr ixBufA lenBufA)+            Just ixBufB ->+              go (V.unsafeTail xs) ixBufB (lenBufA + (ixBufA - ixBufB))+        else pure (xs,MutableBytes arr ixBufA lenBufA)+  go xs0 off0 len0++-- | Paste the builder into the byte array starting at offset zero.+-- This repeatedly reallocates the byte array if it cannot accomodate+-- the builder, replaying the builder each time.+pasteGrowST ::+     Int -- ^ How many bytes to grow by at a time+  -> Builder+  -> MutableByteArray s+     -- ^ Initial buffer, used linearly. Do not reuse this argument.+  -> ST s (MutableByteArrayOffset s)+     -- ^ Final buffer that accomodated the builder.+pasteGrowST !n b !arr0 = do+  let go !arr !sz = pasteST b (MutableBytes arr 0 sz) >>= \case+        Nothing -> do+          let szNext = sz + n+          arrNext <- PM.newByteArray szNext+          go arrNext szNext+        Just ix -> pure (MutableByteArrayOffset{array=arr,offset=ix})+  go arr0 =<< PM.getSizeofMutableByteArray arr0++-- | Variant of 'pasteGrowST' that runs in 'IO'.+pasteGrowIO ::+     Int -- ^ How many bytes to grow by at a time+  -> Builder+  -> MutableByteArray RealWorld+     -- ^ Initial buffer, used linearly. Do not reuse this argument.+  -> IO (MutableByteArrayOffset RealWorld)+     -- ^ Final buffer that accomodated the builder.+pasteGrowIO !n b !arr = stToIO (pasteGrowST n b arr)++-- | Execute the builder, pasting its contents into a buffer.+-- If the buffer is not large enough, this returns 'Nothing'.+-- Otherwise, it returns the index in the buffer that follows+-- the payload just written.+pasteST :: Builder -> MutableBytes s -> ST s (Maybe Int)+{-# inline pasteST #-}+pasteST (Builder f) (MutableBytes (MutableByteArray arr) (I# off) (I# len)) =+  ST $ \s0 -> case f arr off len s0 of+    (# s1, r #) -> if isTrue# (r /=# (-1#))+      then (# s1, Just (I# r) #)+      else (# s1, Nothing #)++-- | Variant of 'pasteST' that runs in 'IO'.+pasteIO :: Builder -> MutableBytes RealWorld -> IO (Maybe Int)+{-# inline pasteIO #-}+pasteIO b m = stToIO (pasteST b m)++-- | Constructor for 'Builder' that works on a function with lifted+-- arguments instead of unlifted ones. This is just as unsafe as the+-- actual constructor.+construct :: (forall s. MutableBytes s -> ST s (Maybe Int)) -> Builder+construct f = Builder+  $ \arr off len s0 ->+    case unST (f (MutableBytes (MutableByteArray arr) (I# off) (I# len))) s0 of+      (# s1, m #) -> case m of+        Nothing -> (# s1, (-1#) #)+        Just (I# n) -> (# s1, n #)++fromUnsafe :: forall n. KnownNat n => Unsafe.Builder n -> Builder+{-# inline fromUnsafe #-}+fromUnsafe (Unsafe.Builder f) = Builder $ \arr off len s0 ->+  case fromIntegral (natVal' (proxy# :: Proxy# n)) of+    I# req -> case len >=# req of+      1# -> f arr off s0+      _ -> (# s0, (-1#) #)++-- | Create a builder from an unsliced byte sequence.+bytearray :: ByteArray -> Builder+bytearray a = bytes (Bytes a 0 (sizeofByteArray a))++-- | Create a builder from a sliced byte sequence.+bytes :: Bytes -> Builder+bytes (Bytes src soff slen) = construct $ \(MutableBytes arr off len) -> if len >= slen+  then do+    copyByteArray arr off src soff slen+    pure (Just (len - slen))+  else pure Nothing++-- | Encodes an unsigned 64-bit integer as decimal.+-- This encoding never starts with a zero unless the+-- argument was zero.+word64Dec :: Word64 -> Builder+word64Dec w = fromUnsafe (Unsafe.word64Dec w)++-- | Encode a 64-bit unsigned integer as hexadecimal, zero-padding+-- the encoding to 16 digits. This uses uppercase for the alphabetical+-- digits. For example, this encodes the number 1022 as @00000000000003FE@.+word64PaddedUpperHex :: Word64 -> Builder+word64PaddedUpperHex w =+  fromUnsafe (Unsafe.word64PaddedUpperHex w)++-- | Encode a 32-bit unsigned integer as hexadecimal, zero-padding+-- the encoding to 8 digits. This uses uppercase for the alphabetical+-- digits. For example, this encodes the number 1022 as @000003FE@.+word32PaddedUpperHex :: Word32 -> Builder+word32PaddedUpperHex w =+  fromUnsafe (Unsafe.word32PaddedUpperHex w)++unST :: ST s a -> State# s -> (# State# s, a #)+unST (ST f) = f++shrinkMutableByteArray :: MutableByteArray s -> Int -> ST s ()+shrinkMutableByteArray (MutableByteArray arr) (I# sz) =+  primitive_ (shrinkMutableByteArray# arr sz)+
+ src/Data/ByteArray/Builder/Small/Unsafe.hs view
@@ -0,0 +1,204 @@+{-# language GADTSyntax #-}+{-# language KindSignatures #-}+{-# language ScopedTypeVariables #-}+{-# language BangPatterns #-}+{-# language MagicHash #-}+{-# language UnboxedTuples #-}+{-# language RankNTypes #-}+{-# language LambdaCase #-}+{-# language TypeOperators #-}+{-# language DataKinds #-}++-- | The functions in this module do not check to+-- see if there is enough space in the buffer.+module Data.ByteArray.Builder.Small.Unsafe+  ( -- * Builder+    Builder(..)+  , construct+    -- * Execute+  , run+  , pasteST+  , pasteIO+    -- * Combine+  , append+    -- * Encode Integral Types+  , word64Dec+  , word64PaddedUpperHex+  , word32PaddedUpperHex+  ) where++import Control.Monad.Primitive+import Control.Monad.ST+import Data.Bits+import Data.Bytes.Types+import Data.Char (ord)+import Data.Primitive+import GHC.Exts+import GHC.ST+import GHC.Word+import Data.Kind+import GHC.TypeLits (KnownNat,Nat,type (+),natVal')++-- | A builder parameterized by the maximum number of bytes it uses+-- when executed.+newtype Builder :: Nat -> Type where+   Builder ::+        (forall s. MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #))+     -> Builder n++-- | Execute the builder. This function is safe.+run :: forall n. KnownNat n+  => Builder n -- ^ Builder+  -> ByteArray+{-# inline run #-}+run b = runST $ do+  arr <- newByteArray (fromIntegral (natVal' (proxy# :: Proxy# n)))+  len <- pasteST b arr 0+  shrinkMutableByteArray arr len+  unsafeFreezeByteArray arr++-- | This function does not enforce the known upper bound on the+-- size. It is up to the user to do this.+pasteST :: Builder n -> MutableByteArray s -> Int -> ST s Int+{-# inline pasteST #-}+pasteST (Builder f) (MutableByteArray arr) (I# off) =+  ST $ \s0 -> case f arr off s0 of+    (# s1, r #) -> (# s1, (I# r) #)++-- | This function does not enforce the known upper bound on the+-- size. It is up to the user to do this.+pasteIO :: Builder n -> MutableByteArray RealWorld -> Int -> IO Int+{-# inline pasteIO #-}+pasteIO b m off = stToIO (pasteST b m off)++-- | Constructor for 'Builder' that works on a function with lifted+-- arguments instead of unlifted ones. This is just as unsafe as the+-- actual constructor.+construct :: (forall s. MutableByteArray s -> Int -> ST s Int) -> Builder n+{-# inline construct #-}+construct f = Builder+  $ \arr off s0 ->+    case unST (f (MutableByteArray arr) (I# off)) s0 of+      (# s1, (I# n) #) -> (# s1, n #)++-- | Concatenate two builders.+append :: Builder n -> Builder m -> Builder (n + m)+append (Builder f) (Builder g) =+  Builder $ \arr off0 s0 -> case f arr off0 s0 of+    (# s1, r #) -> g arr r s1++-- | Requires up to 19 bytes. Encodes an unsigned 64-bit integer as decimal.+-- This encoding never starts with a zero unless the argument was zero.+word64Dec :: Word64 -> Builder 19+word64Dec (W64# w) = word64Dec# w++-- | Requires up to 19 bytes.+word64Dec# :: Word# -> Builder 19+{-# noinline word64Dec# #-}+word64Dec# w# = construct $ \arr off0 -> if w /= 0+  then do+    let go off x = if x > 0+          then do+            let (y,z) = quotRem x 10+            writeByteArray arr off (fromIntegral (z + 0x30) :: Word8)+            go (off + 1) y+          else do+            reverseBytes arr off0 (off - 1)+            pure off+    go off0 w+  else do+    writeByteArray arr off0 (c2w '0')+    pure (off0 + 1)+  where+  w = W64# w#++-- Convert a number between 0 and 16 to the ASCII+-- representation of its hexadecimal character.+-- The use of fromIntegral causes us to incur an+-- unneeded bitmask. This actually needs a Word64+-- argument.+toHexUpper :: Word -> Word8+toHexUpper w' = fromIntegral+    $ (complement theMask .&. loSolved)+  .|. (theMask .&. hiSolved)+  where+  w = w' .&. 0xF+  -- This is all ones if the value was >= 10+  theMask = (1 .&. unsafeShiftR (w - 10) 63) - 1+  loSolved = w + 48+  hiSolved = w + 55++-- | Requires exactly 16 bytes. Encodes a 64-bit unsigned integer as+-- hexadecimal, zero-padding the encoding to 16 digits. This uses+-- uppercase for the alphabetical digits. For example, this encodes the+-- number 1022 as @00000000000003FE@.+word64PaddedUpperHex :: Word64 -> Builder 16+word64PaddedUpperHex (W64# w) = word64PaddedUpperHex# w++-- | Requires exactly 8 bytes. Encodes a 32-bit unsigned integer as+-- hexadecimal, zero-padding the encoding to 8 digits. This uses+-- uppercase for the alphabetical digits.+word32PaddedUpperHex :: Word32 -> Builder 8+word32PaddedUpperHex (W32# w) = word32PaddedUpperHex# w++word64PaddedUpperHex# :: Word# -> Builder 16+{-# noinline word64PaddedUpperHex# #-}+word64PaddedUpperHex# w# = construct $ \arr off -> do+  writeByteArray arr off (toHexUpper (unsafeShiftR w 60))+  writeByteArray arr (off + 1) (toHexUpper (unsafeShiftR w 56))+  writeByteArray arr (off + 2) (toHexUpper (unsafeShiftR w 52))+  writeByteArray arr (off + 3) (toHexUpper (unsafeShiftR w 48))+  writeByteArray arr (off + 4) (toHexUpper (unsafeShiftR w 44))+  writeByteArray arr (off + 5) (toHexUpper (unsafeShiftR w 40))+  writeByteArray arr (off + 6) (toHexUpper (unsafeShiftR w 36))+  writeByteArray arr (off + 7) (toHexUpper (unsafeShiftR w 32))+  writeByteArray arr (off + 8) (toHexUpper (unsafeShiftR w 28))+  writeByteArray arr (off + 9) (toHexUpper (unsafeShiftR w 24))+  writeByteArray arr (off + 10) (toHexUpper (unsafeShiftR w 20))+  writeByteArray arr (off + 11) (toHexUpper (unsafeShiftR w 16))+  writeByteArray arr (off + 12) (toHexUpper (unsafeShiftR w 12))+  writeByteArray arr (off + 13) (toHexUpper (unsafeShiftR w 8))+  writeByteArray arr (off + 14) (toHexUpper (unsafeShiftR w 4))+  writeByteArray arr (off + 15) (toHexUpper (unsafeShiftR w 0))+  pure (off + 16)+  where+  w = W# w#++word32PaddedUpperHex# :: Word# -> Builder 8+{-# noinline word32PaddedUpperHex# #-}+word32PaddedUpperHex# w# = construct $ \arr off -> do+  writeByteArray arr off (toHexUpper (unsafeShiftR w 28))+  writeByteArray arr (off + 1) (toHexUpper (unsafeShiftR w 24))+  writeByteArray arr (off + 2) (toHexUpper (unsafeShiftR w 20))+  writeByteArray arr (off + 3) (toHexUpper (unsafeShiftR w 16))+  writeByteArray arr (off + 4) (toHexUpper (unsafeShiftR w 12))+  writeByteArray arr (off + 5) (toHexUpper (unsafeShiftR w 8))+  writeByteArray arr (off + 6) (toHexUpper (unsafeShiftR w 4))+  writeByteArray arr (off + 7) (toHexUpper (unsafeShiftR w 0))+  pure (off + 8)+  where+  w = W# w#++-- Reverse the bytes in the designated slice. This takes+-- an inclusive start offset and an inclusive end offset.+reverseBytes :: MutableByteArray s -> Int -> Int -> ST s ()+{-# inline reverseBytes #-}+reverseBytes arr begin end = go begin end where+  go ixA ixB = if ixA < ixB+    then do+      a :: Word8 <- readByteArray arr ixA+      b :: Word8 <- readByteArray arr ixB+      writeByteArray arr ixA b+      writeByteArray arr ixB a+      go (ixA + 1) (ixB - 1)+    else pure ()++c2w :: Char -> Word8+c2w = fromIntegral . ord++unST :: ST s a -> State# s -> (# State# s, a #)+unST (ST f) = f++shrinkMutableByteArray :: MutableByteArray s -> Int -> ST s ()+shrinkMutableByteArray (MutableByteArray arr) (I# sz) =+  primitive_ (shrinkMutableByteArray# arr sz)
+ test/Main.hs view
@@ -0,0 +1,64 @@+{-# language BangPatterns #-}+{-# language ScopedTypeVariables #-}+{-# language TypeApplications #-}++import Control.Monad.ST (runST)+import Data.Bytes.Types (MutableBytes(..))+import Data.ByteArray.Builder.Small+import Data.Word+import Data.Char (ord)+import Data.Primitive (ByteArray)+import Debug.Trace+import Test.Tasty (defaultMain,testGroup,TestTree)+import Test.QuickCheck ((===))+import Text.Printf (printf)+import qualified Data.Primitive as PM+import qualified Data.List as L+import qualified Data.Vector as V+import qualified Test.Tasty.QuickCheck as TQC+import qualified Test.QuickCheck as QC+import qualified GHC.Exts as Exts++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "Tests"+  [ TQC.testProperty "word64Dec" $ \w ->+      run 1 (word64Dec w) === pack (show w)+  , TQC.testProperty "word64Dec-x3" $ \x y z ->+      run 1 (word64Dec x <> word64Dec y <> word64Dec z)+      ===+      pack (show x ++ show y ++ show z)+  , TQC.testProperty "word64PaddedUpperHex" $ \w ->+      run 1 (word64PaddedUpperHex w)+      ===+      pack (showWord64PaddedUpperHex w)+  , TQC.testProperty "pasteArrayST" $ \(xs :: [Word64]) ->+      (runArray word64Dec (V.fromList xs))+      ===+      pack (foldMap show xs)+  ]++pack :: String -> ByteArray+pack = Exts.fromList . map (fromIntegral @Int @Word8 . ord)++-- This is used to test pasteArrayST+runArray ::+     (a -> Builder) -- ^ Builder+  -> V.Vector a -- ^ Elements to serialize+  -> ByteArray -- ^ Number of elements serialized, serialization+runArray f !xs = runST $ do+  let go !v0 !sz !chunks = if V.null v0+        then pure (mconcat (L.reverse chunks))+        else do+          arr <- PM.newByteArray sz+          (v1,MutableBytes _ off _) <- pasteArrayST (MutableBytes arr 0 sz) f v0+          -- If nothing was serialized, we need a bigger buffer+          let szNext = if V.length v0 == V.length v1 then sz + 1 else sz+          c <- PM.unsafeFreezeByteArray =<< PM.resizeMutableByteArray arr off+          go v1 szNext (c : chunks)+  go xs 1 []++showWord64PaddedUpperHex :: Word64 -> String+showWord64PaddedUpperHex = printf "%016X"