hw-prim 0.6.2.5 → 0.6.2.6

raw patch · 4 files changed

+95/−4 lines, 4 filesdep +semigroupsPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

Dependencies added: semigroups

API changes (from Hackage documentation)

Files

• hw-prim.cabal +5/−1
• src/HaskellWorks/Data/ByteString.hs +38/−0
• src/HaskellWorks/Data/ByteString/Lazy.hs +14/−3
• test/HaskellWorks/Data/ByteStringSpec.hs +38/−0

@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack  name:           hw-prim-version:        0.6.2.5+version:        0.6.2.6 synopsis:       Primitive functions and data types description:    Primitive functions and data types. category:       Data@@ -41,6 +41,7 @@     , bytestring      >= 0.9        && < 0.11     , mmap            >= 0.5        && < 0.6     , vector          >= 0.12       && < 0.13+    , semigroups      >= 0.8.4      && < 0.19     , transformers    >= 0.4        && < 0.6   if flag(bounds-checking-enabled)     cpp-options: -DBOUNDS_CHECKING_ENABLED@@ -95,6 +96,7 @@     , bytestring      >= 0.9        && < 0.11     , mmap            >= 0.5        && < 0.6     , vector          >= 0.12       && < 0.13+    , semigroups      >= 0.8.4      && < 0.19     , transformers    >= 0.4        && < 0.6     , QuickCheck          >= 2.10       && < 2.12     , directory           >= 1.2        && < 1.4@@ -106,6 +108,7 @@   if flag(bounds-checking-enabled)     cpp-options: -DBOUNDS_CHECKING_ENABLED   other-modules:+      HaskellWorks.Data.ByteStringSpec       HaskellWorks.Data.FromByteStringSpec       HaskellWorks.Data.FromForeignRegionSpec       HaskellWorks.Data.SearchSpec@@ -127,6 +130,7 @@     , bytestring      >= 0.9        && < 0.11     , mmap            >= 0.5        && < 0.6     , vector          >= 0.12       && < 0.13+    , semigroups      >= 0.8.4      && < 0.19     , transformers    >= 0.4        && < 0.6     , criterion     >= 1.2      && < 1.6     , hw-prim

