diff --git a/Data/JsonStream/CLexer.hs b/Data/JsonStream/CLexer.hs --- a/Data/JsonStream/CLexer.hs +++ b/Data/JsonStream/CLexer.hs @@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} @@ -9,7 +10,10 @@ , unescapeText ) where +#if !MIN_VERSION_bytestring(0,10,6) import Control.Applicative ((<$>)) +#endif + import Control.Monad (when) import qualified Data.Aeson as AE import qualified Data.ByteString as BSW diff --git a/Data/JsonStream/Parser.hs b/Data/JsonStream/Parser.hs --- a/Data/JsonStream/Parser.hs +++ b/Data/JsonStream/Parser.hs @@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -39,6 +40,11 @@ , runParser' , parseByteString , parseLazyByteString + -- * Aeson in-place replacement functions + , decode + , eitherDecode + , decodeStrict + , eitherDecodeStrict -- * FromJSON parser , value , string @@ -71,12 +77,17 @@ , objectFound ) where +#if !MIN_VERSION_bytestring(0,10,6) +import Data.Monoid (Monoid, mappend, mempty) +#endif + import Control.Applicative import qualified Data.Aeson as AE -import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString.Char8 as BS +import qualified Data.ByteString.Lazy.Char8 as BL +import qualified Data.ByteString.Lazy.Internal as BL +import Data.Char (isSpace) import qualified Data.HashMap.Strict as HMap -import Data.Monoid (Monoid, mappend, mempty) import Data.Scientific (Scientific, isInteger, toBoundedInteger, toRealFloat) import qualified Data.Text as T @@ -116,15 +127,16 @@ yieldResults :: [a] -> ParseResult a -> ParseResult a yieldResults values end = foldr Yield end values --- | '<*>' will run both parsers in parallel and combine results. It --- behaves as a list functor (produces all combinations), but the typical +-- | '<*>' will run both parsers in parallel and combine results. +-- +-- It behaves as a list functor (produces all combinations), but the typical -- use is: -- --- > JSON: text = [{"name": "John", "age": 20}, {"age": 30, "name": "Frank"} ] --- > >>> let parser = arrayOf $ (,) <$> "name" .: string --- > <*> "age" .: integer --- > >>> parseByteString parser text :: [(Text,Int)] --- > [("John",20),("Frank",30)] +-- >>> :set -XOverloadedStrings +-- >>> let text = "[{\"name\": \"John\", \"age\": 20}, {\"age\": 30, \"name\": \"Frank\"}]" +-- >>> let parser = arrayOf $ (,) <$> "name" .: string <*> "age" .: integer +-- >>> parseByteString parser text :: [(T.Text,Int)] +-- [("John",20),("Frank",30)] instance Applicative Parser where pure x = Parser $ \tok -> process (callParse ignoreVal tok) where @@ -149,11 +161,11 @@ -- | '<>' will run both parsers in parallel yielding from both as the data comes -- --- > json: [{"key1": [1,2], "key2": [5,6], "key3": [8,9]}] --- > >>> let parser = arrayOf $ "key1" .: (arrayOf value) --- > <> "key2" .: (arrayOf value) --- > >>> parseByteString parser json :: [Int] --- > [1,2,5,6] +-- >>> :m +Data.Monoid +-- >>> let test = "[{\"key1\": [1,2], \"key2\": [5,6], \"key3\": [8,9]}]" +-- >>> let parser = arrayOf $ "key1" .: (arrayOf value) <> "key2" .: (arrayOf value) +-- >>> parseByteString parser test :: [Int] +-- [1,2,5,6] instance Monoid (Parser a) where mempty = ignoreVal mappend m1 m2 = Parser $ \tok -> process (callParse m1 tok) (callParse m2 tok) @@ -172,21 +184,20 @@ -- from the second parser. Constant-space if second parser returns -- constant number of items. '.|' is implemented using this operator. -- --- > >>> let json = "[{\"key1\": [1,2], \"key2\": [5,6], \"key3\": [8,9]}]" --- > >>> let parser = arrayOf $ "key1" .: (arrayOf value) <|> "key2" .: (arrayOf value) --- > >>> parseByteString parser json :: [Int] --- > [1,2] --- > >>> let parser = arrayOf $ "key-non" .: (arrayOf value) <|> "key2" .: (arrayOf value) --- > >>> parseByteString parser json :: [Int] --- > [5,6] +-- >>> let json = "[{\"key1\": [1,2], \"key2\": [5,6], \"key3\": [8,9]}]" +-- >>> let parser = arrayOf $ "key1" .: (arrayOf value) <|> "key2" .: (arrayOf value) +-- >>> parseByteString parser json :: [Int] +-- [1,2] +-- >>> let parser = arrayOf $ "key-non" .: (arrayOf value) <|> "key2" .: (arrayOf value) +-- >>> parseByteString parser json :: [Int] +-- [5,6] -- -- 'many' - Gather matches and return them as list. -- --- > >>> let json = "[{\"keys\":[1,2], \"values\":[5,6]}, {\"keys\":[9,8], \"values\":[7,6]}]" --- > >>> let parser = arrayOf $ (,) <$> many ("keys" .: arrayOf integer) --- > <*> many ("values" .: arrayOf integer) --- > >>> parseByteString parser json :: [([Int], [Int])] --- > [([1,2],[5,6]),([9,8],[7,6])] +-- >>> let json = "[{\"keys\":[1,2], \"values\":[5,6]}, {\"keys\":[9,8], \"values\":[7,6]}]" +-- >>> let parser = arrayOf $ (,) <$> many ("keys" .: arrayOf integer) <*> many ("values" .: arrayOf integer) +-- >>> parseByteString parser json :: [([Int], [Int])] +-- [([1,2],[5,6]),([9,8],[7,6])] instance Alternative Parser where empty = ignoreVal m1 <|> m2 = Parser $ \tok -> process [] (callParse m1 tok) (Just $ callParse m2 tok) @@ -259,9 +270,9 @@ -- | Generate start/end values when an array is found, in between run a parser. -- The inner parser is not run if an array is not found. -- --- > >>> let test = "[[1,2,3],true,[],false,{\"key\":1}]" :: ByteString --- > >>> parseByteString (arrayOf (arrayFound 10 20 (1 .! integer))) test :: [Int] --- > [10,2,20,10,20] +-- >>> let test = "[[1,2,3],true,[],false,{\"key\":1}]" :: BS.ByteString +-- >>> parseByteString (arrayOf (arrayFound 10 20 (1 .! integer))) test :: [Int] +-- [10,2,20,10,20] arrayFound :: a -> a -> Parser a -> Parser a arrayFound = elemFound ArrayBegin @@ -463,9 +474,9 @@ -- | Match 'FromJSON' value. Calls parseJSON on the parsed value. -- --- > >>> let json = "[{\"key1\": [1,2], \"key2\": [5,6]}]" --- > >>> parseByteString (arrayOf value) json :: [Value] --- > [Object fromList [("key2",Array (fromList [Number 5.0,Number 6.0])),("key1",Array (fromList [Number 1.0,Number 2.0]))]] +-- >>> let json = "[{\"key1\": [1,2], \"key2\": [5,6]}]" +-- >>> parseByteString (arrayOf value) json :: [AE.Value] +-- [Object (fromList [("key2",Array [Number 5.0,Number 6.0]),("key1",Array [Number 1.0,Number 2.0])])] value :: AE.FromJSON a => Parser a value = Parser $ \ntok -> loop (callParse aeValue ntok) where @@ -479,8 +490,8 @@ -- | Take maximum n matching items. -- --- > >>> parseByteString (takeI 3 $ arrayOf integer) "[1,2,3,4,5,6,7,8,9,0]" :: [Int] --- > [1,2,3] +-- >>> parseByteString (takeI 3 $ arrayOf integer) "[1,2,3,4,5,6,7,8,9,0]" :: [Int] +-- [1,2,3] takeI :: Int -> Parser a -> Parser a takeI num valparse = Parser $ \tok -> loop num (callParse valparse tok) where @@ -533,8 +544,8 @@ -- | Let only items matching a condition pass. -- --- > >>> parseByteString (filterI (>5) $ arrayOf integer) "[1,2,3,4,5,6,7,8,9,0]" :: [Int] --- > [6,7,8,9] +-- >>> parseByteString (filterI (>5) $ arrayOf integer) "[1,2,3,4,5,6,7,8,9,0]" :: [Int] +-- [6,7,8,9] filterI :: (a -> Bool) -> Parser a -> Parser a filterI cond valparse = Parser $ \ntok -> loop (callParse valparse ntok) where @@ -565,9 +576,9 @@ -- | 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] +-- >>> let json = "{\"key1\": {\"nested-key\": 3}}" +-- >>> parseByteString ("key1" .: "nested-key" .: integer) json :: [Int] +-- [3] (.:) :: T.Text -> Parser a -> Parser a (.:) = objectWithKey infixr 7 .: @@ -594,8 +605,8 @@ -- | Synonym for 'arrayWithIndexOf'. Matches n-th item in array. -- --- > >>> parseByteString (arrayOf (1 .! bool)) "[ [1,true,null], [2,false], [3]]" :: [Bool] --- > [True,False] +-- >>> parseByteString (arrayOf (1 .! bool)) "[ [1,true,null], [2,false], [3]]" :: [Bool] +-- [True,False] (.!) :: Int -> Parser a -> Parser a (.!) = arrayWithIndexOf infixr 7 .! @@ -623,11 +634,11 @@ -- | Parse a bytestring, generate lazy list of parsed values. If an error occurs, throws an exception. -- --- > parseByteString (arrayOf integer) "[1,2,3,4]" :: [Int] --- > [1,2,3,4] +-- >>> parseByteString (arrayOf integer) "[1,2,3,4]" :: [Int] +-- [1,2,3,4] -- --- > parseByteString (arrayOf ("name" .: string)) "[{\"name\":\"KIWI\"}, {\"name\":\"BIRD\"}]" --- > ["KIWI","BIRD"] +-- >>> parseByteString (arrayOf ("name" .: string)) "[{\"name\":\"KIWI\"}, {\"name\":\"BIRD\"}]" +-- ["KIWI","BIRD"] parseByteString :: Parser a -> BS.ByteString -> [a] parseByteString parser startdata = loop (runParser' parser startdata) where @@ -638,37 +649,85 @@ -- | Parse a lazy bytestring, generate lazy list of parsed values. If an error occurs, throws an exception. parseLazyByteString :: Parser a -> BL.ByteString -> [a] -parseLazyByteString parser input = loop chunks (runParser parser) +parseLazyByteString parser input = loop input (runParser parser) where - chunks = BL.toChunks input - loop [] (ParseNeedData _) = error "Not enough data." - loop (dta:rest) (ParseNeedData np) = loop rest (np dta) + loop BL.Empty (ParseNeedData _) = error "Not enough data." + loop (BL.Chunk dta rest) (ParseNeedData np) = loop rest (np dta) loop _ (ParseDone _) = [] loop _ (ParseFailed err) = error err loop rest (ParseYield v np) = v : loop rest np +-- | Deserialize a JSON value from lazy 'BL.ByteString'. +-- +-- If this fails due to incomplete or invalid input, 'Nothing' is returned. +-- +-- The input must consist solely of a JSON document, with no trailing data except for whitespace. +decode :: AE.FromJSON a => BL.ByteString -> Maybe a +decode bs = + case eitherDecode bs of + Right val -> Just val + Left _ -> Nothing + +-- | Like 'decode' but returns an error message when decoding fails. +eitherDecode :: AE.FromJSON a => BL.ByteString -> Either String a +eitherDecode bs = loop bs (runParser value) + where + loop BL.Empty (ParseNeedData _) = Left "Not enough data." + loop (BL.Chunk dta rest) (ParseNeedData np) = loop rest (np dta) + loop _ (ParseDone _) = Left "Nothing parsed." + loop _ (ParseFailed err) = Left err + loop rest (ParseYield v next) = checkExit v next rest + + checkExit v (ParseDone srest) rest + | BS.all isSpace srest && BL.all isSpace rest = Right v + | otherwise = Left "Data followed by non-whitespace characters." + checkExit _ (ParseYield _ _) _ = Left "Multiple value parses?" + checkExit _ (ParseFailed err) _ = Left err + checkExit _ (ParseNeedData _) BL.Empty = Left "Incomplete json structure." + checkExit v (ParseNeedData cont) (BL.Chunk dta rest) = checkExit v (cont dta) rest + +-- | Like 'decode', but on strict 'BS.ByteString' +decodeStrict :: AE.FromJSON a => BS.ByteString -> Maybe a +decodeStrict bs = + case eitherDecodeStrict bs of + Right val -> Just val + Left _ -> Nothing + +-- | Like 'eitherDecode', but on strict 'BS.ByteString' +eitherDecodeStrict :: AE.FromJSON a => BS.ByteString -> Either String a +eitherDecodeStrict bs = + case runParser' value bs of + ParseYield next v -> checkExit v next + ParseNeedData _ -> Left "Incomplete json structure." + ParseFailed err -> Left err + ParseDone _ -> Left "No data found." + where + checkExit (ParseDone rest) v + | BS.all isSpace rest = Right v + checkExit _ _ = Left "Data folowed by non-whitespace characters." + -- $use -- --- > >>> parseByteString value "[1,2,3]" :: [[Int]] --- > [[1,2,3]] +-- >>> parseByteString value "[1,2,3]" :: [[Int]] +-- [[1,2,3]] +-- -- The 'value' parser matches any 'AE.FromJSON' value. The above command is essentially -- identical to the aeson decode function; the parsing process can generate more -- objects, therefore the results is [a]. -- -- Example of json-stream style parsing: -- --- > >>> parseByteString (arrayOf integer) "[1,2,3]" :: [Int] --- > [1,2,3] +-- >>> parseByteString (arrayOf integer) "[1,2,3]" :: [Int] +-- [1,2,3] -- -- Parsers can be combinated using '<*>' and '<|>' operators. The parsers are -- run in parallel and return combinations of the parsed values. -- --- > JSON: text = [{"name": "John", "age": 20}, {"age": 30, "name": "Frank"} ] --- > >>> let parser = arrayOf $ (,) <$> "name" .: string --- > <*> "age" .: integer --- > >>> parseByteString parser text :: [(Text,Int)] --- > [("John",20),("Frank",30)] +-- >>> let text = "[{\"name\": \"John\", \"age\": 20}, {\"age\": 30, \"name\": \"Frank\"} ]" +-- >>> let parser = arrayOf $ (,) <$> "name" .: string <*> "age" .: integer +-- >>> parseByteString parser text :: [(T.Text,Int)] +-- [("John",20),("Frank",30)] -- -- When parsing larger values, it is advisable to use lazy ByteStrings. The parsing -- is then more memory efficient as less lexical state @@ -716,12 +775,11 @@ -- but in a slightly different albeit more natural way. New operators are '.!' for -- array access and '.|' to handle missing values. -- --- > -- JSON: [{"name": "test1", "value": 1}, {"name": "test2", "value": null}, {"name": "test3"}] --- > >>> let person = (,) <$> "name" .: string --- > >>> <*> "value" .: integer .| (-1) --- > >>> let people = arrayOf person --- > >>> parseByteString people (..JSON..) :: [(Text, Int)] --- > [("test1",1),("test2",-1),("test3",-1)] +-- >>> let test = "[{\"name\": \"test1\", \"value\": 1}, {\"name\": \"test2\", \"value\": null}, {\"name\": \"test3\"}]" +-- >>> let person = (,) <$> "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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # json-stream - Applicative incremental JSON parser for Haskell -[![Build Status](https://travis-ci.org/ondrap/json-stream.svg?branch=master)](https://travis-ci.org/ondrap/json-stream) [![Hackage](https://img.shields.io/hackage/v/json-stream.svg)]() +[![Build Status](https://travis-ci.org/ondrap/json-stream.svg?branch=master)](https://travis-ci.org/ondrap/json-stream) [![Hackage](https://img.shields.io/hackage/v/json-stream.svg)](https://hackage.haskell.org/package/json-stream) Most haskellers use the excellent [aeson](https://hackage.haskell.org/package/aeson) library to decode and encode JSON structures. Unfortunately, although very fast, this parser diff --git a/c_lib/lexer.h b/c_lib/lexer.h --- a/c_lib/lexer.h +++ b/c_lib/lexer.h @@ -29,6 +29,7 @@ int restype; int startpos; // Startpos + length should point to unparsed data for } and ] int length; + int _padding; // 64-bit architectures will align adddata to 8-bytes anyway, make it explicit and hope for best long adddata; // Additional data to result }; diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,6 @@ +# 0.4.1.0 +Added aeson-compatibile encode/decode functions. + # 0.4.0.0 Breaking changes (this could *really* break your code): - Changed `<|>` to `<>` (`Monoid` is better for 'appending' than `Alternative`) diff --git a/json-stream.cabal b/json-stream.cabal --- a/json-stream.cabal +++ b/json-stream.cabal @@ -1,5 +1,5 @@ name: json-stream -version: 0.4.0.0 +version: 0.4.1.0 synopsis: Incremental applicative JSON parser description: Easy to use JSON parser fully supporting incremental parsing. Parsing grammar in applicative form. @@ -36,7 +36,7 @@ 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 && <4.9 + build-depends: base >=4.7 && <4.10 , bytestring , text , aeson >= 0.7 @@ -45,8 +45,32 @@ , scientific default-language: Haskell2010 + Ghc-Options: -Wall -fwarn-incomplete-uni-patterns +test-suite doctest + Type: exitcode-stdio-1.0 + Default-Language: Haskell2010 + HS-Source-Dirs: test, . + Ghc-Options: -threaded -Wall + Main-Is: doctests.hs + c-sources: c_lib/lexer.c, c_lib/unescape_string.c + includes: c_lib/lexer.h + include-dirs: c_lib + cc-options: -fPIC + Build-Depends: base >= 4.7 && <4.10 + , doctest >= 0.9.3 + , bytestring + , text + , aeson + , vector + , unordered-containers + , hspec + , scientific + , directory + , QuickCheck + , quickcheck-unicode + test-suite spec main-is: Spec.hs other-modules: Data.JsonStream.CLexType @@ -59,7 +83,7 @@ hs-source-dirs: test, . default-language: Haskell2010 ghc-options: -Wall - build-depends: base >=4.7 && <4.9 + build-depends: base >=4.7 && <4.10 , bytestring , text , aeson diff --git a/test/doctests.hs b/test/doctests.hs new file mode 100644 --- /dev/null +++ b/test/doctests.hs @@ -0,0 +1,6 @@ +module Main where + +import Test.DocTest + +main :: IO () +main = doctest [ "-idist/build", "dist/build/doctest/doctest-tmp/c_lib/lexer.o", "dist/build/doctest/doctest-tmp/c_lib/unescape_string.o", "Data/JsonStream/Parser.hs"]