Z-Data 0.1.5.0 → 0.1.6.0

raw patch · 45 files changed

+1116/−1166 lines, 45 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• Z-Data.cabal +37/−3
• Z/Data/Array.hs +0/−15
• Z/Data/Array/Cast.hs +0/−7
• Z/Data/Array/Checked.hs +0/−4
• Z/Data/Array/QQ.hs +0/−7
• Z/Data/Array/Unaligned.hs +26/−36
• Z/Data/Array/UnliftedArray.hs +36/−33
• Z/Data/Builder.hs +0/−9
• Z/Data/Builder/Base.hs +4/−14
• Z/Data/Builder/Numeric.hs +2/−32
• Z/Data/Builder/Numeric/DigitTable.hs +0/−1
• Z/Data/CBytes.hs +28/−11
• Z/Data/Generics/Utils.hs +0/−11
• Z/Data/JSON/Base.hs +120/−60
• Z/Data/JSON/Builder.hs +6/−38
• Z/Data/JSON/Value.hs +2/−12
• Z/Data/Parser.hs +0/−7
• Z/Data/Parser/Base.hs +6/−9
• Z/Data/Parser/Numeric.hs +0/−5
• Z/Data/PrimRef/PrimIORef.hs +0/−4
• Z/Data/PrimRef/PrimSTRef.hs +0/−2
• Z/Data/Text.hs +0/−6
• Z/Data/Text/Base.hs +24/−13
• Z/Data/Text/Builder.hs +0/−598
• Z/Data/Text/Extra.hs +2/−7
• Z/Data/Text/Search.hs +0/−7
• Z/Data/Text/ShowT.hs +694/−0
• Z/Data/Text/UTF8Codec.hs +0/−4
• Z/Data/Text/UTF8Rewind.hsc +2/−5
• Z/Data/Vector.hs +0/−17
• Z/Data/Vector/Base.hs +1/−21
• Z/Data/Vector/Extra.hs +6/−10
• Z/Data/Vector/FlatIntMap.hs +2/−11
• Z/Data/Vector/FlatIntSet.hs +7/−13
• Z/Data/Vector/FlatMap.hs +2/−12
• Z/Data/Vector/FlatSet.hs +9/−16
• Z/Data/Vector/QQ.hs +0/−4
• Z/Data/Vector/Search.hs +0/−6
• Z/Data/Vector/Sort.hs +26/−18
• Z/Foreign.hs +0/−4
• test/Z/Data/Text/BuilderSpec.hs +0/−68
• test/Z/Data/Text/ExtraSpec.hs +0/−3
• test/Z/Data/Text/SearchSpec.hs +0/−3
• test/Z/Data/Text/ShowTSpec.hs +68/−0

@@ -1,5 +1,11 @@ # Revision history for Z-Data +## 0.1.6.0  -- 2020-10-09++* Rename `ToText` to `ShowT`, `toText` to `showT`, add FFI types instances.+* Change `Text` 's `Show` and `ShowT` escaping rules to reuse JSON escaping, remove `Read` instance.+* Add `ShowT` instances to `CBytes` and FFI types.+ ## 0.1.5.0  -- 2020-10-02  * Rework `CBytes` type to use unpinned byte array, add `withCBytesUnsafe`, `allocCBytesUnsafe`.

@@ -1,6 +1,6 @@ cabal-version:              2.4 name:                       Z-Data-version:                    0.1.5.0+version:                    0.1.6.0 synopsis:                   Array, vector and text description:                This package provides array, slice and text operations license:                    BSD-3-Clause@@ -84,9 +84,9 @@                             Z.Data.Text.Base                             Z.Data.Text.Extra                             Z.Data.Text.Search+                            Z.Data.Text.ShowT                             Z.Data.Text.UTF8Codec                             Z.Data.Text.UTF8Rewind-                            Z.Data.Text.Builder                              Z.Data.Builder                             Z.Data.Builder.Base@@ -168,6 +168,40 @@                             -Wno-unticked-promoted-constructors                             -Wno-incomplete-patterns                             -- ploymorphic pattern synonym messed exhaustiveness checker+    default-extensions:     BangPatterns+                            CApiFFI+                            ConstraintKinds+                            CPP +                            DerivingStrategies+                            DeriveGeneric+                            DeriveAnyClass+                            DefaultSignatures+                            DataKinds+                            FlexibleContexts+                            FlexibleInstances+                            GeneralizedNewtypeDeriving +                            KindSignatures+                            MagicHash+                            MultiParamTypeClasses+                            PartialTypeSignatures+                            PatternSynonyms +                            PolyKinds+                            QuantifiedConstraints+                            QuasiQuotes+                            OverloadedStrings+                            RankNTypes+                            RecordWildCards+                            ScopedTypeVariables +                            StandaloneDeriving+                            TemplateHaskell+                            TypeApplications+                            TypeFamilyDependencies+                            TypeFamilies+                            TypeOperators+                            TupleSections+                            UnboxedTuples +                            UnliftedFFITypes +                            ViewPatterns  test-suite Z-Data-Test     type:                   exitcode-stdio-1.0@@ -185,7 +219,7 @@                             Z.Data.Parser.NumericSpec                             Z.Data.Array.UnalignedSpec                             Z.Data.Text.BaseSpec-                            Z.Data.Text.BuilderSpec+                            Z.Data.Text.ShowTSpec                             Z.Data.Text.ExtraSpec                             Z.Data.Text.SearchSpec                             Z.Data.Vector.BaseSpec

