Z-Data 0.2.0.0 → 0.3.0.0

raw patch · 45 files changed

+2226/−911 lines, 45 filesdep +timedep −word8PVP ok

version bump matches the API change (PVP)

Dependencies added: time

Dependencies removed: word8

API changes (from Hackage documentation)

Files

• ChangeLog.md +11/−0
• README.md +1/−1
• Z-Data.cabal +12/−5
• Z/Data/ASCII.hs +343/−0
• Z/Data/Array/Unaligned.hs +403/−85
• Z/Data/Builder.hs +9/−9
• Z/Data/Builder/Base.hs +30/−27
• Z/Data/Builder/Numeric.hs +17/−31
• Z/Data/Builder/Time.hs +141/−0
• Z/Data/CBytes.hs +70/−59
• Z/Data/JSON.hs +37/−42
• Z/Data/JSON/Base.hs +207/−7
• Z/Data/JSON/Builder.hs +7/−4
• Z/Data/JSON/Value.hs +4/−4
• Z/Data/Parser.hs +11/−3
• Z/Data/Parser/Base.hs +19/−11
• Z/Data/Parser/Numeric.hs +32/−24
• Z/Data/Parser/Time.hs +142/−0
• Z/Data/PrimRef/PrimIORef.hs +1/−0
• Z/Data/PrimRef/PrimSTRef.hs +1/−0
• Z/Data/Text.hs +4/−1
• Z/Data/Text/Base.hs +4/−3
• Z/Data/Text/Print.hs +462/−0
• Z/Data/Text/Regex.hs +3/−3
• Z/Data/Text/ShowT.hs +0/−462
• Z/Data/Vector.hs +1/−1
• Z/Data/Vector/Base.hs +6/−19
• Z/Data/Vector/Base64.hs +2/−2
• Z/Data/Vector/FlatIntMap.hs +5/−5
• Z/Data/Vector/FlatIntSet.hs +4/−4
• Z/Data/Vector/FlatMap.hs +5/−5
• Z/Data/Vector/FlatSet.hs +4/−4
• Z/Data/Vector/Hex.hs +2/−2
• Z/Foreign.hs +8/−3
• cbits/regex.cc +3/−3
• test/Z/Data/Array/UnalignedSpec.hs +58/−0
• test/Z/Data/Builder/TimeSpec.hs +38/−0
• test/Z/Data/JSON/ValueSpec.hs +0/−1
• test/Z/Data/Parser/BaseSpec.hs +3/−2
• test/Z/Data/Parser/NumericSpec.hs +0/−1
• test/Z/Data/Parser/TimeSpec.hs +36/−0
• test/Z/Data/Text/PrintSpec.hs +68/−0
• test/Z/Data/Text/ShowTSpec.hs +0/−68
• test/Z/Data/Vector/BaseSpec.hs +4/−3
• test/Z/Data/Vector/ExtraSpec.hs +8/−7

@@ -1,5 +1,16 @@ # Revision history for Z-Data +## 0.3.0.0  -- 2020-12-29++* Hide `Text` constructor from `Z.Data.Text`.+* Add `fromStdString` to `Z.Data.CBytes`.+* Re-export `touch` from `Z.Foreign`, export `ConvertError` constructor from `Z.Data.JSON`.+* Add `anyChar8` to `Z.Data.Parser`.+* Add `Z.Data.ASCII`, move `c2w`, `w2c`, `isDigit`, `isSpace`, `isHexDigit` and ASCII constants to it.+* Rename `ShowT` class to `Print`, re-export from `Z.Data.Text` module.+* Add various JSON instances of types from `time` package, add `Z.Data.Builder.Time` and `Z.Data.Parser.Time`.+* Fix a bug affecting comparing `PrimVector`s.+ ## 0.2.0.0  -- 2020-12-15  * Add `Z.Data.Text.Regex` module, which provide regex functions using RE2.

@@ -65,7 +65,7 @@ ([],Right (Array [Number 1.0,Number 2.0,Number 3.0,Number 4.0,Number 5.0])) > > -- JSON module support deriving through Generic-> set -XDeriveAnyClass -XDeriveGeneric+> :set -XDeriveAnyClass -XDeriveGeneric > data Foo = Foo {foo :: Double} deriving (JSON.FromValue, JSON.ToValue, JSON.EncodeJSON, Generic) > JSON.toValue (Foo 0.01) Object [("foo",Number 1.0e-2)]

@@ -1,6 +1,6 @@ cabal-version:              2.4 name:                       Z-Data-version:                    0.2.0.0+version:                    0.3.0.0 synopsis:                   Array, vector and text description:                This package provides array, slice and text operations license:                    BSD-3-Clause@@ -129,6 +129,7 @@                             Z.Data.Array.QQ                             Z.Data.Array.Unaligned                             Z.Data.Array.UnliftedArray+                            Z.Data.ASCII                             Z.Data.CBytes                             Z.Data.Vector                             Z.Data.Vector.Base@@ -148,7 +149,7 @@                             Z.Data.Text.Extra                             Z.Data.Text.Regex                             Z.Data.Text.Search-                            Z.Data.Text.ShowT+                            Z.Data.Text.Print                             Z.Data.Text.UTF8Codec                             Z.Data.Text.UTF8Rewind @@ -156,12 +157,14 @@                             Z.Data.Builder.Base                             Z.Data.Builder.Numeric                             Z.Data.Builder.Numeric.DigitTable+                            Z.Data.Builder.Time                              Z.Data.Generics.Utils                              Z.Data.Parser                             Z.Data.Parser.Base                             Z.Data.Parser.Numeric+                            Z.Data.Parser.Time                              Z.Data.PrimRef                             Z.Data.PrimRef.PrimSTRef@@ -172,6 +175,7 @@                             Z.Data.JSON.Builder                             Z.Data.JSON.Value +                             Z.Foreign      build-depends:          base                    >= 4.12 && <5.0@@ -182,9 +186,10 @@                           , case-insensitive        == 1.2.*                           , deepseq                 >= 1.4 && < 1.5                           , QuickCheck              >= 2.10+                          , tagged                  == 0.8.*                           , template-haskell        >= 2.14.0+                          , time                    >= 1.9 && < 2.0                           , unordered-containers    == 0.2.*-                          , tagged                  == 0.8.*      if os(windows)         extra-libraries:    stdc++@@ -321,15 +326,17 @@     build-tool-depends:     hsc2hs:hsc2hs, hspec-discover:hspec-discover     other-modules:          Z.Data.CBytesSpec                             Z.Data.Builder.NumericSpec+                            Z.Data.Builder.TimeSpec                             Z.Data.JSON.BaseSpec                             Z.Data.JSON.ValueSpec                             Z.Data.Parser.BaseSpec                             Z.Data.Parser.NumericSpec+                            Z.Data.Parser.TimeSpec                             Z.Data.Array.UnalignedSpec                             Z.Data.Text.BaseSpec                             Z.Data.Text.ExtraSpec                             Z.Data.Text.SearchSpec-                            Z.Data.Text.ShowTSpec+                            Z.Data.Text.PrintSpec                             Z.Data.Vector.BaseSpec                             Z.Data.Vector.ExtraSpec                             Z.Data.Vector.SearchSpec@@ -347,9 +354,9 @@                           , HUnit                           , QuickCheck              >= 2.10                           , quickcheck-instances-                          , word8                           , scientific                           , primitive+                          , time      c-sources:              test/cbits/ffi.c 

