Add slice and unsafeSlice for ByteArray

CHANGELOG.md

@@ -1,4 +1,10 @@
 ## 0.22.0
++ Added `slice :: ByteArray bs => bs -> Int -> Int -> Maybe bs`
+  and `unsafeSlice :: ByteArray bs => bs -> Int -> Int -> bs`
+  to `Data.ByteArray.Methods` (re-exported via `Data.ByteArray`).
+  `slice bs offset len` extracts `len` bytes starting at `offset`.
+  Returns `Nothing` for negative offset/length or out-of-bounds access.
+  `unsafeSlice` calls `error` on invalid arguments. (closes #7)
 + Added `map :: (ByteArrayAccess ba, ByteArray ba) => (Word8 -> Word8) -> ba -> ba`
   to `Data.ByteArray.Methods` (re-exported via `Data.ByteArray`).
   Applies a function to each byte of a byte array. (closes #5)

Data/ByteArray/Methods.hs

@@ -40,6 +40,8 @@ module Data.ByteArray.Methods
     , append
     , concat
     , map
+    , slice
+    , unsafeSlice
     ) where
 
 import           Data.ByteArray.Types
@@ -313,3 +315,29 @@ map f ba = copyAndFreeze ba $ loop 0
 -- | Convert a bytearray to another type of bytearray
 convert :: (ByteArrayAccess bin, ByteArray bout) => bin -> bout
 convert bs = inlineUnsafeCreate (length bs) (copyByteArrayToPtr bs)
+
+-- | Extract @len@ bytes starting at byte @offset@.
+-- Returns 'Nothing' if @offset@ or @len@ is negative, or if @offset + len@
+-- exceeds the byte array length.
+slice :: ByteArray bs => bs -> Int -> Int -> Maybe bs
+slice bs offset len
+    | offset < 0           = Nothing
+    | len < 0              = Nothing
+    | offset + len > bsLen = Nothing
+    | otherwise            = Just $ unsafeCreate len $ \d ->
+        withByteArray bs $ \s -> memCopy d (s `plusPtr` offset) len
+  where
+    bsLen = length bs
+
+-- | Like 'slice' but calls 'error' when arguments are out of bounds.
+-- This includes negative @offset@, negative @len@, or @offset + len@
+-- exceeding the byte array length.
+unsafeSlice :: ByteArray bs => bs -> Int -> Int -> bs
+unsafeSlice bs offset len
+    | offset < 0           = error "unsafeSlice: negative offset"
+    | len < 0              = error "unsafeSlice: negative length"
+    | offset + len > bsLen = error "unsafeSlice: offset + length exceeds byte array size"
+    | otherwise            = unsafeCreate len $ \d ->
+        withByteArray bs $ \s -> memCopy d (s `plusPtr` offset) len
+  where
+    bsLen = length bs

tests/Imports.hs

@@ -5,6 +5,7 @@ module Imports
     , testCase
     , assertBool
     , assertEqual
+    , assertException
     , (@?=)
     ) where
 
@@ -16,13 +17,13 @@ import Test.Tasty                   as X (TestTree, testGroup, defaultMain, Test
 import Test.QuickCheck              as X
     ( Arbitrary(..), Gen, Property
     , (===), (.&&.)
-    , elements, choose, forAll, property, ioProperty
+    , elements, choose, forAll, property, ioProperty, (==>)
     , Testable
     )
 
 import Test.Tasty.Providers         (singleTest, IsTest(..), testPassed, testFailed)
 import Test.QuickCheck              (quickCheckWithResult, stdArgs, isSuccess, Args(..))
-import Control.Exception            (SomeException, try)
+import Control.Exception            (SomeException, ErrorCall, try, evaluate)
 
 -- | QuickCheck property test provider for tasty
 newtype QCTest = QCTest Property
@@ -71,3 +72,11 @@ infix 1 @?=
 actual @?= expected
     | actual == expected = return ()
     | otherwise = fail ("expected: " ++ show expected ++ "\n but got: " ++ show actual)
+
+-- | Assert that evaluating a value throws an 'ErrorCall' exception.
+assertException :: forall a . a -> IO ()
+assertException val = do
+    r <- try (evaluate val) :: IO (Either ErrorCall a)
+    case r of
+        Left _  -> return ()
+        Right _ -> fail "expected an exception but none was thrown"

tests/Tests.hs

@@ -252,4 +252,26 @@ main = defaultMain $ testGroup "memory"
             let b = witnessID (B.pack l)
                 f x = x + fromIntegral w :: Word8
              in B.map f b == (witnessID . B.pack . Prelude.map f $ l)
+        , testProperty "slice == Just (take len . drop offset)" $ \(Words8 l) ->
+            let bs = witnessID (B.pack l)
+                bsLen = B.length bs
+            in bsLen > 0 ==>
+               forAll (choose (0, bsLen)) $ \offset ->
+               forAll (choose (0, bsLen - offset)) $ \len ->
+                 B.slice bs offset len == Just (B.take len (B.drop offset bs))
+        , testProperty "slice out of bounds == Nothing" $ \(Words8 l) ->
+            let bs = witnessID (B.pack l)
+                bsLen = B.length bs
+            in B.slice bs 0 (bsLen + 1) == Nothing
+        , testProperty "slice negative offset == Nothing" $ \(Words8 l) ->
+            let bs = witnessID (B.pack l)
+            in B.slice bs (-1) 0 == Nothing
+        , testProperty "slice negative length == Nothing" $ \(Words8 l) ->
+            let bs = witnessID (B.pack l)
+            in B.slice bs 0 (-1) == Nothing
+        , testCase "unsafeSlice errors on out of bounds" $ do
+            let bs = witnessID (B.pack [1,2,3,4,5])
+            assertException (B.unsafeSlice bs (-1) 1)
+            assertException (B.unsafeSlice bs 0 (-1))
+            assertException (B.unsafeSlice bs 0 (B.length bs + 1))
         ]