diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,14 @@ +## 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) + ## 0.21.1 + Reverted 0.21.0 changes: restored custom Base16/Base32/Base64 encode/decode, the GHC.Prim-based `Bytes` implementation, and `readWord8OffAddr#`-based FNV diff --git a/Data/ByteArray/Methods.hs b/Data/ByteArray/Methods.hs --- a/Data/ByteArray/Methods.hs +++ b/Data/ByteArray/Methods.hs @@ -39,6 +39,9 @@ , all , append , concat + , map + , slice + , unsafeSlice ) where import Data.ByteArray.Types @@ -49,7 +52,7 @@ import Foreign.Storable import Foreign.Ptr -import Prelude hiding (length, take, drop, span, reverse, concat, replicate, splitAt, null, pred, last, any, all) +import Prelude hiding (length, take, drop, span, reverse, concat, replicate, splitAt, null, pred, last, any, all, map) import qualified Prelude @@ -200,7 +203,7 @@ concat :: (ByteArrayAccess bin, ByteArray bout) => [bin] -> bout concat l = unsafeCreate retLen (loopCopy l) where - retLen = sum $ map length l + retLen = sum $ Prelude.map length l loopCopy [] _ = return () loopCopy (x:xs) dst = do @@ -296,6 +299,45 @@ all :: (ByteArrayAccess ba) => (Word8 -> Bool) -> ba -> Bool all f b = not (any (not . f) b) +-- | Map a function over each byte of a bytearray +map :: (ByteArrayAccess ba, ByteArray ba) => (Word8 -> Word8) -> ba -> ba +map f ba = copyAndFreeze ba $ loop 0 + where + len = length ba + loop i ptr + | i == len = return () + | otherwise = do + let ptr' = ptr `plusPtr` i + x <- peek ptr' + poke ptr' $ f x + loop (i + 1) ptr + -- | 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/ram.cabal b/ram.cabal --- a/ram.cabal +++ b/ram.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: ram -version: 0.21.1 +version: 0.22.0 synopsis: memory and related abstraction stuff description: This is a fork of memory. It's open to accept changes from anyone, diff --git a/tests/Imports.hs b/tests/Imports.hs --- a/tests/Imports.hs +++ b/tests/Imports.hs @@ -5,6 +5,7 @@ , testCase , assertBool , assertEqual + , assertException , (@?=) ) where @@ -16,13 +17,13 @@ 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 @@ 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 --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -248,4 +248,30 @@ , testProperty "span (const False)" $ \(Words8 l) -> let b = witnessID (B.pack l) in B.span (const False) b == (B.empty, b) + , testProperty "map f == pack . Prelude.map f . unpack" $ \(Words8 l) (Positive w) -> + 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)) ]