Z-Data 1.0.0.1 → 1.1.0.0

raw patch · 21 files changed

+438/−101 lines, 21 filesdep +randomdep +uuid-typesPVP ok

version bump matches the API change (PVP)

Dependencies added: random, uuid-types

API changes (from Hackage documentation)

Files

• ChangeLog.md +11/−0
• README.md +1/−0
• Z-Data.cabal +5/−1
• Z/Data/Array.hs +53/−4
• Z/Data/Array/Base.hs +55/−1
• Z/Data/Array/UnliftedArray.hs +63/−2
• Z/Data/Builder.hs +3/−0
• Z/Data/Builder/UUID.hs +73/−0
• Z/Data/CBytes.hs +5/−5
• Z/Data/JSON.hs +1/−1
• Z/Data/JSON/Base.hs +11/−2
• Z/Data/JSON/Builder.hs +7/−7
• Z/Data/Parser.hs +3/−0
• Z/Data/Parser/UUID.hs +45/−0
• Z/Data/PrimRef.hs +4/−1
• Z/Data/Text.hs +1/−0
• Z/Data/Text/Base.hs +14/−0
• Z/Data/Vector.hs +1/−0
• Z/Data/Vector/Base.hs +22/−9
• Z/Data/Vector/Sort.hs +3/−15
• cbits/text.c +57/−53

@@ -1,5 +1,16 @@ # Revision history for Z-Data +## 1.1.0.0  -- 2021-07-15++* Fix building issues on ARM platform.+* Add `UUID` builders and parsers(both textual binary).+* Add more `PrimUnlifed` instances to `Z.Data.Array.UnliftedArray`.+* Add `doubleMutableArr` to `Z.Data.Array`, useful in some buffer building logic.+* Add `shuffle` and `permutations` to `Z.Data.Vector` and `Z.Data.Text`.+* Add `prettyJSON'` to `Z.Data.JSON` with custom indentation.+* Change `CBytes` 's JSON instance to write `__base64` field(instead of `base64` field) when not UTF8 encoded.+* Add missing type alias `UnliftedIORef` for `UnliftedRef RealWorld`.+ ## 1.0.0.1  -- 2021-07-08  * Fix a regression in `match` parsing combinator where matched chunk is returned instead of precise matched input.

