Z-Data 0.5.0.0 → 0.6.0.0
raw patch · 20 files changed
+261/−147 lines, 20 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- Z.Data.JSON: parseValueChunks' :: Monad m => m Bytes -> Bytes -> m (Either ParseError Value)
- Z.Data.JSON.Base: parseValueChunks' :: Monad m => m Bytes -> Bytes -> m (Either ParseError Value)
- Z.Data.JSON.Value: parseValueChunks' :: Monad m => m Bytes -> Bytes -> m (Either ParseError Value)
- Z.Data.Vector.Base64: Base64Bytes :: Bytes -> Base64Bytes
- Z.Data.Vector.Base64: [unBase64Bytes] :: Base64Bytes -> Bytes
- Z.Data.Vector.Base64: instance Data.Hashable.Class.Hashable Z.Data.Vector.Base64.Base64Bytes
- Z.Data.Vector.Base64: instance GHC.Base.Monoid Z.Data.Vector.Base64.Base64Bytes
- Z.Data.Vector.Base64: instance GHC.Base.Semigroup Z.Data.Vector.Base64.Base64Bytes
- Z.Data.Vector.Base64: instance GHC.Classes.Eq Z.Data.Vector.Base64.Base64Bytes
- Z.Data.Vector.Base64: instance GHC.Classes.Ord Z.Data.Vector.Base64.Base64Bytes
- Z.Data.Vector.Base64: instance GHC.Show.Show Z.Data.Vector.Base64.Base64Bytes
- Z.Data.Vector.Base64: instance Z.Data.JSON.Base.JSON Z.Data.Vector.Base64.Base64Bytes
- Z.Data.Vector.Base64: instance Z.Data.Text.Print.Print Z.Data.Vector.Base64.Base64Bytes
- Z.Data.Vector.Base64: newtype Base64Bytes
+ Z.Data.Array.Unaligned: primArrayFromBE :: forall a. (Prim a, Unaligned (BE a)) => PrimArray Word8 -> Int -> Int -> PrimArray a
+ Z.Data.Array.Unaligned: primArrayToBE :: forall a. (Prim a, Unaligned (BE a)) => PrimArray a -> Int -> Int -> PrimArray Word8
+ Z.Data.Builder: BE :: a -> BE a
+ Z.Data.Builder: LE :: a -> LE a
+ Z.Data.Builder: [getBE] :: BE a -> a
+ Z.Data.Builder: [getLE] :: LE a -> a
+ Z.Data.Builder: newtype BE a
+ Z.Data.Builder: newtype LE a
+ Z.Data.Builder.Base: BE :: a -> BE a
+ Z.Data.Builder.Base: LE :: a -> LE a
+ Z.Data.Builder.Base: [getBE] :: BE a -> a
+ Z.Data.Builder.Base: [getLE] :: LE a -> a
+ Z.Data.Builder.Base: newtype BE a
+ Z.Data.Builder.Base: newtype LE a
+ Z.Data.JSON.Base: instance Z.Data.JSON.Base.JSON Z.Data.Vector.Base.Bytes
+ Z.Data.JSON.Base: instance Z.Data.JSON.Base.JSON [GHC.Types.Char]
+ Z.Data.Parser: BE :: a -> BE a
+ Z.Data.Parser: LE :: a -> LE a
+ Z.Data.Parser: [getBE] :: BE a -> a
+ Z.Data.Parser: [getLE] :: LE a -> a
+ Z.Data.Parser: newtype BE a
+ Z.Data.Parser: newtype LE a
+ Z.Data.Parser.Base: BE :: a -> BE a
+ Z.Data.Parser.Base: LE :: a -> LE a
+ Z.Data.Parser.Base: [getBE] :: BE a -> a
+ Z.Data.Parser.Base: [getLE] :: LE a -> a
+ Z.Data.Parser.Base: newtype BE a
+ Z.Data.Parser.Base: newtype LE a
- Z.Data.JSON: parseValueChunks :: Monad m => m Bytes -> Bytes -> m (Bytes, Either ParseError Value)
+ Z.Data.JSON: parseValueChunks :: Monad m => ParseChunks m Bytes ParseError Value
- Z.Data.JSON.Base: parseValueChunks :: Monad m => m Bytes -> Bytes -> m (Bytes, Either ParseError Value)
+ Z.Data.JSON.Base: parseValueChunks :: Monad m => ParseChunks m Bytes ParseError Value
- Z.Data.JSON.Value: parseValueChunks :: Monad m => m Bytes -> Bytes -> m (Bytes, Either ParseError Value)
+ Z.Data.JSON.Value: parseValueChunks :: Monad m => ParseChunks m Bytes ParseError Value
Files
- ChangeLog.md +6/−0
- LICENSE +1/−1
- README.md +4/−4
- Z-Data.cabal +3/−3
- Z/Data/ASCII.hs +13/−0
- Z/Data/Array/Unaligned.hs +32/−0
- Z/Data/Builder.hs +1/−0
- Z/Data/Builder/Base.hs +7/−1
- Z/Data/Builder/Numeric.hs +5/−5
- Z/Data/CBytes.hs +19/−22
- Z/Data/JSON.hs +3/−2
- Z/Data/JSON/Base.hs +22/−1
- Z/Data/JSON/Value.hs +1/−8
- Z/Data/Parser.hs +2/−1
- Z/Data/Parser/Base.hs +5/−1
- Z/Data/Vector/Base64.hs +2/−30
- cbits/regex.cc +27/−0
- cbits/text.c +33/−0
- test/Z/Data/JSON/BaseSpec.hs +50/−43
- third_party/utf8rewind/source/utf8rewind.c +25/−25
ChangeLog.md view
@@ -1,5 +1,11 @@ # Revision history for Z-Data +## 0.6.0.0 -- 2020-02-04++* Add `primArrayFromBE/primArrayFromBE` to `Z.Data.Array.Unaligned`.+* Change `[Char]` 's JSON instance to use JSON text, Add `Bytes` 's JSON instance to use base64 encoding.+* Add `escapeCBytes`, `toEscapedText` to `Z.Data.CBytes`, change `CBytes` 's JSON instance to use base64 encoding.+ ## 0.5.0.0 -- 2020-01-15 * Add `ParseChunks` type alias, remove `parseChunks'` from `Z.Data.JSON`.
LICENSE view
@@ -1,6 +1,6 @@ Z-Data LICENSE -Copyright (c) Project Z Contributors, 2017-2020+Copyright (c) Z.Haskell Contributors, 2017-2020 All rights reserved.
README.md view
@@ -1,8 +1,8 @@ ## Z-Data -[](https://hackage.haskell.org/package/Z-Data) [](https://github.com/haskell-Z/z-data/actions) [](https://github.com/haskell-Z/z-data/actions) [](https://github.com/haskell-Z/z-data/actions)+[](//hackage.haskell.org/package/Z-Data) [](//github.com/Z.Haskell/z-data/actions) [](//github.com/Z.Haskell/z-data/actions) [](//github.com/Z.Haskell/z-data/actions) -This package is part of [Z](https://github.com/haskell-Z/Z) project, provides basic data structures and functions:+This package is part of [Z.Haskell](//zhaskell.github.io/docs/) project, providing basic data structures and functions: * Array, vector(array slice), sorting, searching * Text based UTF-8, basic unicode manipulating, regex@@ -14,7 +14,7 @@ * A working haskell compiler system, GHC(>=8.6), cabal-install(>=2.4), hsc2hs. -* Tests need [hspec-discover](https://hackage.haskell.org/package/hspec-discover).+* Tests need [hspec-discover](//hackage.haskell.org/package/hspec-discover). ## Example usage @@ -77,7 +77,7 @@ ```bash # get code-git clone --recursive git@github.com:haskell-Z/z-data.git +git clone --recursive git@github.com:Z.Haskell/z-data.git cd z-data # build cabal build
Z-Data.cabal view
@@ -1,13 +1,13 @@ cabal-version: 2.4 name: Z-Data-version: 0.5.0.0+version: 0.6.0.0 synopsis: Array, vector and text description: This package provides array, slice and text operations license: BSD-3-Clause license-file: LICENSE-author: Project Z Contributors+author: Z.Haskell Contributors maintainer: winterland1989@gmail.com-copyright: (c) Project Z Contributors+copyright: (c) Z.Haskell Contributors category: Data build-type: Custom homepage: https://github.com/haskell-Z/z-data
Z/Data/ASCII.hs view
@@ -1,3 +1,16 @@+{-|+Module : Z.Data.ASCII+Description : ASCII chars+Copyright : (c) Dong Han, 2020+License : BSD+Maintainer : winterland1989@gmail.com+Stability : experimental+Portability : non-portable++ASCII Chars utility.++-}+ module Z.Data.ASCII where import GHC.Word
Z/Data/Array/Unaligned.hs view
@@ -17,6 +17,7 @@ import Control.Monad.Primitive import Data.Primitive.ByteArray import Data.Primitive.PrimArray+import Data.Primitive.Types import GHC.Int import GHC.IO import GHC.Exts@@ -125,6 +126,36 @@ {-# INLINE indexPrimWord8ArrayAs #-} indexPrimWord8ArrayAs (PrimArray ba#) (I# i#) = indexWord8ArrayAs# ba# i# +-- | Encode PrimArray elements in big endian.+primArrayToBE :: forall a. (Prim a, Unaligned (BE a)) => PrimArray a -> Int -> Int -> PrimArray Word8+{-# INLINE primArrayToBE #-}+primArrayToBE parr off len = unsafeDupablePerformIO $ do+ buf <- newPrimArray siz+ go buf off 0+ where+ s = getUnalignedSize (unalignedSize @(BE a))+ siz = len * s+ go buf !i !j+ | j == siz = unsafeFreezePrimArray buf+ | otherwise = do+ writePrimWord8ArrayAs buf j (BE (indexPrimArray parr i))+ go buf (i+1) (j+s)++-- | Decode PrimArray elements in big endian.+primArrayFromBE :: forall a. (Prim a, Unaligned (BE a)) => PrimArray Word8 -> Int -> Int -> PrimArray a+{-# INLINE primArrayFromBE #-}+primArrayFromBE parr off len = unsafeDupablePerformIO $ do+ buf <- newPrimArray siz+ go buf off 0+ where+ s = getUnalignedSize (unalignedSize @(BE a))+ siz = len `quot` s+ go buf !i !j+ | j == siz = unsafeFreezePrimArray buf+ | otherwise = do+ writePrimArray buf j (getBE (indexPrimWord8ArrayAs parr i))+ go buf (i+s) (j+1)+ instance Unaligned Word8 where {-# INLINE unalignedSize #-} unalignedSize = UnalignedSize 1@@ -154,6 +185,7 @@ -- | big endianess wrapper -- newtype BE a = BE { getBE :: a } deriving (Show, Eq)+ #define USE_HOST_IMPL(END) \ {-# INLINE writeWord8ArrayAs# #-}; \
Z/Data/Builder.hs view
@@ -30,6 +30,7 @@ , writeN -- * Pritimive builders , encodePrim+ , BE(..), LE(..) , encodePrimLE , encodePrimBE -- * More builders
Z/Data/Builder/Base.hs view
@@ -42,6 +42,7 @@ , writeN -- * Pritimive builders , encodePrim+ , BE(..), LE(..) , encodePrimLE , encodePrimBE -- * More builders@@ -103,7 +104,7 @@ -- Notes on 'IsString' instance: @Builder ()@'s 'IsString' instance use 'stringModifiedUTF8', -- which is different from 'stringUTF8' in that it DOES NOT PROVIDE UTF8 GUARANTEES! : ----- * @\\NUL@ will be written as @\xC0 \x80@.+-- * @\\NUL@ will be written as @\\xC0 \\x80@. -- * @\\xD800@ ~ @\\xDFFF@ will be encoded in three bytes as normal UTF-8 codepoints. -- newtype Builder a = Builder { runBuilder :: (a -> BuildStep) -> BuildStep }@@ -317,6 +318,11 @@ f buf' offset' >> k () (Buffer buf' (offset'+n))))) -- | Write a primitive type in host byte order.+--+-- @+-- > encodePrim (256 :: Word16, BE 256 :: BE Word16)+-- > [0,1,1,0]+-- @ encodePrim :: forall a. Unaligned a => a -> Builder () {-# INLINE encodePrim #-} {-# SPECIALIZE INLINE encodePrim :: Word -> Builder () #-}
Z/Data/Builder/Numeric.hs view
@@ -100,13 +100,12 @@ -- -- @ -- import Z.Data.Builder as B--- import Z.Data.Text as T ----- > T.validate . B.buildBytes $ B.intWith defaultIFormat (12345 :: Int)+-- > B.buildText $ B.intWith defaultIFormat (12345 :: Int) -- "12345"--- > T.validate . B.buildBytes $ B.intWith defaultIFormat{width=10, padding=RightSpacePadding} (12345 :: Int)+-- > B.buildText $ B.intWith defaultIFormat{width=10, padding=RightSpacePadding} (12345 :: Int) -- "12345 "--- > T.validate . B.buildBytes $ B.intWith defaultIFormat{width=10, padding=ZeroPadding} (12345 :: Int)+-- > B.buildText $ B.intWith defaultIFormat{width=10, padding=ZeroPadding} (12345 :: Int) -- "0000012345" -- @ --@@ -704,7 +703,8 @@ insertDot n [] = encodePrim DIGIT_0 >> insertDot (n-1) [] insertDot n (r:rs) = encodeDigit r >> insertDot (n-1) rs - ------------------------------------------------------------------------------+------------------------------------------------------------------------------+ -- Conversion of 'Float's and 'Double's to ASCII in decimal using Grisu3 ------------------------------------------------------------------------
Z/Data/CBytes.hs view
@@ -31,6 +31,7 @@ import Control.DeepSeq import Control.Monad+import Control.Applicative ((<|>)) import Control.Exception import Control.Monad.Primitive import Control.Monad.ST@@ -62,7 +63,7 @@ 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.JSON.Base ((.=), (.!), (.:)) import Z.Data.Text.UTF8Codec (encodeCharModifiedUTF8, decodeChar) import qualified Z.Data.Vector.Base as V import Z.Foreign hiding (fromStdString)@@ -106,12 +107,15 @@ let l = case V.elemIndex 0 arr of Just i -> i _ -> sizeofPrimArray arr- mpa <- newPrimArray (l+1)- copyPrimArray mpa 0 arr 0 l- -- write \\NUL terminator- writePrimArray mpa l 0- pa <- unsafeFreezePrimArray mpa- return (CBytes pa))+ if l+1 == sizeofPrimArray arr+ then return (CBytes arr)+ else do+ mpa <- newPrimArray (l+1)+ copyPrimArray mpa 0 arr 0 l+ -- write \\NUL terminator+ writePrimArray mpa l 0+ pa <- unsafeFreezePrimArray mpa+ return (CBytes pa)) -- | Use this pattern to match or construct 'CBytes', result will be trimmed down to first @\\NUL@ byte if there's any. pattern CB :: V.Bytes -> CBytes@@ -203,34 +207,27 @@ {-# INLINE toUTF8BuilderP #-} toUTF8BuilderP _ = T.stringUTF8 . show . unpack --- | JSON instances check if 'CBytes' is proper UTF8 encoded,--- if it is, decode/encode it as 'T.Text', otherwise as 'V.Bytes'.+-- | JSON instances check if 'CBytes' is properly UTF8 encoded,+-- if it is, decode/encode it as 'T.Text', otherwise as an object with a base64 field. -- -- @ -- > encodeText ("hello" :: CBytes) -- "\"hello\""--- > encodeText ("hello\\NUL" :: CBytes) -- @\\NUL@ is encoded as C0 80--- "[104,101,108,108,111,192,128]"+-- > encodeText ("hello\\NUL" :: CBytes) -- @\\NUL@ is encoded as C0 80, which is illegal UTF8+-- "{\"base64\":\"aGVsbG/AgA==\"}" -- @ instance JSON.JSON CBytes where {-# INLINE fromValue #-}- fromValue value =- case value of- JSON.String t ->- return (fromText t)- JSON.Array arr ->- fromBytes <$> V.traverseWithIndex- (\ k v -> JSON.fromValue v <?> JSON.Index k) arr- _ -> JSON.fail'- "converting Z.Data.CBytes.CBytes failed, expected array or string"+ fromValue v = JSON.withText "Z.Data.CBytes" (pure . fromText) v+ <|> JSON.withFlatMapR "Z.Data.CBytes" (\ o -> fromBytes <$> o .: "base64") v {-# INLINE toValue #-} toValue cbytes = case toTextMaybe cbytes of Just t -> JSON.toValue t- Nothing -> JSON.toValue (toBytes cbytes)+ Nothing -> JSON.object $ [ "base64" .= toBytes cbytes ] {-# INLINE encodeJSON #-} encodeJSON cbytes = case toTextMaybe cbytes of Just t -> JSON.encodeJSON t- Nothing -> B.square . JSON.commaSepVec . toBytes $ cbytes+ Nothing -> JSON.object' $ "base64" .! toBytes cbytes -- | Concatenate two 'CBytes'. append :: CBytes -> CBytes -> CBytes
Z/Data/JSON.hs view
@@ -30,7 +30,7 @@ , decode, decode', decodeText, decodeText', ParseChunks, decodeChunks , encode, encodeChunks, encodeText -- * parse into JSON Value- , parseValue, parseValue', parseValueChunks, parseValueChunks'+ , parseValue, parseValue', parseValueChunks -- * Generic functions , gToValue, gFromValue, gEncodeJSON -- * Convert 'Value' to Haskell data@@ -101,8 +101,9 @@ -- different behaviour, namely: -- -- * @Maybe a@ are encoded as JSON @null@ in 'Nothing' case, or directly encoded to its payload in 'Just' case.--- * @[a]@ are encoded to JSON array, including @[Char]@, i.e. there's no special treatment to 'String'. To get JSON string, use 'T.Text'.+-- * @[a]@ are encoded to JSON array, @[Char]@ are encoded into JSON string. -- * 'NonEmpty', 'Vector', 'PrimVector', 'HashSet', 'FlatSet', 'FlatIntSet' are also encoded to JSON array.+-- * 'Bytes' are encoded into JSON text using base64 encoding. -- * 'HashMap', 'FlatMap', 'FlatIntMap' are encoded to JSON object. -- $custom-settings
Z/Data/JSON/Base.hs view
@@ -20,7 +20,7 @@ , decode, decode', decodeText, decodeText', P.ParseChunks, decodeChunks , encode, encodeChunks, encodeText -- * parse into JSON Value- , JV.parseValue, JV.parseValue', JV.parseValueChunks, JV.parseValueChunks'+ , JV.parseValue, JV.parseValue', JV.parseValueChunks -- * Generic functions , gToValue, gFromValue, gEncodeJSON -- * Convert 'Value' to Haskell data@@ -97,6 +97,7 @@ import qualified Z.Data.Text as T import qualified Z.Data.Text.Print as T import qualified Z.Data.Vector.Base as V+import qualified Z.Data.Vector.Base64 as Base64 import qualified Z.Data.Vector.Extra as V import qualified Z.Data.Vector.FlatIntMap as FIM import qualified Z.Data.Vector.FlatIntSet as FIS@@ -1027,6 +1028,17 @@ {-# INLINE encodeJSON #-} encodeJSON = B.square . commaSepVec +-- | This is an INCOHERENT instance, encode binary data with base64 encoding.+instance {-# INCOHERENT #-} JSON V.Bytes where+ fromValue = withText "Z.Data.Vector.Bytes" $ \ t ->+ case Base64.base64Decode (T.getUTF8Bytes t) of+ Just bs -> pure bs+ Nothing -> fail' "illegal base64 encoding bytes"+ {-# INLINE toValue #-}+ toValue = String . Base64.base64EncodeText+ {-# INLINE encodeJSON #-}+ encodeJSON = B.quotes . Base64.base64EncodeBuilder+ instance (Eq a, Hashable a, JSON a) => JSON (HS.HashSet a) where {-# INLINE fromValue #-} fromValue = withArray "Z.Data.Vector.FlatSet.FlatSet" $ \ vs ->@@ -1045,6 +1057,15 @@ toValue = Array . V.pack . map toValue {-# INLINE encodeJSON #-} encodeJSON = B.square . commaSepList++-- | This is an INCOHERENT instance, to provide JSON text encoding behaviour.+instance {-# INCOHERENT #-} JSON [Char] where+ {-# INLINE fromValue #-}+ fromValue = withText "String" (pure . T.unpack)+ {-# INLINE toValue #-}+ toValue = String . T.pack+ {-# INLINE encodeJSON #-}+ encodeJSON = JB.string . T.pack instance JSON a => JSON (NonEmpty a) where {-# INLINE fromValue #-}
Z/Data/JSON/Value.hs view
@@ -28,7 +28,6 @@ , parseValue , parseValue' , parseValueChunks- , parseValueChunks' -- * Value Parsers , value , object@@ -140,15 +139,9 @@ parseValue' = P.parse' (value <* skipSpaces <* P.endOfInput) -- | Increamental parse 'Value' without consuming trailing bytes.-parseValueChunks :: Monad m => m V.Bytes -> V.Bytes -> m (V.Bytes, Either P.ParseError Value)+parseValueChunks :: Monad m => P.ParseChunks m V.Bytes P.ParseError Value {-# INLINE parseValueChunks #-} parseValueChunks = P.parseChunks value---- | Increamental parse 'Value' and consume all trailing JSON white spaces, if there're--- bytes left, parsing will fail.-parseValueChunks' :: Monad m => m V.Bytes -> V.Bytes -> m (Either P.ParseError Value)-{-# INLINE parseValueChunks' #-}-parseValueChunks' mi inp = snd <$> P.parseChunks (value <* skipSpaces <* P.endOfInput) mi inp --------------------------------------------------------------------------------
Z/Data/Parser.hs view
@@ -35,7 +35,8 @@ -- * Basic parsers , ensureN, endOfInput, atEnd -- * Primitive decoders- , decodePrim, decodePrimLE, decodePrimBE+ , decodePrim, BE(..), LE(..)+ , decodePrimLE, decodePrimBE -- * More parsers , scan, scanChunks, peekMaybe, peek, satisfy, satisfyWith , anyWord8, word8, anyChar8, char8, skipWord8, endOfLine, skip, skipWhile, skipSpaces
Z/Data/Parser/Base.hs view
@@ -24,7 +24,8 @@ -- * Basic parsers , ensureN, endOfInput, atEnd -- * Primitive decoders- , decodePrim, decodePrimLE, decodePrimBE+ , decodePrim, BE(..), LE(..)+ , decodePrimLE, decodePrimBE -- * More parsers , scan, scanChunks, peekMaybe, peek, satisfy, satisfyWith , anyWord8, word8, anyChar8, char8, skipWord8, endOfLine, skip, skipWhile, skipSpaces@@ -275,6 +276,7 @@ then Partial (\ inp' -> k (V.null inp') inp') else k False inp +-- | Decode a primitive type in host byte order. decodePrim :: forall a. (Unaligned a) => Parser a {-# INLINE decodePrim #-} {-# SPECIALIZE INLINE decodePrim :: Parser Word #-}@@ -297,6 +299,7 @@ where n = getUnalignedSize (unalignedSize @a) +-- | Decode a primitive type in little endian. decodePrimLE :: forall a. (Unaligned (LE a)) => Parser a {-# INLINE decodePrimLE #-} {-# SPECIALIZE INLINE decodePrimLE :: Parser Word #-}@@ -317,6 +320,7 @@ where n = getUnalignedSize (unalignedSize @(LE a)) +-- | Decode a primitive type in big endian. decodePrimBE :: forall a. (Unaligned (BE a)) => Parser a {-# INLINE decodePrimBE #-} {-# SPECIALIZE INLINE decodePrimBE :: Parser Word #-}
Z/Data/Vector/Base64.hs view
@@ -12,10 +12,8 @@ -} module Z.Data.Vector.Base64- ( -- * The Base64Bytes type- Base64Bytes(..)- -- * Encoding & Decoding functions- , base64Encode+ (-- * Encoding & Decoding functions+ base64Encode , base64EncodeLength , base64EncodeText , base64EncodeBuilder@@ -30,38 +28,12 @@ import Control.Exception import Data.Word import Data.Bits (unsafeShiftL, unsafeShiftR, (.&.))-import Data.Hashable (Hashable(..)) import GHC.Stack import System.IO.Unsafe 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.Print as T-import qualified Z.Data.JSON as JSON import Z.Foreign---- | New type wrapper for 'V.Bytes' with base64 encoding Show\/JSON instances.-newtype Base64Bytes = Base64Bytes { unBase64Bytes :: V.Bytes }- deriving (Eq, Ord)- deriving newtype (Monoid, Semigroup, Hashable)--instance Show Base64Bytes where- show (Base64Bytes bs) = T.unpack $ base64EncodeText bs--instance T.Print Base64Bytes where- {-# INLINABLE toUTF8BuilderP #-}- toUTF8BuilderP _ (Base64Bytes bs) = B.quotes (base64EncodeBuilder bs)--instance JSON.JSON Base64Bytes where- {-# INLINE fromValue #-}- fromValue = JSON.withText "Z.Data.Text.Base64Bytes" $ \ t ->- case base64Decode (T.getUTF8Bytes t) of- Just bs -> return (Base64Bytes bs)- Nothing -> JSON.fail' "illegal base64 encoding bytes"- {-# INLINE toValue #-}- toValue (Base64Bytes bs) = JSON.String (base64EncodeText bs)- {-# INLINE encodeJSON #-}- encodeJSON (Base64Bytes bs) = base64EncodeBuilder bs -- | Encode 'V.Bytes' using base64 encoding. base64Encode :: V.Bytes -> V.Bytes
cbits/regex.cc view
@@ -1,3 +1,30 @@+/*+Copyright (c) 2020-2021 Dong Han+All rights reserved.+Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:+ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.+ * Neither the name of Johan Tibell nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+*/+ #include <HsFFI.h> #include <cstddef> #include <cstdlib>
cbits/text.c view
@@ -1,3 +1,30 @@+/*+Copyright (c) 2017-2021 Dong Han+All rights reserved.+Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:+ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.+ * Neither the name of Johan Tibell nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+*/+ #include <text.h> #include <stdint.h> #include <utf8rewind.h>@@ -331,6 +358,12 @@ HsInt rv = 2; // for start and end quotes const unsigned char *i = src + srcoff; const unsigned char *srcend = i + srclen;+ // unroll loop for ~4% improvement + for (; i < srcend-4; ) {+ rv += escape_char_length[*i] + escape_char_length[*(i+1)] ++ escape_char_length[*(i+2)] + escape_char_length[*(i+3)];+ i += 4;+ } for (; i < srcend; i++) { rv += escape_char_length[*i]; }
test/Z/Data/JSON/BaseSpec.hs view
@@ -22,6 +22,7 @@ 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.CBytes as CBytes import Data.Time (Day, DiffTime, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime) import Data.Time.Calendar (CalendarDiffDays (..), DayOfWeek (..)) import Data.Time.LocalTime (CalendarDiffTime (..))@@ -47,6 +48,7 @@ | RecordII { testFour :: Double } | List [a]+ | Str String deriving (Show, Eq, Generic, JSON) mid :: JSON a => a -> a@@ -103,36 +105,37 @@ \\\u001a\\u001b\\u001c\\u001d\\u001e\\u001f\"" -- tests from MessagePack suit- it "int" $ property $ \(a :: Int ) -> a `shouldBe` mid a- it "int8" $ property $ \(a :: Int8 ) -> a `shouldBe` mid a- it "int16" $ property $ \(a :: Int16 ) -> a `shouldBe` mid a- it "int32" $ property $ \(a :: Int32 ) -> a `shouldBe` mid a- it "int64" $ property $ \(a :: Int64 ) -> a `shouldBe` mid a- it "word" $ property $ \(a :: Word ) -> a `shouldBe` mid a- it "word8" $ property $ \(a :: Word8 ) -> a `shouldBe` mid a- it "word16" $ property $ \(a :: Word16) -> a `shouldBe` mid a- it "word32" $ property $ \(a :: Word32) -> a `shouldBe` mid a- it "word64" $ property $ \(a :: Word64) -> a `shouldBe` mid a+ it "Int" $ property $ \(a :: Int ) -> a `shouldBe` mid a+ it "Int8" $ property $ \(a :: Int8 ) -> a `shouldBe` mid a+ it "Int16" $ property $ \(a :: Int16 ) -> a `shouldBe` mid a+ it "Int32" $ property $ \(a :: Int32 ) -> a `shouldBe` mid a+ it "Int64" $ property $ \(a :: Int64 ) -> a `shouldBe` mid a+ it "Word" $ property $ \(a :: Word ) -> a `shouldBe` mid a+ it "Word8" $ property $ \(a :: Word8 ) -> a `shouldBe` mid a+ it "Word16" $ property $ \(a :: Word16) -> a `shouldBe` mid a+ it "Word32" $ property $ \(a :: Word32) -> a `shouldBe` mid a+ it "Word64" $ property $ \(a :: Word64) -> a `shouldBe` mid a it "()" $ property $ \(a :: ()) -> a `shouldBe` mid a- it "bool" $ property $ \(a :: Bool) -> a `shouldBe` mid a- it "float" $ property $ \(a :: Float) -> a `shouldBe` mid a- it "double" $ property $ \(a :: Double) -> a `shouldBe` mid a- it "string" $ property $ \(a :: String) -> a `shouldBe` mid a- it "bytes" $ property $ \(a :: V.Bytes) -> a `shouldBe` mid a- it "primvector" $ property $ \(a :: V.PrimVector Int) -> a `shouldBe` mid a- it "vector" $ property $ \(a :: V.Vector [Integer]) -> a `shouldBe` mid a- it "maybe int" $ property $ \(a :: (Maybe Int)) -> a `shouldBe` mid a- it "[int]" $ property $ \(a :: [Int]) -> a `shouldBe` mid a- it "[string]" $ property $ \(a :: [String]) -> a `shouldBe` mid a- it "(int, int)" $ property $ \(a :: (Int, Int)) -> a `shouldBe` mid a- it "(int, int, int)" $ property $ \(a :: (Int, Int, Int)) -> a `shouldBe` mid a- it "(int, int, int, int)" $ property $ \(a :: (Int, Int, Int, Int)) -> a `shouldBe` mid a- it "(int, int, int, int, int)" $ property $ \(a :: (Int, Int, Int, Int, Int)) -> a `shouldBe` mid a- it "(int, int, int, int, int, int)" $ property $ \(a :: (Int, Int, Int, Int, Int, Int)) -> a `shouldBe` mid a- it "(int, int, int, int, int, int, int)" $ property $ \(a :: (Int, Int, Int, Int, Int, Int, Int)) -> a `shouldBe` mid a- it "[(int, double)]" $ property $ \(a :: [(Int, Double)]) -> a `shouldBe` mid a- it "[(string, string)]" $ property $ \(a :: [(String, String)]) -> a `shouldBe` mid a+ it "Bool" $ property $ \(a :: Bool) -> a `shouldBe` mid a+ it "Float" $ property $ \(a :: Float) -> a `shouldBe` mid a+ it "Double" $ property $ \(a :: Double) -> a `shouldBe` mid a+ it "String" $ property $ \(a :: String) -> a `shouldBe` mid a+ it "Bytes" $ property $ \(a :: CBytes.CBytes) -> a `shouldBe` mid a+ it "CByte" $ property $ \(a :: V.Bytes) -> a `shouldBe` mid a+ it "PrimVector" $ property $ \(a :: V.PrimVector Int) -> a `shouldBe` mid a+ it "Vector" $ property $ \(a :: V.Vector [Integer]) -> a `shouldBe` mid a+ it "Maybe Int" $ property $ \(a :: (Maybe Int)) -> a `shouldBe` mid a+ it "[Int]" $ property $ \(a :: [Int]) -> a `shouldBe` mid a+ it "[String]" $ property $ \(a :: [String]) -> a `shouldBe` mid a+ it "(Int, Int)" $ property $ \(a :: (Int, Int)) -> a `shouldBe` mid a+ it "(Int, Int, Int)" $ property $ \(a :: (Int, Int, Int)) -> a `shouldBe` mid a+ it "(Int, Int, Int, Int)" $ property $ \(a :: (Int, Int, Int, Int)) -> a `shouldBe` mid a+ it "(Int, Int, Int, Int, Int)" $ property $ \(a :: (Int, Int, Int, Int, Int)) -> a `shouldBe` mid a+ it "(Int, Int, Int, Int, Int, Int)" $ property $ \(a :: (Int, Int, Int, Int, Int, Int)) -> a `shouldBe` mid a+ it "(Int, Int, Int, Int, Int, Int, Int)" $ property $ \(a :: (Int, Int, Int, Int, Int, Int, Int)) -> a `shouldBe` mid a+ it "[(Int, Double)]" $ property $ \(a :: [(Int, Double)]) -> a `shouldBe` mid a+ it "[(String, String)]" $ property $ \(a :: [(String, String)]) -> a `shouldBe` mid a it "HashMap Text Int" $ property $ \(a :: HM.HashMap T.Text Int) -> a `shouldBe` mid a it "HashSet Text" $ property $ \(a :: HS.HashSet T.Text) -> a `shouldBe` mid a it "Map Text Int" $ property $ \(a :: M.Map T.Text Int) -> a `shouldBe` mid a@@ -141,21 +144,21 @@ it "IntSet" $ property $ \(a :: IS.IntSet) -> a `shouldBe` mid a it "Seq Int" $ property $ \(a :: Seq.Seq Int) -> a `shouldBe` mid a it "Tree Int" $ property $ \(a :: Tree.Tree Int) -> a `shouldBe` mid a- it "maybe int" $ property $ \(a :: Maybe Int) -> a `shouldBe` mid a- it "maybe nil" $ property $ \(a :: Maybe ()) -> a `shouldBe` mid a- it "maybe bool" $ property $ \(a :: Maybe Bool) -> a `shouldBe` mid a- it "maybe double" $ property $ \(a :: Maybe Double) -> a `shouldBe` mid a- it "maybe string" $ property $ \(a :: Maybe String) -> a `shouldBe` mid a- it "maybe bytes" $ property $ \ (a :: Maybe V.Bytes) -> a `shouldBe` mid a- it "maybe [int]" $ property $ \(a :: Maybe [Int]) -> a `shouldBe` mid a- it "maybe [string]" $ property $ \(a :: Maybe [String]) -> a `shouldBe` mid a- it "maybe (int, int)" $ property $ \(a :: Maybe (Int, Int)) -> a `shouldBe` mid a- it "maybe (int, int, int)" $ property $ \(a :: Maybe (Int, Int, Int)) -> a `shouldBe` mid a- it "maybe (int, int, int, int)" $ property $ \(a :: Maybe (Int, Int, Int, Int)) -> a `shouldBe` mid a- it "maybe (int, int, int, int, int)" $ property $ \(a :: Maybe (Int, Int, Int, Int, Int)) -> a `shouldBe` mid a- it "maybe [(int, double)]" $ property $ \(a :: Maybe [(Int, Double)]) -> a `shouldBe` mid a- it "maybe [(string, string)]" $ property $ \(a :: Maybe [(String, String)]) -> a `shouldBe` mid a- it "either int float" $ property $ \(a :: Either Int Float) -> a `shouldBe` mid a+ it "Maybe Int" $ property $ \(a :: Maybe Int) -> a `shouldBe` mid a+ it "Maybe Nil" $ property $ \(a :: Maybe ()) -> a `shouldBe` mid a+ it "Maybe Bool" $ property $ \(a :: Maybe Bool) -> a `shouldBe` mid a+ it "Maybe Double" $ property $ \(a :: Maybe Double) -> a `shouldBe` mid a+ it "Maybe String" $ property $ \(a :: Maybe String) -> a `shouldBe` mid a+ it "Maybe Bytes" $ property $ \ (a :: Maybe V.Bytes) -> a `shouldBe` mid a+ it "Maybe [Int]" $ property $ \(a :: Maybe [Int]) -> a `shouldBe` mid a+ it "Maybe [String]" $ property $ \(a :: Maybe [String]) -> a `shouldBe` mid a+ it "Maybe (Int, Int)" $ property $ \(a :: Maybe (Int, Int)) -> a `shouldBe` mid a+ it "Maybe (Int, Int, Int)" $ property $ \(a :: Maybe (Int, Int, Int)) -> a `shouldBe` mid a+ it "Maybe (Int, Int, Int, Int)" $ property $ \(a :: Maybe (Int, Int, Int, Int)) -> a `shouldBe` mid a+ it "Maybe (Int, Int, Int, Int, Int)" $ property $ \(a :: Maybe (Int, Int, Int, Int, Int)) -> a `shouldBe` mid a+ it "Maybe [(Int, Double)]" $ property $ \(a :: Maybe [(Int, Double)]) -> a `shouldBe` mid a+ it "Maybe [(String, String)]" $ property $ \(a :: Maybe [(String, String)]) -> a `shouldBe` mid a+ it "Either Int float" $ property $ \(a :: Either Int Float) -> a `shouldBe` mid a it "Day" $ property $ \(a :: Day) -> a `shouldBe` mid a it "DiffTime" $ property $ \(a :: DiffTime) -> a `shouldBe` mid a it "LocalTime" $ property $ \(a :: LocalTime) -> a `shouldBe` mid a@@ -199,6 +202,10 @@ , Unary 123456 , (Product "ABC" (Just 'x') (123456::Integer)) , (Record 0.123456 Nothing (Just (123456::Integer)))])++ it "List are encode as string" $+ JSON.encodeText (Str "hello" :: T ()) == encodeText' (Str "hello" :: T ())+ it "control characters are escaped" $ JSON.encodeText (T.pack $ map toEnum [0..0x1F]) ===
third_party/utf8rewind/source/utf8rewind.c view
@@ -34,6 +34,11 @@ #include "internal/seeking.h" #include "internal/streaming.h" +#if WIN32 || _WINDOWS +#include <windows.h> +#include <winnls.h> +#endif + size_t utf8len(const char* text) { const uint8_t* src; @@ -556,47 +561,42 @@ https://www-01.ibm.com/support/knowledgecenter/ssw_aix_61/com.ibm.aix.nlsgdrf/support_languages_locales.htm */ -#if WIN32 || _WINDOWS - #define UTF8_LOCALE_CHECK(_name, _ansiCodepage, _oemCodepage) \ - (codepage == _ansiCodepage || codepage == _oemCodepage) - - unsigned int codepage; - _locale_t locale = _get_current_locale(); +#define UTF8_LOCALE_CHECK(_name) \ + !strncasecmp(locale, _name, 5) - if (locale == 0) +#if WIN32 || _WINDOWS + WCHAR localeW[LOCALE_NAME_MAX_LENGTH]; + size_t localeBufLen = LOCALE_NAME_MAX_LENGTH * sizeof(char); + char *locale = malloc(localeBufLen); + GetUserDefaultLocaleName(localeW, LOCALE_NAME_MAX_LENGTH); + wcstombs(locale, localeW, localeBufLen); + if (UTF8_LOCALE_CHECK("lt-lt")) { - return UTF8_LOCALE_DEFAULT; + return UTF8_LOCALE_LITHUANIAN; } - - // Microsoft changed the name of the codepage member in VS2015. - - #if _MSC_VER >= 1900 - codepage = ((__crt_locale_data_public*)(locale)->locinfo)->_locale_lc_codepage; - #else - codepage = locale->locinfo->lc_codepage; - #endif + else if ( + UTF8_LOCALE_CHECK("tr-tr") || + UTF8_LOCALE_CHECK("az-az")) + { + return UTF8_LOCALE_TURKISH_AND_AZERI_LATIN; + } #else - #define UTF8_LOCALE_CHECK(_name, _ansiCodepage, _oemCodepage) \ - !strncasecmp(locale, _name, 5) - const char* locale = setlocale(LC_ALL, 0); if (locale == 0) { return UTF8_LOCALE_DEFAULT; } -#endif - - if (UTF8_LOCALE_CHECK("lt_lt", 1257, 775)) + if (UTF8_LOCALE_CHECK("lt_lt")) { return UTF8_LOCALE_LITHUANIAN; } else if ( - UTF8_LOCALE_CHECK("tr_tr", 1254, 857) || - UTF8_LOCALE_CHECK("az_az", 1254, 857)) + UTF8_LOCALE_CHECK("tr_tr") || + UTF8_LOCALE_CHECK("az_az")) { return UTF8_LOCALE_TURKISH_AND_AZERI_LATIN; } - +#endif return UTF8_LOCALE_DEFAULT; }