json-stream 0.4.4.2 → 0.4.5.0

raw patch · 5 files changed

+238/−73 lines, 5 filesdep +containersdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: containers

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Data/JsonStream/Parser.hs +203/−54
• Data/JsonStream/Unescape.hs +1/−3
• README.md +23/−9
• changelog.md +5/−0
• json-stream.cabal +6/−7

@@ -4,6 +4,9 @@ {-# LANGUAGE PatternGuards       #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections       #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}  -- | -- Module : Data.JsonStream.Parser@@ -16,7 +19,7 @@ -- An incremental applicative-style JSON parser, suitable for high performance -- memory efficient stream parsing. ----- The parser is using "Data.Aeson" types and 'FromJSON' instance, it can be+-- The parser is optionally using "Data.Aeson" types and 'FromJSON' instance, it can be -- easily combined with aeson monadic parsing instances when appropriate.  module Data.JsonStream.Parser (@@ -72,25 +75,24 @@   , arrayWithIndexOf   , indexedArrayOf   , nullable+    -- * Fast structure parser+  , objectOf+  , Object     -- * Parsing modifiers   , filterI   , takeI   , mapWithFailure   , manyReverse+  , foldI+  , foldMapI+  , unFoldI+  , catMaybeI     -- * SAX-like parsers   , arrayFound   , objectFound ) where -#if !MIN_VERSION_bytestring(0,10,6)-import           Data.Monoid                 (Monoid, mappend, mempty)-#endif--#if MIN_VERSION_base(4,10,0)-import           Data.Semigroup                 (Semigroup(..))-#endif--import           Control.Applicative+import Control.Applicative ( Alternative(..), optional ) import qualified Data.Aeson                  as AE import qualified Data.Aeson.Types            as AE import qualified Data.ByteString.Char8       as BS@@ -108,11 +110,13 @@                                               toBoundedInteger, toRealFloat) import qualified Data.Text                   as T import qualified Data.Vector                 as Vec-import           Foreign.C.Types+import Foreign.C.Types ( CLong ) -import           Data.JsonStream.CLexer-import           Data.JsonStream.TokenParser+import Data.JsonStream.CLexer ( unescapeText, tokenParser )+import Data.JsonStream.TokenParser ( TokenResult(..), Element(..) ) import Data.JsonStream.Unescape (unsafeDecodeASCII)+import qualified Data.Map.Strict as Map+import Unsafe.Coerce (unsafeCoerce)  -- | Limit for the size of an object key objectKeyStringLimit :: Int@@ -183,17 +187,11 @@ -- >>> let parser = arrayOf $ "key1" .: (arrayOf value) <> "key2" .: (arrayOf value) -- >>> parseByteString parser test :: [Int] -- [1,2,5,6]-#if MIN_VERSION_base(4,10,0) instance Monoid (Parser a) where   mempty = ignoreVal   mappend = (<>) instance Semigroup (Parser a) where   (<>) m1 m2 =-#else-instance Monoid (Parser a) where-  mempty = ignoreVal-  mappend m1 m2 =-#endif     Parser $ \tok -> process (callParse m1 tok) (callParse m2 tok)     where       process (Yield v np1) p2 = Yield v (process np1 p2)@@ -258,7 +256,7 @@     (PartialResult ArrayBegin ntp) -> moreData (nextitem 0) ntp     (PartialResult _ _) -> callParse ignoreVal tp -- Run ignoreval parser on the same output we got     (TokMoreData ntok) -> MoreData (array' valparse, ntok)-    (TokFailed) -> Failed "Array - token failed"+    TokFailed -> Failed "Array - token failed"   where     nextitem !_ _ (ArrayEnd ctx) ntok = Done ctx ntok     nextitem !i tok _ _ = arrcontent i (callParse (valparse i) tok)@@ -320,7 +318,7 @@     (PartialResult ObjectBegin ntp) -> moreData (nextitem False) ntp     (PartialResult _ _) -> callParse ignoreVal tp -- Run ignoreval parser on the same output we got     (TokMoreData ntok) -> MoreData (object' once valparse, ntok)-    TokFailed -> Failed "Array - token failed"+    TokFailed -> Failed "Object - token failed"   where     nextitem _ _ (ObjectEnd ctx) ntok = Done ctx ntok     nextitem yielded _ (JValue (AE.String key)) ntok =@@ -354,7 +352,7 @@           | otherwise -> moreData (getLongKey (str:acc) (len + BS.length str)) ntok         _ -> Failed "Object longstr - lexer failed." --- | Helper function to deduplicate TokMoreData/FokFailed logic+-- | Helper function to deduplicate TokMoreData/TokFailed logic moreData :: (TokenResult -> Element -> TokenResult -> ParseResult v) -> TokenResult -> ParseResult v moreData parser tok =   case tok of@@ -551,7 +549,7 @@ jNull :: Parser () jNull = jvalue cvt (const Nothing)   where-    cvt (AE.Null) = Just ()+    cvt AE.Null = Just ()     cvt _ = Nothing  -- | Parses a field with a possible null value.@@ -651,6 +649,39 @@       | cond v = Yield v (loop np)       | otherwise = loop np +-- | Fold over values in stream+foldI :: (b -> a -> b) -> b -> Parser a -> Parser b+foldI mfold start f = Parser $ \ntok -> loop start (callParse f ntok)+  where+    loop !acc (Done ctx ntp) = Yield acc (Done ctx ntp)+    loop !acc (MoreData (Parser np, ntok)) = MoreData (Parser (loop acc . np), ntok)+    loop !acc (Yield v np) = loop (acc `mfold` v) np+    loop _ (Failed err) = Failed err++-- | Strict foldMap over values in stream+foldMapI :: Monoid m => (a -> m) -> Parser a -> Parser m+foldMapI f = foldI (\b a -> b <> f a) mempty++-- | Filter Nothing values out of a stream+catMaybeI :: Parser (Maybe a) -> Parser a+catMaybeI valparse = Parser $ \ntok -> loop (callParse valparse ntok)+  where+    loop (Done ctx ntp) = Done ctx ntp+    loop (Failed err) = Failed err+    loop (MoreData (Parser np, ntok)) = MoreData (Parser (loop . np), ntok)+    loop (Yield (Just v) np) = Yield v (loop np)+    loop (Yield Nothing np) = loop np++-- | From a list of values generate single values+unFoldI :: Parser [a] -> Parser a+unFoldI valparse = Parser $ \ntok -> loop (callParse valparse ntok)+  where+    loop (Done ctx ntp) = Done ctx ntp+    loop (Failed err) = Failed err+    loop (MoreData (Parser np, ntok)) = MoreData (Parser (loop . np), ntok)+    loop (Yield (v:rest) np) = Yield v (loop (Yield rest np))+    loop (Yield [] np) = loop np+ -- | A back-door for lifting of possibly failing actions. -- If an action fails with Left value, convert it into failure -- of parsing@@ -669,35 +700,57 @@  --- Convenience operators --- | Synonym for 'objectWithKey'. Matches key in an object. The '.:' operators can be chained.------ >>> let json = "{\"key1\": {\"nested-key\": 3}}"--- >>> parseByteString ("key1" .: "nested-key" .: integer) json :: [Int]--- [3]-(.:) :: T.Text -> Parser a -> Parser a-(.:) = objectWithKey-infixr 7 .:+class OnObject o a where+  -- | Synonym for 'objectWithKey'. The '.:' operators can be chained.+  --+  -- >>> let json = "{\"key1\": {\"nested-key\": 3}}"+  -- >>> parseByteString ("key1" .: "nested-key" .: integer) json :: [Int]+  -- > [3]+  --+  -- It works both as a standalone parser and as a part of 'objectOf' parser+  --+  -- >>> let test = "[{\"name\": \"test1\", \"value\": 1}, {\"name\": \"test2\", \"value\": null}, {\"name\": \"test3\"}]"+  -- >>> let person = objectOf $ (,) <$> "name" .: string <*> "value" .: integer .| (-1)+  -- >>> let people = arrayOf person+  -- >>> parseByteString people test :: [(T.Text, Int)]+  -- [("test1",1),("test2",-1),("test3",-1)] --- | Returns 'Nothing' if value is null or does not exist or match. Otherwise returns 'Just' value.------ > key .:? val = optional (key .: val)-(.:?) :: T.Text -> Parser a -> Parser (Maybe a)-key .:? val = optional (key .: val)-infixr 7 .:?+  (.:) :: T.Text -> Parser a -> o a+  -- | Returns 'Nothing' if value is null or does not exist or match. Otherwise returns 'Just' value.+  --+  -- > key .:? val = optional (key .: val)+  --+  -- It could be similarly used in the 'objectOf' parser+  (.:?) :: T.Text -> Parser a -> o (Maybe a) --- | Return default value if the parsers on the left hand didn't produce a result.------ > p .| defval = p <|> pure defval------ The operator works on complete left side, the following statements are equal:------ > Record <$>  "key1" .: "nested-key" .: value .| defaultValue--- > Record <$> (("key1" .: "nested-key" .: value) .| defaultValue)-(.|) :: Parser a -> a -> Parser a-p .| defval = p <|> pure defval+  -- | Return default value if the parsers on the left hand didn't produce a result.+  --+  -- > p .| defval = p <|> pure defval+  --+  -- The operator works on complete left side, the following statements are equal:+  --+  -- > Record <$>  "key1" .: "nested-key" .: value .| defaultValue+  -- > Record <$> (("key1" .: "nested-key" .: value) .| defaultValue)+  (.|) :: o a -> a -> o a++infixr 7 .:+infixr 7 .:? infixl 6 .| +instance OnObject Parser a where+  (.:) = objectWithKey+  key .:? val = optional (key .: val)+  p .| defval = p <|> pure defval +instance OnObject Object a where+  (.:) = fastObjectWithKey+  (.:?) = fastObjectWithKeyMaybe+  (Object pmap out) .| defval = Object pmap altFunc+    where+      altFunc dmap = case out dmap of+        [] -> [defval]+        res -> res+ -- | Synonym for 'arrayWithIndexOf'. Matches n-th item in array. -- -- >>> parseByteString (arrayOf (1 .! bool)) "[ [1,true,null], [2,false], [3]]" :: [Bool]@@ -802,6 +855,86 @@       | BS.all isSpace rest = Right v     checkExit _ _ = Left "Data folowed by non-whitespace characters." +--- High performance object parsing++-- | Representation for applicative JSON one-pass object parsing+data Object f = Object +  (Map.Map T.Text (Parser ())) -- ^ Field parsers+  (Map.Map T.Text [()] -> [f]) -- ^ How to generate results from already parsed fields+  deriving (Functor)++-- We use unsafeCoerce to convert to () and back; we guarantee that there exists only+-- one key to the map and so the original Parser will get the right type of value.+-- This allows to drop the Typeable constraint, but the code better be OK here.++instance Applicative Object where+  pure f = Object mempty (const (pure f))+  (Object amap adata) <*> (Object bmap bdata) =+      let dmap = Map.unionWithKey (\k _ _ -> error ("JStream Object - duplicate field access: " <> T.unpack k)) amap bmap+      in dmap `seq` Object dmap dfunc+    where+      dfunc dmap = ($) <$> adata dmap <*> bdata dmap++instance Alternative Object where+  empty = Object mempty (const [])+  (Object amap adata) <|> (Object bmap bdata) =+      let dmap = Map.unionWithKey (\k _ _ -> error ("JStream Object - duplicate field access: " <> T.unpack k)) amap bmap+      in dmap `seq` Object dmap dfunc+    where+      -- Return second one if first one generates nothing+      dfunc dmap =+        case adata dmap of+          [] -> bdata dmap+          lst -> lst++instance Semigroup (Object a) where+  (Object amap adata) <> (Object bmap bdata) =+      let dmap = Map.unionWithKey (\k _ _ -> error ("JStream Object - duplicate field access: " <> T.unpack k)) amap bmap+      in dmap `seq` Object dmap dfunc+    where+      -- Return second one if first one generates nothing+      dfunc dmap = adata dmap <> bdata dmap++-- | Similar to 'objectWithKey', generates a field-accessor in JSON object+fastObjectWithKey :: forall a. T.Text -> Parser a -> Object a+fastObjectWithKey tname parser = Object (Map.singleton tname parseObj) mkObj+  where+    mkObj dmap = case unsafeCoerce <$> Map.lookup tname dmap of+      Just (vals :: [a]) -> reverse vals+      Nothing -> []+    parseObj = unsafeCoerce <$> parser++fastObjectWithKeyMaybe :: forall a. T.Text -> Parser a -> Object (Maybe a)+fastObjectWithKeyMaybe tname parser = Object (Map.singleton tname parseObj) mkObj+  where+    mkObj dmap = case unsafeCoerce <$> Map.lookup tname dmap of+      Just (vals :: [a]) -> Just <$> reverse vals+      Nothing -> [Nothing]+    parseObj = unsafeCoerce <$> parser++-- | Parser for faster object parsing+--+-- The whole object is parsed in a single run. Use the '.:' combinator to+-- access the fields; you may not access the same field more than once. If you+-- try to access the same field, an 'error' is called.+--+-- The operators '.:', '.:?', '<|>' and '<>' are supported and will produce+-- the same results as if used directly with parallel parsing.+objectOf :: forall f. Object f -> Parser f+objectOf (Object pmap odata) =+  unFoldI $ odata <$> foldResults (object' False parseKey)+  where+    foldResults :: Parser (T.Text, ()) -> Parser (Map.Map T.Text [()])+    foldResults = foldI (\bmap (k,v) -> Map.alter (addVal v) k bmap) mempty+      where+        addVal v Nothing = Just [v]+        addVal v (Just old) = Just (v:old)++    parseKey :: T.Text -> Parser (T.Text, ())+    parseKey key = case Map.lookup key pmap of+      Nothing -> ignoreVal+      Just p -> (key,) <$> p+ -- $use -- -- >>> parseByteString value "[1,2,3]" :: [[Int]]@@ -838,7 +971,7 @@ -- -- The 'value' parser works by creating an aeson AST and passing it to the -- 'parseJSON' method. The AST can consume a lot of memory before it is rejected--- in 'parseJSON'. To achieve constant space the parsers 'safeString', 'number', 'integer',+-- in 'parseJSON'. To achieve constant space the parsers 'safeString', 'objectOf', 'number', 'integer', -- 'real' and 'bool' -- must be used; these parsers reject and do not parse data if it does not match the -- type.@@ -856,6 +989,9 @@ -- '.!' and '.:' functions combined with constant space -- parsers or limiting the number of returned elements with 'takeI'. --+-- Running many parallel parsers (e.g. when parsing objects with a lot of fields) will slow+-- things done. Use the 'objectOf'.+-- -- If the source object contains an object with multiple keys with a same name, -- json-stream matches the key multiple times. The only exception -- is 'objectWithKey' ('.:' and '.:?') that return at most one value for a given key.@@ -875,19 +1011,32 @@ -- >>> let people = arrayOf person -- >>> parseByteString people test :: [(T.Text, Int)] -- [("test1",1),("test2",-1),("test3",-1)]-+--+-- The above code would run 3 parsers in parallel to get the appropriate results. +-- You can use the 'objectOf' parser to get a similar result in a more performant way.+--+-- >>> let test = "[{\"name\": \"test1\", \"value\": 1}, {\"name\": \"test2\", \"value\": null}, {\"name\": \"test3\"}]"+-- >>> let person = objectOf $ (,) <$> "name" .: string <*> "value" .: integer .| (-1)+-- >>> let people = arrayOf person+-- >>> parseByteString people test :: [(T.Text, Int)]+-- [("test1",1),("test2",-1),("test3",-1)]+-- -- $performance -- The parser tries to do the least amount of work to get the job done, skipping over items that -- are not required. General guidelines to get best performance: ----- Do not use the 'value' parser for the whole object if the object is big. Do not use json-stream--- applicative parsing for creating objects if they have lots of records, unless you are skipping--- large part of the structure. Every '<*>' causes parallel parsing, too many parallel parsers--- kill performance.+-- Do not use the 'value' parser for the whole object if the object is big.+-- Consider using the 'objectOf' parser to parse objects instead of direct applicative parsing+-- for creating objects if they have lots of records. Every '<*>' outside of direct 'objectOf' parser+-- causes parallel parsing. Too many parallel parsers kill performance. --+-- > arrayOf $ objectOf $ MyStructure <$> "field1" .: string <*> "field2" .: integer <*> .... <*> "field20" .: string+--+-- will be the fastest and use the least memory. +-- -- > arrayOf value :: Parser MyStructure -- MyStructure with FromJSON instance ----- will probably behave better than+-- will probably still behave better than -- -- > arrayOf $ MyStructure <$> "field1" .: string <*> "field2" .: integer <*> .... <*> "field20" .: string --

@@ -2,9 +2,7 @@ {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE MagicHash                #-} {-# LANGUAGE UnliftedFFITypes         #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE MultiWayIf   #-}-{-# LANGUAGE PatternGuards   #-}+{-# OPTIONS_GHC -Wno-unused-imports #-}  module Data.JsonStream.Unescape (     unescapeText

@@ -127,21 +127,28 @@ >>> let test = "[{\"name\": \"John\", \"age\": 20}, {\"age\": 30, \"name\": \"Frank\"} ]" >>> let parser = arrayOf $ (,) <$> "name" .: value                                <*> "age" .: value->>> parseByteString  parser test :: [(Text,Int)]+>>> parseByteString parser test :: [(Text,Int)] [("John",20),("Frank",30)] +-- Use objectOf for parsing objects (it's faster than parallel parsing).+>>> let test = "[{\"name\": \"John\", \"age\": 20}, {\"age\": 30, \"name\": \"Frank\"} ]"+>>> let parser = arrayOf $ objectOf $ (,) <$> "name" .: value+                                          <*> "age" .: value+>>> parseByteString parser test :: [(Text,Int)]+[("John",20),("Frank",30)]+ -- If you have more results returned from each branch, all are combined. >>> let test = "[{\"key1\": [1,2], \"key2\": [5,6], \"key3\": [8,9]}]" >>> let parser = arrayOf $ (,) <$> "key2" .: (arrayOf value)                                <*> "key1" .: (arrayOf value)->>> parse parser test :: [(Int, Int)]+>>> parseByteString parser test :: [(Int, Int)] [(6,2),(6,1),(5,2),(5,1)]  -- Use <> to return both branches let test = "[{\"key1\": [1,2], \"key2\": [5,6], \"key3\": [8,9]}]" >>> let parser = arrayOf $    "key1" .: (arrayOf value)                            <> "key2" .: (arrayOf value)->>> parse parser test :: [Int]+>>> parseByteString parser test :: [Int] [1,2,5,6]  -- objectItems function enriches value with object key@@ -152,12 +159,19 @@ [("key1",1),("key1",2),("key1",3),("key2",5),("key2",6),("key2",7)]  -- .:? produces a maybe value; Nothing if match is not found or is null.--- .!= converts Maybe back with a default->>> let test = "[{\"name\":\"John\", \"value\": 12}, {\"name\":\"name2\"}]"->>> let parser = arrayOf $ (,) <$> "name"  .: string-                               <*> "value" .:? integer .!= 0->>> parseByteString parser test :: [(String,Int)]-[("John",12),("name2",0)]+-- .| produces a default value if the preceding didn't produce anything+>>> let test = "[{\"name\":\"John\", \"value\": 12}, {\"name\":\"name2\"}, {\"value\":12}]"+>>> let parser = arrayOf $ (,) <$> "name"  .:? string+                               <*> "value" .: integer .| 0+>>> parseByteString parser test :: [(Maybe Text, Int)]+[(Just "John",12),(Just "name2",0),(Nothing,12)]++-- And it works the same with the objectOf parser+>>> let test = "[{\"name\":\"John\", \"value\": 12}, {\"name\":\"name2\"}, {\"value\":12}]"+>>> let parser = arrayOf $ objectOf $ (,) <$> "name"  .:? string+                                          <*> "value" .: integer .| 0+>>> parseByteString parser test :: [(Maybe Text, Int)]+[(Just "John",12),(Just "name2",0),(Nothing,12)]  ``` 

@@ -1,3 +1,8 @@+# 0.4.5.0++- objectOf parser for faster one-pass JSON object parsing+- set minimum base to 4.11+ # 0.4.4.2  - aeson-2.1

@@ -1,5 +1,5 @@ name:                json-stream-version:             0.4.4.2+version:             0.4.5.0 synopsis:            Incremental applicative JSON parser description:         Easy to use JSON parser fully supporting incremental parsing.                      Parsing grammar in applicative form.@@ -11,8 +11,6 @@                      of the input data. In addition to performance-critical parts written in C,                      a lot of performance is gained by being less memory intensive especially                      when used for stream parsing.-                     .-                     * WARNING: 0.4.0.0 has code-breaking semantic changes, see changelog!  homepage:            https://github.com/ondrap/json-stream license:             BSD3@@ -42,12 +40,13 @@   c-sources:           c_lib/lexer.c, c_lib/unescape_string.c   includes:            c_lib/lexer.h   include-dirs:        c_lib-  build-depends:         base >=4.7 && <5+  build-depends:         base >=4.11 && <5                        , bytestring                        , text                        , aeson >= 0.7 && < 2.2                        , vector                        , unordered-containers+                       , containers                        , scientific                        , primitive   if flag(conduit)@@ -72,7 +71,7 @@   includes:            c_lib/lexer.h   include-dirs:        c_lib   cc-options:          -fPIC-  Build-Depends:         base >= 4.7 && <5+  Build-Depends:         base >= 4.11 && <5                        , doctest >= 0.9.3                        , bytestring                        , text@@ -101,7 +100,7 @@   hs-source-dirs:      test, .   default-language:    Haskell2010   ghc-options:         -Wall-  build-depends:         base >=4.7 && <5+  build-depends:         base >=4.11 && <5                        , bytestring                        , text                        , aeson@@ -122,7 +121,7 @@ --   c-sources:           c_lib/lexer.c --   include-dirs:        c_lib --   default-language:    Haskell2010---   build-depends:         base >=4.7 && <5+--   build-depends:         base >=4.11 && <5 --                        , bytestring --                        , text --                        , aeson