@@ -0,0 +1,343 @@+module Z.Data.ASCII where++import GHC.Word+import GHC.Exts++-- | Conversion between 'Word8' and 'Char'. Should compile to a no-op.+--+w2c :: Word8 -> Char+{-# INLINE w2c #-}+w2c (W8# w#) = C# (chr# (word2Int# w#))++-- | Unsafe conversion between 'Char' and 'Word8'. This is a no-op and+-- silently truncates to 8 bits Chars > @\\255@.+c2w :: Char -> Word8+{-# INLINE c2w #-}+c2w (C# c#) = W8# (int2Word# (ord# c#))++-- | @\\NUL <= w && w <= \\DEL@+isASCII :: Word8 -> Bool+{-# INLINE isASCII #-}+isASCII w = w <= DEL++-- | @A ~ Z@+isUpper :: Word8 -> Bool+{-# INLINE isUpper #-}+isUpper w = w - LETTER_A <= 25++-- | @a ~ z@+isLower :: Word8 -> Bool+{-# INLINE isLower #-}+isLower w =  w - LETTER_a <= 25++-- | @ISO-8859-1@ control letter.+isControl :: Word8 -> Bool+{-# INLINE isControl #-}+isControl w = w <= 0x1f || w - DEL <= 32++-- | @ISO-8859-1@ space letter.+isSpace :: Word8 -> Bool+{-# INLINE isSpace #-}+isSpace w = w == SPACE || w - TAB <= 4 || w == 0xa0++-- | @0 ~ 9@+isDigit :: Word8 -> Bool+{-# INLINE isDigit #-}+isDigit w = w - DIGIT_0 <= 9++-- | @0 ~ 7@+isOctDigit :: Word8 -> Bool+{-# INLINE isOctDigit #-}+isOctDigit w = w - DIGIT_0 <= 7++-- | @0 ~ 9, A ~ F, a ~ f@+isHexDigit :: Word8 -> Bool+{-# INLINE isHexDigit #-}+isHexDigit w = w - DIGIT_0 <= 9 || w - LETTER_A <= 5 || w - LETTER_a <= 5++----------------------------------------------------------------++-- | @\\NUL@+pattern NUL :: Word8+pattern NUL          = 0x00+-- | @\\t@+pattern TAB :: Word8+pattern TAB          = 0x09+-- | @\\n@+pattern NEWLINE :: Word8+pattern NEWLINE      = 0x0a+-- | @\\v@+pattern VERTICAL_TAB :: Word8+pattern VERTICAL_TAB = 0x0b+-- | @\\f@+pattern FORM_FEED :: Word8+pattern FORM_FEED    = 0x0c+-- | @\\r@+pattern CARRIAGE_RETURN :: Word8+pattern CARRIAGE_RETURN = 0x0d++-- | @\' \'@+pattern SPACE :: Word8+pattern SPACE        = 0x20+-- | @\!@+pattern EXCLAM :: Word8+pattern EXCLAM       = 0x21+-- | @\"@+pattern QUOTE_DOUBLE :: Word8+pattern QUOTE_DOUBLE = 0x22+-- | @\#@+pattern HASH :: Word8+pattern HASH         = 0x23+-- | @\#@+pattern NUMBER_SIGN :: Word8+pattern NUMBER_SIGN  = 0x23+-- | @\$@+pattern DOLLAR :: Word8+pattern DOLLAR       = 0x24+-- | @\%@+pattern PERCENT :: Word8+pattern PERCENT      = 0x25+-- | @\&@+pattern AMPERSAND :: Word8+pattern AMPERSAND    = 0x26+-- | @\&@+pattern AND :: Word8+pattern AND          = 0x26+-- | @\'@+pattern QUOTE_SINGLE :: Word8+pattern QUOTE_SINGLE = 0x27+-- | @(@+pattern PAREN_LEFT :: Word8+pattern PAREN_LEFT   = 0x28+-- | @)@+pattern PAREN_RIGHT :: Word8+pattern PAREN_RIGHT  = 0x29+-- | @*@+pattern ASTERISK :: Word8+pattern ASTERISK     = 0x2a+-- | @+@+pattern PLUS :: Word8+pattern PLUS         = 0x2b+-- | @,@+pattern COMMA :: Word8+pattern COMMA        = 0x2c+-- | @-@+pattern HYPHEN :: Word8+pattern HYPHEN       = 0x2d+-- | @-@+pattern MINUS :: Word8+pattern MINUS        = 0x2d+-- | @.@+pattern PERIOD :: Word8+pattern PERIOD       = 0x2e+-- | @.@+pattern DOT :: Word8+pattern DOT          = 0x2e+-- | @\/@+pattern SLASH :: Word8+pattern SLASH        = 0x2f++pattern DIGIT_0 :: Word8+pattern DIGIT_0      = 0x30+pattern DIGIT_1 :: Word8+pattern DIGIT_1      = 0x31+pattern DIGIT_2 :: Word8+pattern DIGIT_2      = 0x32+pattern DIGIT_3 :: Word8+pattern DIGIT_3      = 0x33+pattern DIGIT_4 :: Word8+pattern DIGIT_4      = 0x34+pattern DIGIT_5 :: Word8+pattern DIGIT_5      = 0x35+pattern DIGIT_6 :: Word8+pattern DIGIT_6      = 0x36+pattern DIGIT_7 :: Word8+pattern DIGIT_7      = 0x37+pattern DIGIT_8 :: Word8+pattern DIGIT_8      = 0x38+pattern DIGIT_9 :: Word8+pattern DIGIT_9      = 0x39++-- | @:@+pattern COLON :: Word8+pattern COLON        = 0x3a+-- | @;@+pattern SEMICOLON :: Word8+pattern SEMICOLON    = 0x3b+-- | @<@+pattern LESS :: Word8+pattern LESS         = 0x3c+-- | @<@+pattern ANGLE_LEFT :: Word8+pattern ANGLE_LEFT   = 0x3c+-- | @=@+pattern EQUAL :: Word8+pattern EQUAL        = 0x3d+-- | @>@+pattern GREATER :: Word8+pattern GREATER      = 0x3e+-- | @>@+pattern ANGLE_RIGHT :: Word8+pattern ANGLE_RIGHT  = 0x3e+-- | @\?@+pattern QUESTION :: Word8+pattern QUESTION     = 0x3f+-- | @\@@+pattern AT :: Word8+pattern AT           = 0x40++pattern LETTER_A :: Word8+pattern LETTER_A     = 0x41+pattern LETTER_B :: Word8+pattern LETTER_B     = 0x42+pattern LETTER_C :: Word8+pattern LETTER_C     = 0x43+pattern LETTER_D :: Word8+pattern LETTER_D     = 0x44+pattern LETTER_E :: Word8+pattern LETTER_E     = 0x45+pattern LETTER_F :: Word8+pattern LETTER_F     = 0x46+pattern LETTER_G :: Word8+pattern LETTER_G     = 0x47+pattern LETTER_H :: Word8+pattern LETTER_H     = 0x48+pattern LETTER_I :: Word8+pattern LETTER_I     = 0x49+pattern LETTER_J :: Word8+pattern LETTER_J     = 0x4a+pattern LETTER_K :: Word8+pattern LETTER_K     = 0x4b+pattern LETTER_L :: Word8+pattern LETTER_L     = 0x4c+pattern LETTER_M :: Word8+pattern LETTER_M     = 0x4d+pattern LETTER_N :: Word8+pattern LETTER_N     = 0x4e+pattern LETTER_O :: Word8+pattern LETTER_O     = 0x4f+pattern LETTER_P :: Word8+pattern LETTER_P     = 0x50+pattern LETTER_Q :: Word8+pattern LETTER_Q     = 0x51+pattern LETTER_R :: Word8+pattern LETTER_R     = 0x52+pattern LETTER_S :: Word8+pattern LETTER_S     = 0x53+pattern LETTER_T :: Word8+pattern LETTER_T     = 0x54+pattern LETTER_U :: Word8+pattern LETTER_U     = 0x55+pattern LETTER_V :: Word8+pattern LETTER_V     = 0x56+pattern LETTER_W :: Word8+pattern LETTER_W     = 0x57+pattern LETTER_X :: Word8+pattern LETTER_X     = 0x58+pattern LETTER_Y :: Word8+pattern LETTER_Y     = 0x59+pattern LETTER_Z :: Word8+pattern LETTER_Z     = 0x5a++-- | @[@+pattern BRACKET_LEFT :: Word8+pattern BRACKET_LEFT = 0x5b+-- | @[@+pattern SQUARE_LEFT :: Word8+pattern SQUARE_LEFT = 0x5b+-- | @\\@+pattern BACKSLASH :: Word8+pattern BACKSLASH    = 0x5c+-- | @]@+pattern BRACKET_RIGHT :: Word8+pattern BRACKET_RIGHT = 0x5d+-- | @]@+pattern SQUARE_RIGHT :: Word8+pattern SQUARE_RIGHT = 0x5d+-- | @^@+pattern CIRCUM :: Word8+pattern CIRCUM       = 0x5e+-- | @_@+pattern UNDERSCORE :: Word8+pattern UNDERSCORE   = 0x5f+-- | @`@+pattern GRAVE :: Word8+pattern GRAVE        = 0x60++pattern LETTER_a :: Word8+pattern LETTER_a     = 0x61+pattern LETTER_b :: Word8+pattern LETTER_b     = 0x62+pattern LETTER_c :: Word8+pattern LETTER_c     = 0x63+pattern LETTER_d :: Word8+pattern LETTER_d     = 0x64+pattern LETTER_e :: Word8+pattern LETTER_e     = 0x65+pattern LETTER_f :: Word8+pattern LETTER_f     = 0x66+pattern LETTER_g :: Word8+pattern LETTER_g     = 0x67+pattern LETTER_h :: Word8+pattern LETTER_h     = 0x68+pattern LETTER_i :: Word8+pattern LETTER_i     = 0x69+pattern LETTER_j :: Word8+pattern LETTER_j     = 0x6a+pattern LETTER_k :: Word8+pattern LETTER_k     = 0x6b+pattern LETTER_l :: Word8+pattern LETTER_l     = 0x6c+pattern LETTER_m :: Word8+pattern LETTER_m     = 0x6d+pattern LETTER_n :: Word8+pattern LETTER_n     = 0x6e+pattern LETTER_o :: Word8+pattern LETTER_o     = 0x6f+pattern LETTER_p :: Word8+pattern LETTER_p     = 0x70+pattern LETTER_q :: Word8+pattern LETTER_q     = 0x71+pattern LETTER_r :: Word8+pattern LETTER_r     = 0x72+pattern LETTER_s :: Word8+pattern LETTER_s     = 0x73+pattern LETTER_t :: Word8+pattern LETTER_t     = 0x74+pattern LETTER_u :: Word8+pattern LETTER_u     = 0x75+pattern LETTER_v :: Word8+pattern LETTER_v     = 0x76+pattern LETTER_w :: Word8+pattern LETTER_w     = 0x77+pattern LETTER_x :: Word8+pattern LETTER_x     = 0x78+pattern LETTER_y :: Word8+pattern LETTER_y     = 0x79+pattern LETTER_z :: Word8+pattern LETTER_z     = 0x7a++-- | @{@+pattern BRACE_LEFT :: Word8+pattern BRACE_LEFT   = 0x7b+-- | @{@+pattern CURLY_LEFT :: Word8+pattern CURLY_LEFT   = 0x7b+-- | @|@+pattern BAR :: Word8+pattern BAR          = 0x7c+-- | @|@+pattern OR :: Word8+pattern OR           = 0x7c+-- | @}@+pattern BRACE_RIGHT :: Word8+pattern BRACE_RIGHT  = 0x7d+-- | @}@+pattern CURLY_RIGHT :: Word8+pattern CURLY_RIGHT  = 0x7d+-- | @~@+pattern TILDE :: Word8+pattern TILDE        = 0x7e+-- | @\\DEL@+pattern DEL :: Word8+pattern DEL          = 0x7f

@@ -18,6 +18,7 @@ import           Data.Primitive.ByteArray import           Data.Primitive.PrimArray import           GHC.Int+import           GHC.IO import           GHC.Exts import           GHC.Word import           GHC.Float (stgFloatToWord32, stgWord32ToFloat, stgWord64ToDouble, stgDoubleToWord64)@@ -31,6 +32,9 @@  -------------------------------------------------------------------------------- +newtype UnalignedSize a = UnalignedSize { getUnalignedSize :: Int } deriving (Show, Eq, Ord)+                                                                    deriving newtype Num+ -- | Primitive types which can be unaligned accessed -- -- It can also be used as a lightweight method to peek\/poke value from\/to C structs@@ -50,18 +54,12 @@ -- @ -- class Unaligned a where-    {-# MINIMAL (unalignedSize# | unalignedSize),+    {-# MINIMAL unalignedSize,                 (indexWord8ArrayAs# | indexBA),                 (writeWord8ArrayAs# | peekMBA),                 (readWord8ArrayAs# | pokeMBA) #-}     -- | byte size-    unalignedSize :: a -> Int-    {-# INLINE unalignedSize #-}-    unalignedSize a = I# (unalignedSize# a)--    unalignedSize# :: a -> Int#-    {-# INLINE unalignedSize# #-}-    unalignedSize# a = case unalignedSize a of I# siz_a# -> siz_a#+    unalignedSize :: UnalignedSize a      -- | index element off byte array with offset in bytes(maybe unaligned)     indexWord8ArrayAs# :: ByteArray# -> Int# -> a@@ -72,13 +70,14 @@     readWord8ArrayAs#  :: MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)     {-# INLINE  readWord8ArrayAs# #-}     readWord8ArrayAs# mba# i# s# =-        (unsafeCoerce# (peekMBA (unsafeCoerce# mba#) (I# i#) :: IO a)) s#+        unsafeCoerce# (peekMBA (unsafeCoerce# mba#) (I# i#) :: IO a) s#      -- | write element to byte array with offset in bytes(maybe unaligned)     writeWord8ArrayAs# :: MutableByteArray# s -> Int# -> a -> State# s -> State# s     {-# INLINE  writeWord8ArrayAs# #-}     writeWord8ArrayAs# mba# i# x s# =-        unsafeCoerce# (pokeMBA (unsafeCoerce# mba#) (I# i#) x) s#+        let !(# s'#, _ #) = unIO (pokeMBA (unsafeCoerce# mba#) (I# i#) x :: IO ()) (unsafeCoerce# s#)+        in unsafeCoerce# s'#      -- | IO version of 'writeWord8ArrayAs#' but more convenient to write manually.     peekMBA :: MutableByteArray# RealWorld -> Int -> IO a@@ -128,7 +127,7 @@  instance Unaligned Word8 where     {-# INLINE unalignedSize #-}-    unalignedSize _ = 1+    unalignedSize = UnalignedSize 1     {-# INLINE writeWord8ArrayAs# #-}     writeWord8ArrayAs# mba# i# (W8# x#) = writeWord8Array# mba# i# x#     {-# INLINE readWord8ArrayAs# #-}@@ -139,7 +138,7 @@  instance Unaligned Int8 where     {-# INLINE unalignedSize #-}-    unalignedSize _ = 1+    unalignedSize = UnalignedSize 1     {-# INLINE writeWord8ArrayAs# #-}     writeWord8ArrayAs# mba# i# (I8# x#) = writeInt8Array# mba# i# x#     {-# INLINE readWord8ArrayAs# #-}@@ -169,7 +168,7 @@  instance Unaligned Word16 where     {-# INLINE unalignedSize #-}-    unalignedSize _ = 2+    unalignedSize = UnalignedSize 2     {-# INLINE writeWord8ArrayAs# #-}     writeWord8ArrayAs# mba# i# (W16# x#) = writeWord8ArrayAsWord16# mba# i# x#     {-# INLINE readWord8ArrayAs# #-}@@ -180,7 +179,7 @@  instance Unaligned (LE Word16) where     {-# INLINE unalignedSize #-}-    unalignedSize _ = 2+    unalignedSize = UnalignedSize 2 #if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)     {-# INLINE writeWord8ArrayAs# #-}     writeWord8ArrayAs# mba# i# (LE (W16# x#)) s0# =@@ -202,7 +201,7 @@  instance Unaligned (BE Word16) where     {-# INLINE unalignedSize #-}-    unalignedSize _ = 2+    unalignedSize = UnalignedSize 2 #if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)     USE_HOST_IMPL(BE) #else@@ -239,7 +238,7 @@  instance Unaligned Word32 where     {-# INLINE unalignedSize #-}-    unalignedSize _ = 4+    unalignedSize = UnalignedSize 4     {-# INLINE writeWord8ArrayAs# #-}     writeWord8ArrayAs# mba# i# (W32# x#) =  writeWord8ArrayAsWord32# mba# i# x#     {-# INLINE readWord8ArrayAs# #-}@@ -251,7 +250,7 @@  instance Unaligned (LE Word32) where     {-# INLINE unalignedSize #-}-    unalignedSize _ = 4+    unalignedSize = UnalignedSize 4 #if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)     {-# INLINE writeWord8ArrayAs# #-}     writeWord8ArrayAs# mba# i# (LE (W32# x#)) s0# =@@ -283,7 +282,7 @@  instance Unaligned (BE Word32) where     {-# INLINE unalignedSize #-}-    unalignedSize _ = 4+    unalignedSize = UnalignedSize 4 #if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)     USE_HOST_IMPL(BE) #else@@ -330,7 +329,7 @@  instance Unaligned Word64 where     {-# INLINE unalignedSize #-}-    unalignedSize _ = 8+    unalignedSize = UnalignedSize 8     {-# INLINE writeWord8ArrayAs# #-}     writeWord8ArrayAs# mba# i# (W64# x#) =  writeWord8ArrayAsWord64# mba# i# x#     {-# INLINE readWord8ArrayAs# #-}@@ -342,7 +341,7 @@  instance Unaligned (LE Word64) where     {-# INLINE unalignedSize #-}-    unalignedSize _ = 8+    unalignedSize = UnalignedSize 8 #if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)     {-# INLINE writeWord8ArrayAs# #-}     writeWord8ArrayAs# mba# i# (LE (W64# x#)) s0# =@@ -394,7 +393,7 @@  instance Unaligned (BE Word64) where     {-# INLINE unalignedSize #-}-    unalignedSize _ = 8+    unalignedSize = UnalignedSize 8 #if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)     USE_HOST_IMPL(BE) #else@@ -462,10 +461,10 @@ instance Unaligned Word where #if SIZEOF_HSWORD == 4     {-# INLINE unalignedSize #-}-    unalignedSize _ = 4+    unalignedSize = UnalignedSize 4 #else     {-# INLINE unalignedSize #-}-    unalignedSize _ = 8+    unalignedSize = UnalignedSize 8 #endif     {-# INLINE writeWord8ArrayAs# #-}     writeWord8ArrayAs# mba# i# (W# x#) = writeWord8ArrayAsWord# mba# i# x#@@ -478,7 +477,7 @@ instance Unaligned (LE Word) where #if SIZEOF_HSWORD == 4     {-# INLINE unalignedSize #-}-    unalignedSize _ = 4+    unalignedSize = UnalignedSize 4     {-# INLINE writeWord8ArrayAs# #-}     writeWord8ArrayAs# mba# i# (LE (W# x#)) = writeWord8ArrayAs# mba# i# (LE (W32# x#))     {-# INLINE readWord8ArrayAs# #-}@@ -488,7 +487,7 @@     indexWord8ArrayAs# ba# i# = case (indexWord8ArrayAs# ba# i#) of (LE (W32# x#)) -> LE (W# x#) #else     {-# INLINE unalignedSize #-}-    unalignedSize _ = 8+    unalignedSize = UnalignedSize 8     {-# INLINE writeWord8ArrayAs# #-}     writeWord8ArrayAs# mba# i# (LE (W# x#)) = writeWord8ArrayAs# mba# i# (LE (W64# x#))     {-# INLINE readWord8ArrayAs# #-}@@ -501,7 +500,7 @@ instance Unaligned (BE Word) where #if SIZEOF_HSWORD == 4     {-# INLINE unalignedSize #-}-    unalignedSize _ = 4+    unalignedSize = UnalignedSize 4     {-# INLINE writeWord8ArrayAs# #-}     writeWord8ArrayAs# mba# i# (BE (W# x#)) = writeWord8ArrayAs# mba# i# (BE (W32# x#))     {-# INLINE readWord8ArrayAs# #-}@@ -511,7 +510,7 @@     indexWord8ArrayAs# ba# i# = case (indexWord8ArrayAs# ba# i#) of (BE (W32# x#)) -> BE (W# x#) #else     {-# INLINE unalignedSize #-}-    unalignedSize _ = 8+    unalignedSize = UnalignedSize 8     {-# INLINE writeWord8ArrayAs# #-}     writeWord8ArrayAs# mba# i# (BE (W# x#)) = writeWord8ArrayAs# mba# i# (BE (W64# x#))     {-# INLINE readWord8ArrayAs# #-}@@ -525,7 +524,7 @@  instance Unaligned Int16 where     {-# INLINE unalignedSize #-}-    unalignedSize _ = 2+    unalignedSize = UnalignedSize 2     {-# INLINE writeWord8ArrayAs# #-}     writeWord8ArrayAs# mba# i# (I16# x#) = writeWord8ArrayAsInt16# mba# i# x#     {-# INLINE readWord8ArrayAs# #-}@@ -536,7 +535,7 @@  instance Unaligned (LE Int16) where     {-# INLINE unalignedSize #-}-    unalignedSize _ = 2+    unalignedSize = UnalignedSize 2 #if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)     {-# INLINE writeWord8ArrayAs# #-}     writeWord8ArrayAs# mba# i# (LE (I16# x#)) =@@ -555,7 +554,7 @@  instance Unaligned (BE Int16) where     {-# INLINE unalignedSize #-}-    unalignedSize _ = 2+    unalignedSize = UnalignedSize 2 #if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)     USE_HOST_IMPL(BE) #else@@ -576,7 +575,7 @@  instance Unaligned Int32 where     {-# INLINE unalignedSize #-}-    unalignedSize _ = 4+    unalignedSize = UnalignedSize 4     {-# INLINE writeWord8ArrayAs# #-}     writeWord8ArrayAs# mba# i# (I32# x#) = writeWord8ArrayAsInt32# mba# i# x#     {-# INLINE readWord8ArrayAs# #-}@@ -587,7 +586,7 @@  instance Unaligned (LE Int32) where     {-# INLINE unalignedSize #-}-    unalignedSize _ = 4+    unalignedSize = UnalignedSize 4 #if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)     {-# INLINE writeWord8ArrayAs# #-}     writeWord8ArrayAs# mba# i# (LE (I32# x#)) =@@ -606,7 +605,7 @@  instance Unaligned (BE Int32) where     {-# INLINE unalignedSize #-}-    unalignedSize _ = 4+    unalignedSize = UnalignedSize 4 #if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)     USE_HOST_IMPL(BE) #else@@ -627,7 +626,7 @@  instance Unaligned Int64 where     {-# INLINE unalignedSize #-}-    unalignedSize _ = 8+    unalignedSize = UnalignedSize 8     {-# INLINE writeWord8ArrayAs# #-}     writeWord8ArrayAs# mba# i# (I64# x#) = writeWord8ArrayAsInt64# mba# i# x#     {-# INLINE readWord8ArrayAs# #-}@@ -638,7 +637,7 @@  instance Unaligned (LE Int64) where     {-# INLINE unalignedSize #-}-    unalignedSize _ = 8+    unalignedSize = UnalignedSize 8 #if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)     {-# INLINE writeWord8ArrayAs# #-}     writeWord8ArrayAs# mba# i# (LE (I64# x#)) =@@ -657,7 +656,7 @@  instance Unaligned (BE Int64) where     {-# INLINE unalignedSize #-}-    unalignedSize _ = 8+    unalignedSize = UnalignedSize 8 #if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)     USE_HOST_IMPL(BE) #else@@ -679,10 +678,10 @@ instance Unaligned Int where #if SIZEOF_HSWORD == 4     {-# INLINE unalignedSize #-}-    unalignedSize _ = 4+    unalignedSize = UnalignedSize 4 #else     {-# INLINE unalignedSize #-}-    unalignedSize _ = 8+    unalignedSize = UnalignedSize 8 #endif     {-# INLINE writeWord8ArrayAs# #-}     writeWord8ArrayAs# mba# i# (I# x#) = writeWord8ArrayAsInt# mba# i# x#@@ -695,7 +694,7 @@ instance Unaligned (LE Int) where #if SIZEOF_HSWORD == 4     {-# INLINE unalignedSize #-}-    unalignedSize _ = 4+    unalignedSize = UnalignedSize 4     {-# INLINE writeWord8ArrayAs# #-}     writeWord8ArrayAs# mba# i# (LE (I# x#)) = writeWord8ArrayAs# mba# i# (LE (I32# x#))     {-# INLINE readWord8ArrayAs# #-}@@ -705,7 +704,7 @@     indexWord8ArrayAs# ba# i# = case (indexWord8ArrayAs# ba# i#) of (LE (I32# x#)) -> LE (I# x#) #else     {-# INLINE unalignedSize #-}-    unalignedSize _ = 8+    unalignedSize = UnalignedSize 8     {-# INLINE writeWord8ArrayAs# #-}     writeWord8ArrayAs# mba# i# (LE (I# x#)) = writeWord8ArrayAs# mba# i# (LE (I64# x#))     {-# INLINE readWord8ArrayAs# #-}@@ -718,7 +717,7 @@ instance Unaligned (BE Int) where #if SIZEOF_HSWORD == 4     {-# INLINE unalignedSize #-}-    unalignedSize _ = 4+    unalignedSize = UnalignedSize 4     {-# INLINE writeWord8ArrayAs# #-}     writeWord8ArrayAs# mba# i# (BE (I# x#)) = writeWord8ArrayAs# mba# i# (BE (I32# x#))     {-# INLINE readWord8ArrayAs# #-}@@ -728,7 +727,7 @@     indexWord8ArrayAs# ba# i# = case (indexWord8ArrayAs# ba# i#) of (BE (I32# x#)) -> BE (I# x#) #else     {-# INLINE unalignedSize #-}-    unalignedSize _ = 8+    unalignedSize = UnalignedSize 8     {-# INLINE writeWord8ArrayAs# #-}     writeWord8ArrayAs# mba# i# (BE (I# x#)) = writeWord8ArrayAs# mba# i# (BE (I64# x#))     {-# INLINE readWord8ArrayAs# #-}@@ -742,7 +741,7 @@  instance Unaligned (Ptr a) where     {-# INLINE unalignedSize #-}-    unalignedSize _ = SIZEOF_HSPTR+    unalignedSize = UnalignedSize SIZEOF_HSPTR     {-# INLINE writeWord8ArrayAs# #-}     writeWord8ArrayAs# mba# i# (Ptr x#) = writeWord8ArrayAsAddr# mba# i# x#     {-# INLINE readWord8ArrayAs# #-}@@ -753,7 +752,7 @@  instance Unaligned Float where     {-# INLINE unalignedSize #-}-    unalignedSize _ = 4+    unalignedSize = UnalignedSize 4     {-# INLINE writeWord8ArrayAs# #-}     writeWord8ArrayAs# mba# i# (F# x#) = writeWord8ArrayAsFloat# mba# i# x#     {-# INLINE readWord8ArrayAs# #-}@@ -764,7 +763,7 @@  instance Unaligned (LE Float) where     {-# INLINE unalignedSize #-}-    unalignedSize _ = 4+    unalignedSize = UnalignedSize 4 #if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)     {-# INLINE writeWord8ArrayAs# #-}     writeWord8ArrayAs# mba# i# (LE (F# x#)) =@@ -783,7 +782,7 @@  instance Unaligned (BE Float) where     {-# INLINE unalignedSize #-}-    unalignedSize _ = 4+    unalignedSize = UnalignedSize 4 #if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)     USE_HOST_IMPL(BE) #else@@ -804,7 +803,7 @@  instance Unaligned Double where     {-# INLINE unalignedSize #-}-    unalignedSize _ = 8+    unalignedSize = UnalignedSize 8     {-# INLINE writeWord8ArrayAs# #-}     writeWord8ArrayAs# mba# i# (D# x#) = writeWord8ArrayAsDouble# mba# i# x#     {-# INLINE readWord8ArrayAs# #-}@@ -815,7 +814,7 @@  instance Unaligned (LE Double) where     {-# INLINE unalignedSize #-}-    unalignedSize _ = 8+    unalignedSize = UnalignedSize 8 #if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)     {-# INLINE writeWord8ArrayAs# #-}     writeWord8ArrayAs# mba# i# (LE (D# x#)) =@@ -834,7 +833,7 @@  instance Unaligned (BE Double) where     {-# INLINE unalignedSize #-}-    unalignedSize _ = 4+    unalignedSize = UnalignedSize 4 #if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)     USE_HOST_IMPL(BE) #else@@ -856,7 +855,7 @@ -- | Char's instance use 31bit wide char prim-op. instance Unaligned Char where     {-# INLINE unalignedSize #-}-    unalignedSize _ = 4+    unalignedSize = UnalignedSize 4     {-# INLINE writeWord8ArrayAs# #-}     writeWord8ArrayAs# mba# i# (C# x#) = writeWord8ArrayAsWideChar# mba# i# x#     {-# INLINE readWord8ArrayAs# #-}@@ -867,7 +866,7 @@  instance Unaligned (LE Char) where     {-# INLINE unalignedSize #-}-    unalignedSize _ = 4+    unalignedSize = UnalignedSize 4 #if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)     {-# INLINE writeWord8ArrayAs# #-}     writeWord8ArrayAs# mba# i# (LE (C# x#)) =@@ -886,7 +885,7 @@  instance Unaligned (BE Char) where     {-# INLINE unalignedSize #-}-    unalignedSize _ = 4+    unalignedSize = UnalignedSize 4 #if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)     USE_HOST_IMPL(BE) #else@@ -903,46 +902,365 @@         in BE (C# (chr# x#)) #endif -{- not really useful+-- | Write a, b in order instance (Unaligned a, Unaligned b) => Unaligned (a, b) where     {-# INLINE unalignedSize #-}-    unalignedSize (a, b) = unalignedSize a + unalignedSize b-    {-# INLINE writeWord8ArrayAs# #-}-    writeWord8ArrayAs# mba# i# (a, b) s0 =-        let s1 = writeWord8ArrayAs# mba# i# a s0-        in writeWord8ArrayAs# mba# (i# +# unalignedSize# a) b s1-    {-# INLINE readWord8ArrayAs# #-}-    readWord8ArrayAs# mba# i# s0 =-        let !(# s1, a #) = readWord8ArrayAs# mba# i# s0-            !(# s2, b #) = readWord8ArrayAs# mba# (i# +# unalignedSize# a) s1-        in (# s2, (a, b) #)-    {-# INLINE indexWord8ArrayAs# #-}-    indexWord8ArrayAs# ba# i# =-        let a = indexWord8ArrayAs# ba# i#-            b = indexWord8ArrayAs# ba# (i# +# unalignedSize# a)+    unalignedSize =+        UnalignedSize ( getUnalignedSize (unalignedSize @a)+                      + getUnalignedSize (unalignedSize @b)+                      )+    {-# INLINE pokeMBA #-}+    pokeMBA mba# i (a, b) = do+        pokeMBA mba# i a+        pokeMBA mba# j b+      where+        j = i + getUnalignedSize (unalignedSize @a)++    {-# INLINE peekMBA #-}+    peekMBA mba# i = do+        !a <- peekMBA mba# i+        !b <- peekMBA mba# j+        return (a, b)+      where+        j = i + getUnalignedSize (unalignedSize @a)++    {-# INLINE indexBA #-}+    indexBA ba# i =+        let !a = indexBA ba# i+            !b = indexBA ba# j         in (a, b)+      where+        j = i + getUnalignedSize (unalignedSize @a) +-- | Write a, b, c in order instance (Unaligned a, Unaligned b, Unaligned c) => Unaligned (a, b, c) where     {-# INLINE unalignedSize #-}-    unalignedSize (a, b, c) = unalignedSize a + unalignedSize b + unalignedSize c-    {-# INLINE writeWord8ArrayAs# #-}-    writeWord8ArrayAs# mba# i# (a, b, c) s0 =-        let s1 = writeWord8ArrayAs# mba# i# a s0-            s2 = writeWord8ArrayAs# mba# (i# +# unalignedSize# a) b s1-        in writeWord8ArrayAs# mba# (i# +# unalignedSize# a +# unalignedSize# b) c s2-    {-# INLINE readWord8ArrayAs# #-}-    readWord8ArrayAs# mba# i# s0 =-        let !(# s1, a #) = readWord8ArrayAs# mba# i# s0-            !(# s2, b #) = readWord8ArrayAs# mba# (i# +# unalignedSize# a) s1-            !(# s3, c #) = readWord8ArrayAs# mba# (i# +# unalignedSize# a +# unalignedSize# b) s2-        in (# s3, (a, b, c) #)-    {-# INLINE indexWord8ArrayAs# #-}-    indexWord8ArrayAs# ba# i# =-        let a = indexWord8ArrayAs# ba# i#-            b = indexWord8ArrayAs# ba# (i# +# unalignedSize# a)-            c = indexWord8ArrayAs# ba# (i# +# unalignedSize# a +# unalignedSize# b)+    unalignedSize =+        UnalignedSize ( getUnalignedSize (unalignedSize @a)+                      + getUnalignedSize (unalignedSize @b)+                      + getUnalignedSize (unalignedSize @c)+                      )+    {-# INLINE pokeMBA #-}+    pokeMBA mba# i (a, b, c) = do+        pokeMBA mba# i a+        pokeMBA mba# j b+        pokeMBA mba# k c+      where+        j = i + getUnalignedSize (unalignedSize @a)+        k = j + getUnalignedSize (unalignedSize @b)++    {-# INLINE peekMBA #-}+    peekMBA mba# i = do+        !a <- peekMBA mba# i+        !b <- peekMBA mba# j+        !c <- peekMBA mba# k+        return (a, b, c)+      where+        j = i + getUnalignedSize (unalignedSize @a)+        k = j + getUnalignedSize (unalignedSize @b)++    {-# INLINE indexBA #-}+    indexBA ba# i =+        let !a = indexBA ba# i+            !b = indexBA ba# j+            !c = indexBA ba# k         in (a, b, c)--}+      where+        j = i + getUnalignedSize (unalignedSize @a)+        k = j + getUnalignedSize (unalignedSize @b)++-- | Write a, b, c, d in order+instance (Unaligned a, Unaligned b, Unaligned c, Unaligned d) => Unaligned (a, b, c, d) where+    {-# INLINE unalignedSize #-}+    unalignedSize =+        UnalignedSize ( getUnalignedSize (unalignedSize @a)+                      + getUnalignedSize (unalignedSize @b)+                      + getUnalignedSize (unalignedSize @c)+                      + getUnalignedSize (unalignedSize @d)+                      )+    {-# INLINE pokeMBA #-}+    pokeMBA mba# i (a, b, c, d) = do+        pokeMBA mba# i a+        pokeMBA mba# j b+        pokeMBA mba# k c+        pokeMBA mba# l d+      where+        j = i + getUnalignedSize (unalignedSize @a)+        k = j + getUnalignedSize (unalignedSize @b)+        l = k + getUnalignedSize (unalignedSize @c)++    {-# INLINE peekMBA #-}+    peekMBA mba# i = do+        !a <- peekMBA mba# i+        !b <- peekMBA mba# j+        !c <- peekMBA mba# k+        !d <- peekMBA mba# l+        return (a, b, c, d)+      where+        j = i + getUnalignedSize (unalignedSize @a)+        k = j + getUnalignedSize (unalignedSize @b)+        l = k + getUnalignedSize (unalignedSize @c)++    {-# INLINE indexBA #-}+    indexBA ba# i =+        let !a = indexBA ba# i+            !b = indexBA ba# j+            !c = indexBA ba# k+            !d = indexBA ba# l+        in (a, b, c, d)+      where+        j = i + getUnalignedSize (unalignedSize @a)+        k = j + getUnalignedSize (unalignedSize @b)+        l = k + getUnalignedSize (unalignedSize @c)++-- | Write a, b, c, d, e in order+instance (Unaligned a, Unaligned b, Unaligned c, Unaligned d, Unaligned e) => Unaligned (a, b, c, d, e) where+    {-# INLINE unalignedSize #-}+    unalignedSize =+        UnalignedSize ( getUnalignedSize (unalignedSize @a)+                      + getUnalignedSize (unalignedSize @b)+                      + getUnalignedSize (unalignedSize @c)+                      + getUnalignedSize (unalignedSize @d)+                      + getUnalignedSize (unalignedSize @e)+                      )+    {-# INLINE pokeMBA #-}+    pokeMBA mba# i (a, b, c, d, e) = do+        pokeMBA mba# i a+        pokeMBA mba# j b+        pokeMBA mba# k c+        pokeMBA mba# l d+        pokeMBA mba# m e+      where+        j = i + getUnalignedSize (unalignedSize @a)+        k = j + getUnalignedSize (unalignedSize @b)+        l = k + getUnalignedSize (unalignedSize @c)+        m = l + getUnalignedSize (unalignedSize @d)++    {-# INLINE peekMBA #-}+    peekMBA mba# i = do+        !a <- peekMBA mba# i+        !b <- peekMBA mba# j+        !c <- peekMBA mba# k+        !d <- peekMBA mba# l+        !e <- peekMBA mba# m+        return (a, b, c, d, e)+      where+        j = i + getUnalignedSize (unalignedSize @a)+        k = j + getUnalignedSize (unalignedSize @b)+        l = k + getUnalignedSize (unalignedSize @c)+        m = l + getUnalignedSize (unalignedSize @d)++    {-# INLINE indexBA #-}+    indexBA ba# i =+        let !a = indexBA ba# i+            !b = indexBA ba# j+            !c = indexBA ba# k+            !d = indexBA ba# l+            !e = indexBA ba# m+        in (a, b, c, d, e)+      where+        j = i + getUnalignedSize (unalignedSize @a)+        k = j + getUnalignedSize (unalignedSize @b)+        l = k + getUnalignedSize (unalignedSize @c)+        m = l + getUnalignedSize (unalignedSize @d)+++-- | Write a, b, c, d, e, f in order+instance (Unaligned a, Unaligned b, Unaligned c, Unaligned d, Unaligned e, Unaligned f) => Unaligned (a, b, c, d, e, f) where+    {-# INLINE unalignedSize #-}+    unalignedSize =+        UnalignedSize ( getUnalignedSize (unalignedSize @a)+                      + getUnalignedSize (unalignedSize @b)+                      + getUnalignedSize (unalignedSize @c)+                      + getUnalignedSize (unalignedSize @d)+                      + getUnalignedSize (unalignedSize @e)+                      + getUnalignedSize (unalignedSize @f)+                      )+    {-# INLINE pokeMBA #-}+    pokeMBA mba# i (a, b, c, d, e, f) = do+        pokeMBA mba# i a+        pokeMBA mba# j b+        pokeMBA mba# k c+        pokeMBA mba# l d+        pokeMBA mba# m e+        pokeMBA mba# n f+      where+        j = i + getUnalignedSize (unalignedSize @a)+        k = j + getUnalignedSize (unalignedSize @b)+        l = k + getUnalignedSize (unalignedSize @c)+        m = l + getUnalignedSize (unalignedSize @d)+        n = m + getUnalignedSize (unalignedSize @e)++    {-# INLINE peekMBA #-}+    peekMBA mba# i = do+        !a <- peekMBA mba# i+        !b <- peekMBA mba# j+        !c <- peekMBA mba# k+        !d <- peekMBA mba# l+        !e <- peekMBA mba# m+        !f <- peekMBA mba# n+        return (a, b, c, d, e, f)+      where+        j = i + getUnalignedSize (unalignedSize @a)+        k = j + getUnalignedSize (unalignedSize @b)+        l = k + getUnalignedSize (unalignedSize @c)+        m = l + getUnalignedSize (unalignedSize @d)+        n = m + getUnalignedSize (unalignedSize @e)++    {-# INLINE indexBA #-}+    indexBA ba# i =+        let !a = indexBA ba# i+            !b = indexBA ba# j+            !c = indexBA ba# k+            !d = indexBA ba# l+            !e = indexBA ba# m+            !f = indexBA ba# n+        in (a, b, c, d, e, f)+      where+        j = i + getUnalignedSize (unalignedSize @a)+        k = j + getUnalignedSize (unalignedSize @b)+        l = k + getUnalignedSize (unalignedSize @c)+        m = l + getUnalignedSize (unalignedSize @d)+        n = m + getUnalignedSize (unalignedSize @e)++-- | Write a, b, c, d, e, f, g in order+instance (Unaligned a, Unaligned b, Unaligned c, Unaligned d, Unaligned e, Unaligned f, Unaligned g) => Unaligned (a, b, c, d, e, f, g) where+    {-# INLINE unalignedSize #-}+    unalignedSize =+        UnalignedSize ( getUnalignedSize (unalignedSize @a)+                      + getUnalignedSize (unalignedSize @b)+                      + getUnalignedSize (unalignedSize @c)+                      + getUnalignedSize (unalignedSize @d)+                      + getUnalignedSize (unalignedSize @e)+                      + getUnalignedSize (unalignedSize @f)+                      + getUnalignedSize (unalignedSize @g)+                      )+    {-# INLINE pokeMBA #-}+    pokeMBA mba# i (a, b, c, d, e, f, g) = do+        pokeMBA mba# i a+        pokeMBA mba# j b+        pokeMBA mba# k c+        pokeMBA mba# l d+        pokeMBA mba# m e+        pokeMBA mba# n f+        pokeMBA mba# o g+      where+        j = i + getUnalignedSize (unalignedSize @a)+        k = j + getUnalignedSize (unalignedSize @b)+        l = k + getUnalignedSize (unalignedSize @c)+        m = l + getUnalignedSize (unalignedSize @d)+        n = m + getUnalignedSize (unalignedSize @e)+        o = n + getUnalignedSize (unalignedSize @f)++    {-# INLINE peekMBA #-}+    peekMBA mba# i = do+        !a <- peekMBA mba# i+        !b <- peekMBA mba# j+        !c <- peekMBA mba# k+        !d <- peekMBA mba# l+        !e <- peekMBA mba# m+        !f <- peekMBA mba# n+        !g <- peekMBA mba# o+        return (a, b, c, d, e, f, g)+      where+        j = i + getUnalignedSize (unalignedSize @a)+        k = j + getUnalignedSize (unalignedSize @b)+        l = k + getUnalignedSize (unalignedSize @c)+        m = l + getUnalignedSize (unalignedSize @d)+        n = m + getUnalignedSize (unalignedSize @e)+        o = n + getUnalignedSize (unalignedSize @f)++    {-# INLINE indexBA #-}+    indexBA ba# i =+        let !a = indexBA ba# i+            !b = indexBA ba# j+            !c = indexBA ba# k+            !d = indexBA ba# l+            !e = indexBA ba# m+            !f = indexBA ba# n+            !g = indexBA ba# o+        in (a, b, c, d, e, f, g)+      where+        j = i + getUnalignedSize (unalignedSize @a)+        k = j + getUnalignedSize (unalignedSize @b)+        l = k + getUnalignedSize (unalignedSize @c)+        m = l + getUnalignedSize (unalignedSize @d)+        n = m + getUnalignedSize (unalignedSize @e)+        o = n + getUnalignedSize (unalignedSize @f)+++-- | Write a, b, c, d, e, f, g, h in order+instance (Unaligned a, Unaligned b, Unaligned c, Unaligned d, Unaligned e, Unaligned f, Unaligned g, Unaligned h) => Unaligned (a, b, c, d, e, f, g, h) where+    {-# INLINE unalignedSize #-}+    unalignedSize =+        UnalignedSize ( getUnalignedSize (unalignedSize @a)+                      + getUnalignedSize (unalignedSize @b)+                      + getUnalignedSize (unalignedSize @c)+                      + getUnalignedSize (unalignedSize @d)+                      + getUnalignedSize (unalignedSize @e)+                      + getUnalignedSize (unalignedSize @f)+                      + getUnalignedSize (unalignedSize @g)+                      + getUnalignedSize (unalignedSize @h)+                      )+    {-# INLINE pokeMBA #-}+    pokeMBA mba# i (a, b, c, d, e, f, g, h) = do+        pokeMBA mba# i a+        pokeMBA mba# j b+        pokeMBA mba# k c+        pokeMBA mba# l d+        pokeMBA mba# m e+        pokeMBA mba# n f+        pokeMBA mba# o g+        pokeMBA mba# p h+      where+        j = i + getUnalignedSize (unalignedSize @a)+        k = j + getUnalignedSize (unalignedSize @b)+        l = k + getUnalignedSize (unalignedSize @c)+        m = l + getUnalignedSize (unalignedSize @d)+        n = m + getUnalignedSize (unalignedSize @e)+        o = n + getUnalignedSize (unalignedSize @f)+        p = o + getUnalignedSize (unalignedSize @g)++    {-# INLINE peekMBA #-}+    peekMBA mba# i = do+        !a <- peekMBA mba# i+        !b <- peekMBA mba# j+        !c <- peekMBA mba# k+        !d <- peekMBA mba# l+        !e <- peekMBA mba# m+        !f <- peekMBA mba# n+        !g <- peekMBA mba# o+        !h <- peekMBA mba# p+        return (a, b, c, d, e, f, g, h)+      where+        j = i + getUnalignedSize (unalignedSize @a)+        k = j + getUnalignedSize (unalignedSize @b)+        l = k + getUnalignedSize (unalignedSize @c)+        m = l + getUnalignedSize (unalignedSize @d)+        n = m + getUnalignedSize (unalignedSize @e)+        o = n + getUnalignedSize (unalignedSize @f)+        p = o + getUnalignedSize (unalignedSize @g)++    {-# INLINE indexBA #-}+    indexBA ba# i =+        let !a = indexBA ba# i+            !b = indexBA ba# j+            !c = indexBA ba# k+            !d = indexBA ba# l+            !e = indexBA ba# m+            !f = indexBA ba# n+            !g = indexBA ba# o+            !h = indexBA ba# p+        in (a, b, c, d, e, f, g, h)+      where+        j = i + getUnalignedSize (unalignedSize @a)+        k = j + getUnalignedSize (unalignedSize @b)+        l = k + getUnalignedSize (unalignedSize @c)+        m = l + getUnalignedSize (unalignedSize @d)+        n = m + getUnalignedSize (unalignedSize @e)+        o = n + getUnalignedSize (unalignedSize @f)+        p = o + getUnalignedSize (unalignedSize @g)+ --------------------------------------------------------------------------------  -- Prim instances for newtypes in Foreign.C.Types

@@ -33,7 +33,7 @@   , encodePrimLE   , encodePrimBE   -- * More builders-  , stringModifiedUTF8, charModifiedUTF8, stringUTF8, charUTF8, string7, char7, string8, char8, text+  , stringModifiedUTF8, charModifiedUTF8, stringUTF8, charUTF8, string7, char7, word7, string8, char8, word8, text   -- * Numeric builders   -- ** Integral type formatting   , IFormat(..)@@ -52,17 +52,17 @@   , floatWith   , scientific   , scientificWith-  -- * Patterns-  , pattern PLUS-  , pattern MINUS-  , pattern ZERO-  , pattern SPACE-  , pattern DOT-  , pattern LITTLE_E-  , pattern BIG_E     -- * Builder helpers   , paren, curly, square, angle, quotes, squotes, colon, comma, intercalateVec, intercalateList+    -- * Time+  , day+  , timeOfDay+  , timeZone+  , utcTime+  , localTime+  , zonedTime   ) where  import           Z.Data.Builder.Base import           Z.Data.Builder.Numeric+import           Z.Data.Builder.Time

@@ -45,7 +45,7 @@   , encodePrimLE   , encodePrimBE   -- * More builders-  , stringModifiedUTF8, charModifiedUTF8, stringUTF8, charUTF8, string7, char7, string8, char8, text+  , stringModifiedUTF8, charModifiedUTF8, stringUTF8, charUTF8, string7, char7, word7, string8, char8, word8, text   -- * Builder helpers   , paren, curly, square, angle, quotes, squotes, colon, comma, intercalateVec, intercalateList   ) where@@ -60,6 +60,7 @@ import           GHC.Stack import           Data.Primitive.PrimArray import           Z.Data.Array.Unaligned+import           Z.Data.ASCII import qualified Z.Data.Text.Base                 as T import qualified Z.Data.Text.UTF8Codec            as T import qualified Z.Data.Vector.Base               as V@@ -287,8 +288,8 @@                 else do                     vs <- unsafeInterleaveIO . loop =<< k (Buffer buf' 0)                     return (v':v:vs)-                 + --------------------------------------------------------------------------------  ensureN :: Int  -- ^ size bound@@ -330,7 +331,7 @@ encodePrim x = do     writeN n (\ mpa i -> writePrimWord8ArrayAs mpa i x)   where-    n = unalignedSize (undefined :: a)+    n = getUnalignedSize (unalignedSize @a)  -- | Write a primitive type with little endianess. encodePrimLE :: forall a. Unaligned (LE a) => a -> Builder ()@@ -416,9 +417,16 @@ -- Codepoints beyond @'\x7F'@ will be chopped. char7 :: Char -> Builder () {-# INLINE char7 #-}-char7 chr = do-    writeN 1 (\ mpa i -> writePrimWord8ArrayAs mpa i (V.c2w chr .&. 0x7F))+char7 chr =+    writeN 1 (\ mpa i -> writePrimWord8ArrayAs mpa i (c2w chr .&. 0x7F)) +-- | Turn 'Word8' into 'Builder' with ASCII7 encoding+--+-- Codepoints beyond @'\x7F'@ will be chopped.+word7 :: Word8 -> Builder ()+{-# INLINE word7 #-}+word7 w = writeN 1 (\ mpa i -> writePrimWord8ArrayAs mpa i (w .&. 0x7F))+ -- | Turn 'String' into 'Builder' with ASCII8 encoding -- -- Codepoints beyond @'\xFF'@ will be chopped.@@ -436,8 +444,16 @@ char8 :: Char -> Builder () {-# INLINE char8 #-} char8 chr = do-    writeN 1 (\ mpa i -> writePrimWord8ArrayAs mpa i (V.c2w chr))+    writeN 1 (\ mpa i -> writePrimWord8ArrayAs mpa i (c2w chr)) +-- | Turn 'Word8' into 'Builder' with ASCII8 encoding, (alias to 'encodePrim').+--+-- Note, this encoding is NOT compatible with UTF8 encoding, i.e. bytes written+-- by this builder may not be legal UTF8 encoding bytes.+word8 :: Word8 -> Builder ()+{-# INLINE word8 #-}+word8 = encodePrim+ -- | Write UTF8 encoded 'Text' using 'Builder'. -- -- Note, if you're trying to write string literals builders,@@ -449,59 +465,46 @@  -------------------------------------------------------------------------------- -#define BACKSLASH 92-#define CLOSE_ANGLE 62-#define CLOSE_CURLY 125-#define CLOSE_PAREN 41-#define CLOSE_SQUARE 93-#define COMMA 44-#define COLON 58-#define DOUBLE_QUOTE 34-#define OPEN_ANGLE 60-#define OPEN_CURLY 123-#define OPEN_PAREN 40-#define OPEN_SQUARE 91-#define SINGLE_QUOTE 39  -- | add @(...)@ to original builder. paren :: Builder () -> Builder () {-# INLINE paren #-}-paren b = encodePrim @Word8 OPEN_PAREN >> b >> encodePrim @Word8 CLOSE_PAREN+paren b = encodePrim PAREN_LEFT >> b >> encodePrim PAREN_RIGHT  -- | add @{...}@ to original builder. curly :: Builder () -> Builder () {-# INLINE curly #-}-curly b = encodePrim @Word8 OPEN_CURLY >> b >> encodePrim @Word8 CLOSE_CURLY+curly b = encodePrim CURLY_LEFT >> b >> encodePrim CURLY_RIGHT  -- | add @[...]@ to original builder. square :: Builder () -> Builder () {-# INLINE square #-}-square b = encodePrim @Word8 OPEN_SQUARE >> b >> encodePrim @Word8 CLOSE_SQUARE+square b = encodePrim SQUARE_LEFT >> b >> encodePrim SQUARE_RIGHT  -- | add @/<.../>@ to original builder. angle :: Builder () -> Builder () {-# INLINE angle #-}-angle b = encodePrim @Word8 OPEN_ANGLE >> b >> encodePrim @Word8 CLOSE_ANGLE+angle b = encodePrim ANGLE_LEFT >> b >> encodePrim ANGLE_RIGHT  -- | add @/".../"@ to original builder. quotes :: Builder () -> Builder () {-# INLINE quotes #-}-quotes b = encodePrim @Word8 DOUBLE_QUOTE >> b >> encodePrim @Word8 DOUBLE_QUOTE+quotes b = encodePrim QUOTE_DOUBLE >> b >> encodePrim QUOTE_DOUBLE  -- | add @/'.../'@ to original builder. squotes :: Builder () -> Builder () {-# INLINE squotes #-}-squotes b = encodePrim @Word8 SINGLE_QUOTE >> b >> encodePrim @Word8 SINGLE_QUOTE+squotes b = encodePrim QUOTE_SINGLE >> b >> encodePrim QUOTE_SINGLE  -- | write an ASCII @:@ colon :: Builder () {-# INLINE colon #-}-colon = encodePrim @Word8 COLON+colon = encodePrim COLON  -- | write an ASCII @,@ comma :: Builder () {-# INLINE comma #-}-comma = encodePrim @Word8 COMMA+comma = encodePrim COMMA  -- | Use separator to connect a vector of builders. --

@@ -30,14 +30,6 @@   , floatWith   , scientific   , scientificWith-  -- * Patterns-  , pattern PLUS-  , pattern MINUS-  , pattern ZERO-  , pattern SPACE-  , pattern DOT-  , pattern LITTLE_E-  , pattern BIG_E   -- * Misc   , grisu3   , grisu3_sp@@ -57,6 +49,7 @@ import           GHC.Exts import           GHC.Float import           GHC.Integer+import           Z.Data.ASCII import           Z.Data.Builder.Base import           Z.Data.Builder.Numeric.DigitTable import           Z.Foreign@@ -87,6 +80,7 @@  -- | @defaultIFormat = IFormat 0 NoPadding False@ defaultIFormat :: IFormat+{-# INLINE defaultIFormat #-} defaultIFormat = IFormat 0 NoPadding False  data Padding = NoPadding | RightSpacePadding | LeftSpacePadding | ZeroPadding deriving (Show, Eq, Ord, Enum)@@ -182,7 +176,7 @@                         let !leadingN = width-n'                         writePrimArray marr off MINUS                   -- leading MINUS                         let off' = off + 1-                        setPrimArray marr off' leadingN ZERO            -- leading zeros+                        setPrimArray marr off' leadingN DIGIT_0            -- leading zeros                         let off'' = off' + leadingN                         writePositiveDec marr off'' n qq                 -- digits                         let off''' = off'' + n@@ -230,7 +224,7 @@                         let !leadingN = width-n'                         writePrimArray marr off MINUS                   -- leading MINUS                         let off' = off + 1-                        setPrimArray marr off' leadingN ZERO            -- leading zeros+                        setPrimArray marr off' leadingN DIGIT_0            -- leading zeros                         let off'' = off' + leadingN                         writePositiveDec marr off'' n qq                 -- digits                 LeftSpacePadding ->@@ -275,7 +269,7 @@                         let !leadingN = width-n'                         writePrimArray marr off PLUS                    -- leading PLUS                         let off' = off + 1-                        setPrimArray marr off' leadingN ZERO            -- leading zeros+                        setPrimArray marr off' leadingN DIGIT_0            -- leading zeros                         let off'' = off' + leadingN                         writePositiveDec marr off'' n i                  -- digits                 LeftSpacePadding ->@@ -308,7 +302,7 @@                 ZeroPadding ->                     writeN width $ \marr off -> do                         let !leadingN = width-n-                        setPrimArray marr off leadingN ZERO             -- leading zeros+                        setPrimArray marr off leadingN DIGIT_0             -- leading zeros                         let off' = off + leadingN                         writePositiveDec marr off' n i                   -- digits                 LeftSpacePadding ->@@ -369,6 +363,7 @@  -- | Format a 'Integer' into decimal ASCII digits. integer :: Integer -> Builder ()+{-# INLINE integer #-} #ifdef INTEGER_GMP integer (S# i#) = int (I# i#) #endif@@ -413,7 +408,7 @@      -- Split n into digits in base p. We first split n into digits     -- in base p*p and then split each of these digits into two.-    -- Note that the first 'digit' modulo p*p may have a leading ZERO+    -- Note that the first 'digit' modulo p*p may have a leading DIGIT_0     -- in base p that we need to drop - this is what jsplith takes care of.     -- jsplitb the handles the remaining digits.     jsplitf :: Integer -> Integer -> [Integer]@@ -465,27 +460,18 @@            | otherwise = go (k + 12) (v `quot` 1000000000000)         fin v n = if v >= n then 1 else 0 -pattern MINUS, PLUS, ZERO, SPACE, DOT, LITTLE_E, BIG_E :: Word8-pattern PLUS     = 43-pattern MINUS    = 45-pattern ZERO     = 48-pattern SPACE    = 32-pattern DOT      = 46-pattern LITTLE_E = 101-pattern BIG_E    = 69- -- | Decimal digit to ASCII digit. i2wDec :: (Integral a) => a -> Word8 {-# INLINE i2wDec #-} {-# SPECIALIZE INLINE i2wDec :: Int -> Word8 #-}-i2wDec v = ZERO + fromIntegral v+i2wDec v = DIGIT_0 + fromIntegral v  -- | Hexadecimal digit to ASCII char. i2wHex :: (Integral a) => a -> Word8 {-# INLINE i2wHex #-} {-# SPECIALIZE INLINE i2wHex :: Int -> Word8 #-} i2wHex v-    | v <= 9    = ZERO + fromIntegral v+    | v <= 9    = DIGIT_0 + fromIntegral v     | otherwise = 87 + fromIntegral v       -- fromEnum 'a' - 10  -- | Hexadecimal digit to UPPERCASED ASCII char.@@ -493,7 +479,7 @@ {-# INLINE i2wHexUpper #-} {-# SPECIALIZE INLINE i2wHexUpper :: Int -> Word8 #-} i2wHexUpper v-    | v <= 9    = ZERO + fromIntegral v+    | v <= 9    = DIGIT_0 + fromIntegral v     | otherwise = 55 + fromIntegral v       -- fromEnum 'A' - 10  --------------------------------------------------------------------------------@@ -656,7 +642,7 @@                 encodeDigit i                 encodePrim DOT                 encodeDigits is'-                encodePrim LITTLE_E+                encodePrim LETTER_e                 int (e-1)             []      -> error "doFmt/Exponent: []"         Just dec@@ -670,7 +656,7 @@                         let (ei,is') = roundTo 10 1 is                             n:_ = if ei > 0 then List.init is' else is'                         encodeDigit n-                        encodePrim LITTLE_E+                        encodePrim LETTER_e                         int (e-1+ei)         Just dec ->             let !dec' = max dec 1 in@@ -683,7 +669,7 @@                     encodeDigit d                     encodePrim DOT                     encodeDigits ds'-                    encodePrim LITTLE_E+                    encodePrim LETTER_e                     int (e-1+ei)     Fixed -> case decs of         Nothing@@ -710,13 +696,13 @@      encodeDigits = mapM_ encodeDigit -    encodeZeros n = replicateM_ n (encodePrim ZERO)+    encodeZeros n = replicateM_ n (encodePrim DIGIT_0) -    mk0 [] = encodePrim ZERO+    mk0 [] = encodePrim DIGIT_0     mk0 ls = encodeDigits ls      insertDot 0     rs = encodePrim DOT >> mk0 rs-    insertDot n     [] = encodePrim ZERO >> insertDot (n-1) []+    insertDot n     [] = encodePrim DIGIT_0 >> insertDot (n-1) []     insertDot n (r:rs) = encodeDigit r >> insertDot (n-1) rs   ------------------------------------------------------------------------------

@@ -0,0 +1,141 @@+{-|+Module:      Z.Data.Parser.Time+Description : Builders for types from time.+Copyright:   (c) 2015-2016 Bryan O'Sullivan+             (c) 2020 Dong Han+License:     BSD3+Maintainer:  Dong <winterland1989@gmail.com>+Stability:   experimental+Portability: portable++Builders for dates and times.+-}++module Z.Data.Builder.Time+  ( day+  , timeOfDay+  , timeZone+  , utcTime+  , localTime+  , zonedTime+  ) where++import Control.Monad+import Data.Time+import Data.Word+import Data.Fixed+import Data.Int+import           Z.Data.Builder.Base        (Builder)+import qualified Z.Data.Builder.Base        as B+import qualified Z.Data.Builder.Numeric     as B+import Z.Data.Builder.Numeric   (i2wDec)+import Z.Data.ASCII++-- | @YYYY-mm-dd@.+day :: Day -> Builder ()+{-# INLINE day #-}+day dd = encodeYear yr <>+         B.encodePrim (HYPHEN, mh, ml, HYPHEN, dh, dl)+  where (yr, m, d)    = toGregorian dd+        (mh, ml)  = twoDigits m+        (dh, dl)  = twoDigits d+        encodeYear y+            | y >= 1000 = B.integer y+            | y >= 0    = B.encodePrim (padYear y)+            | y >= -999 = B.encodePrim (MINUS, padYear y)+            | otherwise = B.integer y+        padYear y =+            let (ab,c) = (fromIntegral y :: Int) `quotRem` 10+                (a, b)  = ab `quotRem` 10+            in (DIGIT_0, i2wDec a, i2wDec b, i2wDec c)++-- | @HH-MM-SS@.+timeOfDay :: TimeOfDay -> Builder ()+{-# INLINE timeOfDay #-}+timeOfDay t = timeOfDay64 (toTimeOfDay64 t)++-- | Timezone format in @+HH:MM@, with single letter @Z@ for @+00:00@.+timeZone :: TimeZone -> Builder ()+{-# INLINE timeZone #-}+timeZone (TimeZone off _ _)+  | off == 0  = B.word8 LETTER_Z+  | otherwise = B.encodePrim (s, hh, hl, COLON, mh, ml)+  where !s         = if off < 0 then MINUS else PLUS+        (hh, hl)   = twoDigits h+        (mh, ml)   = twoDigits m+        (h,m)      = abs off `quotRem` 60++-- | Write 'UTCTime' in ISO8061 @YYYY-MM-DDTHH:MM:SS.SSSZ@(time zone will always be @Z@).+utcTime :: UTCTime -> Builder ()+{-# INLINE utcTime #-}+utcTime (UTCTime d s) = dayTime d (diffTimeOfDay64 s) >> B.word8 LETTER_Z++-- | Write 'LocalTime' in ISO8061 @YYYY-MM-DDTHH:MM:SS.SSS@.+localTime :: LocalTime -> Builder ()+{-# INLINE localTime #-}+localTime (LocalTime d t) = dayTime d (toTimeOfDay64 t)++-- | Write 'ZonedTime' in ISO8061 @YYYY-MM-DD HH:MM:SS.SSSZ@.+zonedTime :: ZonedTime -> Builder ()+{-# INLINE zonedTime #-}+zonedTime (ZonedTime t z) = localTime t >> timeZone z++--------------------------------------------------------------------------------++-- | Like TimeOfDay, but using a fixed-width integer for seconds.+type TimeOfDay64 = (Int, Int, Int64)++diffTimeOfDay64 :: DiffTime -> TimeOfDay64+{-# INLINE diffTimeOfDay64 #-}+diffTimeOfDay64 t+  | t >= 86400 = (23, 59, 60000000000000 + pico (t - 86400))+  | otherwise = (fromIntegral h, fromIntegral m, s)+    where (h,mp) = pico t `quotRem` 3600000000000000+          (m,s)  = mp `quotRem` 60000000000000+          pico   = fromIntegral . diffTimeToPicoseconds++toTimeOfDay64 :: TimeOfDay -> TimeOfDay64+{-# INLINE toTimeOfDay64 #-}+toTimeOfDay64 (TimeOfDay h m (MkFixed s)) = (h, m, fromIntegral s)++dayTime :: Day -> TimeOfDay64 -> Builder ()+{-# INLINE dayTime #-}+dayTime d t = day d >> B.word8 LETTER_T >> timeOfDay64 t++timeOfDay64 :: TimeOfDay64 -> Builder ()+{-# INLINE timeOfDay64 #-}+timeOfDay64 (!h, !m, !s) = do+    B.encodePrim (hh, hl, COLON, mh, ml, COLON, sh, sl)+    when (frac /= 0) $ do+        B.encodePrim DOT+        replicateM_ (12 - n1) (B.word8 DIGIT_0)+        forM_ ds (B.word8 . B.i2wDec)+  where+    (real, frac) = s `quotRem` 1000000000000 -- number of picoseconds  in 1 second++    (hh, hl)     = twoDigits h+    (mh, ml)     = twoDigits m+    (sh, sl)     = twoDigits (fromIntegral real)++    (frac', n0) = ctz frac 0+    (ds, n1) = toDigits frac' [] n0++    ctz :: Int64 -> Int -> (Int64, Int)+    ctz !x !n =+        let (x', r) = x `quotRem` 10+        in if r == 0+            then ctz x' (n+1)+            else (x, n)++    toDigits :: Int64 -> [Int64] -> Int -> ([Int64], Int)+    toDigits !x !acc !n =+        let (x', r) = x `quotRem` 10+        in if x' == 0+            then ((r:acc), n+1)+            else toDigits x' (r:acc) (n+1)++twoDigits :: Int -> (Word8, Word8)+{-# INLINE twoDigits #-}+twoDigits a = (i2wDec hi, i2wDec lo)+  where (hi,lo) = a `quotRem` 10+

@@ -21,22 +21,23 @@   , unpack   , null, length   , empty, singleton, append, concat, intercalate, intercalateElem-  , fromCString, fromCStringN+  , fromCString, fromCStringN, fromStdString   , withCBytesUnsafe, withCBytes, allocCBytesUnsafe, allocCBytes   , withCBytesListUnsafe, withCBytesList+  , pokeMBACBytes, peekMBACBytes, indexBACBytes   -- * re-export   , CString-  , V.c2w, V.w2c   ) where  import           Control.DeepSeq import           Control.Monad+import           Control.Exception import           Control.Monad.Primitive import           Control.Monad.ST import           Data.Bits-import           Data.Foldable           (foldlM)-import           Data.Hashable           (Hashable(..))-import qualified Data.List               as List+import           Data.Foldable              (foldlM)+import           Data.Hashable              (Hashable(..))+import qualified Data.List                  as List import           Data.Primitive.PrimArray import           Data.Word import           Foreign.C.String@@ -44,30 +45,29 @@ import           GHC.CString import           GHC.Ptr import           GHC.Stack-import           Prelude                 hiding (all, any, appendFile, break,-                                          concat, concatMap, drop, dropWhile,-                                          elem, filter, foldl, foldl1, foldr,-                                          foldr1, getContents, getLine, head,-                                          init, interact, last, length, lines,-                                          map, maximum, minimum, notElem, null,-                                          putStr, putStrLn, readFile, replicate,-                                          reverse, scanl, scanl1, scanr, scanr1,-                                          span, splitAt, tail, take, takeWhile,-                                          unlines, unzip, writeFile, zip,-                                          zipWith)+import           Prelude                    hiding (all, any, appendFile, break,+                                                concat, concatMap, drop, dropWhile,+                                                elem, filter, foldl, foldl1, foldr,+                                                foldr1, getContents, getLine, head,+                                                init, interact, last, length, lines,+                                                map, maximum, minimum, notElem, null,+                                                putStr, putStrLn, readFile, replicate,+                                                reverse, scanl, scanl1, scanr, scanr1,+                                                span, splitAt, tail, take, takeWhile,+                                                unlines, unzip, writeFile, zip,+                                                zipWith) import           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 qualified Z.Data.Text.UTF8Codec as T-import qualified Z.Data.JSON.Base      as JSON-import           Z.Data.JSON.Base      ((<?>))-import           Z.Data.Text.UTF8Codec (encodeCharModifiedUTF8, decodeChar)-import qualified Z.Data.Vector.Base    as V-import           Z.Foreign-import           System.IO.Unsafe        (unsafeDupablePerformIO)-import           Test.QuickCheck.Arbitrary (Arbitrary(..), CoArbitrary(..))+import qualified Z.Data.Builder             as B+import qualified Z.Data.Text                as T+import qualified Z.Data.Text.Print          as T+import qualified Z.Data.Text.UTF8Codec      as T+import qualified Z.Data.JSON.Base           as JSON+import           Z.Data.JSON.Base           ((<?>))+import           Z.Data.Text.UTF8Codec      (encodeCharModifiedUTF8, decodeChar)+import qualified Z.Data.Vector.Base         as V+import           Z.Foreign                  hiding (fromStdString)+import           System.IO.Unsafe           (unsafeDupablePerformIO)+import           Test.QuickCheck.Arbitrary  (Arbitrary(..), CoArbitrary(..))  -- | A efficient wrapper for short immutable null-terminated byte sequences which can be -- automatically freed by ghc garbage collector.@@ -160,44 +160,45 @@ 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 #-}-    unalignedSize (CBytes arr) = sizeofPrimArray arr-    {-# INLINE peekMBA #-}-    peekMBA mba# i = do-        b <- getSizeofMutableByteArray (MutableByteArray mba#)-        let rest = b-i-        l <- c_memchr mba# i 0 rest-        let l' = if l == -1 then rest else l-        mpa <- newPrimArray (l'+1)-        copyMutablePrimArray mpa 0 (MutablePrimArray mba#) i l'-        -- write \\NUL terminator-        writePrimArray mpa l' 0-        pa <- unsafeFreezePrimArray mpa-        return (CBytes pa)+-- | Poke 'CBytes' until a \\NUL terminator(or to the end of the array if there's none).+peekMBACBytes :: MBA# Word8 -> Int -> IO CBytes+{-# INLINE peekMBACBytes #-}+peekMBACBytes mba# i = do+    b <- getSizeofMutableByteArray (MutableByteArray mba#)+    let rest = b-i+    l <- c_memchr mba# i 0 rest+    let l' = if l == -1 then rest else l+    mpa <- newPrimArray (l'+1)+    copyMutablePrimArray mpa 0 (MutablePrimArray mba#) i l'+    -- write \\NUL terminator+    writePrimArray mpa l' 0+    pa <- unsafeFreezePrimArray mpa+    return (CBytes pa) -    {-# INLINE pokeMBA #-}-    pokeMBA mba# i (CBytes pa) = do+-- | Poke 'CBytes' with \\NUL terminator.+pokeMBACBytes :: MBA# Word8 -> Int -> CBytes -> IO ()+{-# INLINE pokeMBACBytes #-}+pokeMBACBytes mba# i (CBytes pa) = do         let l = sizeofPrimArray pa         copyPrimArray (MutablePrimArray mba# :: MutablePrimArray RealWorld Word8) i pa 0 l -    {-# INLINE indexBA #-}-    indexBA ba# i = runST (do-        let b = sizeofByteArray (ByteArray ba#)-            rest = b-i-            l = V.c_memchr ba# i 0 rest-            l' = if l == -1 then rest else l-        mpa <- newPrimArray (l'+1)-        copyPrimArray mpa 0 (PrimArray ba#) i l'-        writePrimArray mpa l' 0-        pa <- unsafeFreezePrimArray mpa-        return (CBytes pa))+indexBACBytes :: BA# Word8 -> Int -> CBytes+{-# INLINE indexBACBytes #-}+indexBACBytes ba# i = runST (do+    let b = sizeofByteArray (ByteArray ba#)+        rest = b-i+        l = V.c_memchr ba# i 0 rest+        l' = if l == -1 then rest else l+    mpa <- newPrimArray (l'+1)+    copyPrimArray mpa 0 (PrimArray ba#) i l'+    writePrimArray mpa l' 0+    pa <- unsafeFreezePrimArray mpa+    return (CBytes pa))  -- | This instance provide UTF8 guarantee, illegal codepoints will be written as 'T.replacementChar's. -- -- Escaping rule is same with 'String'.-instance T.ShowT CBytes where+instance T.Print CBytes where     {-# INLINE toUTF8BuilderP #-}     toUTF8BuilderP _ = T.stringUTF8 . show . unpack @@ -482,7 +483,7 @@  -- | Write 'CBytes' \'s byte sequence to buffer. ----- This function is different from 'T.ShowT' instance in that it directly write byte sequence without+-- This function is different from 'T.Print' instance in that it directly write byte sequence without -- checking if it's UTF8 encoded. toBuilder :: CBytes -> B.Builder () toBuilder = B.bytes . toBytes@@ -603,6 +604,16 @@     writePrimArray mba l' 0     bs <- unsafeFreezePrimArray mba     return (CBytes bs, a)++-- | Run FFI in bracket and marshall @std::string*@ result into 'CBytes',+-- memory pointed by @std::string*@ will be @delete@ ed.+fromStdString :: IO (Ptr StdString) -> IO CBytes+fromStdString f = bracket f hs_delete_std_string+    (\ q -> do+        siz <- hs_std_string_size q+        let !siz' = siz + 1+        (bs,_) <- allocPrimArrayUnsafe siz' (hs_copy_std_string q siz')+        return (CBytes bs))  -------------------------------------------------------------------------------- 

