diff --git a/AUTHORS b/AUTHORS new file mode 100644 --- /dev/null +++ b/AUTHORS @@ -0,0 +1,4 @@ +# Authors ordered by first contribution. +Dong Han +Tao He +Song Xue diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,12 @@ # Revision history for Z-Data +## 0.5.0.0 -- 2020-01-15 + +* Add `ParseChunks` type alias, remove `parseChunks'` from `Z.Data.JSON`. +* Change JSON instance of `Data.Version` to use JSON Array. +* Add `fromByteString` and `toByteString` to `Z.Foreign`. +* Change license's copyright to test --test-show-details=direct + ## 0.4.0.0 -- 2020-01-11 * Merge `FromValue`, `ToValue`, `EncodeJSON` to `JSON` class, add instances for containers. diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,7 +1,6 @@ Z-Data LICENSE -Copyright (c) Dong Han, 2017-2020 -Copyright (c) Tao He, 2017-2019 +Copyright (c) Project Z Contributors, 2017-2020 All rights reserved. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -4,10 +4,10 @@ This package is part of [Z](https://github.com/haskell-Z/Z) project, provides basic data structures and functions: -* Array, vector(array slice) -* Text based UTF-8, basic unicode manipulating +* Array, vector(array slice), sorting, searching +* Text based UTF-8, basic unicode manipulating, regex * FFI utilties -* Parsing and building monad +* Fast parsing and building monad * JSON encoding and decoding ## Requirements @@ -55,7 +55,7 @@ > B.buildBytes $ "builders: " >> B.hex (3 :: Word16) >> B.comma >> B.double 1.2345678 [98,117,105,108,100,101,114,115,58,32,48,48,48,51,44,49,46,50,51,52,53,54,55,56] > -> T.validate . B.buildBytes $ "builders: " >> B.hex (3 :: Word16) >> B.comma >> B.double 1.2345678 +> B.buildText $ "builders: " >> B.hex (3 :: Word16) >> B.comma >> B.double 1.2345678 "builders: 0003,1.2345678" > > import qualified Z.Data.JSON as JSON @@ -66,7 +66,7 @@ > > -- JSON module support deriving through Generic > :set -XDeriveAnyClass -XDeriveGeneric -> data Foo = Foo {foo :: Double} deriving (JSON.FromValue, JSON.ToValue, JSON.EncodeJSON, Generic) +> data Foo = Foo {foo :: Double} deriving (JSON.JSON, Generic) > JSON.toValue (Foo 0.01) Object [("foo",Number 1.0e-2)] > JSON.encodeText (Foo 0.01) @@ -82,7 +82,7 @@ # build cabal build # test -cabal run Z-Data-Test +cabal test --test-show-details=direct # install cabal install # generate document diff --git a/Z-Data.cabal b/Z-Data.cabal --- a/Z-Data.cabal +++ b/Z-Data.cabal @@ -1,14 +1,13 @@ cabal-version: 2.4 name: Z-Data -version: 0.4.0.0 +version: 0.5.0.0 synopsis: Array, vector and text description: This package provides array, slice and text operations license: BSD-3-Clause license-file: LICENSE -author: Dong Han, Tao He +author: Project Z Contributors maintainer: winterland1989@gmail.com -copyright: (c) Dong Han, 2017-2020 - (c) Tao He, 2017-2020 +copyright: (c) Project Z Contributors category: Data build-type: Custom homepage: https://github.com/haskell-Z/z-data @@ -17,6 +16,7 @@ extra-source-files: ChangeLog.md README.md LICENSE + AUTHORS include/bytes.h include/dtoa.h @@ -179,7 +179,8 @@ Z.Foreign - build-depends: base >= 4.12 && <5.0 + build-depends: base >= 4.12 && < 5.0 + , bytestring >= 0.10.4 && < 0.12 , ghc-prim >= 0.5.3 && < 0.6.2 , primitive >= 0.7.1 && < 0.7.2 , scientific == 0.3.* diff --git a/Z/Data/CBytes.hs b/Z/Data/CBytes.hs --- a/Z/Data/CBytes.hs +++ b/Z/Data/CBytes.hs @@ -462,7 +462,7 @@ -- | /O(n)/, convert to 'T.Text' using UTF8 encoding assumption. -- -- Throw 'T.InvalidUTF8Exception' in case of invalid codepoint. -toText :: CBytes -> T.Text +toText :: HasCallStack => CBytes -> T.Text {-# INLINABLE toText #-} toText = T.validate . toBytes diff --git a/Z/Data/JSON.hs b/Z/Data/JSON.hs --- a/Z/Data/JSON.hs +++ b/Z/Data/JSON.hs @@ -27,7 +27,7 @@ , snakeCase, trainCase -- * Encode & Decode , DecodeError - , decode, decode', decodeText, decodeText', decodeChunks, decodeChunks' + , decode, decode', decodeText, decodeText', ParseChunks, decodeChunks , encode, encodeChunks, encodeText -- * parse into JSON Value , parseValue, parseValue', parseValueChunks, parseValueChunks' @@ -53,7 +53,7 @@ -- This module is intended to be used qualified, e.g. -- -- > import qualified Z.Data.JSON as JSON --- > import Z.Data.JSON ((.:), ToValue(..), FromValue(..), EncodeJSON(..)) +-- > import Z.Data.JSON ((.:), JSON(..)) -- -- The easiest way to use the library is to define target data type, deriving -- 'GHC.Generics.Generic' and 'JSON' instances, which provides: diff --git a/Z/Data/JSON/Base.hs b/Z/Data/JSON/Base.hs --- a/Z/Data/JSON/Base.hs +++ b/Z/Data/JSON/Base.hs @@ -17,11 +17,11 @@ JSON(..), Value(..), defaultSettings, Settings(..) , -- * Encode & Decode DecodeError - , decode, decode', decodeText, decodeText', decodeChunks, decodeChunks' + , decode, decode', decodeText, decodeText', P.ParseChunks, decodeChunks , encode, encodeChunks, encodeText -- * parse into JSON Value , JV.parseValue, JV.parseValue', JV.parseValueChunks, JV.parseValueChunks' - -- * Generic FromValue, ToValue & EncodeJSON + -- * Generic functions , gToValue, gFromValue, gEncodeJSON -- * Convert 'Value' to Haskell data , convertValue, Converter(..), fail', (), prependContext @@ -77,14 +77,13 @@ import Data.Time.Calendar (CalendarDiffDays (..), DayOfWeek (..)) import Data.Time.LocalTime (CalendarDiffTime (..)) import Data.Time.Clock.System (SystemTime (..)) -import Data.Version (Version, parseVersion) +import Data.Version (Version(versionBranch), makeVersion) import Data.Word import Foreign.C.Types import GHC.Exts (Proxy#, proxy#) import GHC.Generics import GHC.Natural import System.Exit -import Text.ParserCombinators.ReadP (readP_to_S) import qualified Z.Data.Array as A import qualified Z.Data.Builder as B import Z.Data.Generics.Utils @@ -162,7 +161,7 @@ Right r -> (bs', Right r) -- | Decode JSON doc chunks, return trailing bytes. -decodeChunks :: (JSON a, Monad m) => m V.Bytes -> V.Bytes -> m (V.Bytes, Either DecodeError a) +decodeChunks :: (JSON a, Monad m) => P.ParseChunks m V.Bytes DecodeError a {-# INLINE decodeChunks #-} decodeChunks mb bs = do mr <- P.parseChunks JV.value mb bs @@ -173,18 +172,6 @@ Left cErr -> pure (bs', Left (Right cErr)) Right r -> pure (bs', Right r) --- | Decode JSON doc chunks, consuming trailing JSON whitespaces (other trailing bytes are not allowed). -decodeChunks' :: (JSON a, Monad m) => m V.Bytes -> V.Bytes -> m (Either DecodeError a) -{-# INLINE decodeChunks' #-} -decodeChunks' mb bs = do - mr <- P.parseChunks (JV.value <* JV.skipSpaces <* P.endOfInput) mb bs - case mr of - (_, Left pErr) -> pure (Left (Left pErr)) - (_, Right v) -> - case convertValue v of - Left cErr -> pure (Left (Right cErr)) - Right r -> pure (Right r) - -- | Directly encode data to JSON bytes. encode :: JSON a => a -> V.Bytes {-# INLINE encode #-} @@ -490,8 +477,8 @@ instance (GToValue f, Selector (MetaSel (Just l) u ss ds)) => GToValue (S1 (MetaSel (Just l) u ss ds) f) where {-# INLINE gToValue #-} gToValue s m1@(M1 x) = - let k = fieldFmt s $ selName m1 - v = gToValue s x + let !k = fieldFmt s $ selName m1 + !v = gToValue s x in Object (V.singleton (k, v)) instance GToValue f => GToValue (S1 (MetaSel Nothing u ss ds) f) where @@ -689,8 +676,8 @@ => GFromFields (a :*: b) where {-# INLINE gFromFields #-} gFromFields s v idx = do - a <- gFromFields s v idx - b <- gFromFields s v (idx + productSize (proxy# :: Proxy# a)) + !a <- gFromFields s v idx + !b <- gFromFields s v (idx + productSize (proxy# :: Proxy# a)) pure (a :*: b) instance (GFromValue f) => GFromFields (S1 (MetaSel Nothing u ss ds) f) where @@ -1131,7 +1118,7 @@ INT_JSON_INSTANCE(Word32) INT_JSON_INSTANCE(Word64) --- | This instance includes a bounds check to prevent maliciously large inputs to fill up the memory of the target system. You can newtype Scientific and provide your own instance using 'withScientific' if you want to allow larger inputs. +-- | This instance includes a bounds check to prevent maliciously large inputs to fill up the memory of the target system. You can newtype 'Integer' and provide your own instance using 'withScientific' if you want to allow larger inputs. instance JSON Integer where {-# INLINE fromValue #-} fromValue = withBoundedScientific "Integer" $ \ n -> @@ -1145,6 +1132,7 @@ {-# INLINE encodeJSON #-} encodeJSON = B.integer +-- | This instance includes a bounds check to prevent maliciously large inputs to fill up the memory of the target system. You can newtype 'Natural' and provide your own instance using 'withScientific' if you want to allow larger inputs. instance JSON Natural where {-# INLINE fromValue #-} fromValue = withBoundedScientific "Natural" $ \ n -> @@ -1210,29 +1198,22 @@ encodeJSON ExitSuccess = "\"ExitSuccess\"" encodeJSON (ExitFailure n) = B.int n +-- | Only round trip 'versionBranch' as JSON array. instance JSON Version where {-# INLINE fromValue #-} - fromValue = withText "Version" (go . readP_to_S parseVersion . T.unpack) - where - go [(v,[])] = pure v - go (_ : xs) = go xs - go _ = fail "converting Version failed" - + fromValue v = makeVersion <$> fromValue v {-# INLINE toValue #-} - toValue = String . T.pack . show - + toValue = toValue . versionBranch {-# INLINE encodeJSON #-} - encodeJSON = B.string7 . show + encodeJSON = encodeJSON . versionBranch instance JSON a => JSON (Maybe a) where {-# INLINE fromValue #-} fromValue Null = pure Nothing fromValue v = Just <$> fromValue v - {-# INLINE toValue #-} toValue Nothing = Null toValue (Just x) = toValue x - {-# INLINE encodeJSON #-} encodeJSON Nothing = "null" encodeJSON (Just x) = encodeJSON x diff --git a/Z/Data/JSON/Builder.hs b/Z/Data/JSON/Builder.hs --- a/Z/Data/JSON/Builder.hs +++ b/Z/Data/JSON/Builder.hs @@ -83,7 +83,6 @@ -- \'\\t\': \"\\t\" -- \'\"\': \"\\\"\" -- \'\\\': \"\\\\\" --- \'\/\': \"\\/\" -- other chars <= 0x1F: "\\u00XX" -- @ -- diff --git a/Z/Data/Parser.hs b/Z/Data/Parser.hs --- a/Z/Data/Parser.hs +++ b/Z/Data/Parser.hs @@ -30,7 +30,7 @@ , Parser , () -- * Running a parser - , parse, parse', parseChunk, parseChunks, finishParsing + , parse, parse', parseChunk, ParseChunks, parseChunks, finishParsing , runAndKeepTrack, match -- * Basic parsers , ensureN, endOfInput, atEnd diff --git a/Z/Data/Parser/Base.hs b/Z/Data/Parser/Base.hs --- a/Z/Data/Parser/Base.hs +++ b/Z/Data/Parser/Base.hs @@ -19,7 +19,7 @@ , Parser(..) , () -- * Running a parser - , parse, parse', parseChunk, parseChunks, finishParsing + , parse, parse', parseChunk, ParseChunks, parseChunks, finishParsing , runAndKeepTrack, match -- * Basic parsers , ensureN, endOfInput, atEnd @@ -172,12 +172,15 @@ Failure errs rest -> (rest, Left errs) Partial f -> finishParsing (f V.empty) +-- | Type alias for a streaming parser, draw chunk from Monad m (with a initial chunk), return result in @Either err x@. +type ParseChunks m chunk err x = m chunk -> chunk -> m (chunk, Either err x) + -- | Run a parser with an initial input string, and a monadic action -- that can supply more input if needed. -- -- Note, once the monadic action return empty bytes, parsers will stop drawing -- more bytes (take it as 'endOfInput'). -parseChunks :: Monad m => Parser a -> m V.Bytes -> V.Bytes -> m (V.Bytes, Either ParseError a) +parseChunks :: Monad m => Parser a -> ParseChunks m V.Bytes ParseError a {-# INLINABLE parseChunks #-} parseChunks (Parser p) m0 inp = go m0 (p Failure Success inp) where diff --git a/Z/Foreign.hs b/Z/Foreign.hs --- a/Z/Foreign.hs +++ b/Z/Foreign.hs @@ -82,6 +82,9 @@ , castPtr , fromNullTerminated, fromPtr, fromPrimPtr , StdString, fromStdString + -- ** convert between bytestring + , fromByteString + , toByteString -- ** re-export , RealWorld , touch @@ -112,6 +115,10 @@ import Z.Data.Array.Unaligned import Z.Data.Array.UnliftedArray import Z.Data.Vector.Base +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import qualified Data.ByteString.Unsafe as B +import Data.ByteString.Short.Internal (ShortByteString(..), fromShort, toShort) -- | Type alias for 'ByteArray#'. -- @@ -488,3 +495,12 @@ foreign import ccall unsafe hs_std_string_size :: Ptr StdString -> IO Int 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 () + +-- | O(n), Convert from 'ByteString'. +fromByteString :: ByteString -> Bytes +fromByteString bs = case toShort bs of + (SBS ba#) -> PrimVector (PrimArray ba#) 0 (B.length bs) + +-- | O(n), Convert tp 'ByteString'. +toByteString :: Bytes -> ByteString +toByteString (PrimVector (PrimArray ba#) s l) = B.unsafeTake l . B.unsafeDrop s . fromShort $ SBS ba#