@@ -1,18 +1,3 @@-{-# LANGUAGE BangPatterns      #-}-{-# LANGUAGE TypeFamilyDependencies #-}-{-# LANGUAGE CPP                    #-}-{-# LANGUAGE FlexibleContexts       #-}-{-# LANGUAGE FlexibleInstances      #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE KindSignatures         #-}-{-# LANGUAGE MagicHash              #-}-{-# LANGUAGE MultiParamTypeClasses  #-}-{-# LANGUAGE ScopedTypeVariables    #-}-{-# LANGUAGE TypeFamilies           #-}-{-# LANGUAGE UnboxedTuples          #-}-{-# LANGUAGE UnliftedFFITypes       #-}-- {-| Module      : Z.Data.Array Description : Fast boxed and unboxed arrays

@@ -1,10 +1,3 @@-{-# LANGUAGE ConstraintKinds       #-}-{-# LANGUAGE CPP                   #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE DefaultSignatures     #-}-{-# LANGUAGE MagicHash             #-}-{-# LANGUAGE MultiParamTypeClasses #-}- {-| Module      : Z.Data.Array.Cast Description : Primitive casting

@@ -1,7 +1,3 @@-{-# LANGUAGE CPP           #-}-{-# LANGUAGE TypeFamilies  #-}-{-# LANGUAGE UnboxedTuples #-}- {-| Module      : Z.Data.Array.Checked Description : Bounded checked boxed and unboxed arrays

@@ -1,10 +1,3 @@-{-# LANGUAGE CPP             #-}-{-# LANGUAGE MagicHash       #-}-{-# LANGUAGE QuasiQuotes     #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TupleSections   #-}-- {-| Module      : Z.Data.Array.QQ Description : Extra stuff for PrimArray related literals

@@ -1,14 +1,4 @@-{-# LANGUAGE BangPatterns      #-}-{-# LANGUAGE CPP               #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MagicHash         #-}-{-# LANGUAGE UnboxedTuples     #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE PolyKinds #-}- {-| Module      : Z.Data.Array.Unaligned Description : unaligned access for primitive arrays@@ -895,29 +885,29 @@ --------------------------------------------------------------------------------  -- Prim instances for newtypes in Foreign.C.Types-deriving instance Unaligned CChar-deriving instance Unaligned CSChar-deriving instance Unaligned CUChar-deriving instance Unaligned CShort-deriving instance Unaligned CUShort-deriving instance Unaligned CInt-deriving instance Unaligned CUInt-deriving instance Unaligned CLong-deriving instance Unaligned CULong-deriving instance Unaligned CPtrdiff-deriving instance Unaligned CSize-deriving instance Unaligned CWchar-deriving instance Unaligned CSigAtomic-deriving instance Unaligned CLLong-deriving instance Unaligned CULLong-deriving instance Unaligned CBool-deriving instance Unaligned CIntPtr-deriving instance Unaligned CUIntPtr-deriving instance Unaligned CIntMax-deriving instance Unaligned CUIntMax-deriving instance Unaligned CClock-deriving instance Unaligned CTime-deriving instance Unaligned CUSeconds-deriving instance Unaligned CSUSeconds-deriving instance Unaligned CFloat-deriving instance Unaligned CDouble+deriving newtype instance Unaligned CChar+deriving newtype instance Unaligned CSChar+deriving newtype instance Unaligned CUChar+deriving newtype instance Unaligned CShort+deriving newtype instance Unaligned CUShort+deriving newtype instance Unaligned CInt+deriving newtype instance Unaligned CUInt+deriving newtype instance Unaligned CLong+deriving newtype instance Unaligned CULong+deriving newtype instance Unaligned CPtrdiff+deriving newtype instance Unaligned CSize+deriving newtype instance Unaligned CWchar+deriving newtype instance Unaligned CSigAtomic+deriving newtype instance Unaligned CLLong+deriving newtype instance Unaligned CULLong+deriving newtype instance Unaligned CBool+deriving newtype instance Unaligned CIntPtr+deriving newtype instance Unaligned CUIntPtr+deriving newtype instance Unaligned CIntMax+deriving newtype instance Unaligned CUIntMax+deriving newtype instance Unaligned CClock+deriving newtype instance Unaligned CTime+deriving newtype instance Unaligned CUSeconds+deriving newtype instance Unaligned CSUSeconds+deriving newtype instance Unaligned CFloat+deriving newtype instance Unaligned CDouble

@@ -1,37 +1,40 @@-{-# language MagicHash #-}-{-# language UnboxedTuples #-}-{-# language TypeFamilies #-}-{-# language TypeApplications #-}-{-# language ScopedTypeVariables #-}+{- |+Module      : Z.Data.Array.UnliftedArray+Description : unlifted primitve arrays+Copyright   : (c) Dong Han, 2017-2020+License     : BSD+Maintainer  : winterland1989@gmail.com+Stability   : experimental+Portability : non-portable --- GHC contains three general classes of value types:------   1. Unboxed types: values are machine values made up of fixed numbers of bytes---   2. Unlifted types: values are pointers, but strictly evaluated---   3. Lifted types: values are pointers, lazily evaluated------ The first category can be stored in a 'ByteArray', and this allows types in--- category 3 that are simple wrappers around category 1 types to be stored--- more efficiently using a 'ByteArray'. This module provides the same facility--- for category 2 types.------ GHC has two primitive types, 'ArrayArray#' and 'MutableArrayArray#'. These--- are arrays of pointers, but of category 2 values, so they are known to not--- be bottom. This allows types that are wrappers around such types to be stored--- in an array without an extra level of indirection.------ The way that the 'ArrayArray#' API works is that one can read and write--- 'ArrayArray#' values to the positions. This works because all category 2--- types share a uniform representation, unlike unboxed values which are--- represented by varying (by type) numbers of bytes. However, using the--- this makes the internal API very unsafe to use, as one has to coerce values--- to and from 'ArrayArray#'.------ The API presented by this module is more type safe. 'UnliftedArray' and--- 'MutableUnliftedArray' are parameterized by the type of arrays they contain, and--- the coercions necessary are abstracted into a class, 'PrimUnlifted', of things--- that are eligible to be stored.---+GHC contains three general classes of value types:++  1. Unboxed types: values are machine values made up of fixed numbers of bytes+  2. Unlifted types: values are pointers, but strictly evaluated+  3. Lifted types: values are pointers, lazily evaluated++The first category can be stored in a 'ByteArray', and this allows types in+category 3 that are simple wrappers around category 1 types to be stored+more efficiently using a 'ByteArray'. This module provides the same facility+for category 2 types.++GHC has two primitive types, 'ArrayArray#' and 'MutableArrayArray#'. These+are arrays of pointers, but of category 2 values, so they are known to not+be bottom. This allows types that are wrappers around such types to be stored+in an array without an extra level of indirection.++The way that the 'ArrayArray#' API works is that one can read and write+'ArrayArray#' values to the positions. This works because all category 2+types share a uniform representation, unlike unboxed values which are+represented by varying (by type) numbers of bytes. However, using the+this makes the internal API very unsafe to use, as one has to coerce values+to and from 'ArrayArray#'.++The API presented by this module is more type safe. 'UnliftedArray' and+'MutableUnliftedArray' are parameterized by the type of arrays they contain, and+the coercions necessary are abstracted into a class, 'PrimUnlifted', of things+that are eligible to be stored.+-} module Z.Data.Array.UnliftedArray where  import Control.Monad.Primitive

@@ -1,12 +1,3 @@-{-# LANGUAGE BangPatterns        #-}-{-# LANGUAGE CPP                 #-}-{-# LANGUAGE FlexibleContexts    #-}-{-# LANGUAGE FlexibleInstances   #-}-{-# LANGUAGE MagicHash           #-}-{-# LANGUAGE RankNTypes          #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE UnboxedTuples       #-}- {-| Module      : Z.Data.Builder Description : Efficient serialization/format.

@@ -1,14 +1,3 @@-{-# LANGUAGE BangPatterns        #-}-{-# LANGUAGE CPP                 #-}-{-# LANGUAGE FlexibleContexts    #-}-{-# LANGUAGE FlexibleInstances   #-}-{-# LANGUAGE MagicHash           #-}-{-# LANGUAGE RankNTypes          #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies        #-}-{-# LANGUAGE TypeApplications    #-}-{-# LANGUAGE UnboxedTuples       #-}- {-| Module      : Z.Data.Builder.Base Description : Efficient serialization/format.@@ -155,6 +144,8 @@     mconcat = foldr append (pure ())     {-# INLINE mconcat #-} +-- | This instance simple write literals' bytes into buffer,+-- which is different from 'stringUTF8' in that it DOES NOT PROVIDE UTF8 GUARANTEES! : instance (a ~ ()) => IsString (Builder a) where     {-# INLINE fromString #-}     fromString = stringModifiedUTF8@@ -430,9 +421,8 @@ -- -- Illegal codepoints will be written as 'T.replacementChar's. ----- Note, if you're trying to write string literals builders, and you know it doen't contain--- '\NUL' or surrgate codepoints, then you can open 'OverloadedStrings' and use 'Builder''s--- 'IsString' instance, it can save an extra UTF-8 validation.+-- This is different from writing string literals builders via @OverloadedStrings@, because string literals+-- do not provide UTF8 guarantees. -- -- This function will be rewritten into a memcpy if possible, (running a fast UTF-8 validation -- at runtime first).

@@ -1,15 +1,3 @@-{-# LANGUAGE BangPatterns        #-}-{-# LANGUAGE CPP                 #-}-{-# LANGUAGE MagicHash           #-}-{-# LANGUAGE OverloadedStrings   #-}-{-# LANGUAGE RankNTypes          #-}-{-# LANGUAGE RecordWildCards     #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies        #-}-{-# LANGUAGE TypeApplications    #-}-{-# LANGUAGE UnboxedTuples       #-}-{-# LANGUAGE UnliftedFFITypes    #-}- {-| Module      : Z.Data.Builder.Numeric Description : Textual numeric builders.@@ -497,16 +485,7 @@  -- | Format a 'FiniteBits' 'Integral' type into hex nibbles. hex :: forall a. (FiniteBits a, Integral a) => a -> Builder ()-{-# SPECIALIZE INLINE hex :: Int    -> Builder () #-}-{-# SPECIALIZE INLINE hex :: Int8   -> Builder () #-}-{-# SPECIALIZE INLINE hex :: Int16  -> Builder () #-}-{-# SPECIALIZE INLINE hex :: Int32  -> Builder () #-}-{-# SPECIALIZE INLINE hex :: Int64  -> Builder () #-}-{-# SPECIALIZE INLINE hex :: Word   -> Builder () #-}-{-# SPECIALIZE INLINE hex :: Word8  -> Builder () #-}-{-# SPECIALIZE INLINE hex :: Word16 -> Builder () #-}-{-# SPECIALIZE INLINE hex :: Word32 -> Builder () #-}-{-# SPECIALIZE INLINE hex :: Word64 -> Builder () #-}+{-# INLINE hex #-} hex w = writeN hexSiz (go w (hexSiz-2))   where     bitSiz = finiteBitSize (undefined :: a)@@ -528,16 +507,7 @@  -- | The UPPERCASED version of 'hex'. heX :: forall a. (FiniteBits a, Integral a) => a -> Builder ()-{-# SPECIALIZE INLINE heX :: Int    -> Builder () #-}-{-# SPECIALIZE INLINE heX :: Int8   -> Builder () #-}-{-# SPECIALIZE INLINE heX :: Int16  -> Builder () #-}-{-# SPECIALIZE INLINE heX :: Int32  -> Builder () #-}-{-# SPECIALIZE INLINE heX :: Int64  -> Builder () #-}-{-# SPECIALIZE INLINE heX :: Word   -> Builder () #-}-{-# SPECIALIZE INLINE heX :: Word8  -> Builder () #-}-{-# SPECIALIZE INLINE heX :: Word16 -> Builder () #-}-{-# SPECIALIZE INLINE heX :: Word32 -> Builder () #-}-{-# SPECIALIZE INLINE heX :: Word64 -> Builder () #-}+{-# INLINE heX #-} heX w = writeN hexSiz (go w (hexSiz-2))   where     bitSiz = finiteBitSize (undefined :: a)

@@ -1,4 +1,3 @@-{-# LANGUAGE MagicHash #-} {-# LANGUAGE NoCPP     #-}  {-|

@@ -1,11 +1,3 @@-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE UnliftedFFITypes #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE PatternSynonyms #-} {-| Module      : Z.Data.CBytes Description : Null-ternimated byte string.@@ -27,7 +19,7 @@   , unpack   , null , length   , empty, append, concat, intercalate, intercalateElem-  , toBytes, fromBytes, toText, toTextMaybe, fromText+  , toBytes, fromBytes, toText, toTextMaybe, fromText, toBuilder, buildCBytes   , fromCString, fromCStringN   , withCBytesUnsafe, withCBytes, allocCBytesUnsafe, allocCBytes   -- re-export@@ -36,7 +28,6 @@   ) where  import           Control.DeepSeq-import           Control.Exception (Exception, throwIO) import           Control.Monad import           Control.Monad.Primitive import           Control.Monad.ST@@ -44,7 +35,6 @@ import           Data.Foldable           (foldlM) import           Data.Hashable           (Hashable(..)) import qualified Data.List               as List-import           Data.Typeable import           Data.Primitive.PrimArray import           Data.Word import           Foreign.C.String@@ -65,11 +55,14 @@                                           zipWith) import           Z.Data.Array import           Z.Data.Array.Unaligned+import qualified Z.Data.Builder        as B import qualified Z.Data.Text           as T+import qualified Z.Data.Text.ShowT     as T import           Z.Data.Text.UTF8Codec (encodeCharModifiedUTF8, decodeChar) import qualified Z.Data.Vector.Base    as V import           Z.Foreign import           System.IO.Unsafe        (unsafeDupablePerformIO)+import           Test.QuickCheck.Arbitrary (Arbitrary(..), CoArbitrary(..))  -- | A efficient wrapper for short immutable null-terminated byte sequences which can be -- automatically freed by ghc garbage collector.@@ -149,6 +142,13 @@     hashWithSalt salt (CBytes pa@(PrimArray ba#)) = unsafeDupablePerformIO $ do         V.c_fnv_hash_ba ba# 0 (sizeofPrimArray pa) salt +instance Arbitrary CBytes where+    arbitrary = pack <$> arbitrary+    shrink a = pack <$> shrink (unpack a)++instance CoArbitrary CBytes where+    coarbitrary = coarbitrary . unpack+ -- | This instance peek bytes until @\NUL@(or input chunk ends), poke bytes with an extra \NUL terminator. instance Unaligned CBytes where     {-# INLINE unalignedSize #-}@@ -181,6 +181,11 @@         pa <- unsafeFreezePrimArray mpa         return (CBytes pa)) +-- | This instance provide UTF8 guarantee, illegal codepoints will be written as 'T.replacementChar's.+instance T.ShowT CBytes where+    {-# INLINE toTextBuilder #-}+    toTextBuilder _ = T.stringUTF8 . show . unpack+ append :: CBytes -> CBytes -> CBytes {-# INLINABLE append #-} append strA@(CBytes pa) strB@(CBytes pb)@@ -408,6 +413,18 @@ fromText :: T.Text -> CBytes {-# INLINABLE fromText #-} fromText = fromBytes . T.getUTF8Bytes+++-- | Write 'CBytes' \'s byte sequence to buffer.+--+-- This function is different from 'ShowT' instance in that it directly write byte sequence without+-- checking if it's UTF8 encoded.+toBuilder :: CBytes -> B.Builder ()+toBuilder = B.bytes . toBytes++-- | Build a 'CBytes' with builder, result will be trimmed down to first byte before @\NUL@ byte if there's any.+buildCBytes :: B.Builder a -> CBytes+buildCBytes = fromBytes . B.buildBytes  -------------------------------------------------------------------------------- 

@@ -1,15 +1,4 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FunctionalDependencies #-}-  module Z.Data.Generics.Utils   ( ProductSize(..)

@@ -1,27 +1,3 @@-{-# LANGUAGE CPP                   #-}-{-# LANGUAGE BangPatterns          #-}-{-# LANGUAGE DataKinds             #-}-{-# LANGUAGE DefaultSignatures     #-}-{-# LANGUAGE DeriveAnyClass        #-}-{-# LANGUAGE DeriveDataTypeable    #-}-{-# LANGUAGE DeriveGeneric         #-}-{-# LANGUAGE DerivingStrategies    #-}-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE KindSignatures        #-}-{-# LANGUAGE MagicHash             #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings     #-}-{-# LANGUAGE QuantifiedConstraints #-}-{-# LANGUAGE RankNTypes            #-}-{-# LANGUAGE ScopedTypeVariables   #-}-{-# LANGUAGE StandaloneDeriving    #-}-{-# LANGUAGE TypeApplications      #-}-{-# LANGUAGE TypeFamilies          #-}-{-# LANGUAGE TypeOperators         #-}-{-# LANGUAGE PartialTypeSignatures #-}- {-| Module      : Z.Data.JSON.Base Description : Fast JSON serialization/deserialization@@ -84,7 +60,7 @@ import qualified Data.Monoid                  as Monoid import           Data.Primitive.Types         (Prim) import qualified Data.Primitive.SmallArray    as A-import           Data.Proxy                   (Proxy (..))+import           Data.Proxy                   (Proxy(..)) import           Data.Ratio                   (Ratio, (%), numerator, denominator) import           Data.Scientific              (Scientific, base10Exponent, toBoundedInteger) import qualified Data.Scientific              as Scientific@@ -92,6 +68,7 @@ import           Data.Tagged                  (Tagged (..)) import           Data.Version                 (Version, parseVersion) import           Data.Word+import           Foreign.C.Types import           GHC.Exts                     (Proxy#, proxy#) import           GHC.Generics import           GHC.Natural@@ -103,7 +80,7 @@ import qualified Z.Data.Parser              as P import qualified Z.Data.Parser.Numeric      as P import qualified Z.Data.Text                as T-import qualified Z.Data.Text.Builder        as TB+import qualified Z.Data.Text.ShowT          as T import qualified Z.Data.Vector.Base         as V import qualified Z.Data.Vector.Extra        as V import qualified Z.Data.Vector.FlatIntMap   as FIM@@ -169,12 +146,12 @@ -- | Text version 'encodeBytes'. encodeText :: EncodeJSON a => a -> T.Text {-# INLINE encodeText #-}-encodeText = TB.buildText . encodeTextBuilder+encodeText = T.buildText . encodeTextBuilder  -- | JSON Docs are guaranteed to be valid UTF-8 texts, so we provide this.-encodeTextBuilder :: EncodeJSON a => a -> TB.TextBuilder ()+encodeTextBuilder :: EncodeJSON a => a -> T.TextBuilder () {-# INLINE encodeTextBuilder #-}-encodeTextBuilder = TB.unsafeFromBuilder . encodeJSON+encodeTextBuilder = T.unsafeFromBuilder . encodeJSON  -- | Run a 'Converter' with input value. convert :: (a -> Converter r) -> a -> Either ConvertError r@@ -204,14 +181,14 @@  instance Show ConvertError where     -- TODO use standard format-    show (ConvertError paths msg) = T.unpack . TB.buildText $ do+    show (ConvertError paths msg) = T.unpack . T.buildText $ do         "<"         mapM_ renderPath (reverse paths)         "> "-        TB.text msg+        T.text msg       where-        renderPath (Index ix) = TB.char7 '[' >> TB.int ix >> TB.char7 ']'-        renderPath (Key k) = TB.char7 '.' >> (TB.unsafeFromBuilder $ JB.string k)+        renderPath (Index ix) = T.char7 '[' >> T.int ix >> T.char7 ']'+        renderPath (Key k) = T.char7 '.' >> (T.unsafeFromBuilder $ JB.string k)         renderPath Embedded = "<Embedded>"  -- | 'Converter' for convert result from JSON 'Value'.@@ -351,11 +328,11 @@ {-# INLINE withBoundedScientific #-} withBoundedScientific name f (Number x)     | e <= 1024 = f x-    | otherwise = fail' . TB.buildText $ do+    | otherwise = fail' . T.buildText $ do         "converting "-        TB.text name+        T.text name         " failed, found a number with exponent "-        TB.int e+        T.int e         ", but it must not be greater than 1024"   where e = base10Exponent x withBoundedScientific name _ v = typeMismatch name "Number" v@@ -367,11 +344,11 @@ withBoundedIntegral name f (Number x) =     case toBoundedInteger x of         Just i -> f i-        _      -> fail' . TB.buildText $ do+        _      -> fail' . T.buildText $ do             "converting "-            TB.text name+            T.text name             "failed, value is either floating or will cause over or underflow "-            TB.scientific x+            T.scientific x withBoundedIntegral name _ v = typeMismatch name "Number" v  withText :: T.Text -> (T.Text -> Converter a) -> Value -> Converter a@@ -804,13 +781,13 @@ instance GBuildLookup (S1 (MetaSel Nothing u ss ds) f) where     {-# INLINE gBuildLookup #-}     gBuildLookup _ siz name (Array v)-        | siz' /= siz = fail' . TB.buildText $ do+        | siz' /= siz = fail' . T.buildText $ do             "converting "-            TB.text name+            T.text name             " failed, product size mismatch, expected "-            TB.int siz+            T.int siz             ", get"-            TB.int siz'+            T.int siz'         | otherwise = pure v       where siz' = V.length v     gBuildLookup _ _   name x         = typeMismatch name "Array" x@@ -818,13 +795,13 @@ instance GBuildLookup (S1 ((MetaSel (Just l) u ss ds)) f) where     {-# INLINE gBuildLookup #-}     gBuildLookup _ siz name (Object v)-        | siz' /= siz = fail' . TB.buildText $ do+        | siz' /= siz = fail' . T.buildText $ do             "converting "-            TB.text name+            T.text name             " failed, product size mismatch, expected "-            TB.int siz+            T.int siz             ", get"-            TB.int siz'+            T.int siz'         | otherwise = pure m       where siz' = FM.size m             m = FM.packVectorR v@@ -908,15 +885,15 @@ instance ToValue T.Text     where {{-# INLINE toValue #-}; toValue = String;} instance EncodeJSON T.Text where {{-# INLINE encodeJSON #-}; encodeJSON = JB.string;} -instance FromValue TB.Str where+instance FromValue T.Str where     {-# INLINE fromValue #-}-    fromValue = withText "Str" (pure . TB.Str . T.unpack)-instance ToValue TB.Str where+    fromValue = withText "Str" (pure . T.Str . T.unpack)+instance ToValue T.Str where     {-# INLINE toValue #-}-    toValue = String . T.pack . TB.chrs-instance EncodeJSON TB.Str where+    toValue = String . T.pack . T.chrs+instance EncodeJSON T.Str where     {-# INLINE encodeJSON #-}-    encodeJSON = JB.string . T.pack . TB.chrs+    encodeJSON = JB.string . T.pack . T.chrs  instance FromValue Scientific where {{-# INLINE fromValue #-}; fromValue = withScientific "Scientific" pure;} instance ToValue Scientific where {{-# INLINE toValue #-}; toValue = Number;}@@ -971,7 +948,7 @@ instance ToValue a => ToValue (FIM.FlatIntMap a) where     {-# INLINE toValue #-}     toValue = Object . V.map' toKV . FIM.sortedKeyValues-      where toKV (V.IPair i x) = let !k = TB.buildText (TB.int i)+      where toKV (V.IPair i x) = let !k = T.buildText (T.int i)                                      !v = toValue x                                  in (k, v) instance EncodeJSON a => EncodeJSON (FIM.FlatIntMap a) where@@ -1132,9 +1109,9 @@     fromValue = withBoundedScientific "Integer" $ \ n ->         case Scientific.floatingOrInteger n :: Either Double Integer of             Right x -> pure x-            Left _  -> fail' . TB.buildText $ do+            Left _  -> fail' . T.buildText $ do                 "converting Integer failed, unexpected floating number "-                TB.scientific n+                T.scientific n instance ToValue Integer where     {-# INLINE toValue #-}     toValue = Number . fromIntegral@@ -1146,14 +1123,14 @@     {-# INLINE fromValue #-}     fromValue = withBoundedScientific "Natural" $ \ n ->         if n < 0-        then fail' . TB.buildText $ do+        then fail' . T.buildText $ do                 "converting Natural failed, unexpected negative number "-                TB.scientific n+                T.scientific n         else case Scientific.floatingOrInteger n :: Either Double Natural of             Right x -> pure x-            Left _  -> fail' . TB.buildText $ do+            Left _  -> fail' . T.buildText $ do                 "converting Natural failed, unexpected floating number "-                TB.scientific n+                T.scientific n instance ToValue Natural where     {-# INLINE toValue #-}     toValue = Number . fromIntegral@@ -1291,6 +1268,89 @@ deriving newtype instance EncodeJSON a => EncodeJSON (Identity a) deriving newtype instance EncodeJSON a => EncodeJSON (Const a b) deriving newtype instance EncodeJSON b => EncodeJSON (Tagged a b)++--------------------------------------------------------------------------------++deriving newtype instance FromValue CChar+deriving newtype instance FromValue CSChar+deriving newtype instance FromValue CUChar+deriving newtype instance FromValue CShort+deriving newtype instance FromValue CUShort+deriving newtype instance FromValue CInt+deriving newtype instance FromValue CUInt+deriving newtype instance FromValue CLong+deriving newtype instance FromValue CULong+deriving newtype instance FromValue CPtrdiff+deriving newtype instance FromValue CSize+deriving newtype instance FromValue CWchar+deriving newtype instance FromValue CSigAtomic+deriving newtype instance FromValue CLLong+deriving newtype instance FromValue CULLong+deriving newtype instance FromValue CBool+deriving newtype instance FromValue CIntPtr+deriving newtype instance FromValue CUIntPtr+deriving newtype instance FromValue CIntMax+deriving newtype instance FromValue CUIntMax+deriving newtype instance FromValue CClock+deriving newtype instance FromValue CTime+deriving newtype instance FromValue CUSeconds+deriving newtype instance FromValue CSUSeconds+deriving newtype instance FromValue CFloat+deriving newtype instance FromValue CDouble++deriving newtype instance ToValue CChar+deriving newtype instance ToValue CSChar+deriving newtype instance ToValue CUChar+deriving newtype instance ToValue CShort+deriving newtype instance ToValue CUShort+deriving newtype instance ToValue CInt+deriving newtype instance ToValue CUInt+deriving newtype instance ToValue CLong+deriving newtype instance ToValue CULong+deriving newtype instance ToValue CPtrdiff+deriving newtype instance ToValue CSize+deriving newtype instance ToValue CWchar+deriving newtype instance ToValue CSigAtomic+deriving newtype instance ToValue CLLong+deriving newtype instance ToValue CULLong+deriving newtype instance ToValue CBool+deriving newtype instance ToValue CIntPtr+deriving newtype instance ToValue CUIntPtr+deriving newtype instance ToValue CIntMax+deriving newtype instance ToValue CUIntMax+deriving newtype instance ToValue CClock+deriving newtype instance ToValue CTime+deriving newtype instance ToValue CUSeconds+deriving newtype instance ToValue CSUSeconds+deriving newtype instance ToValue CFloat+deriving newtype instance ToValue CDouble++deriving newtype instance EncodeJSON CChar+deriving newtype instance EncodeJSON CSChar+deriving newtype instance EncodeJSON CUChar+deriving newtype instance EncodeJSON CShort+deriving newtype instance EncodeJSON CUShort+deriving newtype instance EncodeJSON CInt+deriving newtype instance EncodeJSON CUInt+deriving newtype instance EncodeJSON CLong+deriving newtype instance EncodeJSON CULong+deriving newtype instance EncodeJSON CPtrdiff+deriving newtype instance EncodeJSON CSize+deriving newtype instance EncodeJSON CWchar+deriving newtype instance EncodeJSON CSigAtomic+deriving newtype instance EncodeJSON CLLong+deriving newtype instance EncodeJSON CULLong+deriving newtype instance EncodeJSON CBool+deriving newtype instance EncodeJSON CIntPtr+deriving newtype instance EncodeJSON CUIntPtr+deriving newtype instance EncodeJSON CIntMax+deriving newtype instance EncodeJSON CUIntMax+deriving newtype instance EncodeJSON CClock+deriving newtype instance EncodeJSON CTime+deriving newtype instance EncodeJSON CUSeconds+deriving newtype instance EncodeJSON CSUSeconds+deriving newtype instance EncodeJSON CFloat+deriving newtype instance EncodeJSON CDouble  -------------------------------------------------------------------------------- 

@@ -1,12 +1,3 @@-{-# LANGUAGE BangPatterns       #-}-{-# LANGUAGE CPP                #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric      #-}-{-# LANGUAGE MagicHash          #-}-{-# LANGUAGE OverloadedStrings  #-}-{-# LANGUAGE UnliftedFFITypes   #-}-{-# LANGUAGE TypeApplications   #-}- {-| Module      : Z.Data.JSON.Builder Description : JSON representation and builders@@ -33,19 +24,12 @@   , Value(..)   ) where -import           Control.Monad-import           Control.Monad.ST.Unsafe  (unsafeIOToST)-import           Data.Primitive.PrimArray-import           Data.Word-import           GHC.Prim                 (unsafeCoerce#)-import qualified Z.Data.Builder              as B-import qualified Z.Data.Builder.Base         as B-import qualified Z.Data.Text            as T-import           Z.Data.Vector.Base     as V-import           Z.Foreign-import           Z.Data.JSON.Value      (Value(..))+import qualified Z.Data.Builder                 as B+import qualified Z.Data.Text                    as T+import qualified Z.Data.Text.ShowT              as T+import           Z.Data.Vector.Base             as V+import           Z.Data.JSON.Value              (Value(..)) -#define DOUBLE_QUOTE 34  -- | Use @:@ as separator to connect a label(no need to escape, only add quotes) with field builders. kv :: T.Text -> B.Builder () -> B.Builder ()@@ -100,20 +84,4 @@ -- string :: T.Text -> B.Builder () {-# INLINE string #-}-string (T.Text (V.PrimVector ba@(PrimArray ba#) s l)) = do-    let siz = escape_json_string_length ba# s l-    B.ensureN siz-    B.Builder (\ _  k (B.Buffer mba@(MutablePrimArray mba#) i) -> do-        if siz == l+2   -- no need to escape-        then do-            writePrimArray mba i DOUBLE_QUOTE-            copyPrimArray mba (i+1) ba s l-            writePrimArray mba (i+1+l) DOUBLE_QUOTE-        else void $ unsafeIOToST (escape_json_string ba# s l (unsafeCoerce# mba#) i)-        k () (B.Buffer mba (i+siz)))--foreign import ccall unsafe escape_json_string_length-    :: BA# Word8 -> Int -> Int -> Int--foreign import ccall unsafe escape_json_string-    :: BA# Word8 -> Int -> Int -> MBA# Word8 -> Int -> IO Int+string = T.escapeTextJSON

@@ -1,12 +1,3 @@-{-# LANGUAGE BangPatterns       #-}-{-# LANGUAGE CPP                #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric      #-}-{-# LANGUAGE DeriveAnyClass     #-}-{-# LANGUAGE MagicHash          #-}-{-# LANGUAGE OverloadedStrings  #-}-{-# LANGUAGE UnliftedFFITypes   #-}- {-| Module      : Z.Data.JSON.Value Description : JSON representation and parsers@@ -49,7 +40,6 @@ import           Control.DeepSeq import           Data.Bits                ((.&.)) import           Data.Functor-import           Data.Primitive.PrimArray import           Data.Scientific          (Scientific, scientific) import           Data.Typeable import           Data.Word@@ -57,7 +47,7 @@ import qualified Z.Data.Parser          as P import           Z.Data.Parser          ((<?>)) import qualified Z.Data.Text            as T-import           Z.Data.Text.Builder    (ToText)+import           Z.Data.Text.ShowT     (ShowT(..)) import           Z.Data.Vector.Base     as V import           Z.Data.Vector.Extra    as V import           Z.Foreign@@ -101,7 +91,7 @@            | Number {-# UNPACK #-} !Scientific            | Bool   !Bool            | Null-         deriving (Eq, Show, Typeable, Generic, ToText)+         deriving (Eq, Show, Typeable, Generic, ShowT)  instance NFData Value where     {-# INLINE rnf #-}

@@ -1,10 +1,3 @@-{-# LANGUAGE BangPatterns        #-}-{-# LANGUAGE CPP                 #-}-{-# LANGUAGE FlexibleContexts    #-}-{-# LANGUAGE MagicHash           #-}-{-# LANGUAGE RankNTypes          #-}-{-# LANGUAGE ScopedTypeVariables #-}- {-| Module      : Z.Data.Parser Description : Efficient deserialization/parse.

@@ -1,11 +1,3 @@-{-# LANGUAGE BangPatterns        #-}-{-# LANGUAGE OverloadedStrings   #-}-{-# LANGUAGE CPP                 #-}-{-# LANGUAGE DeriveDataTypeable  #-}-{-# LANGUAGE FlexibleContexts    #-}-{-# LANGUAGE RankNTypes          #-}-{-# LANGUAGE ScopedTypeVariables #-}- {-| Module      : Z.Data.Parser.Base Description : Efficient deserialization/parse.@@ -244,6 +236,7 @@     else Partial (ensureNPartial l inp kf k)   where     {-# INLINABLE ensureNPartial #-}+    ensureNPartial :: forall r. Int -> V.PrimVector Word8 -> (ParseError -> ParseStep r) -> (() -> ParseStep r) -> ParseStep r     ensureNPartial l0 inp0 kf k =         let go acc !l = \ inp -> do                 let l' = V.length inp@@ -367,7 +360,7 @@ -- the predicate on each chunk of the input until one chunk got splited to -- @Right (V.Bytes, V.Bytes)@ or the input ends. ---scanChunks :: s -> (s -> V.Bytes -> Either s (V.Bytes, V.Bytes, s)) -> Parser (V.Bytes, s)+scanChunks :: forall s. s -> (s -> V.Bytes -> Either s (V.Bytes, V.Bytes, s)) -> Parser (V.Bytes, s) {-# INLINE scanChunks #-} scanChunks s0 consume = Parser (\ _ k inp ->     case consume s0 inp of@@ -376,6 +369,7 @@   where     -- we want to inline consume if possible     {-# INLINABLE scanChunksPartial #-}+    scanChunksPartial :: forall r. s -> ((V.PrimVector Word8, s) -> ParseStep r) -> V.PrimVector Word8 -> ParseStep r     scanChunksPartial s0' k inp0 =         let go s acc = \ inp ->                 if V.null inp@@ -530,6 +524,7 @@   where     -- we want to inline p if possible     {-# INLINABLE skipWhilePartial #-}+    skipWhilePartial :: forall r. (() -> ParseStep r) -> ParseStep r     skipWhilePartial k =         let go = \ inp ->                 if V.null inp@@ -573,6 +568,7 @@         else k want rest)   where     {-# INLINABLE takeTillPartial #-}+    takeTillPartial :: forall r. (V.PrimVector Word8 -> ParseStep r) -> V.PrimVector Word8 -> ParseStep r     takeTillPartial k want =         let go acc = \ inp ->                 if V.null inp@@ -598,6 +594,7 @@   where     -- we want to inline p if possible     {-# INLINABLE takeWhilePartial #-}+    takeWhilePartial :: forall r. (V.PrimVector Word8 -> ParseStep r) -> V.PrimVector Word8 -> ParseStep r     takeWhilePartial k want =         let go acc = \ inp ->                 if V.null inp

@@ -1,8 +1,3 @@-{-# LANGUAGE BangPatterns      #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications  #-}-{-# LANGUAGE CPP               #-}- {-| Module      : Z.Data.Parser.Numeric Description : Textual numeric parsers.

@@ -1,7 +1,3 @@-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE BangPatterns #-}- {-| Module      :  Z.Data.PrimIORef Copyright   :  (c) Dong Han 2017~2019

@@ -1,5 +1,3 @@-{-# LANGUAGE MagicHash #-}- {-| Module      :  Z.Data.PrimRef.PrimSTRef Copyright   :  (c) Dong Han 2017~2019

@@ -1,9 +1,3 @@-{-# LANGUAGE MagicHash, UnboxedTuples #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE UnliftedFFITypes #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE PatternSynonyms #-}- {-| Module      : Z.Data.Text Description : Unicode text processing

@@ -1,12 +1,3 @@-{-# LANGUAGE MagicHash, UnboxedTuples #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE UnliftedFFITypes #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE CPP #-}- {-| Module      : Z.Data.Text.Base Description : Unicode text processing@@ -121,6 +112,8 @@   , c_ascii_validate_addr  ) where +#define DOUBLE_QUOTE 34+ import           Control.DeepSeq import           Control.Exception import           Control.Monad.ST@@ -158,7 +151,7 @@ -- newtype Text = Text     { getUTF8Bytes :: Bytes -- ^ Extract UTF-8 encoded 'Bytes' from 'Text'-    } deriving (Semigroup, Monoid, Typeable)+    } deriving newtype (Monoid, Semigroup)  instance Eq Text where     Text b1 == Text b2 = b1 == b2@@ -168,12 +161,28 @@     Text b1 `compare` Text b2 = b1 `compare` b2 -- UTF-8 encoding property     {-# INLINE compare #-} +-- | The escaping rules is different from 'String' 's 'Show' instance, see "Z.Data.Text.Builder.escapeTextJSON" instance Show Text where-    showsPrec p t = showsPrec p (unpack t)+    show = unpack . escapeTextJSON+        where+            escapeTextJSON (Text (V.PrimVector ba@(PrimArray ba#) s l)) = unsafeDupablePerformIO $ do+                let siz = escape_json_string_length ba# s l+                mba@(MutablePrimArray mba#) <- newPrimArray siz+                if siz == l+2   -- no need to escape+                then do+                    writePrimArray mba 0 DOUBLE_QUOTE+                    copyPrimArray mba 1 ba s l+                    writePrimArray mba (l+1) DOUBLE_QUOTE+                else void $ (escape_json_string ba# s l mba# 0)+                ba' <- unsafeFreezePrimArray mba+                return (Text (V.PrimVector ba' 0 siz)) -instance Read Text where-    readsPrec p str = [ (pack x, y) | (x, y) <- readsPrec p str ]+foreign import ccall unsafe escape_json_string_length+    :: ByteArray# -> Int -> Int -> Int +foreign import ccall unsafe escape_json_string+    :: ByteArray# -> Int -> Int -> MutableByteArray# RealWorld -> Int -> IO Int+ instance NFData Text where     rnf (Text bs) = rnf bs @@ -704,6 +713,7 @@ fromVector (V.PrimVector arr s l) = Text (V.createN l (go s 0))   where     end = s+l+    go :: forall s. Int -> Int -> MutablePrimArray s Word8 -> ST s Int     go !i !j !marr         | i >= end = return j         | otherwise = do@@ -717,6 +727,7 @@ toVector (Text (V.PrimVector arr s l)) = V.createN (l*4) (go s 0)   where     end = s+l+    go :: forall s. Int -> Int -> MutablePrimArray s Char -> ST s Int     go !i !j !marr         | i >= end = return j         | otherwise = do

@@ -1,598 +0,0 @@-{-# LANGUAGE CPP                        #-}-{-# LANGUAGE DataKinds                  #-}-{-# LANGUAGE DefaultSignatures          #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE TypeFamilies               #-}-{-# LANGUAGE TypeOperators              #-}-{-# LANGUAGE StandaloneDeriving         #-}-{-# LANGUAGE FlexibleContexts           #-}-{-# LANGUAGE FlexibleInstances          #-}-{-# LANGUAGE DeriveDataTypeable         #-}-{-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE DeriveGeneric              #-}-{-# LANGUAGE DerivingStrategies         #-}-{-# LANGUAGE DeriveAnyClass             #-}--{-|-Module      : Z.Data.Text.Builder-Description : UTF8 compatible builders.-Copyright   : (c) Dong Han, 2017-2019-License     : BSD-Maintainer  : winterland1989@gmail.com-Stability   : experimental-Portability : non-portable--Base on UTF8 compatible textual builders from 'Z.Data.Builder', we provide a newtype wrapper-'TextBuilder' which can be directly used to build 'Text'.--We also provide faster alternative to 'Show' class, i.e. 'ToText', which also provides 'Generic'-based instances deriving.---}--module Z.Data.Text.Builder-  ( -- * ToText class-  ToText(..), toText, toBuilder, toBytes, toString-  -- * Str newtype-  , Str(..)-  -- * Textual Builder-  , TextBuilder-  , getBuilder-  , unsafeFromBuilder-  , buildText-  -- * Basic UTF8 builders-  , stringUTF8, charUTF8, string7, char7, text-  -- * Numeric builders-  -- ** Integral type formatting-  , B.IFormat(..)-  , B.defaultIFormat-  , B.Padding(..)-  , int-  , intWith-  , integer-  -- ** Fixded size hexidecimal formatting-  , hex, heX-  -- ** IEEE float formating-  , B.FFormat(..)-  , double-  , doubleWith-  , float-  , floatWith-  , scientific-  , scientificWith-  -- * Builder helpers-  , paren, parenWhen, curly, square, angle, quotes, squotes, colon, comma, intercalateVec, intercalateList-  ) where--import           Control.Monad-import qualified Data.Scientific          as Sci-import           Data.String-import           Data.Bits-import           Data.Data                (Data(..))-import           Data.Fixed-import           Data.Functor.Compose-import           Data.Functor.Const-import           Data.Functor.Identity-import           Data.Functor.Product-import           Data.Functor.Sum-import           Data.Int-import           Data.List.NonEmpty           (NonEmpty (..))-import qualified Data.Monoid                  as Monoid-import           Data.Proxy                   (Proxy (..))-import           Data.Ratio                   (Ratio, numerator, denominator)-import           Data.Tagged                  (Tagged (..))-import           Data.Word-import qualified Data.Semigroup               as Semigroup-import           Data.Typeable-import           GHC.Natural-import           GHC.Generics-import           Data.Version-import           Data.Primitive.Types-import qualified Z.Data.Builder         as B-import qualified Z.Data.Text.Base       as T-import           Z.Data.Text.Base       (Text(..))-import qualified Z.Data.Vector.Base     as V-import           Text.Read                (Read(..))-import           Test.QuickCheck.Arbitrary (Arbitrary(..), CoArbitrary(..))---- | Buidlers which guarantee UTF-8 encoding, thus can be used to build--- text directly.------ Notes on 'IsString' instance: It's recommended to use 'IsString' instance, there's a rewrite rule to--- turn encoding loop into a memcpy, which is much faster (the same rule also apply to 'stringUTF8').--- Different from @Builder ()@, @TextBuilder ()@'s 'IsString' instance will give you desired UTF8 guarantees:------ * @\NUL@ will be written directly as @\x00@.------ * @\xD800@ ~ @\xDFFF@ will be replaced by replacement char.----newtype TextBuilder a = TextBuilder { getBuilder :: B.Builder a }-    deriving newtype (Functor, Applicative, Monad)--deriving newtype instance Semigroup (TextBuilder ())-deriving newtype instance Monoid (TextBuilder ())--instance (a ~ ()) => IsString (TextBuilder a) where-    {-# INLINE fromString #-}-    fromString = TextBuilder <$> B.stringUTF8--instance Arbitrary (TextBuilder ()) where-    arbitrary = TextBuilder . B.text <$> arbitrary-    shrink b = TextBuilder . B.text <$> shrink (buildText b)--instance CoArbitrary (TextBuilder ()) where-    coarbitrary = coarbitrary . buildText--instance Show (TextBuilder a) where-    show = show . buildText--instance ToText (TextBuilder a) where-    {-# INLINE toTextBuilder #-}-    toTextBuilder _ b = quotes (void b)---- | Build a 'Text' using 'TextBuilder', which provide UTF-8 encoding guarantee.-buildText :: TextBuilder a -> Text-{-# INLINE buildText #-}-buildText = Text . B.buildBytes . getBuilder---- | Unsafely turn a 'B.Builder' into 'TextBuilder', thus it's user's responsibility to--- ensure only UTF-8 complied bytes are written.-unsafeFromBuilder :: B.Builder a -> TextBuilder a-{-# INLINE unsafeFromBuilder #-}-unsafeFromBuilder = TextBuilder-------------------------------------------------------------------------------------- | Turn 'String' into 'TextBuilder' with UTF8 encoding------ Illegal codepoints will be written as 'T.replacementChar's. This function will be rewritten into a memcpy if possible, (running a fast UTF-8 validation at runtime first).-stringUTF8 :: String -> TextBuilder ()-{-# INLINE stringUTF8 #-}-stringUTF8 = TextBuilder . B.stringUTF8---- | Turn 'Char' into 'TextBuilder' with UTF8 encoding------ Illegal codepoints will be written as 'T.replacementChar's.-charUTF8 :: Char -> TextBuilder ()-{-# INLINE charUTF8 #-}-charUTF8 = TextBuilder . B.charUTF8---- | Turn 'String' into 'TextBuilder' with ASCII7 encoding------ Codepoints beyond @'\x7F'@ will be chopped.-string7 :: String -> TextBuilder ()-{-# INLINE string7 #-}-string7 = TextBuilder . B.string7---- | Turn 'Char' into 'TextBuilder' with ASCII7 encoding------ Codepoints beyond @'\x7F'@ will be chopped.-char7 :: Char -> TextBuilder ()-{-# INLINE char7 #-}-char7 = TextBuilder . B.char7---- | Write UTF8 encoded 'T.Text' using 'Builder'.------ Note, if you're trying to write string literals builders,--- please open 'OverloadedStrings' and use 'Builder's 'IsString' instance,--- it will be rewritten into a memcpy.-text :: T.Text -> TextBuilder ()-{-# INLINE text #-}-text = TextBuilder . B.text-------------------------------------------------------------------------------------- | @int = intWith defaultIFormat@-int :: (Integral a, Bounded a) => a -> TextBuilder ()-{-# INLINE int #-}-int = TextBuilder . B.int---- | Format a 'Bounded' 'Integral' type like @Int@ or @Word16@ into decimal ascii digits.-intWith :: (Integral a, Bounded a)-        => B.IFormat-        -> a-        -> TextBuilder ()-{-# INLINE intWith #-}-intWith fmt x = TextBuilder $ B.intWith fmt x---- | Format a 'Integer' into decimal ascii digits.-integer :: Integer -> TextBuilder ()-{-# INLINE integer #-}-integer = TextBuilder . B.integer---- | Format a 'FiniteBits' 'Integral' type into hex nibbles.-hex :: (FiniteBits a, Integral a) => a -> TextBuilder ()-{-# INLINE hex #-}-hex = TextBuilder . B.hex---- | The UPPERCASED version of 'hex'.-heX :: (FiniteBits a, Integral a) => a -> TextBuilder ()-{-# INLINE heX #-}-heX = TextBuilder . B.heX---- | Decimal encoding of an IEEE 'Float'.------ Using standard decimal notation for arguments whose absolute value lies--- between @0.1@ and @9,999,999@, and scientific notation otherwise.-float :: Float -> TextBuilder ()-{-# INLINE float #-}-float = TextBuilder . B.float---- | Format single-precision float using drisu3 with dragon4 fallback.-floatWith :: B.FFormat-          -> Maybe Int  -- ^ Number of decimal places to render.-          -> Float-          -> TextBuilder ()-{-# INLINE floatWith #-}-floatWith fmt ds x = TextBuilder (B.floatWith fmt ds x)----- | Decimal encoding of an IEEE 'Double'.------ Using standard decimal notation for arguments whose absolute value lies--- between @0.1@ and @9,999,999@, and scientific notation otherwise.-double :: Double -> TextBuilder ()-{-# INLINE double #-}-double = TextBuilder . B.double---- | Format double-precision float using drisu3 with dragon4 fallback.-doubleWith :: B.FFormat-           -> Maybe Int  -- ^ Number of decimal places to render.-           -> Double-           -> TextBuilder ()-{-# INLINE doubleWith #-}-doubleWith fmt ds x = TextBuilder (B.doubleWith fmt ds x)----- | A @Builder@ which renders a scientific number to full--- precision, using standard decimal notation for arguments whose--- absolute value lies between @0.1@ and @9,999,999@, and scientific--- notation otherwise.-scientific :: Sci.Scientific -> TextBuilder ()-{-# INLINE scientific #-}-scientific = TextBuilder . B.scientific---- | Like 'scientific' but provides rendering options.-scientificWith :: B.FFormat-               -> Maybe Int  -- ^ Number of decimal places to render.-               -> Sci.Scientific-               -> TextBuilder ()-{-# INLINE scientificWith #-}-scientificWith fmt ds x = TextBuilder (B.scientificWith fmt ds x)-------------------------------------------------------------------------------------- | add @(...)@ to original builder.-paren :: TextBuilder () -> TextBuilder ()-{-# INLINE paren #-}-paren (TextBuilder b) = TextBuilder (B.paren b)---- | Add "(..)" around builders when condition is met, otherwise add nothing.------ This is useful when defining 'ToText' instances.-parenWhen :: Bool -> TextBuilder () -> TextBuilder ()-{-# INLINE parenWhen #-}-parenWhen True b = paren b-parenWhen _    b = b---- | add @{...}@ to original builder.-curly :: TextBuilder () -> TextBuilder ()-{-# INLINE curly #-}-curly (TextBuilder b) = TextBuilder (B.curly b)---- | add @[...]@ to original builder.-square :: TextBuilder () -> TextBuilder ()-{-# INLINE square #-}-square (TextBuilder b) = TextBuilder (B.square b)---- | add @<...>@ to original builder.-angle :: TextBuilder () -> TextBuilder ()-{-# INLINE angle #-}-angle (TextBuilder b) = TextBuilder (B.angle b)---- | add @"..."@ to original builder.-quotes :: TextBuilder () -> TextBuilder ()-{-# INLINE quotes #-}-quotes (TextBuilder b) = TextBuilder (B.quotes b)---- | add @'...'@ to original builder.-squotes :: TextBuilder () -> TextBuilder ()-{-# INLINE squotes #-}-squotes (TextBuilder b) = TextBuilder (B.squotes b)---- | write an ASCII @:@-colon ::  TextBuilder ()-{-# INLINE colon #-}-colon = TextBuilder B.colon---- | write an ASCII @,@-comma ::  TextBuilder ()-{-# INLINE comma #-}-comma = TextBuilder B.comma---- | Use separator to connect a vector of builders.-intercalateVec :: (V.Vec v a)-               => TextBuilder ()            -- ^ the seperator-               -> (a -> TextBuilder ())     -- ^ value formatter-               -> v a                       -- ^ value list-               ->  TextBuilder ()-{-# INLINE intercalateVec #-}-intercalateVec (TextBuilder s) f = TextBuilder . B.intercalateVec s (getBuilder . f)---- | Use separator to connect a list of builders.-intercalateList :: TextBuilder ()           -- ^ the seperator-                -> (a -> TextBuilder ())    -- ^ value formatter-                -> [a]                      -- ^ value vector-                -> TextBuilder ()-{-# INLINE intercalateList #-}-intercalateList (TextBuilder s) f = TextBuilder . B.intercalateList s (getBuilder . f)------------------------------------------------------------------------------------- | Newtype wrapper for @[Char]@ to provide textual instances.------ We didn't provide special treatment to differentiate instances between @[a]@ and @[Char]@--- in various classes, e.g. 'Z.Data.JSON.ToJSON'.------ This newtype is therefore to provide instances similar to @T.Text@, in case you really--- need to wrap a 'String'.------ >>> Z.Data.JSON.encodeText ("abc" :: String)--- > "[\"a\",\"b\",\"c\"]"   -- Just like any other [a]'s instance--- >>> Z.Data.JSON.encodeText . Str $ ("abc" :: String)--- > "\"abc\""----newtype Str = Str { chrs :: [Char] } deriving stock (Eq, Ord, Data, Typeable, Generic)--instance Show Str where show = show . chrs-instance Read Str where readPrec = Str <$> readPrec--instance ToText Str where-    {-# INLINE toTextBuilder #-}-    toTextBuilder _ = TextBuilder . B.string8 . show------------------------------------------------------------------------------------- Data types------ | A class similar to 'Show', serving the purpose that quickly convert a data type--- to a 'Text' value.-class ToText a where-    toTextBuilder :: Int -> a  -> TextBuilder ()-    default toTextBuilder :: (Generic a, GToText (Rep a)) => Int -> a -> TextBuilder ()-    toTextBuilder p = gToTextBuilder p . from--class GToText f where-    gToTextBuilder :: Int -> f a -> TextBuilder ()---class GFieldToText f where-    gFieldToTextBuilder :: B.Builder () -> Int -> f a -> B.Builder ()--instance (GFieldToText a, GFieldToText b) => GFieldToText (a :*: b) where-    {-# INLINE gFieldToTextBuilder #-}-    gFieldToTextBuilder sep p (a :*: b) =-        gFieldToTextBuilder sep p a >> sep >> gFieldToTextBuilder sep p b--instance (GToText f) => GFieldToText (S1 (MetaSel Nothing u ss ds) f) where-    {-# INLINE gFieldToTextBuilder #-}-    gFieldToTextBuilder _ p (M1 x) = getBuilder (gToTextBuilder p x)--instance (GToText f, Selector (MetaSel (Just l) u ss ds)) => GFieldToText (S1 (MetaSel (Just l) u ss ds) f) where-    {-# INLINE gFieldToTextBuilder #-}-    gFieldToTextBuilder _ _ m1@(M1 x) =-        B.stringModifiedUTF8 (selName m1) >> " = " >> getBuilder (gToTextBuilder 0 x)--instance GToText V1 where-    {-# INLINE gToTextBuilder #-}-    gToTextBuilder _ = error "Z.Data.TextBuilder: empty data type"--instance (GToText f, GToText g) => GToText (f :+: g) where-    {-# INLINE gToTextBuilder #-}-    gToTextBuilder p (L1 x) = gToTextBuilder p x-    gToTextBuilder p (R1 x) = gToTextBuilder p x---- | Constructor without payload, convert to String-instance (Constructor c) => GToText (C1 c U1) where-    {-# INLINE gToTextBuilder #-}-    gToTextBuilder _ m1 =-        TextBuilder . B.stringModifiedUTF8 $ conName m1---- | Constructor with payloads-instance (GFieldToText (S1 sc f), Constructor c) => GToText (C1 c (S1 sc f)) where-    {-# INLINE gToTextBuilder #-}-    gToTextBuilder p m1@(M1 x) =-        parenWhen (p > 10) . TextBuilder $ do-            B.stringModifiedUTF8 $ conName m1-            B.char8 ' '-            if conIsRecord m1-            then B.curly $ gFieldToTextBuilder (B.char7 ',' >> B.char7 ' ') p x-            else gFieldToTextBuilder (B.char7 ' ') 11 x--instance (GFieldToText (a :*: b), Constructor c) => GToText (C1 c (a :*: b)) where-    {-# INLINE gToTextBuilder #-}-    gToTextBuilder p m1@(M1 x) =-        case conFixity m1 of-            Prefix -> parenWhen (p > 10) . TextBuilder $ do-                B.stringModifiedUTF8 $ conName m1-                B.char8 ' '-                if conIsRecord m1-                then B.curly $ gFieldToTextBuilder (B.char7 ',' >> B.char7 ' ') p x-                else gFieldToTextBuilder (B.char7 ' ') 11 x-            Infix _ p' -> parenWhen (p > p') . TextBuilder $ do-                gFieldToTextBuilder-                    (B.char8 ' ' >> B.stringModifiedUTF8 (conName m1) >> B.char8 ' ') (p'+1) x--instance ToText a => GToText (K1 i a) where-    {-# INLINE gToTextBuilder #-}-    gToTextBuilder p (K1 x) = toTextBuilder p x------------------------------------------------------------------------------------- Data types-instance GToText f => GToText (D1 c f) where-    {-# INLINE gToTextBuilder #-}-    gToTextBuilder p (M1 x) = gToTextBuilder p x----- | Directly convert data to 'Text'.-toText :: ToText a => a -> Text-{-# INLINE toText #-}-toText = buildText .  toTextBuilder 0---- | Directly convert data to 'B.Builder'.-toBuilder :: ToText a => a -> B.Builder ()-{-# INLINE toBuilder #-}-toBuilder = getBuilder . toTextBuilder 0---- | Directly convert data to 'V.Bytes'.-toBytes :: ToText a => a -> V.Bytes-{-# INLINE toBytes #-}-toBytes = B.buildBytes .  toBuilder---- | Faster 'show' replacement.-toString :: ToText a => a -> String-{-# INLINE toString #-}-toString = T.unpack . toText--instance ToText Bool where-    {-# INLINE toTextBuilder #-}-    toTextBuilder _ True = TextBuilder "True"-    toTextBuilder _ _    = TextBuilder "False"--instance ToText Char where-    {-# INLINE toTextBuilder #-}-    toTextBuilder _ = TextBuilder . B.string8 . show--instance ToText Double where {{-# INLINE toTextBuilder #-}; toTextBuilder _ = double;}-instance ToText Float  where {{-# INLINE toTextBuilder #-}; toTextBuilder _ = float;}--instance ToText Int     where {{-# INLINE toTextBuilder #-}; toTextBuilder _ = int;}-instance ToText Int8    where {{-# INLINE toTextBuilder #-}; toTextBuilder _ = int;}-instance ToText Int16   where {{-# INLINE toTextBuilder #-}; toTextBuilder _ = int;}-instance ToText Int32   where {{-# INLINE toTextBuilder #-}; toTextBuilder _ = int;}-instance ToText Int64   where {{-# INLINE toTextBuilder #-}; toTextBuilder _ = int;}-instance ToText Word     where {{-# INLINE toTextBuilder #-}; toTextBuilder _ = int;}-instance ToText Word8    where {{-# INLINE toTextBuilder #-}; toTextBuilder _ = int;}-instance ToText Word16   where {{-# INLINE toTextBuilder #-}; toTextBuilder _ = int;}-instance ToText Word32   where {{-# INLINE toTextBuilder #-}; toTextBuilder _ = int;}-instance ToText Word64   where {{-# INLINE toTextBuilder #-}; toTextBuilder _ = int;}--instance ToText Integer  where {{-# INLINE toTextBuilder #-}; toTextBuilder _ = integer;}-instance ToText Natural  where {{-# INLINE toTextBuilder #-}; toTextBuilder _ = integer . fromIntegral}-instance ToText Ordering where-    {-# INLINE toTextBuilder #-}-    toTextBuilder _ GT = TextBuilder "GT"-    toTextBuilder _ EQ = TextBuilder "EQ"-    toTextBuilder _ _  = TextBuilder "LT"--instance ToText () where-    {-# INLINE toTextBuilder #-}-    toTextBuilder _ () = TextBuilder "()"--instance ToText Version where-    {-# INLINE toTextBuilder #-}-    toTextBuilder _ = stringUTF8 . show---- | To keep sync with 'Show' instance's escaping rule, we reuse show here, so it won't be as fast as memcpy.-instance ToText Text where-    {-# INLINE toTextBuilder #-}-    toTextBuilder _ = stringUTF8 . show--instance ToText Sci.Scientific where-    {-# INLINE toTextBuilder #-}-    toTextBuilder _ = scientific--instance ToText a => ToText [a] where-    {-# INLINE toTextBuilder #-}-    toTextBuilder _ = square . intercalateList comma (toTextBuilder 0)--instance ToText a => ToText (V.Vector a) where-    {-# INLINE toTextBuilder #-}-    toTextBuilder _ = square . intercalateVec comma (toTextBuilder 0)--instance (Prim a, ToText a) => ToText (V.PrimVector a) where-    {-# INLINE toTextBuilder #-}-    toTextBuilder _ = square . intercalateVec comma (toTextBuilder 0)--instance (ToText a, ToText b) => ToText (a, b) where-    {-# INLINE toTextBuilder #-}-    toTextBuilder _ (a, b) = paren $  toTextBuilder 0 a-                     >> comma >> toTextBuilder 0 b--instance (ToText a, ToText b, ToText c) => ToText (a, b, c) where-    {-# INLINE toTextBuilder #-}-    toTextBuilder _ (a, b, c) = paren $  toTextBuilder 0 a-                     >> comma >> toTextBuilder 0 b-                     >> comma >> toTextBuilder 0 c--instance (ToText a, ToText b, ToText c, ToText d) => ToText (a, b, c, d) where-    {-# INLINE toTextBuilder #-}-    toTextBuilder _ (a, b, c, d) = paren $  toTextBuilder 0 a-                     >> comma >> toTextBuilder 0 b-                     >> comma >> toTextBuilder 0 c-                     >> comma >> toTextBuilder 0 d--instance (ToText a, ToText b, ToText c, ToText d, ToText e) => ToText (a, b, c, d, e) where-    {-# INLINE toTextBuilder #-}-    toTextBuilder _ (a, b, c, d, e) = paren $  toTextBuilder 0 a-                     >> comma >> toTextBuilder 0 b-                     >> comma >> toTextBuilder 0 c-                     >> comma >> toTextBuilder 0 d-                     >> comma >> toTextBuilder 0 e--instance (ToText a, ToText b, ToText c, ToText d, ToText e, ToText f) => ToText (a, b, c, d, e, f) where-    {-# INLINE toTextBuilder #-}-    toTextBuilder _ (a, b, c, d, e, f) = paren $  toTextBuilder 0 a-                     >> comma >> toTextBuilder 0 b-                     >> comma >> toTextBuilder 0 c-                     >> comma >> toTextBuilder 0 d-                     >> comma >> toTextBuilder 0 e-                     >> comma >> toTextBuilder 0 f--instance (ToText a, ToText b, ToText c, ToText d, ToText e, ToText f, ToText g) => ToText (a, b, c, d, e, f, g) where-    {-# INLINE toTextBuilder #-}-    toTextBuilder _ (a, b, c, d, e, f, g) = paren $  toTextBuilder 0 a-                     >> comma >> toTextBuilder 0 b-                     >> comma >> toTextBuilder 0 c-                     >> comma >> toTextBuilder 0 d-                     >> comma >> toTextBuilder 0 e-                     >> comma >> toTextBuilder 0 f-                     >> comma >> toTextBuilder 0 g--instance ToText a => ToText (Maybe a) where-    {-# INLINE toTextBuilder #-}-    toTextBuilder p (Just x) = parenWhen (p > 10) $ do TextBuilder "Just "-                                                       toTextBuilder 11 x-    toTextBuilder _ _        = TextBuilder "Nothing"--instance (ToText a, ToText b) => ToText (Either a b) where-    {-# INLINE toTextBuilder #-}-    toTextBuilder p (Left x) = parenWhen (p > 10) $ do TextBuilder "Left "-                                                       toTextBuilder 11 x-    toTextBuilder p (Right x) = parenWhen (p > 10) $ do TextBuilder "Right "-                                                        toTextBuilder 11 x--instance (ToText a, Integral a) => ToText (Ratio a) where-    {-# INLINE toTextBuilder #-}-    toTextBuilder p r = parenWhen (p > 10) $ do toTextBuilder 8 (numerator r)-                                                TextBuilder " % "-                                                toTextBuilder 8 (denominator r)--instance HasResolution a => ToText (Fixed a) where-    {-# INLINE toTextBuilder #-}-    toTextBuilder _ = TextBuilder . B.string8 .  show--deriving anyclass instance ToText a => ToText (Semigroup.Min a)-deriving anyclass instance ToText a => ToText (Semigroup.Max a)-deriving anyclass instance ToText a => ToText (Semigroup.First a)-deriving anyclass instance ToText a => ToText (Semigroup.Last a)-deriving anyclass instance ToText a => ToText (Semigroup.WrappedMonoid a)-deriving anyclass instance ToText a => ToText (Semigroup.Dual a)-deriving anyclass instance ToText a => ToText (Monoid.First a)-deriving anyclass instance ToText a => ToText (Monoid.Last a)-deriving anyclass instance ToText a => ToText (NonEmpty a)-deriving anyclass instance ToText a => ToText (Identity a)-deriving anyclass instance ToText a => ToText (Const a b)-deriving anyclass instance ToText (Proxy a)-deriving anyclass instance ToText b => ToText (Tagged a b)-deriving anyclass instance ToText (f (g a)) => ToText (Compose f g a)-deriving anyclass instance (ToText (f a), ToText (g a)) => ToText (Product f g a)-deriving anyclass instance (ToText (f a), ToText (g a), ToText a) => ToText (Sum f g a)

@@ -1,10 +1,3 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE TypeApplications #-}- {-| Module      : Z.Data.Text.Extra Description : Fast text slice manipulation@@ -517,6 +510,7 @@   where     tsiz = length t     csiz = encodeCharLength c+    go :: forall s. MutablePrimArray s Word8 -> Int -> Int -> ST s ()     go marr s' psiz         | s' >= psiz = return ()         | otherwise = copyChar' csiz marr s' marr (s'-csiz) >> go marr (s'+csiz) psiz@@ -536,6 +530,7 @@   where     tsiz = length t     csiz = encodeCharLength c+    go :: forall s. MutablePrimArray s Word8 -> Int -> Int -> ST s ()     go marr s' siz         | s' >= siz = return ()         | otherwise = copyChar' csiz marr s' marr (s'-csiz) >> go marr (s'+csiz) siz

@@ -1,10 +1,3 @@-{-# LANGUAGE BangPatterns        #-}-{-# LANGUAGE FlexibleContexts    #-}-{-# LANGUAGE MagicHash           #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE UnboxedTuples       #-}-- {-| Module      : Z.Data.Text.Search Description : Searching text

@@ -0,0 +1,694 @@+{-|+Module      : Z.Data.Text.Builder+Description : UTF8 compatible builders.+Copyright   : (c) Dong Han, 2017-2019+License     : BSD+Maintainer  : winterland1989@gmail.com+Stability   : experimental+Portability : non-portable++Base on UTF8 compatible textual builders from 'Z.Data.Builder', we provide a newtype wrapper+'TextBuilder' which can be directly used to build 'Text'.++We also provide faster alternative to 'Show' class, i.e. 'ShowT', which also provides 'Generic'+based instances deriving.++-}++module Z.Data.Text.ShowT+  ( -- * ShowT class+  ShowT(..), showT, toBuilder, toBytes, toString+  -- * Str newtype+  , Str(..)+  -- * Textual Builder+  , TextBuilder+  , getBuilder+  , unsafeFromBuilder+  , buildText+  -- * Basic UTF8 builders+  , stringUTF8, charUTF8, string7, char7, text, escapeTextJSON+  -- * Numeric builders+  -- ** Integral type formatting+  , B.IFormat(..)+  , B.defaultIFormat+  , B.Padding(..)+  , int+  , intWith+  , integer+  -- ** Fixded size hexidecimal formatting+  , hex, heX+  -- ** IEEE float formating+  , B.FFormat(..)+  , double+  , doubleWith+  , float+  , floatWith+  , scientific+  , scientificWith+  -- * Builder helpers+  , paren, parenWhen, curly, square, angle, quotes, squotes, colon, comma, intercalateVec, intercalateList+  ) where++import           Control.Monad+import           Control.Monad.ST.Unsafe        (unsafeIOToST)+import qualified Data.Scientific                as Sci+import           Data.String+import           Data.Bits+import           Data.Fixed+import           Data.Primitive.PrimArray+import           Data.Functor.Compose+import           Data.Functor.Const+import           Data.Functor.Identity+import           Data.Functor.Product+import           Data.Functor.Sum+import           Data.Int+import           Data.List.NonEmpty             (NonEmpty (..))+import qualified Data.Monoid                    as Monoid+import           Data.Proxy                     (Proxy(..))+import           Data.Ratio                     (Ratio, numerator, denominator)+import           Data.Tagged                    (Tagged (..))+import           Data.Word+import qualified Data.Semigroup                 as Semigroup+import           Data.Typeable+import           Foreign.C.Types+import           GHC.Exts+import           GHC.Natural+import           GHC.Generics+import           GHC.Stack+import           Data.Version+import           Data.Primitive.Types+import qualified Z.Data.Builder.Base            as B+import qualified Z.Data.Builder.Numeric         as B+import qualified Z.Data.Text.Base               as T+import           Z.Data.Text.Base               (Text(..))+import qualified Z.Data.Array                   as A+import qualified Z.Data.Vector.Base             as V+import           Text.Read                      (Read(..))+import           Test.QuickCheck.Arbitrary (Arbitrary(..), CoArbitrary(..))++#define DOUBLE_QUOTE 34++-- | Buidlers which guarantee UTF-8 encoding, thus can be used to build+-- text directly.+--+-- Notes on 'IsString' instance: It's recommended to use 'IsString' instance, there's a rewrite rule to+-- turn encoding loop into a memcpy, which is much faster (the same rule also apply to 'stringUTF8').+-- Different from @Builder ()@, @TextBuilder ()@'s 'IsString' instance will give you desired UTF8 guarantees:+--+-- * @\NUL@ will be written directly as @\x00@.+--+-- * @\xD800@ ~ @\xDFFF@ will be replaced by replacement char.+--+newtype TextBuilder a = TextBuilder { getBuilder :: B.Builder a }+    deriving newtype (Functor, Applicative, Monad)++deriving newtype instance Semigroup (TextBuilder ())+deriving newtype instance Monoid (TextBuilder ())++instance (a ~ ()) => IsString (TextBuilder a) where+    {-# INLINE fromString #-}+    fromString = TextBuilder <$> B.stringUTF8++instance Arbitrary (TextBuilder ()) where+    arbitrary = TextBuilder . B.text <$> arbitrary+    shrink b = TextBuilder . B.text <$> shrink (buildText b)++instance CoArbitrary (TextBuilder ()) where+    coarbitrary = coarbitrary . buildText++instance Show (TextBuilder a) where+    show = show . buildText++instance ShowT (TextBuilder a) where+    {-# INLINE toTextBuilder #-}+    toTextBuilder _ b = quotes (void b)++-- | Build a 'Text' using 'TextBuilder', which provide UTF-8 encoding guarantee.+buildText :: TextBuilder a -> Text+{-# INLINE buildText #-}+buildText = Text . B.buildBytes . getBuilder++-- | Unsafely turn a 'B.Builder' into 'TextBuilder', thus it's user's responsibility to+-- ensure only UTF-8 complied bytes are written.+unsafeFromBuilder :: B.Builder a -> TextBuilder a+{-# INLINE unsafeFromBuilder #-}+unsafeFromBuilder = TextBuilder++--------------------------------------------------------------------------------++-- | Turn 'String' into 'TextBuilder' with UTF8 encoding+--+-- Illegal codepoints will be written as 'T.replacementChar's. This function will be rewritten into a memcpy if possible, (running a fast UTF-8 validation at runtime first).+stringUTF8 :: String -> TextBuilder ()+{-# INLINE stringUTF8 #-}+stringUTF8 = TextBuilder . B.stringUTF8++-- | Turn 'Char' into 'TextBuilder' with UTF8 encoding+--+-- Illegal codepoints will be written as 'T.replacementChar's.+charUTF8 :: Char -> TextBuilder ()+{-# INLINE charUTF8 #-}+charUTF8 = TextBuilder . B.charUTF8++-- | Turn 'String' into 'TextBuilder' with ASCII7 encoding+--+-- Codepoints beyond @'\x7F'@ will be chopped.+string7 :: String -> TextBuilder ()+{-# INLINE string7 #-}+string7 = TextBuilder . B.string7++-- | Turn 'Char' into 'TextBuilder' with ASCII7 encoding+--+-- Codepoints beyond @'\x7F'@ will be chopped.+char7 :: Char -> TextBuilder ()+{-# INLINE char7 #-}+char7 = TextBuilder . B.char7++-- | Write UTF8 encoded 'T.Text' using 'Builder'.+--+-- Note, if you're trying to write string literals builders,+-- please open 'OverloadedStrings' and use 'Builder's 'IsString' instance,+-- it will be rewritten into a memcpy.+text :: T.Text -> TextBuilder ()+{-# INLINE text #-}+text = TextBuilder . B.text++--------------------------------------------------------------------------------++-- | @int = intWith defaultIFormat@+int :: (Integral a, Bounded a) => a -> TextBuilder ()+{-# INLINE int #-}+int = TextBuilder . B.int++-- | Format a 'Bounded' 'Integral' type like @Int@ or @Word16@ into decimal ascii digits.+intWith :: (Integral a, Bounded a)+        => B.IFormat+        -> a+        -> TextBuilder ()+{-# INLINE intWith #-}+intWith fmt x = TextBuilder $ B.intWith fmt x++-- | Format a 'Integer' into decimal ascii digits.+integer :: Integer -> TextBuilder ()+{-# INLINE integer #-}+integer = TextBuilder . B.integer++-- | Format a 'FiniteBits' 'Integral' type into hex nibbles.+hex :: (FiniteBits a, Integral a) => a -> TextBuilder ()+{-# INLINE hex #-}+hex = TextBuilder . B.hex++-- | The UPPERCASED version of 'hex'.+heX :: (FiniteBits a, Integral a) => a -> TextBuilder ()+{-# INLINE heX #-}+heX = TextBuilder . B.heX++-- | Decimal encoding of an IEEE 'Float'.+--+-- Using standard decimal notation for arguments whose absolute value lies+-- between @0.1@ and @9,999,999@, and scientific notation otherwise.+float :: Float -> TextBuilder ()+{-# INLINE float #-}+float = TextBuilder . B.float++-- | Format single-precision float using drisu3 with dragon4 fallback.+floatWith :: B.FFormat+          -> Maybe Int  -- ^ Number of decimal places to render.+          -> Float+          -> TextBuilder ()+{-# INLINE floatWith #-}+floatWith fmt ds x = TextBuilder (B.floatWith fmt ds x)+++-- | Decimal encoding of an IEEE 'Double'.+--+-- Using standard decimal notation for arguments whose absolute value lies+-- between @0.1@ and @9,999,999@, and scientific notation otherwise.+double :: Double -> TextBuilder ()+{-# INLINE double #-}+double = TextBuilder . B.double++-- | Format double-precision float using drisu3 with dragon4 fallback.+doubleWith :: B.FFormat+           -> Maybe Int  -- ^ Number of decimal places to render.+           -> Double+           -> TextBuilder ()+{-# INLINE doubleWith #-}+doubleWith fmt ds x = TextBuilder (B.doubleWith fmt ds x)+++-- | A @Builder@ which renders a scientific number to full+-- precision, using standard decimal notation for arguments whose+-- absolute value lies between @0.1@ and @9,999,999@, and scientific+-- notation otherwise.+scientific :: Sci.Scientific -> TextBuilder ()+{-# INLINE scientific #-}+scientific = TextBuilder . B.scientific++-- | Like 'scientific' but provides rendering options.+scientificWith :: B.FFormat+               -> Maybe Int  -- ^ Number of decimal places to render.+               -> Sci.Scientific+               -> TextBuilder ()+{-# INLINE scientificWith #-}+scientificWith fmt ds x = TextBuilder (B.scientificWith fmt ds x)++--------------------------------------------------------------------------------++-- | add @(...)@ to original builder.+paren :: TextBuilder () -> TextBuilder ()+{-# INLINE paren #-}+paren (TextBuilder b) = TextBuilder (B.paren b)++-- | Add "(..)" around builders when condition is met, otherwise add nothing.+--+-- This is useful when defining 'ShowT' instances.+parenWhen :: Bool -> TextBuilder () -> TextBuilder ()+{-# INLINE parenWhen #-}+parenWhen True b = paren b+parenWhen _    b = b++-- | add @{...}@ to original builder.+curly :: TextBuilder () -> TextBuilder ()+{-# INLINE curly #-}+curly (TextBuilder b) = TextBuilder (B.curly b)++-- | add @[...]@ to original builder.+square :: TextBuilder () -> TextBuilder ()+{-# INLINE square #-}+square (TextBuilder b) = TextBuilder (B.square b)++-- | add @<...>@ to original builder.+angle :: TextBuilder () -> TextBuilder ()+{-# INLINE angle #-}+angle (TextBuilder b) = TextBuilder (B.angle b)++-- | add @"..."@ to original builder.+quotes :: TextBuilder () -> TextBuilder ()+{-# INLINE quotes #-}+quotes (TextBuilder b) = TextBuilder (B.quotes b)++-- | add @'...'@ to original builder.+squotes :: TextBuilder () -> TextBuilder ()+{-# INLINE squotes #-}+squotes (TextBuilder b) = TextBuilder (B.squotes b)++-- | write an ASCII @:@+colon ::  TextBuilder ()+{-# INLINE colon #-}+colon = TextBuilder B.colon++-- | write an ASCII @,@+comma ::  TextBuilder ()+{-# INLINE comma #-}+comma = TextBuilder B.comma++-- | Use separator to connect a vector of builders.+intercalateVec :: (V.Vec v a)+               => TextBuilder ()            -- ^ the seperator+               -> (a -> TextBuilder ())     -- ^ value formatter+               -> v a                       -- ^ value list+               ->  TextBuilder ()+{-# INLINE intercalateVec #-}+intercalateVec (TextBuilder s) f = TextBuilder . B.intercalateVec s (getBuilder . f)++-- | Use separator to connect a list of builders.+intercalateList :: TextBuilder ()           -- ^ the seperator+                -> (a -> TextBuilder ())    -- ^ value formatter+                -> [a]                      -- ^ value vector+                -> TextBuilder ()+{-# INLINE intercalateList #-}+intercalateList (TextBuilder s) f = TextBuilder . B.intercalateList s (getBuilder . f)++--------------------------------------------------------------------------------+-- | Newtype wrapper for @[Char]@ to provide textual instances.+--+-- We didn't provide special treatment to differentiate instances between @[a]@ and @[Char]@+-- in various classes, e.g. 'Z.Data.JSON.ToJSON'.+--+-- This newtype is therefore to provide instances similar to @T.Text@, in case you really+-- need to wrap a 'String'.+--+-- >>> Z.Data.JSON.encodeText ("abc" :: String)+-- > "[\"a\",\"b\",\"c\"]"   -- Just like any other [a]'s instance+-- >>> Z.Data.JSON.encodeText . Str $ ("abc" :: String)+-- > "\"abc\""+--+newtype Str = Str { chrs :: [Char] } deriving stock (Eq, Ord, Generic)++instance Show Str where show = show . chrs+instance Read Str where readPrec = Str <$> readPrec++instance ShowT Str where+    {-# INLINE toTextBuilder #-}+    toTextBuilder _ = TextBuilder . B.string8 . show++--------------------------------------------------------------------------------+-- Data types+--+-- | A class similar to 'Show', serving the purpose that quickly convert a data type to a 'Text' value.+--+-- You can use newtype or generic deriving to implement instance of this class quickly:+--+-- @+--  {-## LANGUAGE GeneralizedNewtypeDeriving ##-}+--  {-## LANGUAGE DeriveAnyClass ##-}+--  {-## LANGUAGE DeriveGeneric ##-}+--  {-## LANGUAGE DerivingStrategies ##-}+--+--  import GHC.Generics+--+--  newtype FooInt = FooInt Int deriving (Generic)+--                            deriving anyclass ShowT+--+-- > showT (FooInt 3)+-- > "FooInt 3"+--+--  newtype FooInt = FooInt Int deriving (Generic)+--                            deriving newtype ShowT+--+-- > showT (FooInt 3)+-- > "3"+-- @+--+class ShowT a where+    toTextBuilder :: Int -> a  -> TextBuilder ()+    default toTextBuilder :: (Generic a, GToText (Rep a)) => Int -> a -> TextBuilder ()+    toTextBuilder p = gToTextBuilder p . from++class GToText f where+    gToTextBuilder :: Int -> f a -> TextBuilder ()+++class GFieldToText f where+    gFieldToTextBuilder :: B.Builder () -> Int -> f a -> B.Builder ()++instance (GFieldToText a, GFieldToText b) => GFieldToText (a :*: b) where+    {-# INLINE gFieldToTextBuilder #-}+    gFieldToTextBuilder sep p (a :*: b) =+        gFieldToTextBuilder sep p a >> sep >> gFieldToTextBuilder sep p b++instance (GToText f) => GFieldToText (S1 (MetaSel Nothing u ss ds) f) where+    {-# INLINE gFieldToTextBuilder #-}+    gFieldToTextBuilder _ p (M1 x) = getBuilder (gToTextBuilder p x)++instance (GToText f, Selector (MetaSel (Just l) u ss ds)) => GFieldToText (S1 (MetaSel (Just l) u ss ds) f) where+    {-# INLINE gFieldToTextBuilder #-}+    gFieldToTextBuilder _ _ m1@(M1 x) =+        B.stringModifiedUTF8 (selName m1) >> " = " >> getBuilder (gToTextBuilder 0 x)++instance GToText V1 where+    {-# INLINE gToTextBuilder #-}+    gToTextBuilder _ = error "Z.Data.TextBuilder: empty data type"++instance (GToText f, GToText g) => GToText (f :+: g) where+    {-# INLINE gToTextBuilder #-}+    gToTextBuilder p (L1 x) = gToTextBuilder p x+    gToTextBuilder p (R1 x) = gToTextBuilder p x++-- | Constructor without payload, convert to String+instance (Constructor c) => GToText (C1 c U1) where+    {-# INLINE gToTextBuilder #-}+    gToTextBuilder _ m1 =+        TextBuilder . B.stringModifiedUTF8 $ conName m1++-- | Constructor with payloads+instance (GFieldToText (S1 sc f), Constructor c) => GToText (C1 c (S1 sc f)) where+    {-# INLINE gToTextBuilder #-}+    gToTextBuilder p m1@(M1 x) =+        parenWhen (p > 10) . TextBuilder $ do+            B.stringModifiedUTF8 $ conName m1+            B.char8 ' '+            if conIsRecord m1+            then B.curly $ gFieldToTextBuilder (B.char7 ',' >> B.char7 ' ') p x+            else gFieldToTextBuilder (B.char7 ' ') 11 x++instance (GFieldToText (a :*: b), Constructor c) => GToText (C1 c (a :*: b)) where+    {-# INLINE gToTextBuilder #-}+    gToTextBuilder p m1@(M1 x) =+        case conFixity m1 of+            Prefix -> parenWhen (p > 10) . TextBuilder $ do+                B.stringModifiedUTF8 $ conName m1+                B.char8 ' '+                if conIsRecord m1+                then B.curly $ gFieldToTextBuilder (B.char7 ',' >> B.char7 ' ') p x+                else gFieldToTextBuilder (B.char7 ' ') 11 x+            Infix _ p' -> parenWhen (p > p') . TextBuilder $ do+                gFieldToTextBuilder+                    (B.char8 ' ' >> B.stringModifiedUTF8 (conName m1) >> B.char8 ' ') (p'+1) x++instance ShowT a => GToText (K1 i a) where+    {-# INLINE gToTextBuilder #-}+    gToTextBuilder p (K1 x) = toTextBuilder p x++--------------------------------------------------------------------------------+-- Data types+instance GToText f => GToText (D1 c f) where+    {-# INLINE gToTextBuilder #-}+    gToTextBuilder p (M1 x) = gToTextBuilder p x++-- | Directly convert data to 'Text'.+showT :: ShowT a => a -> Text+{-# INLINE showT #-}+showT = buildText .  toTextBuilder 0++-- | Directly convert data to 'B.Builder'.+toBuilder :: ShowT a => a -> B.Builder ()+{-# INLINE toBuilder #-}+toBuilder = getBuilder . toTextBuilder 0++-- | Directly convert data to 'V.Bytes'.+toBytes :: ShowT a => a -> V.Bytes+{-# INLINE toBytes #-}+toBytes = B.buildBytes .  toBuilder++-- | Faster 'show' replacement.+toString :: ShowT a => a -> String+{-# INLINE toString #-}+toString = T.unpack . showT++instance ShowT Bool where+    {-# INLINE toTextBuilder #-}+    toTextBuilder _ True = TextBuilder "True"+    toTextBuilder _ _    = TextBuilder "False"++instance ShowT Char where+    {-# INLINE toTextBuilder #-}+    toTextBuilder _ = TextBuilder . B.string8 . show++instance ShowT Double where {{-# INLINE toTextBuilder #-}; toTextBuilder _ = double;}+instance ShowT Float  where {{-# INLINE toTextBuilder #-}; toTextBuilder _ = float;}++instance ShowT Int     where {{-# INLINE toTextBuilder #-}; toTextBuilder _ = int;}+instance ShowT Int8    where {{-# INLINE toTextBuilder #-}; toTextBuilder _ = int;}+instance ShowT Int16   where {{-# INLINE toTextBuilder #-}; toTextBuilder _ = int;}+instance ShowT Int32   where {{-# INLINE toTextBuilder #-}; toTextBuilder _ = int;}+instance ShowT Int64   where {{-# INLINE toTextBuilder #-}; toTextBuilder _ = int;}+instance ShowT Word     where {{-# INLINE toTextBuilder #-}; toTextBuilder _ = int;}+instance ShowT Word8    where {{-# INLINE toTextBuilder #-}; toTextBuilder _ = int;}+instance ShowT Word16   where {{-# INLINE toTextBuilder #-}; toTextBuilder _ = int;}+instance ShowT Word32   where {{-# INLINE toTextBuilder #-}; toTextBuilder _ = int;}+instance ShowT Word64   where {{-# INLINE toTextBuilder #-}; toTextBuilder _ = int;}++instance ShowT Integer  where {{-# INLINE toTextBuilder #-}; toTextBuilder _ = integer;}+instance ShowT Natural  where {{-# INLINE toTextBuilder #-}; toTextBuilder _ = integer . fromIntegral}+instance ShowT Ordering where+    {-# INLINE toTextBuilder #-}+    toTextBuilder _ GT = TextBuilder "GT"+    toTextBuilder _ EQ = TextBuilder "EQ"+    toTextBuilder _ _  = TextBuilder "LT"++instance ShowT () where+    {-# INLINE toTextBuilder #-}+    toTextBuilder _ () = TextBuilder "()"++instance ShowT Version where+    {-# INLINE toTextBuilder #-}+    toTextBuilder _ = stringUTF8 . show++-- | The escaping rules is same with 'Show' instance: we reuse JSON escaping rules here, so it will be faster.+instance ShowT Text where+    {-# INLINE toTextBuilder #-}+    toTextBuilder _ = TextBuilder . escapeTextJSON++-- | Escape text using JSON string escaping rules and add double quotes, escaping rules:+--+-- @+--    \'\\b\':  \"\\b\"+--    \'\\f\':  \"\\f\"+--    \'\\n\':  \"\\n\"+--    \'\\r\':  \"\\r\"+--    \'\\t\':  \"\\t\"+--    \'\"\':  \"\\\"\"+--    \'\\\':  \"\\\\\"+--    \'\/\':  \"\\/\"+--    other chars <= 0x1F: "\\u00XX"+-- @+--+escapeTextJSON :: T.Text -> B.Builder ()+{-# INLINE escapeTextJSON #-}+escapeTextJSON (T.Text (V.PrimVector ba@(PrimArray ba#) s l)) = do+    let siz = escape_json_string_length ba# s l+    B.ensureN siz+    B.Builder (\ _  k (B.Buffer mba@(MutablePrimArray mba#) i) -> do+        if siz == l+2   -- no need to escape+        then do+            writePrimArray mba i DOUBLE_QUOTE+            copyPrimArray mba (i+1) ba s l+            writePrimArray mba (i+1+l) DOUBLE_QUOTE+        else void $ unsafeIOToST (escape_json_string ba# s l (unsafeCoerce# mba#) i)+        k () (B.Buffer mba (i+siz)))++foreign import ccall unsafe escape_json_string_length+    :: ByteArray# -> Int -> Int -> Int++foreign import ccall unsafe escape_json_string+    :: ByteArray# -> Int -> Int -> MutableByteArray# RealWorld -> Int -> IO Int++instance ShowT Sci.Scientific where+    {-# INLINE toTextBuilder #-}+    toTextBuilder _ = scientific++instance ShowT a => ShowT [a] where+    {-# INLINE toTextBuilder #-}+    toTextBuilder _ = square . intercalateList comma (toTextBuilder 0)++instance ShowT a => ShowT (A.Array a) where+    {-# INLINE toTextBuilder #-}+    toTextBuilder _ = square . intercalateVec comma (toTextBuilder 0)++instance ShowT a => ShowT (A.SmallArray a) where+    {-# INLINE toTextBuilder #-}+    toTextBuilder _ = square . intercalateVec comma (toTextBuilder 0)++instance (A.PrimUnlifted a, ShowT a) => ShowT (A.UnliftedArray a) where+    {-# INLINE toTextBuilder #-}+    toTextBuilder _ = square . intercalateVec comma (toTextBuilder 0)++instance (Prim a, ShowT a) => ShowT (A.PrimArray a) where+    {-# INLINE toTextBuilder #-}+    toTextBuilder _ = square . intercalateVec comma (toTextBuilder 0)++instance ShowT a => ShowT (V.Vector a) where+    {-# INLINE toTextBuilder #-}+    toTextBuilder _ = square . intercalateVec comma (toTextBuilder 0)++instance (Prim a, ShowT a) => ShowT (V.PrimVector a) where+    {-# INLINE toTextBuilder #-}+    toTextBuilder _ = square . intercalateVec comma (toTextBuilder 0)++instance (ShowT a, ShowT b) => ShowT (a, b) where+    {-# INLINE toTextBuilder #-}+    toTextBuilder _ (a, b) = paren $  toTextBuilder 0 a+                     >> comma >> toTextBuilder 0 b++instance (ShowT a, ShowT b, ShowT c) => ShowT (a, b, c) where+    {-# INLINE toTextBuilder #-}+    toTextBuilder _ (a, b, c) = paren $  toTextBuilder 0 a+                     >> comma >> toTextBuilder 0 b+                     >> comma >> toTextBuilder 0 c++instance (ShowT a, ShowT b, ShowT c, ShowT d) => ShowT (a, b, c, d) where+    {-# INLINE toTextBuilder #-}+    toTextBuilder _ (a, b, c, d) = paren $  toTextBuilder 0 a+                     >> comma >> toTextBuilder 0 b+                     >> comma >> toTextBuilder 0 c+                     >> comma >> toTextBuilder 0 d++instance (ShowT a, ShowT b, ShowT c, ShowT d, ShowT e) => ShowT (a, b, c, d, e) where+    {-# INLINE toTextBuilder #-}+    toTextBuilder _ (a, b, c, d, e) = paren $  toTextBuilder 0 a+                     >> comma >> toTextBuilder 0 b+                     >> comma >> toTextBuilder 0 c+                     >> comma >> toTextBuilder 0 d+                     >> comma >> toTextBuilder 0 e++instance (ShowT a, ShowT b, ShowT c, ShowT d, ShowT e, ShowT f) => ShowT (a, b, c, d, e, f) where+    {-# INLINE toTextBuilder #-}+    toTextBuilder _ (a, b, c, d, e, f) = paren $  toTextBuilder 0 a+                     >> comma >> toTextBuilder 0 b+                     >> comma >> toTextBuilder 0 c+                     >> comma >> toTextBuilder 0 d+                     >> comma >> toTextBuilder 0 e+                     >> comma >> toTextBuilder 0 f++instance (ShowT a, ShowT b, ShowT c, ShowT d, ShowT e, ShowT f, ShowT g) => ShowT (a, b, c, d, e, f, g) where+    {-# INLINE toTextBuilder #-}+    toTextBuilder _ (a, b, c, d, e, f, g) = paren $  toTextBuilder 0 a+                     >> comma >> toTextBuilder 0 b+                     >> comma >> toTextBuilder 0 c+                     >> comma >> toTextBuilder 0 d+                     >> comma >> toTextBuilder 0 e+                     >> comma >> toTextBuilder 0 f+                     >> comma >> toTextBuilder 0 g++instance ShowT a => ShowT (Maybe a) where+    {-# INLINE toTextBuilder #-}+    toTextBuilder p (Just x) = parenWhen (p > 10) $ do TextBuilder "Just "+                                                       toTextBuilder 11 x+    toTextBuilder _ _        = TextBuilder "Nothing"++instance (ShowT a, ShowT b) => ShowT (Either a b) where+    {-# INLINE toTextBuilder #-}+    toTextBuilder p (Left x) = parenWhen (p > 10) $ do TextBuilder "Left "+                                                       toTextBuilder 11 x+    toTextBuilder p (Right x) = parenWhen (p > 10) $ do TextBuilder "Right "+                                                        toTextBuilder 11 x++instance (ShowT a, Integral a) => ShowT (Ratio a) where+    {-# INLINE toTextBuilder #-}+    toTextBuilder p r = parenWhen (p > 10) $ do toTextBuilder 8 (numerator r)+                                                TextBuilder " % "+                                                toTextBuilder 8 (denominator r)++instance HasResolution a => ShowT (Fixed a) where+    {-# INLINE toTextBuilder #-}+    toTextBuilder _ = TextBuilder . B.string8 .  show++instance ShowT CallStack where+    {-# INLINE toTextBuilder #-}+    toTextBuilder _ = TextBuilder . B.string8 .  show++deriving newtype instance ShowT CChar+deriving newtype instance ShowT CSChar+deriving newtype instance ShowT CUChar+deriving newtype instance ShowT CShort+deriving newtype instance ShowT CUShort+deriving newtype instance ShowT CInt+deriving newtype instance ShowT CUInt+deriving newtype instance ShowT CLong+deriving newtype instance ShowT CULong+deriving newtype instance ShowT CPtrdiff+deriving newtype instance ShowT CSize+deriving newtype instance ShowT CWchar+deriving newtype instance ShowT CSigAtomic+deriving newtype instance ShowT CLLong+deriving newtype instance ShowT CULLong+deriving newtype instance ShowT CBool+deriving newtype instance ShowT CIntPtr+deriving newtype instance ShowT CUIntPtr+deriving newtype instance ShowT CIntMax+deriving newtype instance ShowT CUIntMax+deriving newtype instance ShowT CClock+deriving newtype instance ShowT CTime+deriving newtype instance ShowT CUSeconds+deriving newtype instance ShowT CSUSeconds+deriving newtype instance ShowT CFloat+deriving newtype instance ShowT CDouble++deriving anyclass instance ShowT a => ShowT (Semigroup.Min a)+deriving anyclass instance ShowT a => ShowT (Semigroup.Max a)+deriving anyclass instance ShowT a => ShowT (Semigroup.First a)+deriving anyclass instance ShowT a => ShowT (Semigroup.Last a)+deriving anyclass instance ShowT a => ShowT (Semigroup.WrappedMonoid a)+deriving anyclass instance ShowT a => ShowT (Semigroup.Dual a)+deriving anyclass instance ShowT a => ShowT (Monoid.First a)+deriving anyclass instance ShowT a => ShowT (Monoid.Last a)+deriving anyclass instance ShowT a => ShowT (NonEmpty a)+deriving anyclass instance ShowT a => ShowT (Identity a)+deriving anyclass instance ShowT a => ShowT (Const a b)+deriving anyclass instance ShowT (Proxy a)+deriving anyclass instance ShowT b => ShowT (Tagged a b)+deriving anyclass instance ShowT (f (g a)) => ShowT (Compose f g a)+deriving anyclass instance (ShowT (f a), ShowT (g a)) => ShowT (Product f g a)+deriving anyclass instance (ShowT (f a), ShowT (g a), ShowT a) => ShowT (Sum f g a)

@@ -1,7 +1,3 @@-{-# LANGUAGE BangPatterns  #-}-{-# LANGUAGE MagicHash     #-}-{-# LANGUAGE UnboxedTuples #-}- {-| Module      : Z.Data.Text.UTF8Codec Description : UTF-8 codecs and helpers.

@@ -1,7 +1,3 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE PatternSynonyms #-}- {-| Module      : Z.Data.Text.UTF8Rewind Description : Errno provided by libuv@@ -67,7 +63,8 @@ -- | Unicode categories. -- -- See 'Z.Data.Text.Base.isCategory', you can combine categories with bitwise or.-newtype Category = Category CSize deriving (Show, Eq, Ord, Bits, FiniteBits, Generic)+newtype Category = Category CSize deriving (Show, Eq, Ord, Generic)+                                    deriving newtype (Bits, FiniteBits)  pattern CategoryLetterUppercase       :: Category pattern CategoryLetterLowercase       :: Category

@@ -1,20 +1,3 @@-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE CApiFFI #-}-{-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE UnliftedFFITypes #-}-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE QuasiQuotes #-}- {-| Module      : Z.Data.Vector Description : Fast boxed and unboxed vector

@@ -1,20 +1,3 @@-{-# LANGUAGE BangPatterns           #-}-{-# LANGUAGE DeriveDataTypeable     #-}-{-# LANGUAGE FlexibleContexts       #-}-{-# LANGUAGE FlexibleInstances      #-}-{-# LANGUAGE MagicHash              #-}-{-# LANGUAGE MultiParamTypeClasses  #-}-{-# LANGUAGE PatternSynonyms        #-}-{-# LANGUAGE RankNTypes             #-}-{-# LANGUAGE ScopedTypeVariables    #-}-{-# LANGUAGE TypeFamilies           #-}-{-# LANGUAGE TypeFamilyDependencies #-}-{-# LANGUAGE UnboxedTuples          #-}-{-# LANGUAGE ViewPatterns           #-}-{-# LANGUAGE UnliftedFFITypes       #-}-{-# LANGUAGE QuantifiedConstraints  #-}-{-# LANGUAGE TypeApplications       #-}- {-| Module      : Z.Data.Vector.Base Description : Fast boxed and unboxed vector@@ -103,7 +86,6 @@ import           Control.Monad.ST import           Data.Bits import           Data.Char                     (ord)-import           Data.Data import qualified Data.Foldable                 as F import           Data.Hashable                 (Hashable(..)) import           Data.Hashable.Lifted          (Hashable1(..), hashWithSalt1)@@ -203,7 +185,6 @@     {-# UNPACK #-} !(SmallArray a)  -- ^ payload     {-# UNPACK #-} !Int             -- ^ offset     {-# UNPACK #-} !Int             -- ^ length-    deriving (Typeable, Data)  instance Vec Vector a where     type IArray Vector = SmallArray@@ -395,7 +376,6 @@     {-# UNPACK #-} !(PrimArray a)   -- ^ payload     {-# UNPACK #-} !Int             -- ^ offset in elements of type a rather than in bytes     {-# UNPACK #-} !Int             -- ^ length in elements of type a rather than in bytes-  deriving Typeable  instance Prim a => Vec PrimVector a where     type IArray PrimVector = PrimArray@@ -1311,7 +1291,7 @@ -- | All exception can be throw by using 'Vec'. data VectorException = IndexOutOfVectorRange {-# UNPACK #-} !Int CallStack                      | EmptyVector CallStack-                    deriving (Show, Typeable)+                    deriving Show instance Exception VectorException  errorEmptyVector :: HasCallStack => a

@@ -1,10 +1,3 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE TypeApplications #-}- {-| Module      : Z.Data.Vector.Extra Description : Fast vector slice manipulation@@ -597,7 +590,7 @@  -- | /O(n)/ An efficient way to join vector with an element. ---intercalateElem :: Vec v a => a -> [v a] -> v a+intercalateElem :: forall v a. Vec v a => a -> [v a] -> v a {-# INLINE intercalateElem #-} intercalateElem _ [] = empty intercalateElem _ [v] = v@@ -606,6 +599,7 @@     len []             !acc = acc     len [Vec _ _ l]    !acc = l + acc     len (Vec _ _ l:vs') !acc = len vs' (acc+l+1)+    go :: forall s. Int -> [v a] -> MArr (IArray v) s a -> ST s ()     go !_ []               !_    = return ()     go !i (Vec arr s l:[]) !marr = copyArr marr i arr s l     go !i (Vec arr s l:vs') !marr = do@@ -630,12 +624,13 @@ -- -- For example, @'zipWith' (+)@ is applied to two vector to produce -- a vector of corresponding sums, the result will be evaluated strictly.-zipWith' :: (Vec v a, Vec u b, Vec w c)+zipWith' :: forall v a u b w c. (Vec v a, Vec u b, Vec w c)          => (a -> b -> c) -> v a -> u b -> w c {-# INLINE zipWith' #-} zipWith' f (Vec arrA sA lA) (Vec arrB sB lB) = create len (go 0)   where     !len = min lA lB+    go :: forall s. Int -> MArr (IArray w) s c -> ST s ()     go !i !marr         | i >= len = return ()         | otherwise = case indexArr' arrA (i+sA) of@@ -646,11 +641,12 @@ -- | 'unzipWith'' disassemble a vector with a disassembling function, -- -- The results inside tuple will be evaluated strictly.-unzipWith' :: (Vec v a, Vec u b, Vec w c)+unzipWith' :: forall v a u b w c. (Vec v a, Vec u b, Vec w c)            => (a -> (b, c)) -> v a -> (u b, w c) {-# INLINE unzipWith' #-} unzipWith' f (Vec arr s l) = createN2 l l (go 0)   where+    go :: forall s. Int -> MArr (IArray u) s b -> MArr (IArray w) s c -> ST s (Int, Int)     go !i !marrB !marrC         | i >= l = return (l,l)         | otherwise = case indexArr' arr (i+s) of

@@ -1,12 +1,3 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE OverloadedStrings #-}- {-| Module      : Z.Data.Vector.FlatIntMap Description : Fast int map based on sorted vector@@ -50,7 +41,7 @@ import qualified Data.Primitive.SmallArray  as A import qualified Z.Data.Vector.Base         as V import qualified Z.Data.Vector.Sort         as V-import qualified Z.Data.Text.Builder        as T+import qualified Z.Data.Text.ShowT          as T import           Data.Function              (on) import           Data.Bits                   (shiftR) import           Data.Data@@ -62,7 +53,7 @@ newtype FlatIntMap v = FlatIntMap { sortedKeyValues :: V.Vector (V.IPair v) }     deriving (Show, Eq, Ord, Typeable) -instance T.ToText v => T.ToText (FlatIntMap v) where+instance T.ShowT v => T.ShowT (FlatIntMap v) where     {-# INLINE toTextBuilder #-}     toTextBuilder p (FlatIntMap vec) = T.parenWhen (p > 10) $ do         T.unsafeFromBuilder "FlatIntMap {"

@@ -1,13 +1,3 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TupleSections #-}- {-| Module      : Z.Data.Vector.FlatIntSet Description : Fast int set based on sorted vector@@ -45,7 +35,7 @@ import qualified Data.Primitive.PrimArray   as A import qualified Z.Data.Vector.Base         as V import qualified Z.Data.Vector.Sort         as V-import qualified Z.Data.Text.Builder        as T+import qualified Z.Data.Text.ShowT          as T import           Data.Bits                   (shiftR) import           Data.Data import           Prelude hiding (elem, null)@@ -54,9 +44,9 @@ --------------------------------------------------------------------------------  newtype FlatIntSet = FlatIntSet { sortedValues :: V.PrimVector Int }-    deriving (Show, Eq, Ord, Typeable, NFData)+    deriving (Show, Eq, Ord, Typeable) -instance T.ToText FlatIntSet where+instance T.ShowT FlatIntSet where     {-# INLINE toTextBuilder #-}     toTextBuilder p (FlatIntSet vec) = T.parenWhen (p > 10) $ do         T.unsafeFromBuilder "FlatIntSet {"@@ -72,6 +62,10 @@     mappend = merge     {-# INLINE mempty #-}     mempty = empty++instance NFData FlatIntSet where+    {-# INLINE rnf #-}+    rnf (FlatIntSet vs) = rnf vs  instance Arbitrary FlatIntSet where     arbitrary = pack <$> arbitrary

@@ -1,13 +1,3 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE ScopedTypeVariables #-}- {-| Module      : Z.Data.Vector.FlatMap Description : Fast map based on sorted vector@@ -51,7 +41,7 @@ import qualified Data.Monoid                as Monoid import qualified Z.Data.Vector.Base as V import qualified Z.Data.Vector.Sort as V-import qualified Z.Data.Text.Builder        as T+import qualified Z.Data.Text.ShowT          as T import           Data.Function              (on) import           Data.Bits                   (shiftR) import           Data.Data@@ -63,7 +53,7 @@ newtype FlatMap k v = FlatMap { sortedKeyValues :: V.Vector (k, v) }     deriving (Show, Eq, Ord, Typeable) -instance (T.ToText k, T.ToText v) => T.ToText (FlatMap k v) where+instance (T.ShowT k, T.ShowT v) => T.ShowT (FlatMap k v) where     {-# INLINE toTextBuilder #-}     toTextBuilder p (FlatMap vec) = T.parenWhen (p > 10) $ do         T.unsafeFromBuilder "FlatMap {"

@@ -1,14 +1,3 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}- {-| Module      : Z.Data.Vector.FlatSet Description : Fast set based on sorted vector@@ -44,9 +33,9 @@ import qualified Data.Primitive.SmallArray  as A import qualified Data.Semigroup             as Semigroup import qualified Data.Monoid                as Monoid-import qualified Z.Data.Vector.Base as V-import qualified Z.Data.Vector.Sort as V-import qualified Z.Data.Text.Builder        as T+import qualified Z.Data.Vector.Base         as V+import qualified Z.Data.Vector.Sort         as V+import qualified Z.Data.Text.ShowT          as T import           Data.Bits                   (shiftR) import           Data.Data import           Prelude hiding (elem, null)@@ -55,9 +44,9 @@ --------------------------------------------------------------------------------  newtype FlatSet v = FlatSet { sortedValues :: V.Vector v }-    deriving (Show, Eq, Ord, Typeable, Foldable, NFData)+    deriving (Show, Eq, Ord, Typeable, Foldable) -instance T.ToText v => T.ToText (FlatSet v) where+instance T.ShowT v => T.ShowT (FlatSet v) where     {-# INLINE toTextBuilder #-}     toTextBuilder p (FlatSet vec) = T.parenWhen (p > 10) $ do         T.unsafeFromBuilder "FlatSet {"@@ -73,6 +62,10 @@     mappend = merge     {-# INLINE mempty #-}     mempty = empty++instance NFData v => NFData (FlatSet v) where+    {-# INLINE rnf #-}+    rnf (FlatSet vs) = rnf vs  instance (Ord v, Arbitrary v) => Arbitrary (FlatSet v) where     arbitrary = pack <$> arbitrary

@@ -1,7 +1,3 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE MagicHash #-}- {-| Module      : Z.Data.Vector.QQ Description : vectors literals using QuasiQuote

@@ -1,9 +1,3 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE ScopedTypeVariables #-}- {-| Module      : Z.Data.Vector.Search Description : Searching vectors

@@ -1,14 +1,3 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE CPP #-}- {-| Module      : Z.Data.Vector.Sort Description : Sorting vectors@@ -68,6 +57,7 @@ import           Data.Word import           Prelude                hiding (splitAt) import           Z.Data.Array+import           Z.Data.Array.Unaligned import           Z.Data.Vector.Base import           Z.Data.Vector.Extra @@ -97,6 +87,8 @@         w <- mergePass w1 w2 mergeTileSize         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@@ -104,12 +96,16 @@             insertSortToMArr cmp v' i marr             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             mergeLoop w1 w2 blockSiz 0             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@@ -120,6 +116,8 @@             mergeBlock src target (i+blockSiz) mergeEnd i (i+blockSiz) i             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@@ -263,7 +261,8 @@  -- | Similar to 'Down' newtype for 'Ord', this newtype can inverse the order of a 'Radix' -- instance when used in 'radixSort'.-newtype RadixDown a = RadixDown a deriving (Show, Eq, Prim)+newtype RadixDown a = RadixDown a deriving (Show, Eq)+                                    deriving newtype (Prim, Unaligned)  instance Radix a => Radix (RadixDown a) where     {-# INLINE bucketSize #-}@@ -293,14 +292,14 @@     | l <= 1 = v     | otherwise = runST (do         bucket <- newArrWith buktSiz 0 :: ST s (MutablePrimArray s Int)-        w1 <- newArr l+        w1 <- newArr l :: ST s (MArr (IArray v) s a)         firstCountPass arr bucket s         accumBucket bucket buktSiz 0 0         firstMovePass arr s bucket w1         w <- if passSiz == 1             then unsafeFreezeArr w1             else do-                w2 <- newArr l+                w2 <- newArr l :: ST s (MArr (IArray v) s a)                 radixLoop w1 w2 bucket buktSiz 1         return $! fromArr w 0 l)   where@@ -309,6 +308,7 @@     !end = s + l      {-# INLINABLE firstCountPass #-}+    firstCountPass :: forall s. IArray v a -> MutablePrimArray s Int -> Int -> ST s ()     firstCountPass !arr' !bucket !i         | i >= end  = return ()         | otherwise = case indexArr' arr' i of@@ -319,6 +319,7 @@                 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 ()         | otherwise = do@@ -327,6 +328,7 @@             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 ()         | otherwise = case indexArr' arr' i of@@ -338,6 +340,7 @@                 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             setArr bucket 0 bsiz 0   -- clear the counting bucket@@ -353,6 +356,7 @@             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 ()         | otherwise = do@@ -363,6 +367,7 @@                 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 ()         | otherwise = do@@ -374,6 +379,7 @@                 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 ()         | otherwise = do@@ -384,6 +390,7 @@                 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 ()         | otherwise = do@@ -449,12 +456,12 @@ -- | merge duplicated adjacent element, prefer left element. -- -- Use this function on a sorted vector will have the same effects as 'nub'.-mergeDupAdjacent :: (Vec v a, Eq a) => v a -> v a+mergeDupAdjacent :: forall v a. (Vec v a, Eq a) => v a -> v a {-# INLINE mergeDupAdjacent #-} mergeDupAdjacent = mergeDupAdjacentBy (==) const  -- | Merge duplicated adjacent element, prefer left element.-mergeDupAdjacentLeft :: Vec v a+mergeDupAdjacentLeft :: forall v a. Vec v a                      => (a -> a -> Bool)   -- ^ equality tester, @\ left right -> eq left right@                      -> v a                      -> v a@@ -462,7 +469,7 @@ {-# INLINE mergeDupAdjacentLeft #-}  -- | Merge duplicated adjacent element, prefer right element.-mergeDupAdjacentRight :: Vec v a+mergeDupAdjacentRight :: forall v a. Vec v a                       => (a -> a -> Bool)  -- ^ equality tester, @\ left right -> eq left right@                       -> v a                       -> v a@@ -470,7 +477,7 @@ mergeDupAdjacentRight eq = mergeDupAdjacentBy eq (\ _ x -> x)  -- | Merge duplicated adjacent element, based on a equality tester and a merger function.-mergeDupAdjacentBy :: Vec v a+mergeDupAdjacentBy :: forall v a. Vec v a                    => (a -> a -> Bool)  -- ^ equality tester, @\ left right -> eq left right@                    -> (a -> a -> a)     -- ^ the merger, @\ left right -> merge left right@                    -> v a -> v a@@ -484,6 +491,7 @@         go arr marr s 1 x0   where     !end = s + l+    go :: forall s. IArray v a -> MArr (IArray v) s a -> Int -> Int -> a -> ST s Int     go !arr' !marr !i !j !x         | i >= end  = return j         | otherwise = do

@@ -1,7 +1,3 @@-{-# LANGUAGE MagicHash           #-}-{-# LANGUAGE BangPatterns        #-}-{-# LANGUAGE ScopedTypeVariables #-}- {-| Module      : Z.Foreign Description : Use PrimArray with FFI

@@ -1,68 +0,0 @@-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE OverloadedStrings #-}--module Z.Data.Text.BuilderSpec where--import qualified Data.List                as L-import           Data.Word-import           Data.Int-import           GHC.Generics-import qualified Z.Data.Text            as T-import           Z.Data.Text.Builder-import           Z.Data.JSON            (Value)-import           Test.QuickCheck-import           Test.QuickCheck.Function-import           Test.QuickCheck.Property-import           Test.Hspec-import           Test.Hspec.QuickCheck---data T a-    = Nullary-    | Unary Int-    | Product T.Text (Maybe Char) a-    | Record { testOne   :: Double-             , testTwo   :: Maybe Bool-             , testThree :: Maybe a-             }-    | List [a]-   deriving (Show, Eq, ToText, Generic)--data I a = I a :+ I a | I a :- I a | J a deriving (Show, Generic, ToText)-infixr 5 :+-infixl 6 :---spec :: Spec-spec = describe "JSON Base instances" $ do--    it "Nullary constructor are encoded as text" $-        toText (Nullary :: T Integer) === "Nullary"--    it "Unary constructor are encoded as single field" $-        toText (Unary 123456 :: T Integer) === "Unary 123456"--    it "Product are encoded as multiple field" $-        toText (Product "ABC" (Just 'x') (123456::Integer)) ===-            "Product \"ABC\" (Just 'x') 123456"--    it "Record are encoded as key values" $-        toText (Record 0.123456 Nothing (Just (123456::Integer))) ===-            "Record {testOne = 0.123456, testTwo = Nothing, testThree = Just 123456}"--    it "List are encode as array" $-        toText (List [Nullary-            , Unary 123456-            , (Product "ABC" (Just 'x') (123456::Integer))-            , (Record 0.123456 Nothing (Just (123456::Integer)))]) ===-                "List [Nullary,Unary 123456,Product \"ABC\" (Just 'x') 123456,\-                    \Record {testOne = 0.123456, testTwo = Nothing, testThree = Just 123456}]"--    it "infix constructor should respect piority" $-        toString (J 1 :- J 2 :+ J 3 :- J 4 :- J 5 :+ J 6 :+ J 7 :+ J 8 :- J 9 :- J 10 :- J 11 :: I Int)-            === show (J 1 :- J 2 :+ J 3 :- J 4 :- J 5 :+ J 6 :+ J 7 :+ J 8 :- J 9 :- J 10 :- J 11)--    prop "Value Show instance === ToText instances" $ \ (v :: Value) ->-        toString v === show v

@@ -1,6 +1,3 @@-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE ScopedTypeVariables #-}- module Z.Data.Text.ExtraSpec where  import qualified Data.List                as List

@@ -1,6 +1,3 @@-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE ScopedTypeVariables #-}- module Z.Data.Text.SearchSpec where  import qualified Data.List                as List

@@ -0,0 +1,68 @@+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}++module Z.Data.Text.ShowTSpec where++import qualified Data.List                as L+import           Data.Word+import           Data.Int+import           GHC.Generics+import qualified Z.Data.Text            as T+import           Z.Data.Text.ShowT+import           Z.Data.JSON            (Value)+import           Test.QuickCheck+import           Test.QuickCheck.Function+import           Test.QuickCheck.Property+import           Test.Hspec+import           Test.Hspec.QuickCheck+++data T a+    = Nullary+    | Unary Int+    | Product T.Text (Maybe Char) a+    | Record { testOne   :: Double+             , testTwo   :: Maybe Bool+             , testThree :: Maybe a+             }+    | List [a]+   deriving (Show, Eq, ShowT, Generic)++data I a = I a :+ I a | I a :- I a | J a deriving (Show, Generic, ShowT)+infixr 5 :++infixl 6 :-++spec :: Spec+spec = describe "JSON Base instances" $ do++    it "Nullary constructor are encoded as text" $+        showT (Nullary :: T Integer) === "Nullary"++    it "Unary constructor are encoded as single field" $+        showT (Unary 123456 :: T Integer) === "Unary 123456"++    it "Product are encoded as multiple field" $+        showT (Product "ABC" (Just 'x') (123456::Integer)) ===+            "Product \"ABC\" (Just 'x') 123456"++    it "Record are encoded as key values" $+        showT (Record 0.123456 Nothing (Just (123456::Integer))) ===+            "Record {testOne = 0.123456, testTwo = Nothing, testThree = Just 123456}"++    it "List are encode as array" $+        showT (List [Nullary+            , Unary 123456+            , (Product "ABC" (Just 'x') (123456::Integer))+            , (Record 0.123456 Nothing (Just (123456::Integer)))]) ===+                "List [Nullary,Unary 123456,Product \"ABC\" (Just 'x') 123456,\+                    \Record {testOne = 0.123456, testTwo = Nothing, testThree = Just 123456}]"++    it "infix constructor should respect piority" $+        toString (J 1 :- J 2 :+ J 3 :- J 4 :- J 5 :+ J 6 :+ J 7 :+ J 8 :- J 9 :- J 10 :- J 11 :: I Int)+            === show (J 1 :- J 2 :+ J 3 :- J 4 :- J 5 :+ J 6 :+ J 7 :+ J 8 :- J 9 :- J 10 :- J 11)++    prop "Value Show instance === ToText instances" $ \ (v :: Value) ->+        toString v === show v