@@ -3,8 +3,11 @@ module HaskellWorks.Data.ByteString   ( chunkedBy   , ToByteString(..)+  , rechunkSegments+  , rechunkSegmentsPadded   ) where +import Data.Semigroup ((<>)) import Data.Word  import qualified Data.ByteString          as BS@@ -45,3 +48,38 @@   else case BS.splitAt n bs of     (as, zs) -> as : chunkedBy n zs {-# INLINE chunkedBy #-}++rechunkSegments :: Int -> [BS.ByteString] -> [BS.ByteString]+rechunkSegments multiple = go+  where go (bs:bss) = case BS.length bs of+              bsLen -> if bsLen < multiple+                then case multiple - bsLen of+                  bsNeed -> case bss of+                    (cs:css) -> case BS.length cs of+                      csLen | csLen >  bsNeed -> (bs <> BS.take bsNeed cs ):go (BS.drop bsNeed cs:css)+                      csLen | csLen == bsNeed -> (bs <> cs                ):go                    css+                      _     | otherwise       ->                            go ((bs <> cs)       :css)+                    [] -> [bs]+                else case (bsLen `div` multiple) * multiple of+                  bsCroppedLen -> if bsCroppedLen == bsLen+                    then bs:go bss+                    else BS.take bsCroppedLen bs:go (BS.drop bsCroppedLen bs:bss)+        go [] = []++rechunkSegmentsPadded :: Int -> [BS.ByteString] -> [BS.ByteString]+rechunkSegmentsPadded multiple = go+  where go (bs:bss) = case BS.length bs of+              bsLen -> if bsLen < multiple+                then case multiple - bsLen of+                  bsNeed -> case bss of+                    (cs:css) -> case BS.length cs of+                      csLen | csLen >  bsNeed -> (bs <> BS.take bsNeed cs ):go (BS.drop bsNeed cs:css)+                      csLen | csLen == bsNeed -> (bs <> cs                ):go                    css+                      _     | otherwise       ->                            go ((bs <> cs)       :css)+                    [] -> [bs <> BS.replicate bsNeed 0]+                else case (bsLen `div` multiple) * multiple of+                  bsCroppedLen -> if bsCroppedLen == bsLen+                    then bs:go bss+                    else BS.take bsCroppedLen bs:go (BS.drop bsCroppedLen bs:bss)+        go [] = []+

@@ -1,12 +1,17 @@ {-# LANGUAGE FlexibleInstances #-} -module HaskellWorks.Data.ByteString.Lazy where+module HaskellWorks.Data.ByteString.Lazy+  ( ToLazyByteString(..)+  , rechunkSegments+  , rechunkSegmentsPadded+  ) where  import Data.Word import HaskellWorks.Data.ByteString (ToByteString (..)) -import qualified Data.ByteString.Lazy as LBS-import qualified Data.Vector.Storable as DVS+import qualified Data.ByteString.Lazy         as LBS+import qualified Data.Vector.Storable         as DVS+import qualified HaskellWorks.Data.ByteString as BS  class ToLazyByteString a where   toLazyByteString :: a -> LBS.ByteString@@ -46,3 +51,9 @@ instance ToLazyByteString [DVS.Vector Word64] where   toLazyByteString vs = LBS.fromChunks (toByteString <$> vs)   {-# INLINE toLazyByteString #-}++rechunkSegments :: Int -> LBS.ByteString -> LBS.ByteString+rechunkSegments multiple = LBS.fromChunks . BS.rechunkSegments multiple . LBS.toChunks++rechunkSegmentsPadded :: Int -> LBS.ByteString -> LBS.ByteString+rechunkSegmentsPadded multiple = LBS.fromChunks . BS.rechunkSegmentsPadded multiple . LBS.toChunks

@@ -0,0 +1,38 @@+module HaskellWorks.Data.ByteStringSpec where++import Control.Monad+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++import qualified Data.ByteString              as BS+import qualified Data.ByteString.Lazy         as LBS+import qualified HaskellWorks.Data.ByteString as BS+import qualified Hedgehog.Gen                 as G+import qualified Hedgehog.Range               as R++{-# ANN module ("HLint: Ignore Redundant do" :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.ByteStringSpec" $ do+  it "rechunkSegments does not modify data" $ requireProperty $ do+    bss       <- forAll $ (BS.pack <$>) <$> G.list (R.linear 0 8) (G.list (R.linear 0 24) (G.word8 R.constantBounded))+    chunkSize <- forAll $ G.int (R.linear 1 4)+    mconcat (BS.rechunkSegments chunkSize bss) === mconcat bss+  it "rechunkSegments creates correctly sized segments" $ requireProperty $ do+    bss       <- forAll $ (BS.pack <$>) <$> G.list (R.linear 0 8) (G.list (R.linear 0 24) (G.word8 R.constantBounded))+    chunkSize <- forAll $ G.int (R.linear 1 4)+    forM_ (drop 1 (reverse (BS.rechunkSegments chunkSize bss))) $ \bs -> do+      (BS.length bs) `mod` chunkSize === 0+  it "rechunkSegmentsPadded does not modify data" $ requireProperty $ do+    bss       <- forAll $ (BS.pack <$>) <$> G.list (R.linear 0 8) (G.list (R.linear 0 24) (G.word8 R.constantBounded))+    chunkSize <- forAll $ G.int (R.linear 1 4)+    elbs      <- forAll $ pure $ LBS.fromChunks bss+    albs      <- forAll $ pure $ LBS.take (LBS.length elbs) (LBS.fromChunks (BS.rechunkSegmentsPadded chunkSize bss))+    albs === elbs+  it "rechunkSegmentsPadded creates correctly sized segments" $ requireProperty $ do+    bss       <- forAll $ (BS.pack <$>) <$> G.list (R.linear 0 8) (G.list (R.linear 0 24) (G.word8 R.constantBounded))+    chunkSize <- forAll $ G.int (R.linear 1 4)+    forM_ (reverse (BS.rechunkSegmentsPadded chunkSize bss)) $ \bs -> do+      (BS.length bs) `mod` chunkSize === 0+