@@ -4,6 +4,7 @@ [![Linux Build Status](https://github.com/ZHaskell/z-data/workflows/ubuntu-ci/badge.svg)](https://github.com/ZHaskell/z-data/actions) [![macOS Build Status](https://github.com/ZHaskell/z-data/workflows/osx-ci/badge.svg)](https://github.com/ZHaskell/z-data/actions) [![Windows Build Status](https://github.com/ZHaskell/z-data/workflows/win-ci/badge.svg)](https://github.com/ZHaskell/z-data/actions)+[![ARM Build Status](https://img.shields.io/drone/build/ZHaskell/z-data?label=arm-ci)](https://cloud.drone.io/ZHaskell/z-data) [![Gitter chat](https://badges.gitter.im/gitterHQ/gitter.svg)](https://gitter.im/Z-Haskell/community) <a href="https://opencollective.com/zhaskell/donate" target="_blank">   <img src="https://opencollective.com/zhaskell/donate/button@2x.png?color=blue" width=128 />

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               Z-Data-version:            1.0.0.1+version:            1.1.0.0 synopsis:           Array, vector and text description:        This package provides array, slice and text operations license:            BSD-3-Clause@@ -149,6 +149,7 @@     Z.Data.Builder.Numeric     Z.Data.Builder.Numeric.DigitTable     Z.Data.Builder.Time+    Z.Data.Builder.UUID     Z.Data.CBytes     Z.Data.Generics.Utils     Z.Data.JSON@@ -160,6 +161,7 @@     Z.Data.Parser.Base     Z.Data.Parser.Numeric     Z.Data.Parser.Time+    Z.Data.Parser.UUID     Z.Data.PrimRef     Z.Data.Text     Z.Data.Text.Base@@ -194,12 +196,14 @@     , hashable              ^>=1.3     , primitive             >=0.7.1  && <0.7.2     , QuickCheck            >=2.10+    , random                >=1.2.0  && <1.3     , scientific            >=0.3.7  && <0.4     , tagged                ^>=0.8     , template-haskell      >=2.14.0     , time                  >=1.9    && <2.0     , unordered-containers  ^>=0.2     , unicode-collation     >=0.1.3 && <0.2+    , uuid-types            >=1.0.4 && <2.0    include-dirs:     third_party/fastbase64/include

@@ -29,7 +29,8 @@   ( -- * Arr typeclass re-export     Arr, MArr   , A.emptyArr, A.singletonArr, A.doubletonArr-  , modifyIndexArr, insertIndexArr, deleteIndexArr+  , modifyIndexArr, insertIndexArr, deleteIndexArr, swapArr, swapMutableArr+  , A.doubleMutableArr, shuffleMutableArr   , RealWorld   -- * Boxed array type   , A.Array(..)@@ -90,11 +91,12 @@ import           Control.Monad.Primitive import           Data.Primitive.Types import           GHC.Stack-import           Z.Data.Array.Base      (Arr, MArr)-import qualified Z.Data.Array.Base      as A+import           System.Random.Stateful         (StatefulGen)  +import           Z.Data.Array.Base              (Arr, MArr)+import qualified Z.Data.Array.Base              as A+import           Control.Monad.ST #ifdef CHECK_ARRAY_BOUND import           Control.Monad-import           Control.Monad.ST #endif  #ifdef CHECK_ARRAY_BOUND@@ -500,4 +502,51 @@         A.unsafeFreezeArr marr #else     A.deleteIndexArr arr s l i+#endif++-- | Swap two elements under given index and return a new array.+swapArr :: Arr arr a+        => arr a+        -> Int +        -> Int+        -> arr a+{-# INLINE swapArr #-}+swapArr arr i j = runST $ do+    marr <- A.thawArr arr 0 (A.sizeofArr arr)+    swapMutableArr marr i j+    A.unsafeFreezeArr marr++-- | Swap two elements under given index, no atomically guarantee is given.+swapMutableArr :: (PrimMonad m, PrimState m ~ s, Arr arr a)+               => MArr arr s a+               -> Int +               -> Int+               -> m ()+{-# INLINE swapMutableArr #-}+swapMutableArr marr i j = do+#ifdef CHECK_ARRAY_BOUND+    siz <- A.sizeofMutableArr marr+    check+        (i>=0 && j>=0 && i<siz && j<siz)+        (A.swapMutableArr marr i j)+#else+    A.swapMutableArr marr i j+#endif++-- | Shuffle array's elements in slice range.+--+-- This function use <https://en.wikipedia.org/wiki/Fisher%E2%80%93Yates_shuffle Fisher-Yates> algorithm. +shuffleMutableArr :: (StatefulGen g m, PrimMonad m, PrimState m ~ s, Arr arr a) => g -> MArr arr s a +            -> Int  -- ^ offset+            -> Int  -- ^ length+            -> m ()+{-# INLINE shuffleMutableArr #-}+shuffleMutableArr g marr s l = do+#ifdef CHECK_ARRAY_BOUND+    siz <- A.sizeofMutableArr marr+    check+        (s>=0 && l>=0 && (s+l)<=siz)+        (A.shuffleMutableArr g marr s l)+#else+        A.shuffleMutableArr g marr s l #endif

@@ -30,7 +30,8 @@   -- * Arr typeclass     Arr(..)   , emptyArr, singletonArr, doubletonArr-  , modifyIndexArr, insertIndexArr, deleteIndexArr+  , modifyIndexArr, insertIndexArr, deleteIndexArr, swapArr, swapMutableArr+  , doubleMutableArr, shuffleMutableArr   , RealWorld   -- * Boxed array type   , Array(..)@@ -65,6 +66,7 @@ import           Control.Monad import           Control.Monad.Primitive import           Control.Monad.ST+import           Data.Bits                      (unsafeShiftL) import           Data.Kind                      (Type) import           Data.Primitive.Array import           Data.Primitive.ByteArray@@ -73,6 +75,7 @@ import           Data.Primitive.SmallArray import           Data.Primitive.Types import           GHC.Exts+import           System.Random.Stateful  ( UniformRange(uniformRM), StatefulGen )   import           Z.Data.Array.Cast import           Z.Data.Array.UnliftedArray @@ -690,3 +693,54 @@     let i' = i+1     when (i'<l) $ copyArr marr i arr (i'+s) (l-i')     unsafeFreezeArr marr++-- | Swap two elements under given index and return a new array.+swapArr :: Arr arr a+             => arr a+             -> Int +             -> Int+             -> arr a+{-# INLINE swapArr #-}+swapArr arr i j = runST $ do+    marr <- thawArr arr 0 (sizeofArr arr)+    swapMutableArr marr i j+    unsafeFreezeArr marr++-- | Swap two elements under given index, no atomically guarantee is given.+swapMutableArr :: (PrimMonad m, PrimState m ~ s, Arr arr a)+             => MArr arr s a+             -> Int +             -> Int+             -> m ()+{-# INLINE swapMutableArr #-}+swapMutableArr marr i j = do+    x <- readArr marr i+    y <- readArr marr j+    writeArr marr i y +    writeArr marr j x ++-- | Resize mutable array to @max (given_size) (2 * original_size)@ if orignal array is smaller than @give_size@.+doubleMutableArr :: (Arr arr a, PrimMonad m, PrimState m ~ s) => MArr arr s a -> Int -> m (MArr arr s a)+{-# INLINE doubleMutableArr #-}+doubleMutableArr marr l = do+    siz <- sizeofMutableArr marr+    if (siz < l)+    then resizeMutableArr marr (max (siz `unsafeShiftL` 1) l)+    else return marr+++-- | Shuffle array's elements in slice range.+--+-- This function use <https://en.wikipedia.org/wiki/Fisher%E2%80%93Yates_shuffle Fisher-Yates> algorithm. +shuffleMutableArr :: (StatefulGen g m, PrimMonad m, PrimState m ~ s, Arr arr a) => g -> MArr arr s a +            -> Int  -- ^ offset+            -> Int  -- ^ length+            -> m ()+{-# INLINE shuffleMutableArr #-}+shuffleMutableArr g marr off n = go (off+n-1)+  where +    go i | i < off+1 = return ()+         | otherwise = do+            j <- uniformRM (off, i) g+            swapMutableArr marr i j +            go (i - 1) 

@@ -38,8 +38,10 @@ module Z.Data.Array.UnliftedArray where  import Control.Monad.Primitive-import Data.Primitive.PrimArray (PrimArray(..),MutablePrimArray(..))-import Data.Primitive.ByteArray (ByteArray(..),MutableByteArray(..))+import Data.Primitive.Array+import Data.Primitive.ByteArray+import Data.Primitive.PrimArray+import Data.Primitive.SmallArray import GHC.MVar (MVar(..)) import GHC.IORef (IORef(..)) import GHC.STRef (STRef(..))@@ -52,6 +54,65 @@     writeUnliftedArray# :: MutableArrayArray# s -> Int# -> a -> State# s -> State# s     readUnliftedArray# :: MutableArrayArray# s -> Int# -> State# s -> (# State# s, a #)     indexUnliftedArray# :: ArrayArray# -> Int# -> a++instance PrimUnlifted (UnliftedArray a) where+    {-# INLINE writeUnliftedArray# #-}+    {-# INLINE readUnliftedArray# #-}+    {-# INLINE indexUnliftedArray# #-}+    writeUnliftedArray# a i (UnliftedArray x) = writeArrayArrayArray# a i x+    readUnliftedArray# a i s0 = case readArrayArrayArray# a i s0 of+        (# s1, x #) -> (# s1, UnliftedArray x #)+    indexUnliftedArray# a i = UnliftedArray (indexArrayArrayArray# a i)++instance PrimUnlifted (MutableUnliftedArray s a) where+    {-# INLINE writeUnliftedArray# #-}+    {-# INLINE readUnliftedArray# #-}+    {-# INLINE indexUnliftedArray# #-}+    writeUnliftedArray# a i (MutableUnliftedArray x) =+        writeMutableArrayArrayArray# a i (unsafeCoerce# x)+    readUnliftedArray# a i s0 = case readMutableArrayArrayArray# a i s0 of+        (# s1, x #) -> (# s1, MutableUnliftedArray (unsafeCoerce# x) #)+    indexUnliftedArray# a i = MutableUnliftedArray (unsafeCoerce# (indexArrayArrayArray# a i))++instance PrimUnlifted (Array a) where+    {-# INLINE writeUnliftedArray# #-}+    {-# INLINE readUnliftedArray# #-}+    {-# INLINE indexUnliftedArray# #-}+    writeUnliftedArray# a i (Array x) =+        writeArrayArrayArray# a i (unsafeCoerce# x)+    readUnliftedArray# a i s0 = case readArrayArrayArray# a i s0 of+        (# s1, x #) -> (# s1, Array (unsafeCoerce# x) #)+    indexUnliftedArray# a i = Array (unsafeCoerce# (indexArrayArrayArray# a i))++instance PrimUnlifted (MutableArray s a) where+    {-# INLINE writeUnliftedArray# #-}+    {-# INLINE readUnliftedArray# #-}+    {-# INLINE indexUnliftedArray# #-}+    writeUnliftedArray# a i (MutableArray x) =+        writeMutableArrayArrayArray# a i (unsafeCoerce# x)+    readUnliftedArray# a i s0 = case readMutableArrayArrayArray# a i s0 of+        (# s1, x #) -> (# s1, MutableArray (unsafeCoerce# x) #)+    indexUnliftedArray# a i = MutableArray (unsafeCoerce# (indexArrayArrayArray# a i))++instance PrimUnlifted (SmallArray a) where+    {-# INLINE writeUnliftedArray# #-}+    {-# INLINE readUnliftedArray# #-}+    {-# INLINE indexUnliftedArray# #-}+    writeUnliftedArray# a i (SmallArray x) =+        writeArrayArrayArray# a i (unsafeCoerce# x)+    readUnliftedArray# a i s0 = case readArrayArrayArray# a i s0 of+        (# s1, x #) -> (# s1, SmallArray (unsafeCoerce# x) #)+    indexUnliftedArray# a i = SmallArray (unsafeCoerce# (indexArrayArrayArray# a i))++instance PrimUnlifted (SmallMutableArray s a) where+    {-# INLINE writeUnliftedArray# #-}+    {-# INLINE readUnliftedArray# #-}+    {-# INLINE indexUnliftedArray# #-}+    writeUnliftedArray# a i (SmallMutableArray x) =+        writeMutableArrayArrayArray# a i (unsafeCoerce# x)+    readUnliftedArray# a i s0 = case readMutableArrayArrayArray# a i s0 of+        (# s1, x #) -> (# s1, SmallMutableArray (unsafeCoerce# x) #)+    indexUnliftedArray# a i = SmallMutableArray (unsafeCoerce# (indexArrayArrayArray# a i))  instance PrimUnlifted (PrimArray a) where     {-# INLINE writeUnliftedArray# #-}

@@ -64,6 +64,8 @@   , utcTime   , localTime   , zonedTime+    -- * UUID+  , uuid, uuidUpper, encodeUUID     -- * Specialized primitive builder   , encodeWord  , encodeWord64, encodeWord32, encodeWord16, encodeWord8   , encodeInt   , encodeInt64 , encodeInt32 , encodeInt16 , encodeInt8 , encodeDouble, encodeFloat@@ -76,4 +78,5 @@ import           Z.Data.Builder.Base import           Z.Data.Builder.Numeric import           Z.Data.Builder.Time+import           Z.Data.Builder.UUID import           Prelude                        ()

@@ -0,0 +1,73 @@+{-|+Module:      Z.Data.Builder.UUID+Description : Builders for UUID.+Copyright:   (c) 2021 Dong Han+License:     BSD3+Maintainer:  Dong <winterland1989@gmail.com>+Stability:   experimental+Portability: portable++Builders for UUID.+-}++module Z.Data.Builder.UUID+    ( uuid, uuidUpper+    , encodeUUID+    ) where++import           Data.UUID.Types.Internal+import           Data.Word+import           Data.Bits+import           Z.Data.ASCII+import qualified Z.Data.Builder.Base         as B+import qualified Z.Data.Builder.Numeric      as B++-- | Write texutal UUID bytes, e.g. @550e8400-e29b-41d4-a716-446655440000@+uuid :: UUID -> B.Builder ()+{-# INLINABLE uuid #-}+uuid (UUID wh wl) =  do+    let !w1 = fromIntegral @Word64 @Word32 $ wh `unsafeShiftR` 32+        !w2 = fromIntegral @Word64 @Word16 $ wh `unsafeShiftR` 16 .&. 0xFFFF+        !w3 = fromIntegral @Word64 @Word16 $ wh .&. 0xFFFF+        !w4 = fromIntegral @Word64 @Word16 $ wl `unsafeShiftR` 48+        !w5 = fromIntegral @Word64 @Word16 $ wl `unsafeShiftR` 32 .&. 0xFFFF+        !w6 = fromIntegral @Word64 @Word32 $ wl .&. 0xFFFFFFFF+    B.hex w1+    B.word8 HYPHEN+    B.hex w2+    B.word8 HYPHEN+    B.hex w3+    B.word8 HYPHEN+    B.hex w4+    B.word8 HYPHEN+    B.hex w5+    B.hex w6++-- | Write texutal UUID bytes, e.g. @550e8400-e29b-41d4-a716-446655440000@+uuidUpper :: UUID -> B.Builder ()+{-# INLINABLE uuidUpper #-}+uuidUpper (UUID wh wl) =  do+    let !w1 = fromIntegral @Word64 @Word32 $ wh `unsafeShiftR` 32+        !w2 = fromIntegral @Word64 @Word16 $ wh `unsafeShiftR` 16 .&. 0xFFFF+        !w3 = fromIntegral @Word64 @Word16 $ wh .&. 0xFFFF+        !w4 = fromIntegral @Word64 @Word16 $ wl `unsafeShiftR` 48+        !w5 = fromIntegral @Word64 @Word16 $ wl `unsafeShiftR` 32 .&. 0xFFFF+        !w6 = fromIntegral @Word64 @Word32 $ wl .&. 0xFFFFFFFF+    B.hexUpper w1+    B.word8 HYPHEN+    B.hexUpper w2+    B.word8 HYPHEN+    B.hexUpper w3+    B.word8 HYPHEN+    B.hexUpper w4+    B.word8 HYPHEN+    B.hexUpper w5+    B.hexUpper w6+++-- | Encode binary UUID(two 64-bits word in big-endian), as described in <http://tools.ietf.org/html/rfc4122 RFC 4122>. +encodeUUID :: UUID -> B.Builder ()+{-# INLINABLE  encodeUUID #-}+encodeUUID (UUID wh wl) = do +    B.encodeWord64BE wh+    B.encodeWord64BE wl

@@ -233,26 +233,26 @@     toUTF8BuilderP _ = T.stringUTF8 . show . unpack  -- | JSON instances check if 'CBytes' is properly UTF8 encoded,--- if it is, decode/encode it as 'T.Text', otherwise as an object with a base64 field.+-- if it is, decode/encode it as 'T.Text', otherwise as an object with a @__base64@ field. -- -- @ -- > encodeText ("hello" :: CBytes) -- "\"hello\"" -- > encodeText ("hello\\NUL" :: CBytes)     -- @\\NUL@ is encoded as C0 80, which is illegal UTF8--- "{\"base64\":\"aGVsbG/AgA==\"}"+-- "{\"__base64\":\"aGVsbG/AgA==\"}" -- @ instance JSON.JSON CBytes where     {-# INLINE fromValue #-}     fromValue v = JSON.withText "Z.Data.CBytes" (pure . fromText) v-                <|> JSON.withFlatMapR "Z.Data.CBytes" (\ o -> fromBytes <$> o .: "base64") v+                <|> JSON.withFlatMapR "Z.Data.CBytes" (\ o -> fromBytes <$> o .: "__base64") v     {-# INLINE toValue #-}     toValue cbytes = case toTextMaybe cbytes of         Just t  -> JSON.toValue t-        Nothing -> JSON.object $ [ "base64" .= toBytes cbytes ]+        Nothing -> JSON.object $ [ "__base64" .= toBytes cbytes ]     {-# INLINE encodeJSON #-}     encodeJSON cbytes = case toTextMaybe cbytes of         Just t  -> JSON.encodeJSON t-        Nothing -> JSON.object' $ "base64" .! toBytes cbytes+        Nothing -> JSON.object' $ "__base64" .! toBytes cbytes  -- | Concatenate two 'CBytes'. append :: CBytes -> CBytes -> CBytes

@@ -34,7 +34,7 @@   , decode, decode', decodeText, decodeText'   , ParseChunks, decodeChunk, decodeChunks   , encode, encodeChunks, encodeText-  , prettyJSON, prettyValue+  , prettyJSON, prettyValue, prettyJSON', prettyValue'     -- * parse into JSON Value   , parseValue, parseValue'   -- * Generic functions

@@ -20,7 +20,7 @@   , decode, decode', decodeText, decodeText'   , P.ParseChunks, decodeChunk, decodeChunks   , encode, encodeChunks, encodeText-  , prettyJSON, JB.prettyValue+  , prettyJSON, JB.prettyValue, prettyJSON', JB.prettyValue'     -- * parse into JSON Value   , JV.parseValue, JV.parseValue'   -- * Generic functions@@ -188,10 +188,19 @@ {-# INLINE convertValue #-} convertValue = convert fromValue --- | Directly encode data to JSON bytes.+-- | Pretty a 'JSON' data with 'JB.prettyValue'. prettyJSON :: JSON a => a -> B.Builder () {-# INLINE prettyJSON #-} prettyJSON = JB.prettyValue . toValue++-- | Pretty a 'JSON' data with 'JB.prettyValue\''.+prettyJSON' :: JSON a+            => Int   -- ^ indentation per level+            -> Int   -- ^ initial indentation+            -> a+            -> B.Builder ()+{-# INLINE prettyJSON' #-}+prettyJSON' i ii = JB.prettyValue' i ii . toValue  -------------------------------------------------------------------------------- 

@@ -37,12 +37,12 @@ -- -- Don't use chars which need escaped in label. kv :: T.Text -> B.Builder () -> B.Builder ()-{-# INLINABLE kv #-}+{-# INLINE kv #-} l `kv` b = B.quotes (B.text l) >> B.colon >> b  -- | Use @:@ as separator to connect a label(escape the label and add quotes) with field builders. kv' :: T.Text -> B.Builder () -> B.Builder ()-{-# INLINABLE kv' #-}+{-# INLINE kv' #-} l `kv'` b = string l >> B.colon >> b  -- | Encode a 'Value', you can use this function with 'toValue' to get 'encodeJSON' with a small overhead.@@ -57,19 +57,19 @@ value _ = "null"  array :: V.Vector Value -> B.Builder ()-{-# INLINABLE array #-}+{-# INLINE array #-} array = B.square . B.intercalateVec B.comma value  array' :: (a -> B.Builder ()) -> V.Vector a -> B.Builder ()-{-# INLINABLE array' #-}+{-# INLINE array' #-} array' f = B.square . B.intercalateVec B.comma f  object :: V.Vector (T.Text, Value) -> B.Builder ()-{-# INLINABLE object #-}+{-# INLINE object #-} object = B.curly . B.intercalateVec B.comma (\ (k, v) -> k `kv'` value v)  object' :: (a -> B.Builder ()) -> V.Vector (T.Text, a) -> B.Builder ()-{-# INLINABLE object' #-}+{-# INLINE object' #-} object' f = B.curly . B.intercalateVec B.comma (\ (k, v) -> k `kv'` f v)  -- | Escape text into JSON string and add double quotes, escaping rules:@@ -87,7 +87,7 @@ -- @ -- string :: T.Text -> B.Builder ()-{-# INLINABLE string #-}+{-# INLINE string #-} string = T.escapeTextJSON  --------------------------------------------------------------------------------

@@ -66,6 +66,8 @@   , timeZone   , utcTime   , zonedTime+  -- * UUID+  , uuid, decodeUUID     -- * Misc   , fail', failWithInput, unsafeLiftIO     -- * Specialized primitive parser@@ -80,4 +82,5 @@ import           Z.Data.Parser.Base import           Z.Data.Parser.Numeric import           Z.Data.Parser.Time+import           Z.Data.Parser.UUID import           Prelude hiding (take, takeWhile, decodeFloat)

@@ -0,0 +1,45 @@+{-|+Module:      Z.Data.Parser.UUID+Description : Parsers for UUID.+Copyright:   (c) 2020 Dong Han+License:     BSD3+Maintainer:  Dong <winterland1989@gmail.com>+Stability:   experimental+Portability: portable++Parsers for parsing UUID.+-}++module Z.Data.Parser.UUID+    ( uuid+    , decodeUUID+    ) where++import           Z.Data.ASCII+import qualified Z.Data.Parser.Base         as P+import qualified Z.Data.Parser.Numeric      as P+import           Data.UUID.Types.Internal++-- | Parse texutal UUID bytes(lower or upper-cased), e.g. @550e8400-e29b-41d4-a716-446655440000@+uuid :: P.Parser UUID+{-# INLINABLE uuid #-}+uuid =  do+    p1 <- P.takeN isHexDigit 8+    P.word8 HYPHEN+    p2 <- P.takeN isHexDigit 4+    P.word8 HYPHEN+    p3 <- P.takeN isHexDigit 4+    P.word8 HYPHEN+    p4 <- P.takeN isHexDigit 4+    P.word8 HYPHEN+    p5 <- P.takeN isHexDigit 12++    let !w1 = P.hexLoop (P.hexLoop (P.hexLoop 0 p1) p2) p3+        !w2 = P.hexLoop (P.hexLoop 0 p4) p5++    pure (UUID w1 w2)++-- | Decode binary UUID(two 64-bits word in big-endian), as described in <http://tools.ietf.org/html/rfc4122 RFC 4122>. +decodeUUID :: P.Parser UUID+{-# INLINABLE  decodeUUID #-}+decodeUUID = UUID <$> P.decodeWord64BE <*> P.decodeWord64BE

@@ -21,7 +21,7 @@   , modifyPrimRef   , Prim(..)     -- * Unlifted references-  , UnliftedRef(..)+  , UnliftedRef(..), UnliftedIORef   , newUnliftedRef   , readUnliftedRef   , writeUnliftedRef@@ -234,6 +234,9 @@ -- | A mutable variable in the 'PrimMonad' which can hold an instance of 'PrimUnlifted'. -- newtype UnliftedRef s a = UnliftedRef (MutableUnliftedArray s a)++-- | Type alias for 'UnliftedRef' in IO.+type UnliftedIORef a =  UnliftedRef RealWorld a  -- | Build a new 'UnliftedRef' --

@@ -40,6 +40,7 @@   , foldl', ifoldl'   , foldr', ifoldr'   , concat, concatR, concatMap+  , shuffle, permutations     -- ** Special folds   , count, all, any     -- ** Text display width

@@ -35,6 +35,7 @@   , foldl', ifoldl'   , foldr', ifoldr'   , concat, concatR, concatMap+  , shuffle, permutations     -- ** Special folds   , count, all, any     -- ** Text display width@@ -122,6 +123,7 @@ import           Control.DeepSeq import           Control.Exception import           Control.Monad.ST+import           Control.Monad.Primitive import           Control.Monad import           Data.Bits import           Data.Char                 hiding (toLower, toUpper, toTitle)@@ -145,6 +147,7 @@ import           Z.Data.Vector.Base        (Bytes, PrimVector(..), c_strlen) import qualified Z.Data.Vector.Base        as V import qualified Z.Data.Vector.Search      as V+import           System.Random.Stateful    (StatefulGen) import           System.IO.Unsafe          (unsafeDupablePerformIO)  import           Prelude                   hiding (concat, concatMap,@@ -608,6 +611,17 @@                 let !siz' = siz `shiftL` 1                 !marr' <- resizeMutablePrimArray marr siz'                 go i' j' k' marr'+++-- | Shuffle a text using  <https://en.wikipedia.org/wiki/Fisher%E2%80%93Yates_shuffle Fisher-Yates> algorithm.+shuffle :: (StatefulGen g m, PrimMonad m) => g -> Text -> m Text+{-# INLINE shuffle #-}+shuffle g t = fromVector <$> V.shuffle g (toVector t)++-- | Generate all permutation of a text using <https://en.wikipedia.org/wiki/Heap%27s_algorithm Heap's algorithm>.+permutations :: Text -> [Text]+{-# INLINE permutations #-}+permutations t = fromVector <$> V.permutations (toVector t)  -------------------------------------------------------------------------------- --

@@ -84,6 +84,7 @@   , mapM, mapM_, forM, forM_   , foldl', ifoldl', foldl1', foldl1Maybe'   , foldr', ifoldr', foldr1', foldr1Maybe'+  , shuffle, permutations     -- ** Special folds   , concat, concatR, concatMap   , maximum, minimum, maximumMaybe, minimumMaybe

@@ -44,6 +44,7 @@   , mapM, mapM_, forM, forM_   , foldl', ifoldl', foldl1', foldl1Maybe'   , foldr', ifoldr', foldr1', foldr1Maybe'+  , shuffle, permutations     -- ** Special folds   , concat, concatR, concatMap   , maximum, minimum, maximumMaybe, minimumMaybe@@ -116,6 +117,7 @@ import           Test.QuickCheck.Arbitrary      (Arbitrary(..), CoArbitrary(..)) import           Test.QuickCheck.Gen            (chooseInt) import           Text.Read                      (Read(..))+import           System.Random.Stateful         (StatefulGen) import           System.IO.Unsafe               (unsafeDupablePerformIO)  import           Z.Data.Array@@ -139,7 +141,7 @@     -- | Create a vector by slicing an array(with offset and length).     fromArr :: IArray v a -> Int -> Int -> v a --- | Change vector types based on same array type, e.g. construct an array from a slice, or vice-versa.+-- | Change vector types based on same array type, e.g. construct a whole slice from an array. arrVec :: (Vec v a, Vec u a, IArray v ~ IArray u) => v a -> u a {-# INLINE arrVec #-} arrVec bs = let (arr, s, l) = toArr bs in fromArr arr s l@@ -761,14 +763,10 @@     -- Keep an eye on its core!     go :: IPair (MArr (IArray v) s a) -> a -> ST s (IPair (MArr (IArray v) s a))     go (IPair i marr) !x = do-        n <- sizeofMutableArr marr-        if i < n-        then do writeArr marr i x-                return (IPair (i+1) marr)-        else do let !n' = n `unsafeShiftL` 1-                !marr' <- resizeMutableArr marr n'-                writeArr marr' i x-                return (IPair (i+1) marr')+        let i' = i+1+        marr' <- doubleMutableArr marr i'+        writeArr marr' i x+        return (IPair i' marr')   -- | A version of 'replicateM' which works on 'Vec', with specialized rules under 'PrimMonad'.@@ -1010,6 +1008,20 @@                     go (i+1) marr                | otherwise = return () +-- | Shuffle a vector using  <https://en.wikipedia.org/wiki/Fisher%E2%80%93Yates_shuffle Fisher-Yates> algorithm.+shuffle :: (StatefulGen g m, PrimMonad m, Vec v a) => g -> v a -> m (v a)+{-# INLINE shuffle #-}+shuffle g (Vec arr s l) = do+    marr <- thawArr arr s l+    shuffleMutableArr g marr 0 l+    arr' <- unsafeFreezeArr marr+    pure $! fromArr arr' 0 l++-- | Generate all permutation of a vector.+permutations :: forall v a. (Vec v a) => v a -> [v a]+{-# INLINE permutations #-}+permutations v = packN (length v) <$> List.permutations (unpack v)+ -------------------------------------------------------------------------------- -- -- Strict folds@@ -1500,3 +1512,4 @@  foreign import ccall unsafe "hs_count_ba" c_count_ba ::     ByteArray# -> Int -> Int -> Word8 -> IO Int+

@@ -88,7 +88,6 @@         return $! fromArr w 0 l)   where     firstPass :: forall s. v a -> Int -> MArr (IArray v) s a -> ST s ()-    {-# INLINABLE firstPass #-}     firstPass !v !i !marr         | i >= l     = return ()         | otherwise = do@@ -97,7 +96,6 @@             firstPass rest (i+mergeTileSize) marr      mergePass :: forall s. MArr (IArray v) s a -> MArr (IArray v) s a -> Int -> ST s (IArray v a)-    {-# INLINABLE mergePass #-}     mergePass !w1 !w2 !blockSiz         | blockSiz >= l = unsafeFreezeArr w1         | otherwise     = do@@ -105,7 +103,6 @@             mergePass w2 w1 (blockSiz*2) -- swap worker array and continue merging      mergeLoop :: forall s. MArr (IArray v) s a -> MArr (IArray v) s a -> Int -> Int -> ST s ()-    {-# INLINABLE mergeLoop #-}     mergeLoop !src !target !blockSiz !i         | i >= l-blockSiz =                 -- remaining elements less than a block             if i >= l@@ -117,7 +114,6 @@             mergeLoop src target blockSiz mergeEnd      mergeBlock :: forall s. MArr (IArray v) s a -> MArr (IArray v) s a -> Int -> Int -> Int -> Int -> Int -> ST s ()-    {-# INLINABLE mergeBlock #-}     mergeBlock !src !target !leftEnd !rightEnd !i !j !k = do         lv <- readArr src i         rv <- readArr src j@@ -152,7 +148,7 @@ insertSort = insertSortBy compare  insertSortBy :: Vec v a => (a -> a -> Ordering) -> v a -> v a-{-# INLINABLE insertSortBy #-}+{-# INLINE insertSortBy #-} insertSortBy cmp v@(Vec _ _ l) | l <= 1 = v                                | otherwise = create l (insertSortToMArr cmp v 0) @@ -162,7 +158,7 @@                   -> Int            -- writing offset in the mutable array                   -> MArr (IArray v) s a   -- writing mutable array, must have enough space!                   -> ST s ()-{-# INLINABLE insertSortToMArr #-}+{-# INLINE insertSortToMArr #-} insertSortToMArr cmp (Vec arr s l) moff marr = go s   where     !end = s + l@@ -171,7 +167,7 @@           | otherwise = case indexArr' arr i of                (# x #) -> do insert x (i+doff)                              go (i+1)-    insert !temp !i+    insert temp !i         | i <= moff = do             writeArr marr moff temp         | otherwise = do@@ -307,7 +303,6 @@     buktSiz = bucketSize (undefined :: a)     !end = s + l -    {-# INLINABLE firstCountPass #-}     firstCountPass :: forall s. IArray v a -> MutablePrimArray s Int -> Int -> ST s ()     firstCountPass !arr' !bucket !i         | i >= end  = return ()@@ -318,7 +313,6 @@                 writeArr bucket r (c+1)                 firstCountPass arr' bucket (i+1) -    {-# INLINABLE accumBucket #-}     accumBucket :: forall s. MutablePrimArray s Int -> Int -> Int -> Int -> ST s ()     accumBucket !bucket !bsiz !i !acc         | i >= bsiz = return ()@@ -327,7 +321,6 @@             writeArr bucket i acc             accumBucket bucket bsiz (i+1) (acc+c) -    {-# INLINABLE firstMovePass #-}     firstMovePass :: forall s. IArray v a -> Int -> MutablePrimArray s Int -> MArr (IArray v) s a -> ST s ()     firstMovePass !arr' !i !bucket !w         | i >= end  = return ()@@ -339,7 +332,6 @@                 writeArr w c x                 firstMovePass arr' (i+1) bucket w -    {-# INLINABLE radixLoop #-}     radixLoop :: forall s. MArr (IArray v) s a -> MArr (IArray v) s a -> MutablePrimArray s Int -> Int -> Int -> ST s ((IArray v) a)     radixLoop !w1 !w2 !bucket !bsiz !pass         | pass >= passSiz-1 = do@@ -355,7 +347,6 @@             movePass w1 bucket pass w2 0             radixLoop w2 w1 bucket bsiz (pass+1) -    {-# INLINABLE countPass #-}     countPass :: forall s. MArr (IArray v) s a -> MutablePrimArray s Int -> Int -> Int -> ST s ()     countPass !marr !bucket !pass !i         | i >= l  = return ()@@ -366,7 +357,6 @@                 writeArr bucket r (c+1)                 countPass marr bucket pass (i+1) -    {-# INLINABLE movePass #-}     movePass :: forall s. MArr (IArray v) s a -> MutablePrimArray s Int -> Int -> MArr (IArray v) s a -> Int -> ST s ()     movePass !src !bucket !pass !target !i         | i >= l  = return ()@@ -378,7 +368,6 @@                 writeArr target c x                 movePass src bucket pass target (i+1) -    {-# INLINABLE lastCountPass #-}     lastCountPass :: forall s. MArr (IArray v) s a -> MutablePrimArray s Int -> Int -> ST s ()     lastCountPass !marr !bucket !i         | i >= l  = return ()@@ -389,7 +378,6 @@                 writeArr bucket r (c+1)                 lastCountPass marr bucket (i+1) -    {-# INLINABLE lastMovePass #-}     lastMovePass :: forall s. MArr (IArray v) s a -> MutablePrimArray s Int -> MArr (IArray v) s a -> Int -> ST s ()     lastMovePass !src !bucket !target !i         | i >= l  = return ()

@@ -38,61 +38,9 @@ #include <simdutf8check.h> #endif -HsInt ascii_validate(const char* p, HsInt off, HsInt len){-    const char* q = p + off;-#if defined(AVX512_IMPLEMENTATION)-    return (HsInt)validate_ascii_fast_avx512(q, (size_t)len);-#elif defined(__AVX2__)-    return (HsInt)validate_ascii_fast_avx(q, (size_t)len);-#elif defined(__SSSE3__) -    return (HsInt)validate_ascii_fast(q, (size_t)len);-#else-    return (HsInt)ascii_u64(q, (size_t)len);-#endif-}-// for some reason unknown, on windows we have to supply a seperated version of ascii_validate-// otherwise we got segfault if we import the same FFI with different type (Addr# vs ByteArray#)-HsInt ascii_validate_addr(const char* p, HsInt len){-#if defined(AVX512_IMPLEMENTATION)-    return (HsInt)validate_ascii_fast_avx512(p, (size_t)len);-#elif defined(__AVX2__)-    return (HsInt)validate_ascii_fast_avx(p, (size_t)len);-#elif defined(__SSSE3__) -    return (HsInt)validate_ascii_fast(p, (size_t)len);-#else-    return (HsInt)ascii_u64(p, (size_t)len);-#endif-}--HsInt utf8_validate(const char* p, HsInt off, HsInt len){-    const char* q = p + off;-#if defined(AVX512_IMPLEMENTATION)-    return (HsInt)validate_utf8_fast_avx512(q, (size_t)len);-#elif defined(__AVX2__)-    return (HsInt)validate_utf8_fast_avx(q, (size_t)len);-#elif defined(__SSSE3__) -    return (HsInt)validate_utf8_fast(q, (size_t)len);-#else-    return utf8_validate_slow(q, (size_t)len);-#endif-}-// for some reason unknown, on windows we have to supply a seperated version of utf8_validate-// otherwise we got segfault if we import the same FFI with different type (Addr# vs ByteArray#)-HsInt utf8_validate_addr(const char* p, HsInt len){-#if defined(AVX512_IMPLEMENTATION)-    return (HsInt)validate_utf8_fast_avx512(p, (size_t)len);-#elif defined(__AVX2__)-    return (HsInt)validate_utf8_fast_avx(p, (size_t)len);-#elif defined(__SSSE3__) -    return (HsInt)validate_utf8_fast(p, (size_t)len);-#else-    return utf8_validate_slow(p, (size_t)len);-#endif-}- //////////////////////////////////////////////////////////////////////////////// -static inline int ascii_u64(const uint8_t *data, size_t len)+int ascii_u64(const uint8_t *data, size_t len) {     uint8_t orall = 0; @@ -170,6 +118,62 @@     }     return ((state == UTF8_ACCEPT) ? 2 : 0); }++////////////////////////////////////////////////////////////////////////////////++HsInt ascii_validate(const char* p, HsInt off, HsInt len){+    const char* q = p + off;+#if defined(AVX512_IMPLEMENTATION)+    return (HsInt)validate_ascii_fast_avx512(q, (size_t)len);+#elif defined(__AVX2__)+    return (HsInt)validate_ascii_fast_avx(q, (size_t)len);+#elif defined(__SSSE3__) +    return (HsInt)validate_ascii_fast(q, (size_t)len);+#else+    return (HsInt)ascii_u64(q, (size_t)len);+#endif+}+// for some reason unknown, on windows we have to supply a seperated version of ascii_validate+// otherwise we got segfault if we import the same FFI with different type (Addr# vs ByteArray#)+HsInt ascii_validate_addr(const char* p, HsInt len){+#if defined(AVX512_IMPLEMENTATION)+    return (HsInt)validate_ascii_fast_avx512(p, (size_t)len);+#elif defined(__AVX2__)+    return (HsInt)validate_ascii_fast_avx(p, (size_t)len);+#elif defined(__SSSE3__) +    return (HsInt)validate_ascii_fast(p, (size_t)len);+#else+    return (HsInt)ascii_u64(p, (size_t)len);+#endif+}++HsInt utf8_validate(const char* p, HsInt off, HsInt len){+    const char* q = p + off;+#if defined(AVX512_IMPLEMENTATION)+    return (HsInt)validate_utf8_fast_avx512(q, (size_t)len);+#elif defined(__AVX2__)+    return (HsInt)validate_utf8_fast_avx(q, (size_t)len);+#elif defined(__SSSE3__) +    return (HsInt)validate_utf8_fast(q, (size_t)len);+#else+    return utf8_validate_slow(q, (size_t)len);+#endif+}+// for some reason unknown, on windows we have to supply a seperated version of utf8_validate+// otherwise we got segfault if we import the same FFI with different type (Addr# vs ByteArray#)+HsInt utf8_validate_addr(const char* p, HsInt len){+#if defined(AVX512_IMPLEMENTATION)+    return (HsInt)validate_utf8_fast_avx512(p, (size_t)len);+#elif defined(__AVX2__)+    return (HsInt)validate_utf8_fast_avx(p, (size_t)len);+#elif defined(__SSSE3__) +    return (HsInt)validate_utf8_fast(p, (size_t)len);+#else+    return utf8_validate_slow(p, (size_t)len);+#endif+}++////////////////////////////////////////////////////////////////////////////////  static inline uint32_t decode_hex(uint32_t c) {     if (c >= '0' && c <= '9')      return c - '0';