bspack 0.0.3 → 0.0.4

raw patch · 6 files changed

+29/−162 lines, 6 filesdep +sandiPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: sandi

API changes (from Hackage documentation)

Files

• Data/ByteString/Pack.hs +0/−4
• Data/ByteString/Pack/Base32.hs +0/−140
• Data/ByteString/Pack/Internal.hs +14/−1
• Tests/Bench.hs +13/−6
• Tests/Tests.hs +0/−9
• bspack.cabal +2/−2

@@ -24,9 +24,6 @@     , putByteString     , fillList     , fillUpWith-      -- *** Encoding-    , putByteStringBase32-    , guessEncodedLength       -- ** skip     , skip     , skipStorable@@ -42,7 +39,6 @@ import System.IO.Unsafe (unsafePerformIO)  import Data.ByteString.Pack.Internal-import Data.ByteString.Pack.Base32  -- | pack the given packer into the given bytestring pack :: Packer a -> Int -> Either String ByteString

@@ -1,140 +0,0 @@--- |--- Module      : Data.ByteString.Pack.Base32--- License     : BSD-Style--- Copyright   : Copyright © 2014 Nicolas DI PRIMA------ Maintainer  : Nicolas DI PRIMA <nicolas@di-prima.fr>--- Stability   : experimental--- Portability : unknown------ Base32 converstion (see RFC4648)-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE MagicHash #-}-module Data.ByteString.Pack.Base32-    ( putByteStringBase32-    , guessEncodedLength-    ) where--import           Control.Monad (void)-import           Data.Bits-import qualified Data.ByteString          as B-import           Data.ByteString.Internal as B-import           Data.ByteString.Pack.Internal-import           Foreign.ForeignPtr (withForeignPtr)-import           Foreign.Ptr-import           Foreign.Storable-import           GHC.Prim-import           GHC.Types-import           GHC.Word---- | convert the given bytestring in base 32-putByteStringBase32 :: ByteString -> Packer ()-putByteStringBase32 bs-    | neededLength == 0 = return ()-    | otherwise         = actionPacker neededLength (actionPackerEncode32 bs)-  where-    sourceLength :: Int-    sourceLength = B.length bs-    neededLength :: Int-    neededLength = guessEncodedLength sourceLength--    actionPackerEncode32 :: ByteString -> Ptr Word8 -> IO ()-    actionPackerEncode32 (PS srcfptr off _) dstptr = do-        withForeignPtr srcfptr $ \srcptr ->-            encode32Ptr (srcptr `plusPtr` off) dstptr sourceLength neededLength (0x00, 0)--encode32Ptr :: Ptr Word8 -> Ptr Word8 -> Int -> Int -> (Word8, Int) -> IO ()--- OK: all the bytes have been consumned, the Cache has been flushed-encode32Ptr _       !dstptr  0  0 (!bits, !size) = void $ flush dstptr (bits, size)-encode32Ptr _       !dstptr  0 !k (!bits, !size) = do-    _ <- flush dstptr (bits, size)-    _ <- B.memset (dstptr `plusPtr` 1) 0x3d (fromIntegral $ k - 1)-    return ()--- OK: consume the byte and iterate-encode32Ptr !srcptr !dstptr !n !k (!bits, !size) = do-    w <- peek srcptr-    case size of-        0 -> flush dstptr (bufferize w 1 5 (bits, size)) >>= encodeNext 1 1 . bufferize w 6 8-        1 -> flush dstptr (bufferize w 1 4 (bits, size)) >>= encodeNext 1 1 . bufferize w 5 8-        2 -> flush dstptr (bufferize w 1 3 (bits, size)) >>= flush (dstptr `plusPtr` 1) . bufferize w 4 8 >>= encodeNext 1 2-        3 -> flush dstptr (bufferize w 1 2 (bits, size)) >>= flush (dstptr `plusPtr` 1) . bufferize w 3 7 >>= encodeNext 1 2 . bufferize w 8 8-        4 -> flush dstptr (bufferize w 1 1 (bits, size)) >>= flush (dstptr `plusPtr` 1) . bufferize w 2 6 >>= encodeNext 1 2 . bufferize w 7 8-        _ -> undefined-  where-    encodeNext :: Int -> Int -> (Word8, Int) -> IO ()-    encodeNext !srcoff !dstoff = encode32Ptr (srcptr `plusPtr` srcoff) (dstptr `plusPtr` dstoff) (n - srcoff) (k - dstoff)-    {-# INLINE encodeNext #-}-                 -flush :: Ptr Word8 -> (Word8, Int) -> IO (Word8, Int)-flush !ptr (!w, _) = do-    poke ptr (toBase32 $ fromIntegral w)-    return (0, 0)-{-# INLINE flush #-}--bufferize :: Word8-          -> Int-          -> Int-          -> (Word8, Int)-          -> (Word8, Int)-bufferize !w !from !to (!bits, !nbRead) = (newBits, newNbRead)-  where-    newBits :: Word8-    newBits = bits .|. (((w `shiftR` shifterR) .&. mask) `shiftL` shifterL)-    newNbRead :: Int-    newNbRead = nbRead + size--    shifterR :: Int-    shifterR = 8 - to-    shifterL :: Int-    shifterL = 5 - size - nbRead--    size :: Int-    size = to - from + 1-    mask :: Word8-    mask = getMask size-{-# INLINE bufferize #-}---- | return the maximum needed length to convert in Base32-guessEncodedLength :: Int -- ^ the lenght of the Bytestring to convert into base32-                   -> Int-guessEncodedLength 0 = 0-guessEncodedLength l-  | modulo == 0 = 8 * l `div` 5-  | otherwise   = 8 * (l + 5 - modulo) `div` 5-  where-    modulo :: Int-    modulo = l `mod` 5-----------------------------------------------------------------------------------                                Helpers                                   -----------------------------------------------------------------------------------getMask :: Int -> Word8-getMask !n =-  case n of-    0 -> 0x00 -- 0000 0000-    1 -> 0x01 -- 0000 0001-    2 -> 0x03 -- 0000 0011-    3 -> 0x07 -- 0000 0111-    4 -> 0x0F -- 0000 1111-    5 -> 0x1F -- 0001 1111-    6 -> 0x3F -- 0011 1111-    7 -> 0x7F -- 0111 1111-    _ -> 0xFF -- 1111 1111--toBase32 :: Word8 -> Word8-toBase32 !w-  | index < 32 = W8# (indexWord8OffAddr# addr i)-  | otherwise  = error $ "toWord8: bad input: cannot convert '" ++ (show index) ++ "'"-  where-    index :: Int-    index = fromIntegral w--    !(I# i) = index-    !(Table addr) = alphabet--data Table = Table !Addr#--alphabet :: Table-alphabet = Table "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567"#

