diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,11 +1,16 @@ # Revision history for Z-Data -## 0.7.1.0 -- 2020-03-03 +## 0.7.2.0 -- 2021-03-22 +* Add `fromMutablePrimArray` for constructing CBytes. +* Add `toBytes'/toBuilder'`(convert with the \NUL terminator) to `Z.Data.CBytes`. + +## 0.7.1.0 -- 2021-03-03 + * Add `CPtr` type, a more lightweight foreign pointer. * Add `toLower/toUpper/toLowerLatin/toUpperLatin` to `Z.Data.ASCII`. -## 0.7.0.0 -- 2020-03-03 +## 0.7.0.0 -- 2021-03-03 * Add more patterns to `Z.Data.ASCII`. * Fix a bug in `Z.Data.Vector.Search` where needle is a singleton. @@ -13,7 +18,7 @@ * Add `scientific'` to `Z.Data.Builder`, Add more `Print` instances. * Bump deps to support GHC 9.0. -## 0.6.1.0 -- 2020-02-04 +## 0.6.1.0 -- 2021-02-04 * Add `key` and `nth` lens to `Z.Data.JSON.Value` for manipulating nested value more easily. * Port patch from bytestring #301 #310 #315, Improve `stime`, `sconcat`, `intersperse`. @@ -24,20 +29,20 @@ * Add `displayWidth` to `Z.Data.Text`. * Move `floatToScientific/doubleToScientific` to `Z.Data.JSON.Value`. -## 0.6.0.0 -- 2020-02-04 +## 0.6.0.0 -- 2021-02-04 * Add `primArrayFromBE/primArrayFromBE` to `Z.Data.Array.Unaligned`. * Change `[Char]` 's JSON instance to use JSON text, Add `Bytes` 's JSON instance to use base64 encoding. * Add `escapeCBytes`, `toEscapedText` to `Z.Data.CBytes`, change `CBytes` 's JSON instance to use base64 encoding. -## 0.5.0.0 -- 2020-01-15 +## 0.5.0.0 -- 2021-01-15 * Add `ParseChunks` type alias, remove `parseChunks'` from `Z.Data.JSON`. * Change JSON instance of `Data.Version` to use JSON Array. * Add `fromByteString` and `toByteString` to `Z.Foreign`. * Change license's copyright to test --test-show-details=direct -## 0.4.0.0 -- 2020-01-11 +## 0.4.0.0 -- 2021-01-11 * Merge `FromValue`, `ToValue`, `EncodeJSON` to `JSON` class, add instances for containers. * A new `Z.Data.JSON.Converter` module to be reused in other protocol decoding. @@ -100,7 +105,7 @@ * Remove `Str` newtype. * Make `CBytes` a newtype. * Add JSON instances for `ExitCode`, Add Unaligned instances for `Ptr a`. -* Use type alias instead of newtypes for `Locale`, `Category` in `Z.Data.Text`. +* Use type alias instead of newtypes for `Locale`, `Category` in `Z.Data.Text`. ## 0.1.6.0 -- 2020-10-09 diff --git a/Z-Data.cabal b/Z-Data.cabal --- a/Z-Data.cabal +++ b/Z-Data.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: Z-Data -version: 0.7.1.0 +version: 0.7.2.0 synopsis: Array, vector and text description: This package provides array, slice and text operations license: BSD-3-Clause @@ -365,4 +365,4 @@ else cpp-options: -DINTEGER_GMP - build-depends: integer-gmp >=0.2 && <1.1 + build-depends: integer-gmp >=0.2 && <1.2 diff --git a/Z/Data/CBytes.hs b/Z/Data/CBytes.hs --- a/Z/Data/CBytes.hs +++ b/Z/Data/CBytes.hs @@ -15,8 +15,9 @@ module Z.Data.CBytes ( -- * The CBytes type CBytes(CB) - , rawPrimArray, fromPrimArray - , toBytes, fromBytes, toText, toTextMaybe, fromText, toBuilder, buildCBytes + , rawPrimArray, fromPrimArray, fromMutablePrimArray + , toBytes, toBytes', fromBytes, toText, toTextMaybe, fromText + , toBuilder, toBuilder', buildCBytes , pack , unpack , null, length @@ -29,47 +30,47 @@ , CString ) where +import Control.Applicative ((<|>)) import Control.DeepSeq -import Control.Monad -import Control.Applicative ((<|>)) import Control.Exception +import Control.Monad import Control.Monad.Primitive import Control.Monad.ST import Data.Bits -import Data.Foldable (foldlM) -import Data.Hashable (Hashable(..)) -import qualified Data.List as List +import Data.Foldable (foldlM) +import Data.Hashable (Hashable (..)) +import qualified Data.List as List import Data.Primitive.PrimArray import Data.Word import Foreign.C.String -import GHC.Exts import GHC.CString +import GHC.Exts import GHC.Ptr import GHC.Stack -import Prelude hiding (all, any, appendFile, break, - concat, concatMap, drop, dropWhile, - elem, filter, foldl, foldl1, foldr, - foldr1, getContents, getLine, head, - init, interact, last, length, lines, - map, maximum, minimum, notElem, null, - putStr, putStrLn, readFile, replicate, - reverse, scanl, scanl1, scanr, scanr1, - span, splitAt, tail, take, takeWhile, - unlines, unzip, writeFile, zip, - zipWith) +import Prelude hiding (all, any, appendFile, break, + concat, concatMap, drop, dropWhile, + elem, filter, foldl, foldl1, foldr, + foldr1, getContents, getLine, head, + init, interact, last, length, lines, + map, maximum, minimum, notElem, + null, putStr, putStrLn, readFile, + replicate, reverse, scanl, scanl1, + scanr, scanr1, span, splitAt, tail, + take, takeWhile, unlines, unzip, + writeFile, zip, zipWith) +import System.IO.Unsafe (unsafeDupablePerformIO) +import Test.QuickCheck.Arbitrary (Arbitrary (..), CoArbitrary (..)) +import Text.Read (Read (..)) import Z.Data.Array -import qualified Z.Data.Builder as B -import qualified Z.Data.Text as T -import qualified Z.Data.Text.Print as T -import qualified Z.Data.Text.UTF8Codec as T -import qualified Z.Data.JSON.Base as JSON -import Z.Data.JSON.Base ((.=), (.!), (.:)) -import Z.Data.Text.UTF8Codec (encodeCharModifiedUTF8, decodeChar) -import qualified Z.Data.Vector.Base as V -import Z.Foreign hiding (fromStdString) -import System.IO.Unsafe (unsafeDupablePerformIO) -import Test.QuickCheck.Arbitrary (Arbitrary(..), CoArbitrary(..)) -import Text.Read (Read(..)) +import qualified Z.Data.Builder as B +import Z.Data.JSON.Base ((.!), (.:), (.=)) +import qualified Z.Data.JSON.Base as JSON +import qualified Z.Data.Text as T +import qualified Z.Data.Text.Print as T +import Z.Data.Text.UTF8Codec (decodeChar, encodeCharModifiedUTF8) +import qualified Z.Data.Text.UTF8Codec as T +import qualified Z.Data.Vector.Base as V +import Z.Foreign hiding (fromStdString) -- | A efficient wrapper for short immutable null-terminated byte sequences which can be -- automatically freed by ghc garbage collector. @@ -100,13 +101,13 @@ rawPrimArray :: PrimArray Word8 } --- | Constuctor a 'CBytes' from arbitrary array, result will be trimmed down to first @\\NUL@ byte if there's any. +-- | Construct a 'CBytes' from arbitrary array, result will be trimmed down to first @\\NUL@ byte if there's any. fromPrimArray :: PrimArray Word8 -> CBytes {-# INLINE fromPrimArray #-} fromPrimArray arr = runST (do let l = case V.elemIndex 0 arr of Just i -> i - _ -> sizeofPrimArray arr + _ -> sizeofPrimArray arr if l+1 == sizeofPrimArray arr then return (CBytes arr) else do @@ -117,6 +118,31 @@ pa <- unsafeFreezePrimArray mpa return (CBytes pa)) +-- | Construct a 'CBytes' from a 'MutablePrimArray'. +-- +-- Result will be shrinked to first @\\NUL@ byte without copy. If there is no +-- @\\NUL@ found in the array, We will resize the origin MutablePrimArray, so, +-- to avoid undefined behaviour, the original MutablePrimArray shall not be +-- accessed anymore. Moreover, no reference to the old one should be kept in +-- order to allow garbage collection of the original MutablePrimArray in case +-- a new MutablePrimArray had to be allocated. +fromMutablePrimArray + :: PrimMonad m + => MutablePrimArray (PrimState m) Word8 + -> m CBytes +{-# INLINE fromMutablePrimArray #-} +fromMutablePrimArray marr = do + let l = sizeofMutablePrimArray marr + arr <- unsafeFreezePrimArray marr + marr' <- case V.elemIndex 0 arr of + Just i -> shrinkMutablePrimArray marr (i + 1) >> return marr + _ -> do + marr' <- resizeMutablePrimArray marr (l + 1) + writePrimArray marr' l 0 + return marr' + !pa <- unsafeFreezePrimArray marr' + return $ CBytes pa + -- | Use this pattern to match or construct 'CBytes', result will be trimmed down to first @\\NUL@ byte if there's any. pattern CB :: V.Bytes -> CBytes {-# COMPLETE CB #-} @@ -222,11 +248,11 @@ <|> JSON.withFlatMapR "Z.Data.CBytes" (\ o -> fromBytes <$> o .: "base64") v {-# INLINE toValue #-} toValue cbytes = case toTextMaybe cbytes of - Just t -> JSON.toValue t + Just t -> JSON.toValue t Nothing -> JSON.object $ [ "base64" .= toBytes cbytes ] {-# INLINE encodeJSON #-} encodeJSON cbytes = case toTextMaybe cbytes of - Just t -> JSON.encodeJSON t + Just t -> JSON.encodeJSON t Nothing -> JSON.object' $ "base64" .! toBytes cbytes -- | Concatenate two 'CBytes'. @@ -426,7 +452,7 @@ {-# INLINE null #-} null (CBytes pa) = indexPrimArray pa 0 == 0 --- | /O(1)/, Return the BTYE length of 'CBytes'. +-- | /O(1)/, Return the BTYE length of 'CBytes' without NULL terminator. -- length :: CBytes -> Int {-# INLINE length #-} @@ -437,6 +463,11 @@ {-# INLINABLE toBytes #-} toBytes (CBytes arr) = V.PrimVector arr 0 (sizeofPrimArray arr - 1) +-- | /O(1)/, convert to 'V.Bytes' with its NULL terminator. +toBytes' :: CBytes -> V.Bytes +{-# INLINABLE toBytes' #-} +toBytes' (CBytes arr) = V.PrimVector arr 0 (sizeofPrimArray arr) + -- | /O(n)/, convert from 'V.Bytes' -- -- Result will be trimmed down to first @\\NUL@ byte if there's any. @@ -449,7 +480,7 @@ | otherwise = runST (do let l' = case V.elemIndex 0 v of Just i -> i - _ -> l + _ -> l mpa <- newPrimArray (l'+1) copyPrimArray mpa 0 arr s l' writePrimArray mpa l' 0 -- the \\NUL terminator @@ -482,11 +513,20 @@ -- This function is different from 'T.Print' instance in that it directly write byte sequence without -- checking if it's UTF8 encoded. toBuilder :: CBytes -> B.Builder () +{-# INLINABLE toBuilder #-} toBuilder = B.bytes . toBytes --- | Build a 'CBytes' with builder, result will be trimmed down to first @\\NUL@ byte if there's any. +-- | Write 'CBytes' \'s byte sequence to buffer, with its NULL terminator. +-- +toBuilder' :: CBytes -> B.Builder () +{-# INLINABLE toBuilder' #-} +toBuilder' = B.bytes . toBytes' + +-- | Build a 'CBytes' with builder, will automatically be trimmed down to first @\\NUL@ byte if there's any, +-- or append with one if there's none. buildCBytes :: B.Builder a -> CBytes -buildCBytes = fromBytes . B.build +{-# INLINABLE buildCBytes #-} +buildCBytes b = fromBytes (B.build (b >> B.word8 0)) -------------------------------------------------------------------------------- diff --git a/Z/Data/Parser/Base.hs b/Z/Data/Parser/Base.hs --- a/Z/Data/Parser/Base.hs +++ b/Z/Data/Parser/Base.hs @@ -731,7 +731,7 @@ else kf ["Z.Data.Parser.Base.bytes: mismatch bytes"] inp) --- | Same as 'bytes' but ignoring case. +-- | Same as 'bytes' but ignoring ASCII case. bytesCI :: V.Bytes -> Parser () {-# INLINE bytesCI #-} bytesCI bs = do diff --git a/test/Z/Data/CBytesSpec.hs b/test/Z/Data/CBytesSpec.hs --- a/test/Z/Data/CBytesSpec.hs +++ b/test/Z/Data/CBytesSpec.hs @@ -1,23 +1,24 @@ -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} module Z.Data.CBytesSpec where -import qualified Data.List as List -import qualified GHC.Exts as List +import Data.Char (ord) +import Data.Hashable (hash, hashWithSalt) +import qualified Data.List as List import Data.Word -import Data.Hashable (hashWithSalt, hash) -import qualified Z.Data.CBytes as CB -import qualified Z.Data.JSON as JSON -import Z.Foreign -import qualified Z.Data.Vector.Base as V +import qualified GHC.Exts as List import System.IO.Unsafe +import Test.Hspec +import Test.Hspec.QuickCheck import Test.QuickCheck import Test.QuickCheck.Function import Test.QuickCheck.Property -import Test.Hspec -import Test.Hspec.QuickCheck +import qualified Z.Data.CBytes as CB +import qualified Z.Data.JSON as JSON +import qualified Z.Data.Vector.Base as V +import Z.Foreign spec :: Spec spec = describe "CBytes-base" $ do @@ -77,3 +78,15 @@ CB.toBytes (CB.pack xs) === (unsafeDupablePerformIO $ CB.withCBytes (CB.pack xs) fromNullTerminated) + describe "CBytes.fromPrimArray" $ do + prop "CBytes pack === CBytes fromPrimArray" $ \(ASCIIString xs) -> + let xs' = List.filter (/= '\NUL') xs + in CB.pack xs' === CB.fromPrimArray (primArrayFromList $ map (fromIntegral . ord) xs') + + describe "CBytes.fromMutablePrimArray" $ do + prop "CBytes pack === CBytes fromMutablePrimArray" $ \(ASCIIString xs) -> + let xs' = List.filter (/= '\NUL') xs + in unsafeDupablePerformIO $ do + marr <- unsafeThawPrimArray (primArrayFromList $ map (fromIntegral . ord) xs') + cb <- CB.fromMutablePrimArray marr + return $ CB.pack xs' === cb diff --git a/test/Z/Data/Parser/BaseSpec.hs b/test/Z/Data/Parser/BaseSpec.hs --- a/test/Z/Data/Parser/BaseSpec.hs +++ b/test/Z/Data/Parser/BaseSpec.hs @@ -8,8 +8,7 @@ import Data.Int import GHC.Float import Text.Printf (printf) -import Data.Char (toLower) -import Z.Data.ASCII (w2c, c2w) +import Z.Data.ASCII (w2c, c2w, toLower) import qualified Z.Data.Parser.Base as P import qualified Z.Data.Text as T import qualified Z.Data.Vector.Base as V @@ -99,7 +98,7 @@ parse'' (P.bytesCI . V.pack $ t) (t ++ s) === Just (V.pack s, ()) prop "bytesCI" $ \ s t -> - parse'' (P.bytesCI . V.pack $ t) (L.map (c2w . toLower . w2c) t ++ s) === Just (V.pack s, ()) + parse'' (P.bytesCI . V.pack $ t) (L.map toLower t ++ s) === Just (V.pack s, ()) prop "atEnd" $ \ s -> parse' P.atEnd s ===