shortbytestring 0.1.0.0 → 0.2.0.0

raw patch · 6 files changed

+141/−157 lines, 6 filesdep +QuickCheckdep ~randomPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck

Dependency ranges changed: random

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• lib/Data/ByteString/Short.hs +1/−18
• lib/Data/ByteString/Short/Internal.hs +108/−59
• lib/Data/ByteString/Short/Word16.hs +5/−76
• shortbytestring.cabal +4/−2
• tests/Properties/ByteString/Common.hs +19/−2

@@ -1,5 +1,9 @@ # Revision history for shortbytestring +## 0.2.0.0 -- 2021-10-31++* Fix issues with CWString conversion+ ## 0.1.0.0 -- YYYY-mm-dd  * First version. Released on an unsuspecting world.

@@ -147,26 +147,9 @@     , takeWhile     ) -import Data.ByteString.Short.Internal-import "bytestring" Data.ByteString.Short-    ( ShortByteString-    , empty-    , fromShort-    , index-#if MIN_VERSION_bytestring(0,11,0)-    , indexMaybe-    , (!?)-#endif-    , length-    , null-    , pack-    , toShort-    , unpack-    ) import "bytestring" Data.ByteString.Short.Internal-    ( createFromPtr )+import Data.ByteString.Short.Internal import Data.Word8-  import qualified "bytestring" Data.ByteString.Short as BS import qualified "bytestring" Data.ByteString.Short.Internal as BS

@@ -5,46 +5,28 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE UnboxedTuples #-}--module Data.ByteString.Short.Internal-  ( create-  , asBA-  , BA(..)-  , MBA(..)-  , newPinnedByteArray-  , newByteArray-  , copyByteArray-  , unsafeFreezeByteArray-  , useAsCString-  , useAsCStringLen-  , useAsCWString-  , useAsCWStringLen-  , packCString-  , packCStringLen-  , packCWString-  , packCWStringLen-  , newCWString-  )+{-# LANGUAGE BangPatterns #-} -where+module Data.ByteString.Short.Internal where  import Prelude hiding     ( length )+import qualified Data.Word16 as W16 import GHC.Exts+import GHC.Word import GHC.ST-    ( ST (ST), runST )-import Data.Word+    ( ST (ST) )+import qualified Data.List as List+#if !MIN_VERSION_base(4,13,0) import Foreign.C.String hiding (newCWString)-import Foreign.Marshal.Alloc (allocaBytes)-import Foreign.Marshal.Array (mallocArray0)-import Foreign.Storable (pokeByteOff)-import "bytestring" Data.ByteString.Short.Internal-import Control.Exception ( throwIO )-#if MIN_VERSION_bytestring(0,10,9)-import Data.ByteString.Internal (c_strlen)-#else import Foreign.C.Types+import Foreign.Storable+import Foreign.Marshal.Alloc #endif+import Foreign.Marshal.Array (withArray0, peekArray0, newArray0, withArrayLen, peekArray)+import "bytestring" Data.ByteString.Short.Internal+import Control.Exception ( throwIO )+import Control.Monad.ST   create :: Int -> (forall s. MBA s -> ST s ()) -> ShortByteString@@ -86,7 +68,12 @@     ST $ \s -> case unsafeFreezeByteArray# mba# s of                  (# s', ba# #) -> (# s', BA# ba# #) +copyAddrToByteArray :: Ptr a -> MBA RealWorld -> Int -> Int -> ST RealWorld ()+copyAddrToByteArray (Ptr src#) (MBA# dst#) (I# dst_off#) (I# len#) =+    ST $ \s -> case copyAddrToByteArray# src# dst# dst_off# len# s of+                 s' -> (# s', () #) + -- this is a copy-paste from bytestring #if !MIN_VERSION_bytestring(0,10,9) ------------------------------------------------------------------------@@ -164,10 +151,10 @@ -- @CWString@ must be null terminated. -- -- @since 0.10.10.0-packCWString :: CWString -> IO ShortByteString-packCWString cstr = do-  len <- c_strlen (coerce cstr)-  packCWStringLen (cstr, fromIntegral len)+packCWString :: Ptr Word16 -> IO ShortByteString+packCWString cwstr = do+  cs <- peekArray0 W16._nul cwstr+  return (packWord16 cs)  -- | /O(n)./ Construct a new @ShortByteString@ from a @CWStringLen@. The -- resulting @ShortByteString@ is an immutable copy of the original @CWStringLen@.@@ -175,10 +162,10 @@ -- Haskell heap. -- -- @since 0.10.10.0-packCWStringLen :: CWStringLen -> IO ShortByteString-packCWStringLen (cstr, len) | len >= 0 = createFromPtr cstr len-packCWStringLen (_, len) =-  moduleErrorIO "packCWStringLen" ("negative length: " ++ show len)+packCWStringLen :: (Ptr Word16, Int) -> IO ShortByteString+packCWStringLen (cp, len) = do+  cs <- peekArray len cp+  return (packWord16 cs)   -- | /O(n) construction./ Use a @ShortByteString@ with a function requiring a@@ -187,40 +174,28 @@ -- subcomputation finishes. -- -- @since 0.10.10.0-useAsCWString :: ShortByteString -> (CWString -> IO a) -> IO a-useAsCWString bs action =-  allocaBytes (l+1) $ \buf -> do-      copyToPtr bs 0 buf (fromIntegral l)-      pokeByteOff buf l (0::Word8)-      action buf-  where l = length bs+useAsCWString :: ShortByteString -> (Ptr Word16 -> IO a) -> IO a+useAsCWString = withArray0 W16._nul . unpackWord16  -- | /O(n) construction./ Use a @ShortByteString@ with a function requiring a @CWStringLen@. -- As for @useAsCWString@ this function makes a copy of the original @ShortByteString@. -- It must not be stored or used after the subcomputation finishes. -- -- @since 0.10.10.0-useAsCWStringLen :: ShortByteString -> (CWStringLen -> IO a) -> IO a-useAsCWStringLen bs action =-  allocaBytes l $ \buf -> do-      copyToPtr bs 0 buf (fromIntegral l)-      action (buf, l)-  where l = length bs+useAsCWStringLen :: ShortByteString -> ((Ptr Word16, Int) -> IO a) -> IO a+useAsCWStringLen bs action = withArrayLen (unpackWord16 bs) $ \ len ptr -> action (ptr, len)  -- | /O(n) construction./ Use a @ShortByteString@ with a function requiring a @CWStringLen@. -- As for @useAsCWString@ this function makes a copy of the original @ShortByteString@. -- It must not be stored or used after the subcomputation finishes. -- -- @since 0.10.10.0-newCWString :: ShortByteString -> IO CWString-newCWString bs = do-  ptr <- mallocArray0 l-  copyToPtr bs 0 ptr (fromIntegral l)-  pokeByteOff ptr l (0::Word8)-  return ptr-  where l = length bs+newCWString :: ShortByteString -> IO (Ptr Word16)+newCWString = newArray0 W16._nul . unpackWord16  ++  -- --------------------------------------------------------------------- -- Internal utilities @@ -230,3 +205,77 @@  moduleErrorMsg :: String -> String -> String moduleErrorMsg fun msg = "Data.ByteString.Short." ++ fun ++ ':':' ':msg++packWord16 :: [Word16] -> ShortByteString+packWord16 cs = packLenWord16 (List.length cs) cs++packLenWord16 :: Int -> [Word16] -> ShortByteString+packLenWord16 len ws0 =+    create (len * 2) (\mba -> go mba 0 ws0)+  where+    go :: MBA s -> Int -> [Word16] -> ST s ()+    go !_   !_ []     = return ()+    go !mba !i (w:ws) = do+      writeWord16Array mba i w+      go mba (i+2) ws+++unpackWord16 :: ShortByteString -> [Word16]+unpackWord16 sbs = go len []+  where+    len = length sbs+    go !i !acc+      | i < 1     = acc+      | otherwise = let !w = indexWord16Array (asBA sbs) (i - 2)+                    in go (i - 2) (w:acc)++packWord16Rev :: [Word16] -> ShortByteString+packWord16Rev cs = packLenWord16Rev ((List.length cs) * 2) cs++packLenWord16Rev :: Int -> [Word16] -> ShortByteString+packLenWord16Rev len ws0 =+    create len (\mba -> go mba len ws0)+  where+    go :: MBA s -> Int -> [Word16] -> ST s ()+    go !_   !_ []     = return ()+    go !mba !i (w:ws) = do+      writeWord16Array mba (i - 2) w+      go mba (i - 2) ws+++-- | This isn't strictly Word16 array write. Instead it's two consecutive Word8 array+-- writes to avoid endianness issues due to primops doing automatic alignment based+-- on host platform. We want to always write LE to the byte array.+writeWord16Array :: MBA s+                 -> Int      -- ^ Word8 index (not Word16)+                 -> Word16+                 -> ST s ()+writeWord16Array (MBA# mba#) (I# i#) (W16# w#) =+  case encodeWord16LE# w# of+    (# lsb#, msb# #) ->+      (ST $ \s -> case writeWord8Array# mba# i# lsb# s of+          s' -> (# s', () #)) >>+      (ST $ \s -> case writeWord8Array# mba# (i# +# 1#) msb# s of+          s' -> (# s', () #))++-- | This isn't strictly Word16 array read. Instead it's two Word8 array reads+-- to avoid endianness issues due to primops doing automatic alignment based+-- on host platform. We expect the byte array to be LE always.+indexWord16Array :: BA+                 -> Int      -- ^ Word8 index (not Word16)+                 -> Word16+indexWord16Array (BA# ba#) (I# i#) = +  case (# indexWord8Array# ba# i#, indexWord8Array# ba# (i# +# 1#) #) of+    (# lsb#, msb# #) -> W16# ((decodeWord16LE# (# lsb#, msb# #)))+++encodeWord16LE# :: Word# -- ^ Word16+                -> (# Word#, Word# #) -- ^ Word8 (LSB, MSB)+encodeWord16LE# x# = (# (x# `and#` int2Word# 0xff#)+                     ,  ((x# `and#` int2Word# 0xff00#) `shiftRL#` 8#) #)++decodeWord16LE# :: (# Word#, Word# #) -- ^ Word8 (LSB, MSB)+                -> Word#              -- ^ Word16+decodeWord16LE# (# lsb#, msb# #) = ((msb# `shiftL#` 8#) `or#` lsb#)++

@@ -179,9 +179,7 @@     , null     ) import GHC.Exts-import GHC.Word-import GHC.ST-    ( ST (ST) )+import GHC.ST ( ST )  import qualified "bytestring" Data.ByteString.Short.Internal as BS import qualified Data.List as List@@ -198,12 +196,12 @@  -- | /O(n)/. Convert a list into a 'ShortByteString' pack :: [Word16] -> ShortByteString-pack = packBytes+pack = packWord16   -- | /O(n)/. Convert a 'ShortByteString' into a list. unpack :: ShortByteString -> [Word16]-unpack = unpackBytes . assertEven+unpack = unpackWord16 . assertEven   -- ---------------------------------------------------------------------@@ -378,7 +376,7 @@ -- > == pack [0, 1, 2, 3, 4, 5] -- unfoldr :: (a -> Maybe (Word16, a)) -> a -> ShortByteString-unfoldr f x0 = packBytesRev $ go x0 mempty+unfoldr f x0 = packWord16Rev $ go x0 mempty  where    go x words' = case f x of                     Nothing -> words'@@ -398,7 +396,7 @@ -- > fst (unfoldrN n f s) == take n (unfoldr f s) -- unfoldrN :: Int -> (a -> Maybe (Word16, a)) -> a -> (ShortByteString, Maybe a)-unfoldrN i f x0 = first packBytesRev $ go (i - 1) x0 mempty+unfoldrN i f x0 = first packWord16Rev $ go (i - 1) x0 mempty  where    go i' x words'     | i' < 0     = (words', Just x)@@ -777,68 +775,8 @@ -- -------------------------------------------------------------------- -- Internal --- | This isn't strictly Word16 array write. Instead it's two consecutive Word8 array--- writes to avoid endianness issues due to primops doing automatic alignment based--- on host platform. We want to always write LE to the byte array.-writeWord16Array :: MBA s-                 -> Int      -- ^ Word8 index (not Word16)-                 -> Word16-                 -> ST s ()-writeWord16Array (MBA# mba#) (I# i#) (W16# w#) =-  case encodeWord16LE# w# of-    (# lsb#, msb# #) ->-      (ST $ \s -> case writeWord8Array# mba# i# lsb# s of-          s' -> (# s', () #)) >>-      (ST $ \s -> case writeWord8Array# mba# (i# +# 1#) msb# s of-          s' -> (# s', () #)) --- | This isn't strictly Word16 array read. Instead it's two Word8 array reads--- to avoid endianness issues due to primops doing automatic alignment based--- on host platform. We expect the byte array to be LE always.-indexWord16Array :: BA-                 -> Int      -- ^ Word8 index (not Word16)-                 -> Word16-indexWord16Array (BA# ba#) (I# i#) = -  case (# indexWord8Array# ba# i#, indexWord8Array# ba# (i# +# 1#) #) of-    (# lsb#, msb# #) -> W16# ((decodeWord16LE# (# lsb#, msb# #))) --packBytes :: [Word16] -> ShortByteString-packBytes cs = packLenBytes (List.length cs) cs--packLenBytes :: Int -> [Word16] -> ShortByteString-packLenBytes len ws0 =-    create (len * 2) (\mba -> go mba 0 ws0)-  where-    go :: MBA s -> Int -> [Word16] -> ST s ()-    go !_   !_ []     = return ()-    go !mba !i (w:ws) = do-      writeWord16Array mba i w-      go mba (i+2) ws--packBytesRev :: [Word16] -> ShortByteString-packBytesRev cs = packLenBytesRev ((List.length cs) * 2) cs--packLenBytesRev :: Int -> [Word16] -> ShortByteString-packLenBytesRev len ws0 =-    create len (\mba -> go mba len ws0)-  where-    go :: MBA s -> Int -> [Word16] -> ST s ()-    go !_   !_ []     = return ()-    go !mba !i (w:ws) = do-      writeWord16Array mba (i - 2) w-      go mba (i - 2) ws---unpackBytes :: ShortByteString -> [Word16]-unpackBytes sbs = go len []-  where-    len = BS.length sbs-    go !i !acc-      | i < 1     = acc-      | otherwise = let !w = indexWord16Array (asBA sbs) (i - 2)-                    in go (i - 2) (w:acc)- -- Returns the index of the first match or the length of the whole -- bytestring if nothing matched. findIndexOrLength :: (Word16 -> Bool) -> ShortByteString -> Int@@ -872,13 +810,4 @@   | otherwise = error ("Uneven number of bytes: " <> show (BS.length sbs) <> ". This is not a Word16 bytestream.")  --encodeWord16LE# :: Word# -- ^ Word16-                -> (# Word#, Word# #) -- ^ Word8 (LSB, MSB)-encodeWord16LE# x# = (# (x# `and#` int2Word# 0xff#)-                     ,  ((x# `and#` int2Word# 0xff00#) `shiftRL#` 8#) #)--decodeWord16LE# :: (# Word#, Word# #) -- ^ Word8 (LSB, MSB)-                -> Word#              -- ^ Word16-decodeWord16LE# (# lsb#, msb# #) = ((msb# `shiftL#` 8#) `or#` lsb#) 

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               shortbytestring-version:            0.1.0.0+version:            0.2.0.0 license:            MIT license-file:       LICENSE maintainer:         hasufell@posteo.de@@ -33,6 +33,7 @@    hs-source-dirs:           lib   default-language:         Haskell2010+  ghc-options: -Wall -Wextra   build-depends:     , base              >=4.9.1.0  && <5     , bytestring        ^>=0.10.8.1@@ -61,7 +62,7 @@     , base             >=4.9.1.0  && <5     , bytestring       ^>=0.10.8.1     , deepseq          ^>=1.4-    , random           ^>=1.1+    , random           >=1.1      && <1.3     , shortbytestring     , tasty-bench      ^>=0.3 @@ -84,6 +85,7 @@     , tasty-quickcheck     , word16     , word8+    , QuickCheck    ghc-options:      -fwarn-unused-binds -threaded -rtsopts   default-language: Haskell2010

@@ -20,11 +20,11 @@  #ifdef WORD8 module Properties.ByteString.Short (tests) where-import Data.Word8 (isSpace)+import Data.Word8 (isSpace, _nul) import qualified "shortbytestring" Data.ByteString.Short as B #else module Properties.ByteString.Short.Word16 (tests) where-import Data.Word16 (isSpace)+import Data.Word16 (isSpace, _nul) import qualified "shortbytestring" Data.ByteString.Short.Word16 as B #endif import "shortbytestring" Data.ByteString.Short (ShortByteString)@@ -38,6 +38,7 @@ import Data.Tuple import Test.Tasty import Test.Tasty.QuickCheck+import Test.QuickCheck.Monadic import Text.Show.Functions ()  #ifdef WORD16@@ -396,6 +397,22 @@   --, testProperty "unfoldr" $   --  \n f (toElem -> a) -> B.unpack (B.take (fromIntegral n) (B.unfoldr (fmap (first toElem) . f) a)) ===   --    take n (unfoldr (fmap (first toElem) . f) a)+  --+#ifdef WORD16+  , testProperty "useAsCWString str packCWString == str" $+    \x -> not (B.any (== _nul) x)+      ==> monadicIO $ run (B.useAsCWString x B.packCWString >>= \x' -> pure (x === x'))+  , testProperty "useAsCWStringLen str packCWStringLen == str" $+    \x -> not (B.any (== _nul) x)+      ==> monadicIO $ run (B.useAsCWStringLen x B.packCWStringLen >>= \x' -> pure (x === x'))+#else+  , testProperty "useAsCString str packCString == str" $+    \x -> not (B.any (== _nul) x)+      ==> monadicIO $ run (B.useAsCString x B.packCString >>= \x' -> pure (x === x'))+  , testProperty "useAsCStringLen str packCStringLen == str" $+    \x -> not (B.any (== _nul) x)+      ==> monadicIO $ run (B.useAsCStringLen x B.packCStringLen >>= \x' -> pure (x === x'))+#endif   ]  stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]