hw-prim 0.6.2.4 → 0.6.2.5

raw patch · 7 files changed

+322/−1 lines, 7 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• hw-prim.cabal +7/−1
• src/HaskellWorks/Data/Vector/AsVector64ns.hs +30/−0
• src/HaskellWorks/Data/Vector/AsVector8ns.hs +86/−0
• src/HaskellWorks/Data/Vector/AsVector8s.hs +73/−0
• test/HaskellWorks/Data/Vector/AsVector64nsSpec.hs +42/−0
• test/HaskellWorks/Data/Vector/AsVector8nsSpec.hs +42/−0
• test/HaskellWorks/Data/Vector/AsVector8sSpec.hs +42/−0

@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack  name:           hw-prim-version:        0.6.2.4+version:        0.6.2.5 synopsis:       Primitive functions and data types description:    Primitive functions and data types. category:       Data@@ -72,8 +72,11 @@       HaskellWorks.Data.Uncons       HaskellWorks.Data.Unsign       HaskellWorks.Data.Vector.AsVector64+      HaskellWorks.Data.Vector.AsVector64ns       HaskellWorks.Data.Vector.AsVector64s       HaskellWorks.Data.Vector.AsVector8+      HaskellWorks.Data.Vector.AsVector8ns+      HaskellWorks.Data.Vector.AsVector8s       HaskellWorks.Data.Vector.BoxedVectorLike       HaskellWorks.Data.Vector.StorableVectorLike   other-modules:@@ -106,7 +109,10 @@       HaskellWorks.Data.FromByteStringSpec       HaskellWorks.Data.FromForeignRegionSpec       HaskellWorks.Data.SearchSpec+      HaskellWorks.Data.Vector.AsVector64nsSpec       HaskellWorks.Data.Vector.AsVector64sSpec+      HaskellWorks.Data.Vector.AsVector8nsSpec+      HaskellWorks.Data.Vector.AsVector8sSpec   default-language: Haskell2010  benchmark bench

@@ -0,0 +1,30 @@+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE Rank2Types          #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections       #-}++module HaskellWorks.Data.Vector.AsVector64ns+  ( AsVector64ns(..)+  ) where++import Control.Applicative                  ((<$>))+import Data.Word+import HaskellWorks.Data.Vector.AsVector8ns (asVector8ns)++import qualified Data.ByteString      as BS+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Vector.Storable as DVS++class AsVector64ns a where+  -- | Represent the value as a list of Vector of 'n' Word64 chunks.  The last chunk will+  -- also be of the specified chunk size filled with trailing zeros.+  asVector64ns :: Int -> a -> [DVS.Vector Word64]++instance AsVector64ns LBS.ByteString where+  asVector64ns n = asVector64ns n . LBS.toChunks+  {-# INLINE asVector64ns #-}++instance AsVector64ns [BS.ByteString] where+  asVector64ns n bss = DVS.unsafeCast <$> asVector8ns (n * 8) bss+  {-# INLINE asVector64ns #-}

