diff --git a/CHANGELOG.md b/CHANGELOG.md index 9489d74..876ab78 100644 --- a/CHANGELOG.md +++ b/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) diff --git a/Data/ByteArray/Methods.hs b/Data/ByteArray/Methods.hs index f93e4cb..61a8790 100644 --- a/Data/ByteArray/Methods.hs +++ b/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 diff --git a/tests/Imports.hs b/tests/Imports.hs index 4108852..b4f74b5 100644 --- a/tests/Imports.hs +++ b/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" diff --git a/tests/Tests.hs b/tests/Tests.hs index b47e1d0..aa43220 100644 --- a/tests/Tests.hs +++ b/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)) ]