{-# LANGUAGE BangPatterns #-}{-# LANGUAGE CPP #-}{-# LANGUAGE OverloadedStrings #-}#if MIN_VERSION_ghc_prim(0,3,1){-# LANGUAGE MagicHash #-}#endif-- |-- Module: Data.Aeson.Parser.Internal-- Copyright: (c) 2011-2016 Bryan O'Sullivan-- (c) 2011 MailRank, Inc.-- License: BSD3-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>-- Stability: experimental-- Portability: portable---- Efficiently and correctly parse a JSON string. The string must be-- encoded as UTF-8.moduleData.Aeson.Parser.Internal(-- * Lazy parsersjson ,jsonEOF ,value ,jstring -- * Strict parsers,json' ,jsonEOF' ,value' -- * Helpers,decodeWith ,decodeStrictWith ,eitherDecodeWith ,eitherDecodeStrictWith )whereimportPrelude()importPrelude.CompatimportData.Aeson.Types.Internal (IResult (..),JSONPath ,Result (..),Value (..))importData.Attoparsec.ByteString.Char8(Parser,char,endOfInput,scientific,skipSpace,string)importData.Text(Text)importData.VectorasVector(Vector,empty,fromListN,reverse)importqualifiedData.Attoparsec.ByteStringasAimportqualifiedData.Attoparsec.LazyasLimportqualifiedData.ByteStringasBimportqualifiedData.ByteString.LazyasLimportqualifiedData.HashMap.StrictasHimportData.Aeson.Parser.Unescape #if MIN_VERSION_ghc_prim(0,3,1)importGHC.Base(Int#,(==#),isTrue#,word2Int#)importGHC.Word(Word8(W8#))#endif#define BACKSLASH 92#define CLOSE_CURLY 125#define CLOSE_SQUARE 93#define COMMA 44#define DOUBLE_QUOTE 34#define OPEN_CURLY 123#define OPEN_SQUARE 91#define C_0 48#define C_9 57#define C_A 65#define C_F 70#define C_a 97#define C_f 102#define C_n 110#define C_t 116-- | Parse a top-level JSON value.---- The conversion of a parsed value to a Haskell value is deferred-- until the Haskell value is needed. This may improve performance if-- only a subset of the results of conversions are needed, but at a-- cost in thunk allocation.---- This function is an alias for 'value'. In aeson 0.8 and earlier, it-- parsed only object or array types, in conformance with the-- now-obsolete RFC 4627.json::ParserValue json =value -- | Parse a top-level JSON value.---- This is a strict version of 'json' which avoids building up thunks-- during parsing; it performs all conversions immediately. Prefer-- this version if most of the JSON data needs to be accessed.---- This function is an alias for 'value''. In aeson 0.8 and earlier, it-- parsed only object or array types, in conformance with the-- now-obsolete RFC 4627.json'::ParserValue json' =value' object_::ParserValue object_ ={-# SCC "object_" #-}Object <$>objectValues jstring value object_'::ParserValue object_' ={-# SCC "object_'" #-}do!vals <-objectValues jstring' value' return(Object vals )wherejstring' =do!s <-jstring returns objectValues::ParserText->ParserValue ->Parser(H.HashMapTextValue )objectValues str val =doskipSpacew <-A.peekWord8'ifw ==CLOSE_CURLYthenA.anyWord8>>returnH.emptyelseloop []where-- Why use acc pattern here, you may ask? because 'H.fromList' use 'unsafeInsert'-- and it's much faster because it's doing in place update to the 'HashMap'!loop acc =dok <-str <*skipSpace<*char':'v <-val <*skipSpacech <-A.satisfy$\w ->w ==COMMA||w==CLOSE_CURLYletacc' =(k ,v ):acc ifch ==COMMAthenskipSpace>>loop acc' elsereturn(H.fromListacc' ){-# INLINE objectValues #-}array_::ParserValue array_ ={-# SCC "array_" #-}Array <$>arrayValues value array_'::ParserValue array_' ={-# SCC "array_'" #-}do!vals <-arrayValues value' return(Array vals )arrayValues::ParserValue ->Parser(VectorValue )arrayValues val =doskipSpacew <-A.peekWord8'ifw ==CLOSE_SQUAREthenA.anyWord8>>returnVector.emptyelseloop []1whereloop acc !len =dov <-val <*skipSpacech <-A.satisfy$\w ->w ==COMMA||w==CLOSE_SQUAREifch ==COMMAthenskipSpace>>loop (v :acc )(len +1)elsereturn(Vector.reverse(Vector.fromListNlen (v :acc ))){-# INLINE arrayValues #-}-- | Parse any JSON value. You should usually 'json' in preference to-- this function, as this function relaxes the object-or-array-- requirement of RFC 4627.---- In particular, be careful in using this function if you think your-- code might interoperate with Javascript. A na&#xef;ve Javascript-- library that parses JSON data using @eval@ is vulnerable to attack-- unless the encoded data represents an object or an array. JSON-- implementations in other languages conform to that same restriction-- to preserve interoperability and security.value::ParserValue value =doskipSpacew <-A.peekWord8'casew ofDOUBLE_QUOTE->A.anyWord8*>(String<$>jstring_)OPEN_CURLY->A.anyWord8*> object_OPEN_SQUARE->A.anyWord8*>array_C_f->string"false"*>pure(Bool False)C_t->string"true"*>pure(Bool True)C_n->string"null"*>pureNull _|w >=48&&w <=57||w ==45->Number <$>scientific|otherwise->fail"not a valid json value"-- | Strict version of 'value'. See also 'json''.value'::ParserValue value' =doskipSpacew <-A.peekWord8'casew ofDOUBLE_QUOTE->do!s <-A.anyWord8*>jstring_ return(String s )OPEN_CURLY->A.anyWord8*> object_'OPEN_SQUARE->A.anyWord8*>array_'C_f->string"false"*>pure(Bool False)C_t->string"true"*>pure(Bool True)C_n->string"null"*>pureNull _|w >=48&&w <=57||w ==45->do!n <-scientificreturn(Number n )|otherwise->fail"not a valid json value"-- | Parse a quoted JSON string.jstring::ParserTextjstring =A.word8DOUBLE_QUOTE*>jstring_-- | Parse a string without a leading quote.jstring_::ParserText{-# INLINE jstring_ #-}jstring_ ={-# SCC "jstring_" #-}dos <-A.scanstartState go <*A.anyWord8caseunescapeText s ofRightr ->returnr Lefterr ->fail$showerr where#if MIN_VERSION_ghc_prim(0,3,1)startState =S 0#go (S a )(W8#c )|isTrue#a =Just(S 0#)|isTrue#(word2Int#c ==#34#)=Nothing-- double quote|otherwise=leta' =word2Int#c ==#92#-- backslashinJust(S a' )dataS =S Int##elsestartState=Falsegoac|a=JustFalse|c==DOUBLE_QUOTE=Nothing|otherwise=leta'=c==backslashinJusta'wherebackslash=BACKSLASH#endifdecodeWith::ParserValue ->(Value ->Result a )->L.ByteString->Maybea decodeWith p to s =caseL.parsep s ofL.Done_v ->caseto v ofSuccess a ->Justa _->Nothing_->Nothing{-# INLINE decodeWith #-}decodeStrictWith::ParserValue ->(Value ->Result a )->B.ByteString->Maybea decodeStrictWith p to s =caseeitherError to (A.parseOnlyp s )ofSuccess a ->Justa _->Nothing{-# INLINE decodeStrictWith #-}eitherDecodeWith::ParserValue ->(Value ->IResult a )->L.ByteString->Either(JSONPath ,String)a eitherDecodeWith p to s =caseL.parsep s ofL.Done_v ->caseto v ofISuccess a ->Righta IError path msg ->Left(path ,msg )L.Fail__msg ->Left([],msg ){-# INLINE eitherDecodeWith #-}eitherDecodeStrictWith::ParserValue ->(Value ->IResult a )->B.ByteString->Either(JSONPath ,String)a eitherDecodeStrictWith p to s =caseeither(IError [])to (A.parseOnlyp s )ofISuccess a ->Righta IError path msg ->Left(path ,msg ){-# INLINE eitherDecodeStrictWith #-}-- $lazy---- The 'json' and 'value' parsers decouple identification from-- conversion. Identification occurs immediately (so that an invalid-- JSON document can be rejected as early as possible), but conversion-- to a Haskell value is deferred until that value is needed.---- This decoupling can be time-efficient if only a smallish subset of-- elements in a JSON value need to be inspected, since the cost of-- conversion is zero for uninspected elements. The trade off is an-- increase in memory usage, due to allocation of thunks for values-- that have not yet been converted.-- $strict---- The 'json'' and 'value'' parsers combine identification with-- conversion. They consume more CPU cycles up front, but have a-- smaller memory footprint.-- | Parse a top-level JSON value followed by optional whitespace and-- end-of-input. See also: 'json'.jsonEOF::ParserValue jsonEOF =json <*skipSpace<*endOfInput-- | Parse a top-level JSON value followed by optional whitespace and-- end-of-input. See also: 'json''.jsonEOF'::ParserValue jsonEOF' =json' <*skipSpace<*endOfInput