@@ -0,0 +1,86 @@+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE Rank2Types          #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections       #-}++module HaskellWorks.Data.Vector.AsVector8ns+  ( AsVector8ns(..)+  ) where++import Control.Applicative ((<$>))+import Control.Monad.ST+import Data.Word+import Foreign.ForeignPtr+-- import HaskellWorks.Data.ByteString (ToByteString (..))+import HaskellWorks.Data.Vector.AsVector8++import qualified Data.ByteString              as BS+import qualified Data.ByteString.Internal     as BS+import qualified Data.ByteString.Lazy         as LBS+import qualified Data.Vector.Storable         as DVS+import qualified Data.Vector.Storable.Mutable as DVSM++class AsVector8ns a where+  -- | Represent the value as a list of Vector of 'n' Word8 chunks.  The last chunk will+  -- also be of the specified chunk size filled with trailing zeros.+  asVector8ns :: Int -> a -> [DVS.Vector Word8]++instance AsVector8ns LBS.ByteString where+  asVector8ns n = asVector8ns n . LBS.toChunks+  {-# INLINE asVector8ns #-}++instance AsVector8ns [BS.ByteString] where+  asVector8ns = bytestringsToVectors+  {-# INLINE asVector8ns #-}++bytestringsToVectors :: Int -> [BS.ByteString] -> [DVS.Vector Word8]+bytestringsToVectors n = go+  where go :: [BS.ByteString] -> [DVS.Vector Word8]+        go bss = case bss of+          (cs:css) -> let csz = BS.length cs in+            if csz >= n+              then if csz `mod` n == 0+                then asVector8 cs:bytestringsToVectors n css+                else let p = (csz `div` n) * n in+                  asVector8 (BS.take p cs):bytestringsToVectors n (BS.drop p cs:css)+              else if csz > 0+                then case DVS.createT (buildOneVector n bss) of+                  (dss, ws) -> if DVS.length ws > 0+                    then ws:go dss+                    else []+                else bytestringsToVectors n css+          [] -> []+{-# INLINE bytestringsToVectors #-}++buildOneVector :: forall s. Int -> [BS.ByteString] -> ST s ([BS.ByteString], DVS.MVector s Word8)+buildOneVector n ss = case dropWhile ((== 0) . BS.length) ss of+  [] -> ([],) <$> DVSM.new 0+  cs -> do+    v64 <- DVSM.unsafeNew n+    let v8 = DVSM.unsafeCast v64+    rs  <- go cs v8+    return (rs, v64)+  where go :: [BS.ByteString] -> DVSM.MVector s Word8 -> ST s [BS.ByteString]+        go ts v = if DVSM.length v > 0+          then case ts of+            (u:us) -> if BS.length u <= DVSM.length v+              then case DVSM.splitAt (BS.length u) v of+                (va, vb) -> do+                  DVSM.copy va (byteStringToVector8 u)+                  go us vb+              else case BS.splitAt (DVSM.length v) u of+                (ua, ub) -> do+                  DVSM.copy v (byteStringToVector8 ua)+                  return (ub:us)+            [] -> do+              DVSM.set v 0+              return []+          else return ts+        {-# INLINE go #-}+{-# INLINE buildOneVector #-}++byteStringToVector8 :: BS.ByteString -> DVSM.MVector s Word8+byteStringToVector8 bs = case BS.toForeignPtr bs of+  (fptr, off, len) -> DVSM.unsafeFromForeignPtr (castForeignPtr fptr) off len+{-# INLINE byteStringToVector8 #-}

@@ -0,0 +1,73 @@+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE Rank2Types          #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections       #-}++module HaskellWorks.Data.Vector.AsVector8s+  ( AsVector8s(..)+  ) where++import Control.Applicative ((<$>))+import Control.Monad.ST+import Data.Word+import Foreign.ForeignPtr++import qualified Data.ByteString              as BS+import qualified Data.ByteString.Internal     as BS+import qualified Data.ByteString.Lazy         as LBS+import qualified Data.Vector.Storable         as DVS+import qualified Data.Vector.Storable.Mutable as DVSM++class AsVector8s a where+  -- | Represent the value as a list of Vector of 'n' Word8 chunks.  The last chunk will+  -- also be of the specified chunk size filled with trailing zeros.+  asVector8s :: Int -> a -> [DVS.Vector Word8]++instance AsVector8s LBS.ByteString where+  asVector8s n = asVector8s n . LBS.toChunks+  {-# INLINE asVector8s #-}++instance AsVector8s [BS.ByteString] where+  asVector8s = bytestringsToVectors+  {-# INLINE asVector8s #-}++bytestringsToVectors :: Int -> [BS.ByteString] -> [DVS.Vector Word8]+bytestringsToVectors n = go+  where go :: [BS.ByteString] -> [DVS.Vector Word8]+        go bs = case DVS.createT (buildOneVector n bs) of+          (cs, ws) -> if DVS.length ws > 0+            then ws:go cs+            else []+{-# INLINE bytestringsToVectors #-}++buildOneVector :: forall s. Int -> [BS.ByteString] -> ST s ([BS.ByteString], DVS.MVector s Word8)+buildOneVector n ss = case dropWhile ((== 0) . BS.length) ss of+  [] -> ([],) <$> DVSM.new 0+  cs -> do+    v8 <- DVSM.unsafeNew n+    rs  <- go cs v8+    return (rs, v8)+  where go :: [BS.ByteString] -> DVSM.MVector s Word8 -> ST s [BS.ByteString]+        go ts v = if DVSM.length v > 0+          then case ts of+            (u:us) -> if BS.length u <= DVSM.length v+              then case DVSM.splitAt (BS.length u) v of+                (va, vb) -> do+                  DVSM.copy va (byteStringToVector8 u)+                  go us vb+              else case BS.splitAt (DVSM.length v) u of+                (ua, ub) -> do+                  DVSM.copy v (byteStringToVector8 ua)+                  return (ub:us)+            [] -> do+              DVSM.set v 0+              return []+          else return ts+        {-# INLINE go #-}+{-# INLINE buildOneVector #-}++byteStringToVector8 :: BS.ByteString -> DVSM.MVector s Word8+byteStringToVector8 bs = case BS.toForeignPtr bs of+  (fptr, off, len) -> DVSM.unsafeFromForeignPtr (castForeignPtr fptr) off len+{-# INLINE byteStringToVector8 #-}