@@ -12,6 +12,7 @@     , Packer(..)     , Cache(..)     , actionPacker+    , actionPackerWithRemain     ) where  import Control.Applicative@@ -72,7 +73,7 @@ appendPacker p1f p2 = p1f >>= \p1 -> p2 >>= \v -> return (p1 v) {-# INLINE appendPacker #-} --- run a sized action+-- | run a sized action actionPacker :: Int -> (Ptr Word8 -> IO a) -> Packer a actionPacker s action = Packer $ \(Cache ptr size) ->     case compare size s of@@ -81,3 +82,15 @@             v <- action ptr             return $ PackerMore v (Cache (ptr `plusPtr` s) (size - s)) {-# INLINE actionPacker #-}++-- | run a sized action+actionPackerWithRemain :: Int -> (Ptr Word8 -> Int -> IO (Int, a)) -> Packer a+actionPackerWithRemain s action = Packer $ \(Cache ptr size) ->+    case compare size s of+        LT -> return $ PackerFail "Not enough space in destination"+        _  -> do+            (remain, v) <- action ptr size+            return $ if remain > s+                then PackerFail "remaining bytes higher than the destination's size"+                else PackerMore v (Cache (ptr `plusPtr` (s - remain)) (size - s + remain))+{-# INLINE actionPackerWithRemain #-}

@@ -23,11 +23,13 @@ import qualified Blaze.ByteString.Builder as Blaze import qualified Blaze.ByteString.Builder.Char8 as Blaze +import qualified Codec.Binary.Base32 as C32+ main :: IO () main = defaultMain     [ bgroup "just fill up with the same char" benchFillUpWith-    , bgroup "write a bytestring" benchWriteByteString-    , bgroup "write byte and bytestring" benchConcatBytes+--    , bgroup "write a bytestring" benchWriteByteString+--    , bgroup "write byte and bytestring" benchConcatBytes     , bgroup "base32" benchBase32     ] @@ -79,8 +81,13 @@     ]  benchBase32 =-    [ bench "bspack 512B" $ whnf (\bs -> pack (putByteStringBase32 bs) 824)      $! B.replicate 512      0x42-    , bench "bspack 10KB" $ whnf (\bs -> pack (putByteStringBase32 bs) 16000)    $! B.replicate 10000    0x42-    , bench "bspack 1MB"  $ whnf (\bs -> pack (putByteStringBase32 bs) 1600000)  $! B.replicate 1000000  0x42-    , bench "bspack 10MB" $ whnf (\bs -> pack (putByteStringBase32 bs) 16000000) $! B.replicate 10000000 0x42+    [ bench "bspack 512B" $ whnf (\bs -> pack (putByteStringBase32 True bs) 824)      $! B.replicate 512      0x42+    , bench "bspack 10KB" $ whnf (\bs -> pack (putByteStringBase32 True bs) 16000)    $! B.replicate 10000    0x42+    , bench "bspack 1MB"  $ whnf (\bs -> pack (putByteStringBase32 True bs) 1600000)  $! B.replicate 1000000  0x42+    , bench "bspack 10MB" $ whnf (\bs -> pack (putByteStringBase32 True bs) 16000000) $! B.replicate 10000000 0x42++    , bench "sandi 512B" $ whnf C32.encode $! B.replicate 512      0x42+    , bench "sandi 10KB" $ whnf C32.encode $! B.replicate 10000    0x42+    , bench "sandi 1MB"  $ whnf C32.encode $! B.replicate 1000000  0x42+    , bench "sandi 10MB" $ whnf C32.encode $! B.replicate 10000000 0x42     ]

@@ -14,7 +14,6 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as B import Data.ByteString.Pack-import Data.ByteString.Pack.Base32 import Data.Char  ------------------------------------------------------------------------------@@ -52,19 +51,11 @@ longByteString =     "Evolution is the change in the inherited characteristics of biological populations over successive generations. Evolutionary processes give rise to diversity at every level of biological organisation, including species, individual organisms and molecules such as DNA and proteins.[1] All life on Earth is descended from a last universal ancestor that lived approximately 3.8 billion years ago. Repeated speciation and the divergence of life can be inferred from shared sets of biochemical and morphological traits, or by shared DNA sequences.[2] These homologous traits and sequences are more similar among species that share a more recent common ancestor, and can be used to reconstruct evolutionary histories, using both existing species and the fossil record. Existing patterns of biodiversity have been shaped both by speciation and by extinction.[3]" -longBase32 :: ByteString-longBase32 = "JBQXG23FNRWCA2LTEBQW4IDBMR3GC3TDMVSCA4DVOJSWY6JNMZ2W4Y3UNFXW4YLMEBYHE33HOJQW23LJNZTSA3DBNZTXKYLHMUXCAQLOEBXXAZLOFVZW65LSMNSSA4DSN5SHKY3UEBXWMIDNN5ZGKIDUNBQW4IDUO5SW45DZEB4WKYLSOMQG6ZRAMN2XI5DJNZTS2ZLEM5SSA4TFONSWC4TDNAWCA2LUEBQWY3DPO5ZSA4TBOBUWIIDEMV3GK3DPOBWWK3TUEBXWMIDSN5RHK43UFQQGG33OMNUXGZJMEBRW64TSMVRXIIDTN5THI53BOJSS4ICXNF2GQIDTORZG63THEBZXK4DQN5ZHIIDGN5ZCA2LOORSWO4TBORUW63RAO5UXI2BAN52GQZLSEBWGC3THOVQWOZLTFQQGE5LJNR2C22LOEBRW63TDOVZHEZLOMN4SAYLOMQQHAYLSMFWGYZLMNFZW2LBAMRSWE5LHM5SXE4ZMEBYHE33GNFWGK4TTFQQHE2LDNAQGY2LCOJQXE2LFOMQGC3TEEBQW4IDBMN2GS5TFEBRW63LNOVXGS5DZFQQEQYLTNNSWY3BANVQWWZLTEBUXIIDFMFZWSZLSEB2G6IDQOJXWI5LDMUQGM3DFPBUWE3DFFQQG2YLJNZ2GC2LOMFRGYZJMEBUGSZ3IFVYXKYLMNF2HSIDTN5THI53BOJSS4==="--longForBase32 :: ByteString-longForBase32 = "Haskell is an advanced purely-functional programming language. An open-source product of more than twenty years of cutting-edge research, it allows rapid development of robust, concise, correct software. With strong support for integration with other languages, built-in concurrency and parallelism, debuggers, profilers, rich libraries and an active community, Haskell makes it easier to produce flexible, maintainable, high-quality software."- refTestsOk = testGroup "All these tests must always pass"     [ testCaseOk "put a byte"    "B"  1  (putWord8 $ fromChar 'B')     , testCaseOk "write string"  "Haskell rocks!" 42 (putByteString "Haskell" >> putWord8 0x20 >> putByteString "rocks!")     , testCaseOk "put a 2 bytes" "XY" 2 (putWord16 0x5958)     , testCaseOk "write long stuff" longByteString (B.length longByteString) (putByteString longByteString)-    , testCaseOk "write base 32 short" "JBQXG23FNRWA====" 20 (putByteStringBase32 "Haskell")-    , testCaseOk "write base 32 long" longBase32 (B.length longBase32 + 10) (putByteStringBase32 longForBase32)     ]  refTestsFail = testGroup "Try to see that pack fails properly"

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                bspack-version:             0.0.3+version:             0.0.4 synopsis:            A simple and fast bytestring packer description:         A simple and fast bytestring packer homepage:            https://github.com/NicolasDP/hs-bspack@@ -17,7 +17,6 @@  library   exposed-modules:     Data.ByteString.Pack-                     , Data.ByteString.Pack.Base32   other-modules:       Data.ByteString.Pack.Internal   -- other-extensions:       build-depends:       base == 4.*@@ -36,6 +35,7 @@                      , criterion                      , bspack                      , blaze-builder+                     , sandi  Test-Suite  tests   type:                exitcode-stdio-1.0