@@ -29,24 +29,21 @@   , Value(..)     -- * parse into JSON Value   , parseValue, parseValue', parseValueChunks, parseValueChunks'+  -- * FromValue, ToValue & EncodeJSON+  , FromValue(..)+  , ToValue(..)+  , EncodeJSON(..)+  , defaultSettings, Settings(..), snakeCase, trainCase+  , gToValue, gFromValue, gEncodeJSON   -- * Convert 'Value' to Haskell data   , convert, convert', Converter(..), fail', (<?>), prependContext-  , PathElement(..), ConvertError+  , PathElement(..), ConvertError(..)   , typeMismatch, fromNull, withBool, withScientific, withBoundedScientific, withRealFloat   , withBoundedIntegral, withText, withArray, withKeyValues, withFlatMap, withFlatMapR   , withHashMap, withHashMapR, withEmbeddedJSON   , (.:), (.:?), (.:!), convertField, convertFieldMaybe, convertFieldMaybe'-  -- * FromValue, ToValue & EncodeJSON-  , ToValue(..)-  , FromValue(..)-  , EncodeJSON(..)-  , defaultSettings, Settings(..), snakeCase, trainCase-  , gToValue, gFromValue, gEncodeJSON-  -- * Helper for manually writing encoders-  , kv, kv'-  , string-  , commaSepList-  , commaSepVec+  -- * Helper for manually writing instance.+  , (.=), object, (.!), object', KVItem   ) where  import           Data.Char@@ -129,42 +126,40 @@ -- >     encodeJSON = JSON.gEncodeJSON JSON.defaultSettings{ JSON.fieldFmt = JSON.snakeCase } . from -- -- >>> JSON.toValue (T 0 [1,2,3])--- Object [(\"foo_t\",Number 0.0),(\"bar_t\",Array [Number 1.0,Number 2.0,Number 3.0])]-+-- Object [("foo_t",Number 0.0),("bar_t",Array [Number 1.0,Number 2.0,Number 3.0])]+-- -- $manually-instance -- -- You can write 'ToValue' and 'FromValue' instances by hand if the 'Generic' based one doesn't suit you. -- Here is an example similar to aeson's. ----- > import qualified Z.Data.Text          as T--- > import qualified Z.Data.Vector        as V--- > import qualified Z.Data.Builder       as B--- > import qualified Z.Data.JSON          as JSON--- > import           Z.Data.JSON          ((.:), kv, commaSepList,--- >                                        FromValue(..), ToValue(..), EncodeJSON(..))--- >--- > data Person = Person { name :: T.Text , age  :: Int } deriving Show--- >--- > instance FromValue Person where--- >     fromValue = JSON.withFlatMapR \"Person\" $ \\ v -> Person--- >                     \<$\> v .: \"name\"--- >                     \<*\> v .: \"age\"--- >--- > instance ToValue Person where--- >     toValue (Person n a) = JSON.Object $ V.pack [(\"name\", toValue n),(\"age\", toValue a)]--- >--- > instance EncodeJSON Person where--- >     encodeJSON (Person n a) = B.curly . commaSepList $ [--- >           \"name\" `kv` string n--- >         , \"age\" `kv` B.int a--- >         ]+-- @+-- import qualified Z.Data.Text          as T+-- import qualified Z.Data.Vector        as V+-- import qualified Z.Data.Builder       as B+-- import qualified Z.Data.JSON          as JSON+-- import           Z.Data.JSON          ((.:), (.=), (.!), FromValue(..), ToValue(..), EncodeJSON(..)) ----- >>> toValue (Person \"Joe\" 12)--- Object [(\"name\",String \"Joe\"),(\"age\",Number 12.0)]--- >>> JSON.convert' @Person . JSON.Object $ V.pack [(\"name\",JSON.String \"Joe\"),(\"age\",JSON.Number 12.0)]--- Right (Person {name = \"Joe\", age = 12})--- >>> JSON.encodeText (Person \"Joe\" 12)--- "{\"name\":\"Joe\",\"age\":12}"+-- data Person = Person { name :: T.Text , age  :: Int } deriving Show+--+-- instance FromValue Person where+--     fromValue = JSON.withFlatMapR \"Person\" $ \\ v -> Person+--                     \<$\> v .: \"name\"+--                     \<*\> v .: \"age\"+--+-- instance ToValue Person where+--     toValue (Person n a) = JSON.object [\"name\" .= n, \"age\" .= a]+--+-- instance EncodeJSON Person where+--     encodeJSON (Person n a) = JSON.object' $ (\"name\" .! n <> \"age\" .! a)+-- @+--+-- >>> toValue (Person "Joe" 12)+-- Object [("name",String "Joe"),("age",Number 12.0)]+-- >>> JSON.convert' @Person . JSON.Object $ V.pack [("name",JSON.String "Joe"),("age",JSON.Number 12.0)]+-- Right (Person {name = "Joe", age = 12})+-- >>> JSON.encodeText (Person "Joe" 12)+-- "{"name":"Joe","age":12}" -- -- The 'Value' type is different from aeson's one in that we use @Vector (Text, Value)@ to represent JSON objects, thus -- we can choose different strategies on key duplication, the lookup map type, etc. so instead of a single 'withObject',

@@ -23,7 +23,7 @@   , JV.parseValue, JV.parseValue', JV.parseValueChunks, JV.parseValueChunks'   -- * Convert 'Value' to Haskell data   , convert, convert', Converter(..), fail', (<?>), prependContext-  , PathElement(..), ConvertError+  , PathElement(..), ConvertError(..)   , typeMismatch, fromNull, withBool, withScientific, withBoundedScientific, withRealFloat   , withBoundedIntegral, withText, withArray, withKeyValues, withFlatMap, withFlatMapR   , withHashMap, withHashMapR, withEmbeddedJSON@@ -37,9 +37,11 @@   , Field, GWriteFields(..), GMergeFields(..), GConstrToValue(..)   , LookupTable, GFromFields(..), GBuildLookup(..), GConstrFromValue(..)   , GAddPunctuation(..), GConstrEncodeJSON(..)-  -- * Helper for manually writing encoders+  -- * Helper for manually writing instance.+  , (.=), object, (.!), object', KVItem   , JB.kv, JB.kv'   , JB.string+  , B.curly, B.square   , commaSepList   , commaSepVec   ) where@@ -70,11 +72,14 @@ import           Data.Proxy                   (Proxy (..)) import           Data.Ratio                   (Ratio, denominator, numerator,                                                (%))-import           Data.Scientific              (Scientific, base10Exponent,-                                               toBoundedInteger)+import           Data.Scientific              (Scientific, base10Exponent, toBoundedInteger) import qualified Data.Scientific              as Scientific import qualified Data.Semigroup               as Semigroup import           Data.Tagged                  (Tagged (..))+import           Data.Time                    (Day, DiffTime, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime)+import           Data.Time.Calendar           (CalendarDiffDays (..), DayOfWeek (..))+import           Data.Time.LocalTime          (CalendarDiffTime (..))+import           Data.Time.Clock.System       (SystemTime (..)) import           Data.Version                 (Version, parseVersion) import           Data.Word import           Foreign.C.Types@@ -91,8 +96,9 @@ import qualified Z.Data.JSON.Value            as JV import qualified Z.Data.Parser                as P import qualified Z.Data.Parser.Numeric        as P+import qualified Z.Data.Text.Base             as T import qualified Z.Data.Text                  as T-import qualified Z.Data.Text.ShowT            as T+import qualified Z.Data.Text.Print            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@@ -172,7 +178,7 @@ {-# INLINE encodeChunks #-} encodeChunks = B.buildChunks . encodeJSON --- | Text version 'encodeBytes'.+-- | Text version 'encode'. encodeText :: EncodeJSON a => a -> T.Text {-# INLINE encodeText #-} encodeText = T.Text . encode@@ -208,7 +214,7 @@ instance Show ConvertError where     show = T.toString -instance T.ShowT ConvertError where+instance T.Print ConvertError where     toUTF8BuilderP _ (ConvertError [] msg) = T.toUTF8Builder msg     toUTF8BuilderP _ (ConvertError paths msg) = do         mapM_ renderPath (reverse paths)@@ -497,6 +503,35 @@ {-# INLINE commaSepVec #-} commaSepVec = B.intercalateVec B.comma encodeJSON +-- | A newtype for 'B.Builder', whose semigroup's instance is to connect two builder with 'B.comma'.+newtype KVItem = KVItem (B.Builder ())++instance Semigroup KVItem where+    {-# INLINE (<>) #-}+    KVItem a <> KVItem b = KVItem (a >> B.comma >> b)++-- | Connect key and value to a 'KVItem' using 'B.colon', key will be escaped.+(.!) :: EncodeJSON v => T.Text -> v -> KVItem+{-# INLINE (.!) #-}+k .! v = KVItem (k `JB.kv'` encodeJSON v)+infixr 8 .!++-- | Add curly for comma connected 'KVItem's.+object' :: KVItem -> B.Builder ()+{-# INLINE object' #-}+object' (KVItem kvb) = B.curly kvb++-- | Connect key and value to a tuple to be used with 'object'.+(.=) :: ToValue v => T.Text -> v -> (T.Text, Value)+{-# INLINE (.=) #-}+k .= v = (k, toValue v)+infixr 8 .=++-- | Alias for @Object . pack@.+object :: [(T.Text, Value)] -> Value+{-# INLINE object #-}+object = Object . V.pack+ --------------------------------------------------------------------------------  -- | Generic encode/decode Settings@@ -1317,6 +1352,171 @@ instance HasResolution a => EncodeJSON (Fixed a) where     {-# INLINE encodeJSON #-}     encodeJSON = B.scientific . realToFrac++--------------------------------------------------------------------------------++instance FromValue UTCTime where+    {-# INLINE fromValue #-}+    fromValue = withText "UTCTime" $ \ t ->+        case P.parse' (P.utcTime <* P.endOfInput) (T.getUTF8Bytes t) of+            Left err -> fail' $ "could not parse date as UTCTime: " <> T.toText err+            Right r  -> return r+instance ToValue UTCTime where+    {-# INLINE toValue #-}+    toValue t = String (B.unsafeBuildText (B.utcTime t))+-- @YYYY-MM-DDTHH:MM:SS.SSSZ@+instance EncodeJSON UTCTime where+    {-# INLINE encodeJSON #-}+    encodeJSON = B.quotes . B.utcTime++instance FromValue ZonedTime where+    {-# INLINE fromValue #-}+    fromValue = withText "ZonedTime" $ \ t ->+        case P.parse' (P.zonedTime <* P.endOfInput) (T.getUTF8Bytes t) of+            Left err -> fail' $ "could not parse date as ZonedTime: " <> T.toText err+            Right r  -> return r+instance ToValue ZonedTime where+    {-# INLINE toValue #-}+    toValue t = String (B.unsafeBuildText (B.zonedTime t))+-- @YYYY-MM-DDTHH:MM:SS.SSSZ@+instance EncodeJSON ZonedTime where+    {-# INLINE encodeJSON #-}+    encodeJSON = B.quotes . B.zonedTime++instance FromValue Day where+    {-# INLINE fromValue #-}+    fromValue = withText "Day" $ \ t ->+        case P.parse' (P.day <* P.endOfInput) (T.getUTF8Bytes t) of+            Left err -> fail' $ "could not parse date as Day: " <> T.toText err+            Right r  -> return r+instance ToValue Day where+    {-# INLINE toValue #-}+    toValue t = String (B.unsafeBuildText (B.day t))+-- @YYYY-MM-DD@+instance EncodeJSON Day where+    {-# INLINE encodeJSON #-}+    encodeJSON = B.quotes . B.day+++instance FromValue LocalTime where+    {-# INLINE fromValue #-}+    fromValue = withText "LocalTime" $ \ t ->+        case P.parse' (P.localTime <* P.endOfInput) (T.getUTF8Bytes t) of+            Left err -> fail' $ "could not parse date as LocalTime: " <> T.toText err+            Right r  -> return r+instance ToValue LocalTime where+    {-# INLINE toValue #-}+    toValue t = String (B.unsafeBuildText (B.localTime t))+-- @YYYY-MM-DDTHH:MM:SS.SSSZ@+instance EncodeJSON LocalTime where+    {-# INLINE encodeJSON #-}+    encodeJSON = B.quotes . B.localTime++instance FromValue TimeOfDay where+    {-# INLINE fromValue #-}+    fromValue = withText "TimeOfDay" $ \ t ->+        case P.parse' (P.timeOfDay <* P.endOfInput) (T.getUTF8Bytes t) of+            Left err -> fail' $ "could not parse time as TimeOfDay: " <> T.toText err+            Right r  -> return r+instance ToValue TimeOfDay where+    {-# INLINE toValue #-}+    toValue t = String (B.unsafeBuildText (B.timeOfDay t))+-- @YYYY-MM-DDTHH:MM:SS.SSSZ@+instance EncodeJSON TimeOfDay where+    {-# INLINE encodeJSON #-}+    encodeJSON = B.quotes . B.timeOfDay++-- | This instance includes a bounds check to prevent maliciously+-- large inputs to fill up the memory of the target system. You can+-- newtype 'NominalDiffTime' and provide your own instance using+-- 'withScientific' if you want to allow larger inputs.+instance FromValue NominalDiffTime where+    {-# INLINE fromValue #-}+    fromValue = withBoundedScientific "NominalDiffTime" $ pure . realToFrac+instance ToValue NominalDiffTime where+    {-# INLINE toValue #-}+    toValue = Number . realToFrac+instance EncodeJSON NominalDiffTime where+    {-# INLINE encodeJSON #-}+    encodeJSON = B.scientific . realToFrac+++-- | This instance includes a bounds check to prevent maliciously+-- large inputs to fill up the memory of the target system. You can+-- newtype 'DiffTime' and provide your own instance using+-- 'withScientific' if you want to allow larger inputs.+instance FromValue DiffTime where+    {-# INLINE fromValue #-}+    fromValue = withBoundedScientific "DiffTime" $ pure . realToFrac+instance ToValue DiffTime where+    {-# INLINE toValue #-}+    toValue = Number . realToFrac+instance EncodeJSON DiffTime where+    {-# INLINE encodeJSON #-}+    encodeJSON = B.scientific . realToFrac++instance FromValue SystemTime where+    {-# INLINE fromValue #-}+    fromValue = withFlatMapR "SystemTime" $ \ v ->+        MkSystemTime <$> v .: "seconds" <*> v .: "nanoseconds"+instance ToValue SystemTime where+    {-# INLINE toValue #-}+    toValue (MkSystemTime s ns) = object [ "seconds" .= s , "nanoseconds" .= ns ]+instance EncodeJSON SystemTime where+    {-# INLINE encodeJSON #-}+    encodeJSON (MkSystemTime s ns) = object' $ ("seconds" .! s <> "nanoseconds" .! ns)++instance FromValue CalendarDiffTime where+    {-# INLINE fromValue #-}+    fromValue = withFlatMapR "CalendarDiffTime" $ \ v ->+        CalendarDiffTime <$> v .: "months" <*> v .: "time"+instance ToValue CalendarDiffTime where+    {-# INLINE toValue #-}+    toValue (CalendarDiffTime m nt) = object [ "months" .= m , "time" .= nt ]+instance EncodeJSON CalendarDiffTime where+    {-# INLINE encodeJSON #-}+    encodeJSON (CalendarDiffTime m nt) = object' $ ("months" .! m <> "time" .! nt)++instance FromValue CalendarDiffDays where+    {-# INLINE fromValue #-}+    fromValue = withFlatMapR "CalendarDiffDays" $ \ v ->+        CalendarDiffDays <$> v .: "months" <*> v .: "days"+instance ToValue CalendarDiffDays where+    {-# INLINE toValue #-}+    toValue (CalendarDiffDays m d) = object ["months" .= m, "days" .= d]+instance EncodeJSON CalendarDiffDays where+    {-# INLINE encodeJSON #-}+    encodeJSON (CalendarDiffDays m d) = object' $ ("months" .! m <> "days" .! d)++instance FromValue DayOfWeek where+    {-# INLINE fromValue #-}+    fromValue (String "monday"   ) = pure Monday+    fromValue (String "tuesday"  ) = pure Tuesday+    fromValue (String "wednesday") = pure Wednesday+    fromValue (String "thursday" ) = pure Thursday+    fromValue (String "friday"   ) = pure Friday+    fromValue (String "saturday" ) = pure Saturday+    fromValue (String "sunday"   ) = pure Sunday+    fromValue (String _   )        = fail' "converting DayOfWeek failed, value should be one of weekdays"+    fromValue v                    = typeMismatch "DayOfWeek" "String" v+instance ToValue DayOfWeek where+    {-# INLINE toValue #-}+    toValue Monday    = String "monday"+    toValue Tuesday   = String "tuesday"+    toValue Wednesday = String "wednesday"+    toValue Thursday  = String "thursday"+    toValue Friday    = String "friday"+    toValue Saturday  = String "saturday"+    toValue Sunday    = String "sunday"+instance EncodeJSON DayOfWeek where+    {-# INLINE encodeJSON #-}+    encodeJSON Monday    = "monday"+    encodeJSON Tuesday   = "tuesday"+    encodeJSON Wednesday = "wednesday"+    encodeJSON Thursday  = "thursday"+    encodeJSON Friday    = "friday"+    encodeJSON Saturday  = "saturday"+    encodeJSON Sunday    = "sunday"  -------------------------------------------------------------------------------- 

@@ -26,14 +26,17 @@   ) where  import           Control.Monad+import           Z.Data.ASCII import qualified Z.Data.Builder                 as B import qualified Z.Data.Text                    as T-import qualified Z.Data.Text.ShowT              as T+import qualified Z.Data.Text.Print              as T import           Z.Data.Vector.Base             as V import           Z.Data.JSON.Value              (Value(..))-import           Data.Scientific              (Scientific, base10Exponent, coefficient)+import           Data.Scientific                (Scientific, base10Exponent, coefficient) --- | Use @:@ as separator to connect a label(no need to escape, only add quotes) with field builders.+-- | Use @:@ as separator to connect a label(no escape, only add quotes) with field builders.+--+-- Don't use chars which need escaped in label. kv :: T.Text -> B.Builder () -> B.Builder () {-# INLINE kv #-} l `kv` b = B.quotes (B.text l) >> B.colon >> b@@ -96,7 +99,7 @@     | e == 0 = B.integer c     | otherwise = do         B.integer c-        when (c /= 0) (replicateM_ e (B.encodePrim B.ZERO))+        when (c /= 0) (replicateM_ e (B.encodePrim DIGIT_0))   where     e = base10Exponent s     c = coefficient s

@@ -46,8 +46,8 @@ import           GHC.Generics import qualified Z.Data.Parser          as P import           Z.Data.Parser          ((<?>))-import qualified Z.Data.Text            as T-import           Z.Data.Text.ShowT     (ShowT(..))+import qualified Z.Data.Text.Base       as T+import           Z.Data.Text.Print     (Print(..)) import           Z.Data.Vector.Base     as V import           Z.Data.Vector.Extra    as V import           Z.Foreign@@ -91,8 +91,8 @@            | Number {-# UNPACK #-} !Scientific            | Bool   !Bool            | Null-         deriving (Eq, Show, Typeable, Generic)-         deriving anyclass ShowT+         deriving (Eq, Ord, Show, Typeable, Generic)+         deriving anyclass Print  instance NFData Value where     {-# INLINE rnf #-}

@@ -38,13 +38,13 @@   , decodePrim, decodePrimLE, decodePrimBE     -- * More parsers   , scan, scanChunks, peekMaybe, peek, satisfy, satisfyWith-  , word8, char8, skipWord8, endOfLine, skip, skipWhile, skipSpaces+  , anyWord8, word8, anyChar8, char8, skipWord8, endOfLine, skip, skipWhile, skipSpaces   , take, takeTill, takeWhile, takeWhile1, bytes, bytesCI   , text     -- * Numeric parsers     -- ** Decimal   , uint, int, integer-  , uint_, int_+  , uint_, int_, digit     -- ** Hex   , hex, hex', hex_     -- ** Fractional@@ -57,10 +57,18 @@   , float', double'   , scientific'   , scientifically'+  -- * Time+  , day+  , localTime+  , timeOfDay+  , timeZone+  , utcTime+  , zonedTime     -- * Misc-  , isSpace, isHexDigit, isDigit, fail'+  , fail'   ) where  import           Z.Data.Parser.Base import           Z.Data.Parser.Numeric+import           Z.Data.Parser.Time import           Prelude hiding (take, takeWhile)

@@ -27,11 +27,10 @@   , decodePrim, decodePrimLE, decodePrimBE     -- * More parsers   , scan, scanChunks, peekMaybe, peek, satisfy, satisfyWith-  , word8, char8, skipWord8, endOfLine, skip, skipWhile, skipSpaces+  , anyWord8, word8, anyChar8, char8, skipWord8, endOfLine, skip, skipWhile, skipSpaces   , take, takeN, takeTill, takeWhile, takeWhile1, bytes, bytesCI   , text     -- * Misc-  , isSpace   , fail'   ) where @@ -45,6 +44,7 @@ import           GHC.Types import           Prelude                            hiding (take, takeWhile) import           Z.Data.Array.Unaligned+import           Z.Data.ASCII import qualified Z.Data.Text.Base                 as T import qualified Z.Data.Vector.Base               as V import qualified Z.Data.Vector.Extra              as V@@ -290,7 +290,7 @@         let !r = indexPrimWord8ArrayAs ba i         in k r (V.PrimVector ba (i+n) (len-n)))   where-    n = unalignedSize (undefined :: a)+    n = getUnalignedSize (unalignedSize @a)  decodePrimLE :: forall a. (Unaligned (LE a)) => Parser a {-# INLINE decodePrimLE #-}@@ -308,7 +308,7 @@         let !r = indexPrimWord8ArrayAs ba i         in k (getLE r) (V.PrimVector ba (i+n) (len-n)))   where-    n = unalignedSize (undefined :: (LE a))+    n = getUnalignedSize (unalignedSize @(LE a))  decodePrimBE :: forall a. (Unaligned (BE a)) => Parser a {-# INLINE decodePrimBE #-}@@ -326,7 +326,7 @@         let !r = indexPrimWord8ArrayAs ba i         in k (getBE r) (V.PrimVector ba (i+n) (len-n)))   where-    n = unalignedSize (undefined :: (BE a))+    n = getUnalignedSize (unalignedSize @(BE a))  -- | A stateful scanner.  The predicate consumes and transforms a -- state argument, and each transformed state is passed to successive@@ -454,12 +454,25 @@             then k () (V.unsafeTail inp)             else kf ["Z.Data.Parser.Base.word8: mismatch byte"] inp) +-- | Return a byte, this is an alias to @decodePrim @Word8@.+--+anyWord8 :: Parser Word8+{-# INLINE anyWord8 #-}+anyWord8 = decodePrim+ -- | Match a specific 8bit char. -- char8 :: Char -> Parser () {-# INLINE char8 #-}-char8 = word8 . V.c2w+char8 = word8 . c2w +-- | Take a byte and return as a 8bit char.+--+anyChar8 :: Parser Char+{-# INLINE anyChar8 #-}+anyChar8 = do+    w <- anyWord8+    return $! w2c w  -- | Match either a single newline byte @\'\\n\'@, or a carriage -- return followed by a newline byte @\"\\r\\n\"@.@@ -539,11 +552,6 @@ skipSpaces :: Parser () {-# INLINE skipSpaces #-} skipSpaces = skipWhile isSpace---- | @isSpace w = w == 32 || w - 9 <= 4 || w == 0xA0@-isSpace :: Word8 -> Bool-{-# INLINE isSpace #-}-isSpace w = w == 32 || w - 9 <= 4 || w == 0xA0  take :: Int -> Parser V.Bytes {-# INLINE take #-}

@@ -14,7 +14,7 @@ module Z.Data.Parser.Numeric   ( -- * Decimal     uint, int, integer-  , uint_, int_+  , uint_, int_, digit     -- * Hex   , hex, hex', hex_     -- * Fractional@@ -28,11 +28,10 @@   , scientific'   , scientifically'     -- * Misc+  , w2iHex, w2iDec   , hexLoop   , decLoop   , decLoopIntegerFast-  , isHexDigit-  , isDigit   , floatToScientific   , doubleToScientific   ) where@@ -43,9 +42,8 @@ import           Data.Int import qualified Data.Scientific          as Sci import           Data.Word+import           Z.Data.ASCII import qualified Z.Data.Builder.Numeric as B-import           Z.Data.Builder.Numeric (pattern PLUS, pattern MINUS, pattern ZERO,-                                         pattern DOT, pattern LITTLE_E, pattern BIG_E) import           Z.Data.Parser.Base     (Parser, (<?>)) import qualified Z.Data.Parser.Base     as P import qualified Z.Data.Vector.Base     as V@@ -55,7 +53,7 @@ #define INT64_SAFE_DIGITS_LEN 18  --- | Parse and decode an unsigned hex number, fail in case of overflow. The hex digits+-- | Parse and decode an unsigned hex number, fail if input length is larger than (bit_size/4). The hex digits -- @\'a\'@ through @\'f\'@ may be upper or lower case. -- -- This parser does not accept a leading @\"0x\"@ string, and consider@@ -98,24 +96,24 @@ hex_ = "Z.Data.Parser.Numeric.hex_" <?> hexLoop 0 <$> P.takeWhile1 isHexDigit  -- | decode hex digits sequence within an array.-hexLoop :: (Integral a, Bits a)+hexLoop :: forall a. (Integral a, Bits a)         => a    -- ^ accumulator, usually start from 0         -> V.Bytes         -> a {-# INLINE hexLoop #-} hexLoop = V.foldl' step   where-    step a w = a `unsafeShiftL` 4 + fromIntegral (w2iHex w)-    w2iHex w-        | w <= 57   = w - 48-        | w <= 70   = w - 55-        | w <= 102  = w - 87+    step a w = a `unsafeShiftL` 4 + fromIntegral (w2iHex w :: a) --- | A fast digit predicate.-isHexDigit :: Word8 -> Bool-{-# INLINE isHexDigit #-}-isHexDigit w = w - 48 <= 9 || w - 65 <= 5 || w - 97 <= 5+-- | Convert A ASCII hex digit to 'Int' value.+w2iHex :: Integral a => Word8 -> a+{-# INLINE w2iHex #-}+w2iHex w+    | w <= 57   = fromIntegral w - 48+    | w <= 70   = fromIntegral w - 55+    | w <= 102  = fromIntegral w - 87 + -- | Same with 'uint', but sliently cast in case of overflow. uint_ :: forall a. (Integral a, Bounded a) => Parser a {-# INLINE uint_ #-}@@ -149,8 +147,15 @@         -> a {-# INLINE decLoop #-} decLoop = V.foldl' step-  where step a w = a * 10 + fromIntegral (w - 48)+  where step a w = a * 10 + w2iDec w ++-- | Convert A ASCII decimal digit to 'Int' value.+--+w2iDec :: Integral a => Word8 -> a+{-# INLINE w2iDec #-}+w2iDec w = fromIntegral w - 48+ -- | decode digits sequence within an array. -- -- A fast version to decode 'Integer' using machine word as much as possible.@@ -160,11 +165,14 @@     | V.length bs <= WORD64_SAFE_DIGITS_LEN = fromIntegral (decLoop @Word64 0 bs)     | otherwise                            = decLoop @Integer 0 bs --- | A fast digit predicate.-isDigit :: Word8 -> Bool-isDigit w = w - 48 <= 9-{-# INLINE isDigit #-} +-- | Take a single decimal digit and return as 'Int'.+--+digit :: Parser Int+digit = do+    d <- P.satisfy isDigit+    return $! w2iDec d+ -- | Parse a decimal number with an optional leading @\'+\'@ or @\'-\'@ sign -- character. --@@ -324,7 +332,7 @@   where     {-# INLINE parseE #-}     parseE c e =-        (do _ <- P.satisfy (\w -> w ==  LITTLE_E || w == BIG_E)+        (do _ <- P.satisfy (\w -> w ==  LETTER_e || w == LETTER_E)             Sci.scientific c . subtract e <$> int) <|> pure (Sci.scientific c (negate e))  --------------------------------------------------------------------------------@@ -406,7 +414,7 @@     !sign <- P.peek     when (sign == MINUS) (P.skipWord8) -- no leading plus is allowed     !intPart <- P.takeWhile1 isDigit-    when (V.length intPart > 1 && V.head intPart == ZERO) (P.fail' "leading zeros are not allowed")+    when (V.length intPart > 1 && V.head intPart == DIGIT_0) (P.fail' "leading zeros are not allowed")     mdot <- P.peekMaybe     !sci <- case mdot of         Just DOT -> do@@ -430,7 +438,7 @@     parseE !c !e = do         me <- P.peekMaybe         e' <- case me of-            Just ec | ec == LITTLE_E || ec == BIG_E -> P.skipWord8 *> int+            Just ec | ec == LETTER_e || ec == LETTER_E -> P.skipWord8 *> int             _ -> pure 0         pure $! Sci.scientific c (e' - e) 

@@ -0,0 +1,142 @@+{-|+Module:      Z.Data.Parser.Time+Description : Parsers for types from time.+Copyright:   (c) 2015-2016 Bryan O'Sullivan+             (c) 2020 Dong Han+License:     BSD3+Maintainer:  Dong <winterland1989@gmail.com>+Stability:   experimental+Portability: portable++Parsers for parsing dates and times.+-}++module Z.Data.Parser.Time+    ( day+    , localTime+    , timeOfDay+    , timeZone+    , utcTime+    , zonedTime+    ) where++import Control.Applicative ((<|>))+import Z.Data.Parser.Base       (Parser)+import qualified Z.Data.Parser.Base       as P+import qualified Z.Data.Parser.Numeric    as P+import Z.Data.ASCII+import Data.Fixed (Pico, Fixed(..))+import Data.Int (Int64)+import Data.Maybe (fromMaybe)+import Data.Time.Calendar (Day, fromGregorianValid)+import Data.Time.Clock (UTCTime(..))+import qualified Z.Data.Vector  as V+import Data.Time.LocalTime      hiding (utc)++-- | Parse a date of the form @[+,-]YYYY-MM-DD@.+day :: Parser Day+day = "date must be of form [+,-]YYYY-MM-DD" P.<?> do+    absOrNeg <- negate <$ P.word8 MINUS <|> id <$ P.word8 PLUS <|> pure id+    y <- (P.integer <* P.word8 HYPHEN)+    m <- (twoDigits <* P.word8 HYPHEN)+    d <- twoDigits+    maybe (P.fail' "invalid date") return (fromGregorianValid (absOrNeg y) m d)++-- | Parse a two-digit integer (e.g. day of month, hour).+twoDigits :: Parser Int+twoDigits = do+    a <- P.digit+    b <- P.digit+    return $! a * 10 + b++-- | Parse a time of the form @HH:MM[:SS[.SSS]]@.+timeOfDay :: Parser TimeOfDay+timeOfDay = do+    h <- twoDigits+    m <- P.char8 ':' *> twoDigits+    s <- (P.char8 ':' *> seconds) <|> pure 0+    if h < 24 && m < 60 && s < 61+    then return (TimeOfDay h m s)+    else P.fail' "invalid time"+++-- | Parse a count of seconds, with the integer part being two digits -- long.+seconds :: Parser Pico+seconds = do+    real <- twoDigits+    mw <- P.peekMaybe+    case mw of+        Just DOT -> do+            t <- P.skipWord8 *> P.takeWhile1 isDigit+            return $! parsePicos real t+        _ -> return $! fromIntegral real+ where+    parsePicos a0 t =+        let V.IPair n t'  = V.foldl' step (V.IPair 12 (fromIntegral a0 :: Int64)) t+            step ma@(V.IPair m !a) w+                | m <= 0    = ma+                | otherwise = V.IPair (m-1) (10 * a + P.w2iDec w)+        in MkFixed (fromIntegral (t' * 10^n))++-- | Parse a time zone, and return 'Nothing' if the offset from UTC is+-- zero. (This makes some speedups possible.)+timeZone :: Parser (Maybe TimeZone)+timeZone = do+    P.skipWhile (== SPACE)+    w <- P.satisfy $ \ w -> w == LETTER_Z || w == PLUS || w == MINUS+    if w == LETTER_Z+    then return Nothing+    else do+        h <- twoDigits+        mm <- P.peekMaybe+        m <- case mm of+               Just COLON         -> P.skipWord8 *> twoDigits+               Just d | isDigit d -> twoDigits+               _                  -> return 0+        let off | w == MINUS = negate off0+                | otherwise  = off0+            off0 = h * 60 + m+        case () of+          _   | off == 0 ->+                return Nothing+              | off < -720 || off > 840 || m > 59 ->+                fail "invalid time zone offset"+              | otherwise ->+                    let !tz = minutesToTimeZone off+                    in return (Just tz)++-- | Parse a date and time, of the form @YYYY-MM-DD HH:MM[:SS[.SSS]]@.+-- The space may be replaced with a @T@.  The number of seconds is optional+-- and may be followed by a fractional component.+localTime :: Parser LocalTime+localTime = LocalTime <$> day <* daySep <*> timeOfDay+  where daySep = P.satisfy (\ w -> w == LETTER_T || w == SPACE)++-- | Behaves as 'zonedTime', but converts any time zone offset into a -- UTC time.+utcTime :: Parser UTCTime+utcTime = do+    lt@(LocalTime d t) <- localTime+    mtz <- timeZone+    case mtz of+        Nothing -> let !tt = timeOfDayToTime t+                   in return (UTCTime d tt)+        Just tz -> return $! localTimeToUTC tz lt++-- | Parse a date with time zone info. Acceptable formats:+--+-- @+--   YYYY-MM-DD HH:MM Z+--   YYYY-MM-DD HH:MM:SS Z+--   YYYY-MM-DD HH:MM:SS.SSS Z+-- @+--+-- The first space may instead be a @T@, and the second space is+-- optional.  The @Z@ represents UTC.  The @Z@ may be replaced with a+-- time zone offset of the form @+0000@ or @-08:00@, where the first+-- two digits are hours, the @:@ is optional and the second two digits+-- (also optional) are minutes.+zonedTime :: Parser ZonedTime+zonedTime = ZonedTime <$> localTime <*> (fromMaybe utc <$> timeZone)++utc :: TimeZone+utc = TimeZone 0 False ""

@@ -1,5 +1,6 @@ {-| Module      :  Z.Data.PrimIORef+Description :  Primitive IO Reference Copyright   :  (c) Dong Han 2017~2019 License     :  BSD-style 

@@ -1,5 +1,6 @@ {-| Module      :  Z.Data.PrimRef.PrimSTRef+Description :  Primitive ST Reference Copyright   :  (c) Dong Han 2017~2019 License     :  BSD-style 

@@ -16,7 +16,7 @@  module Z.Data.Text (   -- * Text type-    Text(..)+    Text, getUTF8Bytes   , validate, validateASCII   , validateMaybe, validateASCIIMaybe   , TextException(..)@@ -30,6 +30,8 @@   -- * Conversion between codepoint vector   , fromVector   , toVector+  -- * Print class+  , Print(..), toText, toString, toUTF8Builder, toUTF8Bytes   -- * Basic interface   , null   , length@@ -145,6 +147,7 @@ import           Z.Data.Text.Base import           Z.Data.Text.Search import           Z.Data.Text.Extra+import           Z.Data.Text.Print import           Prelude                  ()  

@@ -133,6 +133,7 @@ import           GHC.Stack import           GHC.CString               (unpackCString#, unpackCStringUtf8#) import           Z.Data.Array+import           Z.Data.ASCII              (c2w) import           Z.Data.Text.UTF8Codec import           Z.Data.Text.UTF8Rewind import           Z.Data.Vector.Base        (Bytes, PrimVector(..), c_strlen)@@ -305,8 +306,8 @@  -- | /O(n)/ Validate a sequence of bytes is all ascii char byte(<128). ----- Throw 'InvalidASCIIException' in case of invalid byte, It's not faster--- than 'validate', use it only if you want to validate if a ASCII char sequence.+-- Throw 'InvalidASCIIException' in case of invalid byte, It's not always faster+-- than 'validate', use it only if you want to validate ASCII char sequences. -- validateASCII :: HasCallStack => Bytes -> Text {-# INLINE validateASCII #-}@@ -651,7 +652,7 @@ count :: Char -> Text -> Int {-# INLINE count #-} count c (Text v)-    | encodeCharLength c == 1 = let w = V.c2w c in V.count w v+    | encodeCharLength c == 1 = let w = c2w c in V.count w v     | otherwise = let (Text pat) = singleton c                   in List.length $ V.indices pat v False 

@@ -0,0 +1,462 @@+{-|+Module      : Z.Data.Text.Print+Description : UTF8 compatible builders.+Copyright   : (c) Dong Han, 2017-2019+License     : BSD+Maintainer  : winterland1989@gmail.com+Stability   : experimental+Portability : non-portable++This module re-exports some UTF8 compatible textual builders from 'Z.Data.Builder'.++We also provide a faster alternative to 'Show' class, i.e. 'Print', which can be deriving using 'Generic'.+For example to use 'Print' class:++@+{-# LANGUAGE DeriveGeneric, DeriveAnyClass, DerivingStrategies #-}++import qualified Z.Data.Text.Print as T++data Foo = Bar Bytes | Qux Text Int deriving Generic+                                    deriving anyclass T.Print++@++-}++module Z.Data.Text.Print+  ( -- * Print class+    Print(..), toText, toString, toUTF8Builder, toUTF8Bytes+  -- * Basic UTF8 builders+  , escapeTextJSON+  , B.stringUTF8, B.charUTF8, B.string7, B.char7, B.text+  -- * Numeric builders+  -- ** Integral type formatting+  , B.IFormat(..)+  , B.defaultIFormat+  , B.Padding(..)+  , B.int+  , B.intWith+  , B.integer+  -- ** Fixded size hexidecimal formatting+  , B.hex, B.hexUpper+  -- ** IEEE float formating+  , B.FFormat(..)+  , B.double+  , B.doubleWith+  , B.float+  , B.floatWith+  , B.scientific+  , B.scientificWith+  -- * Helpers+  , B.paren, B.curly, B.square, B.angle, B.quotes, B.squotes+  , B.colon, B.comma, B.intercalateVec, B.intercalateList+  , parenWhen+  ) where++import           Control.Monad+import qualified Data.Scientific                as Sci+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 qualified Data.Semigroup                 as Semigroup+import           Data.Typeable+import           Foreign.C.Types+import           GHC.Exts+import           GHC.ForeignPtr+import           GHC.Generics+import           GHC.Natural+import           GHC.Stack+import           GHC.Word+import           Data.Version+import           System.Exit+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++#define DOUBLE_QUOTE 34++--------------------------------------------------------------------------------+-- 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 Print+--+-- > toText (FooInt 3)+-- > "FooInt 3"+--+--  newtype FooInt = FooInt Int deriving (Generic)+--                            deriving newtype Print+--+-- > toText (FooInt 3)+-- > "3"+-- @+--+class Print a where+    -- | Convert data to 'B.Builder' with precendence.+    --+    -- You should return a 'B.Builder' writing in UTF8 encoding only, i.e.+    --+    -- @Z.Data.Text.validateMaybe (Z.Data.Builder.buildBytes (toUTF8BuilderP p a)) /= Nothing@+    toUTF8BuilderP :: Int -> a  -> B.Builder ()++    default toUTF8BuilderP :: (Generic a, GToText (Rep a)) => Int -> a -> B.Builder ()+    {-# INLINE toUTF8BuilderP #-}+    toUTF8BuilderP p = gToUTF8BuilderP p . from++-- | Convert data to 'B.Builder'.+toUTF8Builder :: Print a => a  -> B.Builder ()+{-# INLINE toUTF8Builder #-}+toUTF8Builder = toUTF8BuilderP 0++-- | Convert data to 'V.Bytes' in UTF8 encoding.+toUTF8Bytes :: Print a => a -> V.Bytes+{-# INLINE toUTF8Bytes #-}+toUTF8Bytes = B.build . toUTF8BuilderP 0++-- | Convert data to 'Text'.+toText :: Print a => a -> Text+{-# INLINE toText #-}+toText = Text . toUTF8Bytes++-- | Convert data to 'String', faster 'show' replacement.+toString :: Print a => a -> String+{-# INLINE toString #-}+toString = T.unpack . toText++class GToText f where+    gToUTF8BuilderP :: Int -> f a -> B.Builder ()++class GFieldToText f where+    gFieldToUTF8BuilderP :: B.Builder () -> Int -> f a -> B.Builder ()++instance (GFieldToText a, GFieldToText b) => GFieldToText (a :*: b) where+    {-# INLINE gFieldToUTF8BuilderP #-}+    gFieldToUTF8BuilderP sep p (a :*: b) =+        gFieldToUTF8BuilderP sep p a >> sep >> gFieldToUTF8BuilderP sep p b++instance (GToText f) => GFieldToText (S1 (MetaSel Nothing u ss ds) f) where+    {-# INLINE gFieldToUTF8BuilderP #-}+    gFieldToUTF8BuilderP _ p (M1 x) = gToUTF8BuilderP p x++instance (GToText f, Selector (MetaSel (Just l) u ss ds)) => GFieldToText (S1 (MetaSel (Just l) u ss ds) f) where+    {-# INLINE gFieldToUTF8BuilderP #-}+    gFieldToUTF8BuilderP _ _ m1@(M1 x) =+        B.stringModifiedUTF8 (selName m1) >> " = " >> gToUTF8BuilderP 0 x++instance GToText V1 where+    {-# INLINE gToUTF8BuilderP #-}+    gToUTF8BuilderP _ = error "Z.Data.Text.Print: empty data type"++instance (GToText f, GToText g) => GToText (f :+: g) where+    {-# INLINE gToUTF8BuilderP #-}+    gToUTF8BuilderP p (L1 x) = gToUTF8BuilderP p x+    gToUTF8BuilderP p (R1 x) = gToUTF8BuilderP p x++-- | Constructor without payload, convert to String+instance (Constructor c) => GToText (C1 c U1) where+    {-# INLINE gToUTF8BuilderP #-}+    gToUTF8BuilderP _ m1 = B.stringModifiedUTF8 $ conName m1++-- | Constructor with payloads+instance (GFieldToText (S1 sc f), Constructor c) => GToText (C1 c (S1 sc f)) where+    {-# INLINE gToUTF8BuilderP #-}+    gToUTF8BuilderP p m1@(M1 x) =+        parenWhen (p > 10) $ do+            B.stringModifiedUTF8 $ conName m1+            B.char8 ' '+            if conIsRecord m1+            then B.curly $ gFieldToUTF8BuilderP (B.char7 ',' >> B.char7 ' ') p x+            else gFieldToUTF8BuilderP (B.char7 ' ') 11 x++instance (GFieldToText (a :*: b), Constructor c) => GToText (C1 c (a :*: b)) where+    {-# INLINE gToUTF8BuilderP #-}+    gToUTF8BuilderP p m1@(M1 x) =+        case conFixity m1 of+            Prefix -> parenWhen (p > 10) $ do+                B.stringModifiedUTF8 $ conName m1+                B.char8 ' '+                if conIsRecord m1+                then B.curly $ gFieldToUTF8BuilderP (B.char7 ',' >> B.char7 ' ') p x+                else gFieldToUTF8BuilderP (B.char7 ' ') 11 x+            Infix _ p' -> parenWhen (p > p') $ do+                gFieldToUTF8BuilderP+                    (B.char8 ' ' >> B.stringModifiedUTF8 (conName m1) >> B.char8 ' ') (p'+1) x++instance Print a => GToText (K1 i a) where+    {-# INLINE gToUTF8BuilderP #-}+    gToUTF8BuilderP p (K1 x) = toUTF8BuilderP p x++-- | Add "(..)" around builders when condition is met, otherwise add nothing.+--+-- This is useful when defining 'Print' instances.+parenWhen :: Bool -> B.Builder () -> B.Builder ()+{-# INLINE parenWhen #-}+parenWhen True b = B.paren b+parenWhen _    b = b++--------------------------------------------------------------------------------+-- Data types+instance GToText f => GToText (D1 c f) where+    {-# INLINE gToUTF8BuilderP #-}+    gToUTF8BuilderP p (M1 x) = gToUTF8BuilderP p x++instance Print Bool where+    {-# INLINE toUTF8BuilderP #-}+    toUTF8BuilderP _ True = "True"+    toUTF8BuilderP _ _    = "False"+++instance Print Char where+    {-# INLINE toUTF8BuilderP #-}+    toUTF8BuilderP _ = B.string8 . show++instance Print Double where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.double;}+instance Print Float  where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.float;}++instance Print Int     where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.int;}+instance Print Int8    where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.int;}+instance Print Int16   where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.int;}+instance Print Int32   where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.int;}+instance Print Int64   where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.int;}+instance Print Word    where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.int;}+instance Print Word8   where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.int;}+instance Print Word16  where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.int;}+instance Print Word32  where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.int;}+instance Print Word64  where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.int;}++instance Print Integer  where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.integer;}+instance Print Natural  where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.integer . fromIntegral}+instance Print Ordering where+    {-# INLINE toUTF8BuilderP #-}+    toUTF8BuilderP _ GT = "GT"+    toUTF8BuilderP _ EQ = "EQ"+    toUTF8BuilderP _ _  = "LT"++instance Print () where+    {-# INLINE toUTF8BuilderP #-}+    toUTF8BuilderP _ () = "()"++instance Print Version where+    {-# INLINE toUTF8BuilderP #-}+    toUTF8BuilderP _ = B.stringUTF8 . show++-- | The escaping rules is same with 'Show' instance: we reuse JSON escaping rules here, so it will be faster.+instance Print Text where+    {-# INLINE toUTF8BuilderP #-}+    toUTF8BuilderP _ = 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.writeN siz (\ 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 (escape_json_string ba# s l (unsafeCoerce# mba#) i))++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 Print Sci.Scientific where+    {-# INLINE toUTF8BuilderP #-}+    toUTF8BuilderP _ = B.scientific++instance Print a => Print [a] where+    {-# INLINE toUTF8BuilderP #-}+    toUTF8BuilderP _ = B.square . B.intercalateList B.comma (toUTF8BuilderP 0)++instance Print a => Print (A.Array a) where+    {-# INLINE toUTF8BuilderP #-}+    toUTF8BuilderP _ = B.square . B.intercalateVec B.comma (toUTF8BuilderP 0)++instance Print a => Print (A.SmallArray a) where+    {-# INLINE toUTF8BuilderP #-}+    toUTF8BuilderP _ = B.square . B.intercalateVec B.comma (toUTF8BuilderP 0)++instance (A.PrimUnlifted a, Print a) => Print (A.UnliftedArray a) where+    {-# INLINE toUTF8BuilderP #-}+    toUTF8BuilderP _ = B.square . B.intercalateVec B.comma (toUTF8BuilderP 0)++instance (Prim a, Print a) => Print (A.PrimArray a) where+    {-# INLINE toUTF8BuilderP #-}+    toUTF8BuilderP _ = B.square . B.intercalateVec B.comma (toUTF8BuilderP 0)++instance Print a => Print (V.Vector a) where+    {-# INLINE toUTF8BuilderP #-}+    toUTF8BuilderP _ = B.square . B.intercalateVec B.comma (toUTF8BuilderP 0)++instance (Prim a, Print a) => Print (V.PrimVector a) where+    {-# INLINE toUTF8BuilderP #-}+    toUTF8BuilderP _ = B.square . B.intercalateVec B.comma (toUTF8BuilderP 0)++instance (Print a, Print b) => Print (a, b) where+    {-# INLINE toUTF8BuilderP #-}+    toUTF8BuilderP _ (a, b) = B.paren $  toUTF8BuilderP 0 a+                     >> B.comma >> toUTF8BuilderP 0 b++instance (Print a, Print b, Print c) => Print (a, b, c) where+    {-# INLINE toUTF8BuilderP #-}+    toUTF8BuilderP _ (a, b, c) = B.paren $  toUTF8BuilderP 0 a+                     >> B.comma >> toUTF8BuilderP 0 b+                     >> B.comma >> toUTF8BuilderP 0 c++instance (Print a, Print b, Print c, Print d) => Print (a, b, c, d) where+    {-# INLINE toUTF8BuilderP #-}+    toUTF8BuilderP _ (a, b, c, d) = B.paren $  toUTF8BuilderP 0 a+                     >> B.comma >> toUTF8BuilderP 0 b+                     >> B.comma >> toUTF8BuilderP 0 c+                     >> B.comma >> toUTF8BuilderP 0 d++instance (Print a, Print b, Print c, Print d, Print e) => Print (a, b, c, d, e) where+    {-# INLINE toUTF8BuilderP #-}+    toUTF8BuilderP _ (a, b, c, d, e) = B.paren $  toUTF8BuilderP 0 a+                     >> B.comma >> toUTF8BuilderP 0 b+                     >> B.comma >> toUTF8BuilderP 0 c+                     >> B.comma >> toUTF8BuilderP 0 d+                     >> B.comma >> toUTF8BuilderP 0 e++instance (Print a, Print b, Print c, Print d, Print e, Print f) => Print (a, b, c, d, e, f) where+    {-# INLINE toUTF8BuilderP #-}+    toUTF8BuilderP _ (a, b, c, d, e, f) = B.paren $  toUTF8BuilderP 0 a+                     >> B.comma >> toUTF8BuilderP 0 b+                     >> B.comma >> toUTF8BuilderP 0 c+                     >> B.comma >> toUTF8BuilderP 0 d+                     >> B.comma >> toUTF8BuilderP 0 e+                     >> B.comma >> toUTF8BuilderP 0 f++instance (Print a, Print b, Print c, Print d, Print e, Print f, Print g) => Print (a, b, c, d, e, f, g) where+    {-# INLINE toUTF8BuilderP #-}+    toUTF8BuilderP _ (a, b, c, d, e, f, g) = B.paren $  toUTF8BuilderP 0 a+                     >> B.comma >> toUTF8BuilderP 0 b+                     >> B.comma >> toUTF8BuilderP 0 c+                     >> B.comma >> toUTF8BuilderP 0 d+                     >> B.comma >> toUTF8BuilderP 0 e+                     >> B.comma >> toUTF8BuilderP 0 f+                     >> B.comma >> toUTF8BuilderP 0 g++instance Print a => Print (Maybe a) where+    {-# INLINE toUTF8BuilderP #-}+    toUTF8BuilderP p (Just x) = parenWhen (p > 10) $ "Just " >> toUTF8BuilderP 11 x+    toUTF8BuilderP _ _        = "Nothing"++instance (Print a, Print b) => Print (Either a b) where+    {-# INLINE toUTF8BuilderP #-}+    toUTF8BuilderP p (Left x) = parenWhen (p > 10) $ "Left " >> toUTF8BuilderP 11 x+    toUTF8BuilderP p (Right x) = parenWhen (p > 10) $ "Right " >> toUTF8BuilderP 11 x++instance (Print a, Integral a) => Print (Ratio a) where+    {-# INLINE toUTF8BuilderP #-}+    toUTF8BuilderP p r = parenWhen (p > 10) $ do+        toUTF8BuilderP 8 (numerator r)+        " % "+        toUTF8BuilderP 8 (denominator r)++instance HasResolution a => Print (Fixed a) where+    {-# INLINE toUTF8BuilderP #-}+    toUTF8BuilderP _ = B.string8 .  show++instance Print CallStack where+    {-# INLINE toUTF8BuilderP #-}+    toUTF8BuilderP _ = B.string8 .  show++deriving newtype instance Print CChar+deriving newtype instance Print CSChar+deriving newtype instance Print CUChar+deriving newtype instance Print CShort+deriving newtype instance Print CUShort+deriving newtype instance Print CInt+deriving newtype instance Print CUInt+deriving newtype instance Print CLong+deriving newtype instance Print CULong+deriving newtype instance Print CPtrdiff+deriving newtype instance Print CSize+deriving newtype instance Print CWchar+deriving newtype instance Print CSigAtomic+deriving newtype instance Print CLLong+deriving newtype instance Print CULLong+deriving newtype instance Print CBool+deriving newtype instance Print CIntPtr+deriving newtype instance Print CUIntPtr+deriving newtype instance Print CIntMax+deriving newtype instance Print CUIntMax+deriving newtype instance Print CClock+deriving newtype instance Print CTime+deriving newtype instance Print CUSeconds+deriving newtype instance Print CSUSeconds+deriving newtype instance Print CFloat+deriving newtype instance Print CDouble++instance Print (Ptr a) where+    {-# INLINE toUTF8BuilderP #-}+    toUTF8BuilderP _ (Ptr a) =+        "0x" >> B.hex (W# (int2Word#(addr2Int# a)))+instance Print (ForeignPtr a) where+    {-# INLINE toUTF8BuilderP #-}+    toUTF8BuilderP _ (ForeignPtr a _) =+        "0x" >> B.hex (W# (int2Word#(addr2Int# a)))++deriving anyclass instance Print ExitCode++deriving anyclass instance Print a => Print (Semigroup.Min a)+deriving anyclass instance Print a => Print (Semigroup.Max a)+deriving anyclass instance Print a => Print (Semigroup.First a)+deriving anyclass instance Print a => Print (Semigroup.Last a)+deriving anyclass instance Print a => Print (Semigroup.WrappedMonoid a)+deriving anyclass instance Print a => Print (Semigroup.Dual a)+deriving anyclass instance Print a => Print (Monoid.First a)+deriving anyclass instance Print a => Print (Monoid.Last a)+deriving anyclass instance Print a => Print (NonEmpty a)+deriving anyclass instance Print a => Print (Identity a)+deriving anyclass instance Print a => Print (Const a b)+deriving anyclass instance Print (Proxy a)+deriving anyclass instance Print b => Print (Tagged a b)+deriving anyclass instance Print (f (g a)) => Print (Compose f g a)+deriving anyclass instance (Print (f a), Print (g a)) => Print (Product f g a)+deriving anyclass instance (Print (f a), Print (g a), Print a) => Print (Sum f g a)

@@ -38,7 +38,7 @@ import Foreign.Marshal.Utils            (fromBool) import System.IO.Unsafe import qualified Z.Data.Text.Base       as T-import qualified Z.Data.Text.ShowT      as T+import qualified Z.Data.Text.Print      as T import qualified Z.Data.Vector.Base     as V import qualified Z.Data.Array           as A @@ -48,7 +48,7 @@     , regexCaptureNum :: {-# UNPACK #-} !Int        -- ^ capturing group number(including @\\0@)     , regexPattern :: T.Text                        -- ^ Get back regex's pattern.     } deriving (Show, Generic)-      deriving anyclass T.ShowT+      deriving anyclass T.Print  -- | RE2 Regex options. --@@ -94,7 +94,7 @@     , word_boundary  :: Bool     , one_line       :: Bool     } deriving (Eq, Ord, Show, Generic)-      deriving anyclass T.ShowT+      deriving anyclass T.Print  -- | Default regex options, see 'RegexOpts'. --

@@ -1,462 +0,0 @@-{-|-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--This module re-exports some UTF8 compatible textual builders from 'Z.Data.Builder'.--We also provide a faster alternative to 'Show' class, i.e. 'ShowT', which can be deriving using 'Generic'.-For example to use 'ShowT' class:--@-{-# LANGUAGE DeriveGeneric, DeriveAnyClass, DerivingStrategies #-}--import qualified Z.Data.Text.ShowT as T--data Foo = Bar Bytes | Qux Text Int deriving Generic-                                    deriving anyclass T.ShowT--@---}--module Z.Data.Text.ShowT-  ( -- * ShowT class-    ShowT(..), toText, toString, toUTF8Builder, toUTF8Bytes-  -- * Basic UTF8 builders-  , escapeTextJSON-  , B.stringUTF8, B.charUTF8, B.string7, B.char7, B.text-  -- * Numeric builders-  -- ** Integral type formatting-  , B.IFormat(..)-  , B.defaultIFormat-  , B.Padding(..)-  , B.int-  , B.intWith-  , B.integer-  -- ** Fixded size hexidecimal formatting-  , B.hex, B.hexUpper-  -- ** IEEE float formating-  , B.FFormat(..)-  , B.double-  , B.doubleWith-  , B.float-  , B.floatWith-  , B.scientific-  , B.scientificWith-  -- * Helpers-  , B.paren, B.curly, B.square, B.angle, B.quotes, B.squotes-  , B.colon, B.comma, B.intercalateVec, B.intercalateList-  , parenWhen-  ) where--import           Control.Monad-import qualified Data.Scientific                as Sci-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 qualified Data.Semigroup                 as Semigroup-import           Data.Typeable-import           Foreign.C.Types-import           GHC.Exts-import           GHC.ForeignPtr-import           GHC.Generics-import           GHC.Natural-import           GHC.Stack-import           GHC.Word-import           Data.Version-import           System.Exit-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--#define DOUBLE_QUOTE 34------------------------------------------------------------------------------------- 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------ > toText (FooInt 3)--- > "FooInt 3"------  newtype FooInt = FooInt Int deriving (Generic)---                            deriving newtype ShowT------ > toText (FooInt 3)--- > "3"--- @----class ShowT a where-    -- | Convert data to 'B.Builder' with precendence.-    ---    -- You should return a 'B.Builder' writing in UTF8 encoding only, i.e.-    ---    -- @Z.Data.Text.validateMaybe (Z.Data.Builder.buildBytes (toUTF8BuilderP p a)) /= Nothing@-    toUTF8BuilderP :: Int -> a  -> B.Builder ()--    default toUTF8BuilderP :: (Generic a, GToText (Rep a)) => Int -> a -> B.Builder ()-    {-# INLINE toUTF8BuilderP #-}-    toUTF8BuilderP p = gToUTF8BuilderP p . from---- | Convert data to 'B.Builder'.-toUTF8Builder :: ShowT a => a  -> B.Builder ()-{-# INLINE toUTF8Builder #-}-toUTF8Builder = toUTF8BuilderP 0---- | Convert data to 'V.Bytes' in UTF8 encoding.-toUTF8Bytes :: ShowT a => a -> V.Bytes-{-# INLINE toUTF8Bytes #-}-toUTF8Bytes = B.build . toUTF8BuilderP 0---- | Convert data to 'Text'.-toText :: ShowT a => a -> Text-{-# INLINE toText #-}-toText = Text . toUTF8Bytes---- | Convert data to 'String', faster 'show' replacement.-toString :: ShowT a => a -> String-{-# INLINE toString #-}-toString = T.unpack . toText--class GToText f where-    gToUTF8BuilderP :: Int -> f a -> B.Builder ()--class GFieldToText f where-    gFieldToUTF8BuilderP :: B.Builder () -> Int -> f a -> B.Builder ()--instance (GFieldToText a, GFieldToText b) => GFieldToText (a :*: b) where-    {-# INLINE gFieldToUTF8BuilderP #-}-    gFieldToUTF8BuilderP sep p (a :*: b) =-        gFieldToUTF8BuilderP sep p a >> sep >> gFieldToUTF8BuilderP sep p b--instance (GToText f) => GFieldToText (S1 (MetaSel Nothing u ss ds) f) where-    {-# INLINE gFieldToUTF8BuilderP #-}-    gFieldToUTF8BuilderP _ p (M1 x) = gToUTF8BuilderP p x--instance (GToText f, Selector (MetaSel (Just l) u ss ds)) => GFieldToText (S1 (MetaSel (Just l) u ss ds) f) where-    {-# INLINE gFieldToUTF8BuilderP #-}-    gFieldToUTF8BuilderP _ _ m1@(M1 x) =-        B.stringModifiedUTF8 (selName m1) >> " = " >> gToUTF8BuilderP 0 x--instance GToText V1 where-    {-# INLINE gToUTF8BuilderP #-}-    gToUTF8BuilderP _ = error "Z.Data.Text.ShowT: empty data type"--instance (GToText f, GToText g) => GToText (f :+: g) where-    {-# INLINE gToUTF8BuilderP #-}-    gToUTF8BuilderP p (L1 x) = gToUTF8BuilderP p x-    gToUTF8BuilderP p (R1 x) = gToUTF8BuilderP p x---- | Constructor without payload, convert to String-instance (Constructor c) => GToText (C1 c U1) where-    {-# INLINE gToUTF8BuilderP #-}-    gToUTF8BuilderP _ m1 = B.stringModifiedUTF8 $ conName m1---- | Constructor with payloads-instance (GFieldToText (S1 sc f), Constructor c) => GToText (C1 c (S1 sc f)) where-    {-# INLINE gToUTF8BuilderP #-}-    gToUTF8BuilderP p m1@(M1 x) =-        parenWhen (p > 10) $ do-            B.stringModifiedUTF8 $ conName m1-            B.char8 ' '-            if conIsRecord m1-            then B.curly $ gFieldToUTF8BuilderP (B.char7 ',' >> B.char7 ' ') p x-            else gFieldToUTF8BuilderP (B.char7 ' ') 11 x--instance (GFieldToText (a :*: b), Constructor c) => GToText (C1 c (a :*: b)) where-    {-# INLINE gToUTF8BuilderP #-}-    gToUTF8BuilderP p m1@(M1 x) =-        case conFixity m1 of-            Prefix -> parenWhen (p > 10) $ do-                B.stringModifiedUTF8 $ conName m1-                B.char8 ' '-                if conIsRecord m1-                then B.curly $ gFieldToUTF8BuilderP (B.char7 ',' >> B.char7 ' ') p x-                else gFieldToUTF8BuilderP (B.char7 ' ') 11 x-            Infix _ p' -> parenWhen (p > p') $ do-                gFieldToUTF8BuilderP-                    (B.char8 ' ' >> B.stringModifiedUTF8 (conName m1) >> B.char8 ' ') (p'+1) x--instance ShowT a => GToText (K1 i a) where-    {-# INLINE gToUTF8BuilderP #-}-    gToUTF8BuilderP p (K1 x) = toUTF8BuilderP p x---- | Add "(..)" around builders when condition is met, otherwise add nothing.------ This is useful when defining 'ShowT' instances.-parenWhen :: Bool -> B.Builder () -> B.Builder ()-{-# INLINE parenWhen #-}-parenWhen True b = B.paren b-parenWhen _    b = b------------------------------------------------------------------------------------- Data types-instance GToText f => GToText (D1 c f) where-    {-# INLINE gToUTF8BuilderP #-}-    gToUTF8BuilderP p (M1 x) = gToUTF8BuilderP p x--instance ShowT Bool where-    {-# INLINE toUTF8BuilderP #-}-    toUTF8BuilderP _ True = "True"-    toUTF8BuilderP _ _    = "False"---instance ShowT Char where-    {-# INLINE toUTF8BuilderP #-}-    toUTF8BuilderP _ = B.string8 . show--instance ShowT Double where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.double;}-instance ShowT Float  where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.float;}--instance ShowT Int     where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.int;}-instance ShowT Int8    where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.int;}-instance ShowT Int16   where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.int;}-instance ShowT Int32   where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.int;}-instance ShowT Int64   where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.int;}-instance ShowT Word    where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.int;}-instance ShowT Word8   where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.int;}-instance ShowT Word16  where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.int;}-instance ShowT Word32  where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.int;}-instance ShowT Word64  where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.int;}--instance ShowT Integer  where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.integer;}-instance ShowT Natural  where {{-# INLINE toUTF8BuilderP #-}; toUTF8BuilderP _ = B.integer . fromIntegral}-instance ShowT Ordering where-    {-# INLINE toUTF8BuilderP #-}-    toUTF8BuilderP _ GT = "GT"-    toUTF8BuilderP _ EQ = "EQ"-    toUTF8BuilderP _ _  = "LT"--instance ShowT () where-    {-# INLINE toUTF8BuilderP #-}-    toUTF8BuilderP _ () = "()"--instance ShowT Version where-    {-# INLINE toUTF8BuilderP #-}-    toUTF8BuilderP _ = B.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 toUTF8BuilderP #-}-    toUTF8BuilderP _ = 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.writeN siz (\ 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 (escape_json_string ba# s l (unsafeCoerce# mba#) i))--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 toUTF8BuilderP #-}-    toUTF8BuilderP _ = B.scientific--instance ShowT a => ShowT [a] where-    {-# INLINE toUTF8BuilderP #-}-    toUTF8BuilderP _ = B.square . B.intercalateList B.comma (toUTF8BuilderP 0)--instance ShowT a => ShowT (A.Array a) where-    {-# INLINE toUTF8BuilderP #-}-    toUTF8BuilderP _ = B.square . B.intercalateVec B.comma (toUTF8BuilderP 0)--instance ShowT a => ShowT (A.SmallArray a) where-    {-# INLINE toUTF8BuilderP #-}-    toUTF8BuilderP _ = B.square . B.intercalateVec B.comma (toUTF8BuilderP 0)--instance (A.PrimUnlifted a, ShowT a) => ShowT (A.UnliftedArray a) where-    {-# INLINE toUTF8BuilderP #-}-    toUTF8BuilderP _ = B.square . B.intercalateVec B.comma (toUTF8BuilderP 0)--instance (Prim a, ShowT a) => ShowT (A.PrimArray a) where-    {-# INLINE toUTF8BuilderP #-}-    toUTF8BuilderP _ = B.square . B.intercalateVec B.comma (toUTF8BuilderP 0)--instance ShowT a => ShowT (V.Vector a) where-    {-# INLINE toUTF8BuilderP #-}-    toUTF8BuilderP _ = B.square . B.intercalateVec B.comma (toUTF8BuilderP 0)--instance (Prim a, ShowT a) => ShowT (V.PrimVector a) where-    {-# INLINE toUTF8BuilderP #-}-    toUTF8BuilderP _ = B.square . B.intercalateVec B.comma (toUTF8BuilderP 0)--instance (ShowT a, ShowT b) => ShowT (a, b) where-    {-# INLINE toUTF8BuilderP #-}-    toUTF8BuilderP _ (a, b) = B.paren $  toUTF8BuilderP 0 a-                     >> B.comma >> toUTF8BuilderP 0 b--instance (ShowT a, ShowT b, ShowT c) => ShowT (a, b, c) where-    {-# INLINE toUTF8BuilderP #-}-    toUTF8BuilderP _ (a, b, c) = B.paren $  toUTF8BuilderP 0 a-                     >> B.comma >> toUTF8BuilderP 0 b-                     >> B.comma >> toUTF8BuilderP 0 c--instance (ShowT a, ShowT b, ShowT c, ShowT d) => ShowT (a, b, c, d) where-    {-# INLINE toUTF8BuilderP #-}-    toUTF8BuilderP _ (a, b, c, d) = B.paren $  toUTF8BuilderP 0 a-                     >> B.comma >> toUTF8BuilderP 0 b-                     >> B.comma >> toUTF8BuilderP 0 c-                     >> B.comma >> toUTF8BuilderP 0 d--instance (ShowT a, ShowT b, ShowT c, ShowT d, ShowT e) => ShowT (a, b, c, d, e) where-    {-# INLINE toUTF8BuilderP #-}-    toUTF8BuilderP _ (a, b, c, d, e) = B.paren $  toUTF8BuilderP 0 a-                     >> B.comma >> toUTF8BuilderP 0 b-                     >> B.comma >> toUTF8BuilderP 0 c-                     >> B.comma >> toUTF8BuilderP 0 d-                     >> B.comma >> toUTF8BuilderP 0 e--instance (ShowT a, ShowT b, ShowT c, ShowT d, ShowT e, ShowT f) => ShowT (a, b, c, d, e, f) where-    {-# INLINE toUTF8BuilderP #-}-    toUTF8BuilderP _ (a, b, c, d, e, f) = B.paren $  toUTF8BuilderP 0 a-                     >> B.comma >> toUTF8BuilderP 0 b-                     >> B.comma >> toUTF8BuilderP 0 c-                     >> B.comma >> toUTF8BuilderP 0 d-                     >> B.comma >> toUTF8BuilderP 0 e-                     >> B.comma >> toUTF8BuilderP 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 toUTF8BuilderP #-}-    toUTF8BuilderP _ (a, b, c, d, e, f, g) = B.paren $  toUTF8BuilderP 0 a-                     >> B.comma >> toUTF8BuilderP 0 b-                     >> B.comma >> toUTF8BuilderP 0 c-                     >> B.comma >> toUTF8BuilderP 0 d-                     >> B.comma >> toUTF8BuilderP 0 e-                     >> B.comma >> toUTF8BuilderP 0 f-                     >> B.comma >> toUTF8BuilderP 0 g--instance ShowT a => ShowT (Maybe a) where-    {-# INLINE toUTF8BuilderP #-}-    toUTF8BuilderP p (Just x) = parenWhen (p > 10) $ "Just " >> toUTF8BuilderP 11 x-    toUTF8BuilderP _ _        = "Nothing"--instance (ShowT a, ShowT b) => ShowT (Either a b) where-    {-# INLINE toUTF8BuilderP #-}-    toUTF8BuilderP p (Left x) = parenWhen (p > 10) $ "Left " >> toUTF8BuilderP 11 x-    toUTF8BuilderP p (Right x) = parenWhen (p > 10) $ "Right " >> toUTF8BuilderP 11 x--instance (ShowT a, Integral a) => ShowT (Ratio a) where-    {-# INLINE toUTF8BuilderP #-}-    toUTF8BuilderP p r = parenWhen (p > 10) $ do-        toUTF8BuilderP 8 (numerator r)-        " % "-        toUTF8BuilderP 8 (denominator r)--instance HasResolution a => ShowT (Fixed a) where-    {-# INLINE toUTF8BuilderP #-}-    toUTF8BuilderP _ = B.string8 .  show--instance ShowT CallStack where-    {-# INLINE toUTF8BuilderP #-}-    toUTF8BuilderP _ = 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--instance ShowT (Ptr a) where-    {-# INLINE toUTF8BuilderP #-}-    toUTF8BuilderP _ (Ptr a) =-        "0x" >> B.hex (W# (int2Word#(addr2Int# a)))-instance ShowT (ForeignPtr a) where-    {-# INLINE toUTF8BuilderP #-}-    toUTF8BuilderP _ (ForeignPtr a _) =-        "0x" >> B.hex (W# (int2Word#(addr2Int# a)))--deriving anyclass instance ShowT ExitCode--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)

@@ -66,7 +66,7 @@   , Vector   , PrimVector   -- ** Word8 vector-  , Bytes, packASCII, w2c, c2w+  , Bytes, packASCII   -- * Basic creating   , empty, singleton, copy   -- * Conversion between list

@@ -28,7 +28,7 @@   , Vector(..)   , PrimVector(..)   -- ** Word8 vector-  , Bytes, packASCII, w2c, c2w+  , Bytes, packASCII   -- * Creating utilities   , create, create', creating, creating', createN, createN2   , empty, singleton, copy@@ -222,8 +222,8 @@   where     !endA = sA + lA     !endB = sB + lB-    go !i !j | i >= endA  = endA `compare` endB-             | j >= endB  = endA `compare` endB+    go !i !j | i >= endA  = lA `compare` lB+             | j >= endB  = lA `compare` lB              | otherwise = let o = indexSmallArray baA i `compare` indexSmallArray baB j                            in case o of EQ -> go (i+1) (j+1)                                         x  -> x@@ -398,13 +398,12 @@         0 == I# (compareByteArrays# baA# (sA# *# siz#) baB# (sB# *# siz#) n#)   where     !siz@(I# siz#) = sizeOf (undefined :: a)-    !(I# n#) = min (lA*siz) (lB*siz)+    !(I# n#) = lA*siz  instance (Prim a, Ord a) => Ord (PrimVector a) where     {-# INLINE compare #-}     compare = comparePrimVector - comparePrimVector :: (Prim a, Ord a) => PrimVector a -> PrimVector a -> Ordering {-# INLINE [1] comparePrimVector #-} {-# RULES@@ -416,8 +415,8 @@   where     !endA = sA + lA     !endB = sB + lB-    go !i !j | i >= endA  = endA `compare` endB-             | j >= endB  = endA `compare` endB+    go !i !j | i >= endA  = lA `compare` lB+             | j >= endB  = lA `compare` lB              | otherwise = let o = indexPrimArray baA i `compare` indexPrimArray baB j                            in case o of EQ -> go (i+1) (j+1)                                         x  -> x@@ -522,18 +521,6 @@         arr <- unsafeFreezePrimArray marr         return (PrimVector arr 0 len) --- | Conversion between 'Word8' and 'Char'. Should compile to a no-op.----w2c :: Word8 -> Char-{-# INLINE w2c #-}-w2c (W8# w#) = C# (chr# (word2Int# w#))---- | Unsafe conversion between 'Char' and 'Word8'. This is a no-op and--- silently truncates to 8 bits Chars > @\\255@. It is provided as--- convenience for PrimVector construction.-c2w :: Char -> Word8-{-# INLINE c2w #-}-c2w (C# c#) = W8# (int2Word# (ord# c#))  -------------------------------------------------------------------------------- -- Basic creating

@@ -36,7 +36,7 @@ import qualified Z.Data.Vector.Base         as V import qualified Z.Data.Builder.Base        as B import qualified Z.Data.Text.Base           as T-import qualified Z.Data.Text.ShowT          as T+import qualified Z.Data.Text.Print          as T import qualified Z.Data.JSON                as JSON import           Z.Foreign @@ -48,7 +48,7 @@ instance Show Base64Bytes where     show (Base64Bytes bs) = T.unpack $ base64EncodeText bs -instance T.ShowT Base64Bytes where+instance T.Print Base64Bytes where     {-# INLINABLE toUTF8BuilderP #-}     toUTF8BuilderP _ (Base64Bytes bs) = B.quotes (base64EncodeBuilder bs) 

@@ -40,9 +40,9 @@ 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.ShowT          as T+import qualified Z.Data.Text.Print          as T import           Data.Function              (on)-import           Data.Bits                   (shiftR)+import           Data.Bits                  (unsafeShiftR) import           Data.Data import           Prelude hiding (lookup, null) import           Test.QuickCheck.Arbitrary (Arbitrary(..), CoArbitrary(..))@@ -52,7 +52,7 @@ newtype FlatIntMap v = FlatIntMap { sortedKeyValues :: V.Vector (V.IPair v) }     deriving (Show, Eq, Ord, Typeable) -instance T.ShowT v => T.ShowT (FlatIntMap v) where+instance T.Print v => T.Print (FlatIntMap v) where     {-# INLINE toUTF8BuilderP #-}     toUTF8BuilderP p (FlatIntMap vec) = T.parenWhen (p > 10) $ do         "FlatIntMap{"@@ -184,7 +184,7 @@                                                             | otherwise -> Nothing         | s >  e = Nothing         | otherwise =-            let mid = (s+e) `shiftR` 1+            let mid = (s+e) `unsafeShiftR` 1                 (V.IPair k v)  = arr `A.indexSmallArray` mid             in case k' `compare` k of LT -> go s (mid-1)                                       GT -> go (mid+1) e@@ -350,7 +350,7 @@                                       _  -> Right s         | s >  e = Left s         | otherwise =-            let !mid = (s+e) `shiftR` 1+            let !mid = (s+e) `unsafeShiftR` 1                 (V.IPair k _)  = arr `A.indexSmallArray` mid             in case k' `compare` k of LT -> go s (mid-1)                                       GT -> go (mid+1) e

@@ -35,8 +35,8 @@ 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.ShowT          as T-import           Data.Bits                   (shiftR)+import qualified Z.Data.Text.Print          as T+import           Data.Bits                   (unsafeShiftR) import           Data.Data import           Prelude hiding (elem, null) import           Test.QuickCheck.Arbitrary (Arbitrary(..), CoArbitrary(..))@@ -46,7 +46,7 @@ newtype FlatIntSet = FlatIntSet { sortedValues :: V.PrimVector Int }     deriving (Show, Eq, Ord, Typeable) -instance T.ShowT FlatIntSet where+instance T.Print FlatIntSet where     {-# INLINE toUTF8BuilderP #-}     toUTF8BuilderP p (FlatIntSet vec) = T.parenWhen (p > 10) $ do         "FlatIntSet{"@@ -212,7 +212,7 @@                                       _  -> Right s         | s >  e = Left s         | otherwise =-            let !mid = (s+e) `shiftR` 1+            let !mid = (s+e) `unsafeShiftR` 1                 v = arr `A.indexPrimArray` mid             in case v' `compare` v of LT -> go s (mid-1)                                       GT -> go (mid+1) e

@@ -40,9 +40,9 @@ 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.ShowT          as T+import qualified Z.Data.Text.Print          as T import           Data.Function              (on)-import           Data.Bits                   (shiftR)+import           Data.Bits                  (unsafeShiftR) import           Data.Data import           Prelude hiding (lookup, null) import           Test.QuickCheck.Arbitrary (Arbitrary(..), CoArbitrary(..))@@ -52,7 +52,7 @@ newtype FlatMap k v = FlatMap { sortedKeyValues :: V.Vector (k, v) }     deriving (Show, Eq, Ord, Typeable) -instance (T.ShowT k, T.ShowT v) => T.ShowT (FlatMap k v) where+instance (T.Print k, T.Print v) => T.Print (FlatMap k v) where     {-# INLINE toUTF8BuilderP #-}     toUTF8BuilderP p (FlatMap vec) = T.parenWhen (p > 10) $ do         "FlatMap{"@@ -184,7 +184,7 @@                                                       | otherwise -> Nothing         | i >  j = Nothing         | otherwise =-            let mid = (i+j) `shiftR` 1+            let mid = (i+j) `unsafeShiftR` 1                 (k, v)  = arr `A.indexSmallArray` mid             in case k' `compare` k of LT -> go i (mid-1)                                       GT -> go (mid+1) j@@ -351,7 +351,7 @@                                       _  -> Right i         | i >  j = Left i         | otherwise =-            let !mid = (i+j) `shiftR` 1+            let !mid = (i+j) `unsafeShiftR` 1                 (k, _)  = arr `A.indexSmallArray` mid             in case k' `compare` k of LT -> go i (mid-1)                                       GT -> go (mid+1) j

@@ -35,8 +35,8 @@ 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.ShowT          as T-import           Data.Bits                   (shiftR)+import qualified Z.Data.Text.Print          as T+import           Data.Bits                   (unsafeShiftR) import           Data.Data import           Prelude hiding (elem, null) import           Test.QuickCheck.Arbitrary (Arbitrary(..), CoArbitrary(..))@@ -46,7 +46,7 @@ newtype FlatSet v = FlatSet { sortedValues :: V.Vector v }     deriving (Show, Eq, Ord, Typeable, Foldable) -instance T.ShowT v => T.ShowT (FlatSet v) where+instance T.Print v => T.Print (FlatSet v) where     {-# INLINE toUTF8BuilderP #-}     toUTF8BuilderP p (FlatSet vec) = T.parenWhen (p > 10) $ do         "FlatSet{"@@ -212,7 +212,7 @@                                       _  -> Right (s-s0)         | s >  e = Left s         | otherwise =-            let !mid = (s+e) `shiftR` 1+            let !mid = (s+e) `unsafeShiftR` 1                 v = arr `A.indexSmallArray` mid             in case v' `compare` v of LT -> go s (mid-1)                                       GT -> go (mid+1) e

@@ -34,7 +34,7 @@ import qualified Z.Data.Vector.Base         as V import qualified Z.Data.Builder.Base        as B import qualified Z.Data.Text.Base           as T-import qualified Z.Data.Text.ShowT          as T+import qualified Z.Data.Text.Print          as T import qualified Z.Data.JSON                as JSON import           Z.Foreign @@ -46,7 +46,7 @@ instance Show HexBytes where     show (HexBytes bs) = T.unpack $ hexEncodeText True bs -instance T.ShowT HexBytes where+instance T.Print HexBytes where     {-# INLINE toUTF8BuilderP #-}     toUTF8BuilderP _ (HexBytes bs) = B.quotes (hexEncodeBuilder True bs) 

@@ -1,6 +1,6 @@ {-| Module      : Z.Foreign-Description : Use PrimArray with FFI+Description : Use PrimArray \/ PrimVector with FFI Copyright   : (c) Dong Han, 2017-2018 License     : BSD Maintainer  : winterland1989@gmail.com@@ -84,11 +84,16 @@   , StdString, fromStdString   -- ** re-export   , RealWorld+  , touch   , module Data.Primitive.ByteArray   , module Data.Primitive.PrimArray   , module Foreign.C.Types   , module Data.Primitive.Ptr   , module Z.Data.Array.Unaligned+  -- ** Internal helpers+  , hs_std_string_size+  , hs_copy_std_string+  , hs_delete_std_string   ) where  import           Control.Exception          (bracket)@@ -477,9 +482,9 @@ fromStdString f = bracket f hs_delete_std_string     (\ q -> do         siz <- hs_std_string_size q-        (bs,_) <- allocBytesUnsafe siz (hs_copy_std_string q)+        (bs,_) <- allocBytesUnsafe siz (hs_copy_std_string q siz)         return bs)  foreign import ccall unsafe hs_std_string_size :: Ptr StdString -> IO Int-foreign import ccall unsafe hs_copy_std_string :: Ptr StdString -> MBA# Word8 -> IO ()+foreign import ccall unsafe hs_copy_std_string :: Ptr StdString -> Int -> MBA# Word8 -> IO () foreign import ccall unsafe hs_delete_std_string :: Ptr StdString -> IO ()

@@ -58,12 +58,12 @@     else return 0; } -void hs_copy_std_string(std::string* str, char* buf) {-    if (str != NULL) memcpy(buf, str->c_str(), str->size());+void hs_copy_std_string(std::string* str, HsInt siz, char* buf) {+    if (str != NULL) memcpy(buf, str->c_str(), siz); }  void hs_delete_std_string(std::string* str) {-    if (str != NULL) delete str;+    delete str; }  std::string* hs_re2_quote_meta(const char *in, HsInt off, HsInt len) {

@@ -292,3 +292,61 @@             (ByteArray ba#) <- unsafeFreezeByteArray mba             let (BE w'') = indexWord8ArrayAs# ba# 7#             return $ (w === w') .&&. (w === w'')++--------------------------------------------------------------------------------++        prop "roundtrip (,)" $ \ (w::(Word32,Word64)) -> ioProperty $ do+            mba@(MutableByteArray mba#) <- newByteArray 128+            primitive_ (writeWord8ArrayAs# mba# 7# (w))+            (w') <- primitive (readWord8ArrayAs# mba# 7#)+            (ByteArray ba#) <- unsafeFreezeByteArray mba+            let (w'') = indexWord8ArrayAs# ba# 7#+            return $ (w === w') .&&. (w === w'')++        prop "roundtrip (,,)" $ \ (w::(Word32,Word64,Word32)) -> ioProperty $ do+            mba@(MutableByteArray mba#) <- newByteArray 128+            primitive_ (writeWord8ArrayAs# mba# 7# (w))+            (w') <- primitive (readWord8ArrayAs# mba# 7#)+            (ByteArray ba#) <- unsafeFreezeByteArray mba+            let (w'') = indexWord8ArrayAs# ba# 7#+            return $ (w === w') .&&. (w === w'')++        prop "roundtrip (,,,)" $ \ (w::(Word32,Word64,Word32,Word64)) -> ioProperty $ do+            mba@(MutableByteArray mba#) <- newByteArray 128+            primitive_ (writeWord8ArrayAs# mba# 7# (w))+            (w') <- primitive (readWord8ArrayAs# mba# 7#)+            (ByteArray ba#) <- unsafeFreezeByteArray mba+            let (w'') = indexWord8ArrayAs# ba# 7#+            return $ (w === w') .&&. (w === w'')++        prop "roundtrip (,,,,)" $ \ (w::(Word32,Word64,Word32,Word64,Word32)) -> ioProperty $ do+            mba@(MutableByteArray mba#) <- newByteArray 128+            primitive_ (writeWord8ArrayAs# mba# 7# (w))+            (w') <- primitive (readWord8ArrayAs# mba# 7#)+            (ByteArray ba#) <- unsafeFreezeByteArray mba+            let (w'') = indexWord8ArrayAs# ba# 7#+            return $ (w === w') .&&. (w === w'')++        prop "roundtrip (,,,,,)" $ \ (w::(Word32,Word64,Word32,Word64,Word32,Word64)) -> ioProperty $ do+            mba@(MutableByteArray mba#) <- newByteArray 128+            primitive_ (writeWord8ArrayAs# mba# 7# (w))+            (w') <- primitive (readWord8ArrayAs# mba# 7#)+            (ByteArray ba#) <- unsafeFreezeByteArray mba+            let (w'') = indexWord8ArrayAs# ba# 7#+            return $ (w === w') .&&. (w === w'')++        prop "roundtrip (,,,,,,)" $ \ (w::(Word32,Word64,Word32,Word64,Word32,Word64,Word32)) -> ioProperty $ do+            mba@(MutableByteArray mba#) <- newByteArray 128+            primitive_ (writeWord8ArrayAs# mba# 7# (w))+            (w') <- primitive (readWord8ArrayAs# mba# 7#)+            (ByteArray ba#) <- unsafeFreezeByteArray mba+            let (w'') = indexWord8ArrayAs# ba# 7#+            return $ (w === w') .&&. (w === w'')++        prop "roundtrip (,,,,,,,)" $ \ (w::(Word32,Word64,Word32,Word64,Word32,Word64,Word32,Word64)) -> ioProperty $ do+            mba@(MutableByteArray mba#) <- newByteArray 128+            primitive_ (writeWord8ArrayAs# mba# 7# (w))+            (w') <- primitive (readWord8ArrayAs# mba# 7#)+            (ByteArray ba#) <- unsafeFreezeByteArray mba+            let (w'') = indexWord8ArrayAs# ba# 7#+            return $ (w === w') .&&. (w === w'')

@@ -0,0 +1,38 @@+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Z.Data.Builder.TimeSpec where++import qualified Data.List                as List+import           Data.Word+import           Data.Int+import           GHC.Float+import           Data.Time.Format+import qualified Z.Data.Builder.Time      as B+import qualified Z.Data.Builder.Base      as B+import qualified Z.Data.Text as T+import           Test.QuickCheck+import           Test.QuickCheck.Function+import           Test.QuickCheck.Property+import           Test.QuickCheck.Instances.Time+import           Test.Hspec+import           Test.Hspec.QuickCheck+import           Data.Time.LocalTime++spec :: Spec+spec = describe "builder time" . modifyMaxSuccess (*10) . modifyMaxSize (*10) $ do+    describe "utcTime === format" $ do+        prop "utcTime === format" $ \ t ->+            (formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%QZ" t) === (T.unpack . B.buildText $ B.utcTime t)++    describe "localTime === format" $ do+        prop "localTime === format" $ \ t ->+            (formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%Q" t) === (T.unpack . B.buildText $ B.localTime t)++    describe "zonedTime === format" $ do+        prop "zonedTime === format" $ \ t0 z0 ->+            let z = abs z0 `div` 1440+                t = ZonedTime t0 (minutesToTimeZone z)+            in if z == 0+                then (formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%QZ" t) === (T.unpack . B.buildText $ B.zonedTime t)+                else (formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%Q%Z" t) === (T.unpack . B.buildText $ B.zonedTime t)

@@ -7,7 +7,6 @@ import           Data.Word import           Data.Int import           GHC.Float-import           Data.Word8                  (toLower, toUpper) import qualified Z.Data.Builder         as B import           Test.QuickCheck import           Test.QuickCheck.Function

@@ -8,7 +8,8 @@ import           Data.Int import           GHC.Float import           Text.Printf                 (printf)-import           Data.Word8                  (toLower, toUpper)+import           Data.Char                   (toLower)+import           Z.Data.ASCII                (w2c, c2w) import qualified Z.Data.Parser.Base    as P import qualified Z.Data.Text as T import qualified Z.Data.Vector.Base as V@@ -98,7 +99,7 @@             parse'' (P.bytesCI . V.pack $ t) (t ++ s) === Just (V.pack s, ())          prop "bytesCI" $ \ s t ->-            parse'' (P.bytesCI . V.pack $ t) (L.map toLower t ++ s) === Just (V.pack s, ())+            parse'' (P.bytesCI . V.pack $ t) (L.map (c2w . toLower . w2c) t ++ s) === Just (V.pack s, ())          prop "atEnd" $ \ s ->             parse' P.atEnd s ===

@@ -8,7 +8,6 @@ import           Data.Int import           GHC.Float import           Text.Printf                 (printf)-import           Data.Word8                  (toLower, toUpper) import qualified Z.Data.Parser.Numeric    as P import qualified Z.Data.Parser.Base    as P import qualified Z.Data.Builder.Numeric    as B

@@ -0,0 +1,36 @@+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Z.Data.Parser.TimeSpec where++import qualified Data.List                as List+import           Data.Word+import           Data.Int+import           GHC.Float+import           Data.Time.Format+import qualified Z.Data.Builder           as B+import qualified Z.Data.Parser            as P+import qualified Z.Data.Text as T+import           Test.QuickCheck+import           Test.QuickCheck.Function+import           Test.QuickCheck.Property+import           Test.QuickCheck.Instances.Time+import           Test.Hspec+import           Test.Hspec.QuickCheck+import           Data.Time.LocalTime++spec :: Spec+spec = describe "parser time" . modifyMaxSuccess (*10) . modifyMaxSize (*10) $ do+    describe "utcTime roundtrip" $ do+        prop "utcTime roundtrip" $ \ t ->+            Right t === (P.parse' P.utcTime . B.build $ B.utcTime t)++    describe "localTime roundtrip" $ do+        prop "localTime roundtrip" $ \ t ->+            Right t === (P.parse' P.localTime . B.build $ B.localTime t)++    describe "zonedTime roundtrip" $ do+        prop "zonedTime roundtrip" $ \ t0 z0 ->+            let z = abs z0 `div` 1440+                t = ZonedTime t0 (minutesToTimeZone z)+            in (zonedTimeToUTC <$> Right t) === (zonedTimeToUTC <$> (P.parse' P.zonedTime . B.build $ B.zonedTime t))

@@ -0,0 +1,68 @@+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}++module Z.Data.Text.PrintSpec 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.Print+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, Print, Generic)++data I a = I a :+ I a | I a :- I a | J a deriving (Show, Generic, Print)+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,68 +0,0 @@-{-# 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" $-        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

@@ -7,12 +7,13 @@ import qualified Data.List                as List import           Data.Word import           Data.Hashable            (hashWithSalt, hash)-import qualified Z.Data.Vector.Base     as V import           Test.QuickCheck import           Test.QuickCheck.Function import           Test.QuickCheck.Property import           Test.Hspec import           Test.Hspec.QuickCheck+import qualified Z.Data.Vector.Base     as V+import           Z.Data.ASCII  spec :: Spec spec = describe "vector-base" $ do@@ -75,9 +76,9 @@      describe "Bytes IsString instance property" $ do         prop "ASCII string" $-            "hello world" === V.pack @V.PrimVector (List.map V.c2w "hello world")+            "hello world" === V.pack @V.PrimVector (List.map c2w "hello world")         prop "UTF8 string" $-            "你好世界" === V.pack @V.PrimVector (List.map V.c2w "你好世界")+            "你好世界" === V.pack @V.PrimVector (List.map c2w "你好世界")      describe "vector length == List.length" $ do         prop "vector length === List.length" $ \ xs ->

@@ -5,14 +5,15 @@  import qualified Data.List                as List import           Data.Word-import qualified Z.Data.Vector          as V-import qualified Z.Data.Vector.Base     as V-import qualified Z.Data.Vector.Extra    as V import           Test.QuickCheck import           Test.QuickCheck.Function import           Test.QuickCheck.Property import           Test.Hspec import           Test.Hspec.QuickCheck+import           Z.Data.ASCII+import qualified Z.Data.Vector          as V+import qualified Z.Data.Vector.Base     as V+import qualified Z.Data.Vector.Extra    as V  spec :: Spec spec =  describe "vector-extras" $ do@@ -356,22 +357,22 @@     describe "vector words == List.words" $ do         prop "vector words === List.words" $ \ xs ->             (V.words . V.pack @V.PrimVector @Word8 $ xs)  ===-                (V.pack . List.map V.c2w <$> (List.words . List.map V.w2c $ xs))+                (V.pack . List.map c2w <$> (List.words . List.map w2c $ xs))      describe "vector lines == List.lines" $ do         prop "vector lines === List.lines" $ \ xs ->             (V.lines . V.pack @V.PrimVector @Word8 $ xs)  ===-                (V.pack . List.map V.c2w <$> (List.lines . List.map V.w2c $ xs))+                (V.pack . List.map c2w <$> (List.lines . List.map w2c $ xs))      describe "vector unwords == List.unwords" $ do         prop "vector unwords === List.unwords" $ \ xs ->             (V.unwords $ V.pack @V.PrimVector @Word8 <$> xs)  ===-                (V.pack (List.map V.c2w . List.unwords $ List.map V.w2c <$> xs))+                (V.pack (List.map c2w . List.unwords $ List.map w2c <$> xs))      describe "vector unlines == List.unlines" $ do         prop "vector unlines === List.unlines" $ \ (NonEmpty xs) ->             ((V.unlines $ V.pack @V.PrimVector @Word8 <$> xs) <> V.singleton 10) ===-                (V.pack (List.map V.c2w . List.unlines $ List.map V.w2c <$> xs))+                (V.pack (List.map c2w . List.unlines $ List.map w2c <$> xs))      describe "vector padLeft n x xs = if l >= n then xs else replicate (n-l) x ++ xs" $ do         prop "vector padLeft n x xs = if l >= n then xs else replicate (n-l) x ++ xs" $ \ xs n x ->