@@ -0,0 +1,42 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Vector.AsVector64nsSpec+  ( spec+  ) where++import HaskellWorks.Data.Vector.AsVector64+import HaskellWorks.Data.Vector.AsVector64ns+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++import qualified Data.ByteString      as BS+import qualified Data.Vector.Storable as DVS+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.Vector.AsVector64nsSpec" $ do+  it "Conversion of ByteString works 1" $ 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 (asVector64ns chunkSize [mconcat bss]) === mconcat (asVector64ns chunkSize bss)+    True === True+  it "Conversion of ByteString works 2" $ 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)+    let actual    = mconcat (asVector64ns chunkSize [mconcat bss])+    let expected  = mconcat (asVector64ns chunkSize bss)+    (reverse . dropWhile (== 0) . reverse) (DVS.toList actual) === (reverse . dropWhile (== 0) . reverse) (DVS.toList expected)+    True === True+  it "Conversion of ByteString works 3" $ 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)+    let actual    = mconcat (asVector64ns chunkSize bss)+    let expected  = asVector64 (mconcat bss)+    (reverse . dropWhile (== 0) . reverse) (DVS.toList actual) === (reverse . dropWhile (== 0) . reverse) (DVS.toList expected)+    True === True

@@ -0,0 +1,42 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Vector.AsVector8nsSpec+  ( spec+  ) where++import HaskellWorks.Data.Vector.AsVector8+import HaskellWorks.Data.Vector.AsVector8ns+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++import qualified Data.ByteString      as BS+import qualified Data.Vector.Storable as DVS+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.Vector.AsVector8nsSpec" $ do+  it "Conversion of ByteString works 1" $ 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 (asVector8ns chunkSize [mconcat bss]) === mconcat (asVector8ns chunkSize bss)+    True === True+  it "Conversion of ByteString works 2" $ 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)+    let actual    = mconcat (asVector8ns chunkSize [mconcat bss])+    let expected  = mconcat (asVector8ns chunkSize bss)+    (reverse . dropWhile (== 0) . reverse) (DVS.toList actual) === (reverse . dropWhile (== 0) . reverse) (DVS.toList expected)+    True === True+  it "Conversion of ByteString works 3" $ 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)+    let actual    = mconcat (asVector8ns chunkSize bss)+    let expected  = asVector8 (mconcat bss)+    (reverse . dropWhile (== 0) . reverse) (DVS.toList actual) === (reverse . dropWhile (== 0) . reverse) (DVS.toList expected)+    True === True

@@ -0,0 +1,42 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Vector.AsVector8sSpec+  ( spec+  ) where++import HaskellWorks.Data.Vector.AsVector8+import HaskellWorks.Data.Vector.AsVector8s+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++import qualified Data.ByteString      as BS+import qualified Data.Vector.Storable as DVS+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.Vector.AsVector8sSpec" $ do+  it "Conversion of ByteString works 1" $ 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 (asVector8s chunkSize [mconcat bss]) === mconcat (asVector8s chunkSize bss)+    True === True+  it "Conversion of ByteString works 2" $ 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)+    let actual    = mconcat (asVector8s chunkSize [mconcat bss])+    let expected  = mconcat (asVector8s chunkSize bss)+    (reverse . dropWhile (== 0) . reverse) (DVS.toList actual) === (reverse . dropWhile (== 0) . reverse) (DVS.toList expected)+    True === True+  it "Conversion of ByteString works 3" $ 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)+    let actual    = mconcat (asVector8s chunkSize bss)+    let expected  = asVector8 (mconcat bss)+    (reverse . dropWhile (== 0) . reverse) (DVS.toList actual) === (reverse . dropWhile (== 0) . reverse) (DVS.toList expected)+    True === True