@@ -1,408 +0,0 @@
1−{-# LANGUAGE BangPatterns #-}
2−{-# LANGUAGE CPP #-}
3−{-# LANGUAGE NoImplicitPrelude #-}
4−{-# LANGUAGE OverloadedStrings #-}
5−-- |
6−-- Module: Data.Aeson.Scanner.Internal
7−-- Copyright: (c) 2011-2016 Bryan O'Sullivan
8−-- (c) 2011 MailRank, Inc.
9−-- (c) 2020 Yuras Shumovich
10−-- License: BSD3
11−-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
12−-- Stability: experimental
13−-- Portability: portable
14−--
15−-- Efficiently and correctly parse a JSON string. The string must be
16−-- encoded as UTF-8.
17−
18−module Data.Aeson.Scanner.Internal
19− (
20− -- * Lazy scanners
21− json, jsonEOF
22− , jsonWith
23− , jsonLast
24− , jsonAccum
25− , jsonNoDup
26− , value
27− , jstring
28− , jstring_
29− , scientific
30− -- * Strict scanners
31− , json', jsonEOF'
32− , jsonWith'
33− , jsonLast'
34− , jsonAccum'
35− , jsonNoDup'
36− , value'
37− -- * Helpers
38− , decodeWith
39− , decodeStrictWith
40− , eitherDecodeWith
41− , eitherDecodeStrictWith
42− -- ** Handling objects with duplicate keys
43− , fromListAccum
44− , parseListNoDup
45− ) where
46−
47−import Prelude.Compat
48−
49−import Data.Aeson.Types.Internal
50−import qualified Data.Aeson.Parser.Internal as Parser
51−import Data.Bits (testBit)
52−import Data.ByteString (ByteString)
53−import qualified Data.ByteString.Lazy as Lazy (ByteString)
54−import Data.Function (fix)
55−import Data.Functor.Compat (($>))
56−import Data.HashMap.Strict (HashMap)
57−import qualified Data.HashMap.Strict as HashMap
58−import Data.Scientific (Scientific)
59−import Data.Text (Text)
60−import qualified Data.Text.Encoding as Text
61−import Data.Vector (Vector)
62−import qualified Data.Vector as Vector
63−import Data.Word
64−import Scanner (Scanner)
65−import qualified Scanner
66−import qualified Scanner.Attoparsec as Scanner
67−
68−#define BACKSLASH 92
69−#define CLOSE_CURLY 125
70−#define CLOSE_SQUARE 93
71−#define COMMA 44
72−#define DOUBLE_QUOTE 34
73−#define OPEN_CURLY 123
74−#define OPEN_SQUARE 91
75−#define C_0 48
76−#define C_9 57
77−#define C_A 65
78−#define C_F 70
79−#define C_a 97
80−#define C_f 102
81−#define C_n 110
82−#define C_t 116
83−
84−-- | Parse any JSON value.
85−--
86−-- The conversion of a parsed value to a Haskell value is deferred
87−-- until the Haskell value is needed. This may improve performance if
88−-- only a subset of the results of conversions are needed, but at a
89−-- cost in thunk allocation.
90−--
91−-- This function is an alias for 'value'.
92−--
93−-- ==== Warning
94−--
95−-- If an object contains duplicate keys, only the first one will be kept.
96−-- For a more flexible alternative, see 'jsonWith'.
97−json :: Scanner Value
98−json = value
99−
100−-- | Parse any JSON value.
101−--
102−-- This is a strict version of 'json' which avoids building up thunks
103−-- during parsing; it performs all conversions immediately. Prefer
104−-- this version if most of the JSON data needs to be accessed.
105−--
106−-- This function is an alias for 'value''.
107−--
108−-- ==== Warning
109−--
110−-- If an object contains duplicate keys, only the first one will be kept.
111−-- For a more flexible alternative, see 'jsonWith''.
112−json' :: Scanner Value
113−json' = value'
114−
115−-- Open recursion: object_, object_', array_, array_' are parameterized by the
116−-- toplevel Value parser to be called recursively, to keep the parameter
117−-- mkObject outside of the recursive loop for proper inlining.
118−
119−object_ :: ([(Text, Value)] -> Either String Object)
120− -> Scanner Value -> Scanner Value
121−object_ mkObject val = {-# SCC "object_" #-} Object
122− <$> objectValues mkObject jstring val
123−{-# INLINE object_ #-}
124−
125−object_' :: ([(Text, Value)] -> Either String Object)
126− -> Scanner Value -> Scanner Value
127−object_' mkObject val' = {-# SCC "object_'" #-} do
128− !vals <- objectValues mkObject jstring' val'
129− return (Object vals)
130− where
131− jstring' = do
132− !s <- jstring
133− return s
134−{-# INLINE object_' #-}
135−
136−objectValues :: ([(Text, Value)] -> Either String Object)
137− -> Scanner Text -> Scanner Value -> Scanner (HashMap Text Value)
138−objectValues mkObject str val = do
139− skipSpace
140− w <- lookAhead'
141− if w == CLOSE_CURLY
142− then Scanner.anyWord8 $> HashMap.empty
143− else loop []
144− where
145− -- Why use acc pattern here, you may ask? because 'HashMap.fromList' use
146− -- 'unsafeInsert' and it's much faster because it's doing in place update
147− -- to the 'HashMap'!
148− loop acc = do
149− k <- str <* skipSpace <* Scanner.char8 ':'
150− v <- val <* skipSpace
151− ch <- Scanner.satisfy (\w -> w == COMMA || w == CLOSE_CURLY)
152− let acc' = (k, v) : acc
153− if ch == COMMA
154− then skipSpace >> loop acc'
155− else case mkObject acc' of
156− Left err -> fail err
157− Right obj -> pure obj
158−{-# INLINE objectValues #-}
159−
160−array_ :: Scanner Value -> Scanner Value
161−array_ val = {-# SCC "array_" #-} Array <$> arrayValues val
162−{-# INLINE array_ #-}
163−
164−array_' :: Scanner Value -> Scanner Value
165−array_' val = {-# SCC "array_'" #-} do
166− !vals <- arrayValues val
167− return (Array vals)
168−{-# INLINE array_' #-}
169−
170−arrayValues :: Scanner Value -> Scanner (Vector Value)
171−arrayValues val = do
172− skipSpace
173− w <- lookAhead'
174− if w == CLOSE_SQUARE
175− then Scanner.anyWord8 $> Vector.empty
176− else loop [] 1
177− where
178− loop acc !len = do
179− v <- val <* skipSpace
180− ch <- Scanner.satisfy (\w -> w == COMMA || w == CLOSE_SQUARE)
181− if ch == COMMA
182− then skipSpace >> loop (v:acc) (len+1)
183− else return (Vector.reverse (Vector.fromListN len (v:acc)))
184−{-# INLINE arrayValues #-}
185−
186−-- | Parse any JSON value. Synonym of 'json'.
187−value :: Scanner Value
188−value = jsonWith (pure . HashMap.fromList)
189−
190−-- | Parse any JSON value.
191−--
192−-- This parser is parameterized by a function to construct an 'Object'
193−-- from a raw list of key-value pairs, where duplicates are preserved.
194−-- The pairs appear in __reverse order__ from the source.
195−--
196−-- ==== __Examples__
197−--
198−-- 'json' keeps only the first occurence of each key, using 'HashMap.Lazy.fromList'.
199−--
200−-- @
201−-- 'json' = 'jsonWith' ('Right' '.' 'HashMap.fromList')
202−-- @
203−--
204−-- 'jsonLast' keeps the last occurence of each key, using
205−-- @'HashMap.Lazy.fromListWith' ('const' 'id')@.
206−--
207−-- @
208−-- 'jsonLast' = 'jsonWith' ('Right' '.' 'HashMap.Lazy.fromListWith' ('const' 'id'))
209−-- @
210−--
211−-- 'jsonAccum' keeps wraps all values in arrays to keep duplicates, using
212−-- 'fromListAccum'.
213−--
214−-- @
215−-- 'jsonAccum' = 'jsonWith' ('Right' . 'fromListAccum')
216−-- @
217−--
218−-- 'jsonNoDup' fails if any object contains duplicate keys, using 'parseListNoDup'.
219−--
220−-- @
221−-- 'jsonNoDup' = 'jsonWith' 'parseListNoDup'
222−-- @
223−jsonWith :: ([(Text, Value)] -> Either String Object) -> Scanner Value
224−jsonWith mkObject = fix $ \value_ -> do
225− skipSpace
226− w <- lookAhead'
227− case w of
228− DOUBLE_QUOTE -> Scanner.anyWord8 *> (String <$> jstring_)
229− OPEN_CURLY -> Scanner.anyWord8 *> object_ mkObject value_
230− OPEN_SQUARE -> Scanner.anyWord8 *> array_ value_
231− C_f -> Scanner.string "false" $> Bool False
232− C_t -> Scanner.string "true" $> Bool True
233− C_n -> Scanner.string "null" $> Null
234− _ | w >= 48 && w <= 57 || w == 45
235− -> Number <$> scientific
236− | otherwise -> fail "not a valid json value"
237−{-# INLINE jsonWith #-}
238−
239−-- | Variant of 'json' which keeps only the last occurence of every key.
240−jsonLast :: Scanner Value
241−jsonLast = jsonWith (Right . HashMap.fromListWith (const id))
242−
243−-- | Variant of 'json' wrapping all object mappings in 'Array' to preserve
244−-- key-value pairs with the same keys.
245−jsonAccum :: Scanner Value
246−jsonAccum = jsonWith (Right . fromListAccum)
247−
248−-- | Variant of 'json' which fails if any object contains duplicate keys.
249−jsonNoDup :: Scanner Value
250−jsonNoDup = jsonWith parseListNoDup
251−
252−-- | @'fromListAccum' kvs@ is an object mapping keys to arrays containing all
253−-- associated values from the original list @kvs@.
254−--
255−-- >>> fromListAccum [("apple", Bool True), ("apple", Bool False), ("orange", Bool False)]
256−-- fromList [("apple", [Bool False, Bool True]), ("orange", [Bool False])]
257−fromListAccum :: [(Text, Value)] -> Object
258−fromListAccum =
259− fmap (Array . Vector.fromList . ($ []))
260− . HashMap.fromListWith (.) . (fmap . fmap) (:)
261−
262−-- | @'fromListNoDup' kvs@ fails if @kvs@ contains duplicate keys.
263−parseListNoDup :: [(Text, Value)] -> Either String Object
264−parseListNoDup =
265− HashMap.traverseWithKey unwrap . HashMap.fromListWith (\_ _ -> Nothing)
266− . (fmap . fmap) Just
267− where
268− unwrap k Nothing = Left $ "found duplicate key: " ++ show k
269− unwrap _ (Just v) = Right v
270−
271−-- | Strict version of 'value'. Synonym of 'json''.
272−value' :: Scanner Value
273−value' = jsonWith' (pure . HashMap.fromList)
274−
275−-- | Strict version of 'jsonWith'.
276−jsonWith' :: ([(Text, Value)] -> Either String Object) -> Scanner Value
277−jsonWith' mkObject = fix $ \value_ -> do
278− skipSpace
279− w <- lookAhead'
280− case w of
281− DOUBLE_QUOTE -> do
282− !s <- Scanner.anyWord8 *> jstring_
283− return (String s)
284− OPEN_CURLY -> Scanner.anyWord8 *> object_' mkObject value_
285− OPEN_SQUARE -> Scanner.anyWord8 *> array_' value_
286− C_f -> Scanner.string "false" $> Bool False
287− C_t -> Scanner.string "true" $> Bool True
288− C_n -> Scanner.string "null" $> Null
289− _ | w >= 48 && w <= 57 || w == 45
290− -> do
291− !n <- scientific
292− return (Number n)
293− | otherwise -> fail "not a valid json value"
294−{-# INLINE jsonWith' #-}
295−
296−-- | Variant of 'json'' which keeps only the last occurence of every key.
297−jsonLast' :: Scanner Value
298−jsonLast' = jsonWith' (pure . HashMap.fromListWith (const id))
299−
300−-- | Variant of 'json'' wrapping all object mappings in 'Array' to preserve
301−-- key-value pairs with the same keys.
302−jsonAccum' :: Scanner Value
303−jsonAccum' = jsonWith' (pure . fromListAccum)
304−
305−-- | Variant of 'json'' which fails if any object contains duplicate keys.
306−jsonNoDup' :: Scanner Value
307−jsonNoDup' = jsonWith' parseListNoDup
308−
309−-- | Parse a quoted JSON string.
310−jstring :: Scanner Text
311−jstring = Scanner.word8 DOUBLE_QUOTE *> jstring_
312−
313−-- | Parse a string without a leading quote.
314−jstring_ :: Scanner Text
315−{-# INLINE jstring_ #-}
316−jstring_ = do
317− s <- Scanner.takeWhile $
318− \w -> w /= DOUBLE_QUOTE && w /= BACKSLASH && not (testBit w 7)
319− w <- lookAhead'
320− case w of
321− DOUBLE_QUOTE -> Scanner.anyWord8 $> Text.decodeUtf8 s
322− _ -> Scanner.atto $ Parser.jstringSlow s
323−
324−decodeWith :: Scanner Value -> (Value -> Result a) -> Lazy.ByteString -> Maybe a
325−decodeWith p to s =
326− case Scanner.scanLazy p s of
327− Right v -> case to v of
328− Success a -> Just a
329− _ -> Nothing
330− _ -> Nothing
331−{-# INLINE decodeWith #-}
332−
333−decodeStrictWith :: Scanner Value -> (Value -> Result a) -> ByteString
334− -> Maybe a
335−decodeStrictWith p to s =
336− case either Error to (Scanner.scanOnly p s) of
337− Success a -> Just a
338− _ -> Nothing
339−{-# INLINE decodeStrictWith #-}
340−
341−eitherDecodeWith :: Scanner Value -> (Value -> IResult a) -> Lazy.ByteString
342− -> Either (JSONPath, String) a
343−eitherDecodeWith p to s =
344− case Scanner.scanLazy p s of
345− Right v -> case to v of
346− ISuccess a -> Right a
347− IError path msg -> Left (path, msg)
348− Left msg -> Left ([], msg)
349−{-# INLINE eitherDecodeWith #-}
350−
351−eitherDecodeStrictWith :: Scanner Value -> (Value -> IResult a) -> ByteString
352− -> Either (JSONPath, String) a
353−eitherDecodeStrictWith p to s =
354− case either (IError []) to (Scanner.scanOnly p s) of
355− ISuccess a -> Right a
356− IError path msg -> Left (path, msg)
357−{-# INLINE eitherDecodeStrictWith #-}
358−
359−-- $lazy
360−--
361−-- The 'json' and 'value' parsers decouple identification from
362−-- conversion. Identification occurs immediately (so that an invalid
363−-- JSON document can be rejected as early as possible), but conversion
364−-- to a Haskell value is deferred until that value is needed.
365−--
366−-- This decoupling can be time-efficient if only a smallish subset of
367−-- elements in a JSON value need to be inspected, since the cost of
368−-- conversion is zero for uninspected elements. The trade off is an
369−-- increase in memory usage, due to allocation of thunks for values
370−-- that have not yet been converted.
371−
372−-- $strict
373−--
374−-- The 'json'' and 'value'' parsers combine identification with
375−-- conversion. They consume more CPU cycles up front, but have a
376−-- smaller memory footprint.
377−
378−-- | Parse a top-level JSON value followed by optional whitespace and
379−-- end-of-input. See also: 'json'.
380−jsonEOF :: Scanner Value
381−jsonEOF = json <* skipSpace <* endOfInput
382−
383−-- | Parse a top-level JSON value followed by optional whitespace and
384−-- end-of-input. See also: 'json''.
385−jsonEOF' :: Scanner Value
386−jsonEOF' = json' <* skipSpace <* endOfInput
387−
388−-- | The only valid whitespace in a JSON document is space, newline,
389−-- carriage return, and tab.
390−skipSpace :: Scanner ()
391−skipSpace = Scanner.skipWhile
392− $ \w -> w == 0x20 || w == 0x0a || w == 0x0d || w == 0x09
393−{-# INLINE skipSpace #-}
394−
395−endOfInput :: Scanner ()
396−endOfInput = do
397− w <- Scanner.lookAhead
398− case w of
399− Nothing -> return ()
400− Just _ -> fail "input after data"
401−
402−-- | Parse a JSON number.
403−scientific :: Scanner Scientific
404−scientific = Scanner.atto Parser.scientific
405−
406−lookAhead' :: Scanner Word8
407−lookAhead' = Scanner.lookAhead
408− >>= maybe (fail "unexpected end of input") return