git.iko.soy/typeable/aeson
on master help sign in
Merge pull request #51 from hvr/issue-37
be100f0Bryan O'Sullivan
Data/Aeson/Parser.hs+51
compare with master
unifiedsplit
@@ -14,7 +14,9 @@
14module Data.Aeson.Parser
14module Data.Aeson.Parser
15 (
15 (
16 json
16 json
17+ , json'
17 , value
18 , value
19+ , value'
18 , jstring
20 , jstring
19 ) where
21 ) where
20
22
@@ -47,6 +49,19 @@ json = do
47 then object_
49 then object_
48 else array_
50 else array_
49
51
52+-- | Parse a top-level JSON value. This must be either an object or
53+-- an array.
54+--
55+-- This is a strict parser version of 'json' which avoids
56+-- building up thunks during parsing. Prefer this version if most of
57+-- the JSON data needs to be accessed.
58+json' :: Parser Value
59+json' = do
60+ c <- skipSpace *> satisfy (`B8.elem` "{[")
61+ if c == '{'
62+ then object_'
63+ else array_'
64+
50object_ :: Parser Value
65object_ :: Parser Value
51object_ = {-# SCC "object_" #-} do
66object_ = {-# SCC "object_" #-} do
52 skipSpace
67 skipSpace
@@ -57,12 +72,28 @@ object_ = {-# SCC "object_" #-} do
57 vals <- ((pair <* skipSpace) `sepBy` (char ',' *> skipSpace)) <* char '}'
72 vals <- ((pair <* skipSpace) `sepBy` (char ',' *> skipSpace)) <* char '}'
58 return . Object $ H.fromList vals
73 return . Object $ H.fromList vals
59
74
75+object_' :: Parser Value
76+object_' = {-# SCC "object_'" #-} do
77+ skipSpace
78+ let pair = do
79+ a <- jstring <* skipSpace
80+ b <- char ':' *> skipSpace *> value'
81+ return (a,b)
82+ vals <- ((pair <* skipSpace) `sepBy` (char ',' *> skipSpace)) <* char '}'
83+ return $! Object $ H.fromList vals
84+
60array_ :: Parser Value
85array_ :: Parser Value
61array_ = {-# SCC "array_" #-} do
86array_ = {-# SCC "array_" #-} do
62 skipSpace
87 skipSpace
63 vals <- ((value <* skipSpace) `sepBy` (char ',' *> skipSpace)) <* char ']'
88 vals <- ((value <* skipSpace) `sepBy` (char ',' *> skipSpace)) <* char ']'
64 return . Array $ Vector.fromList vals
89 return . Array $ Vector.fromList vals
65
90
91+array_' :: Parser Value
92+array_' = {-# SCC "array_'" #-} do
93+ skipSpace
94+ vals <- ((value' <* skipSpace) `sepBy` (char ',' *> skipSpace)) <* char ']'
95+ return $! Array $ Vector.fromList vals
96+
66-- | Parse any JSON value. Use 'json' in preference to this function
97-- | Parse any JSON value. Use 'json' in preference to this function
67-- if you are parsing data from an untrusted source.
98-- if you are parsing data from an untrusted source.
68value :: Parser Value
99value :: Parser Value
@@ -79,6 +110,26 @@ value = most <|> (Number <$> number)
79 'n' -> string "ull" *> pure Null
110 'n' -> string "ull" *> pure Null
80 _ -> error "attoparsec panic! the impossible happened!"
111 _ -> error "attoparsec panic! the impossible happened!"
81
112
113+-- | Strict version of 'value'. See also 'json''.
114+value' :: Parser Value
115+value' = most <|> num
116+ where
117+ num = do
118+ n <- number
119+ return $! Number n
120+ most = do
121+ c <- satisfy (`B8.elem` "{[\"ftn")
122+ case c of
123+ '{' -> object_'
124+ '[' -> array_'
125+ '"' -> do
126+ s <- jstring_
127+ return $! String s
128+ 'f' -> string "alse" *> pure (Bool False)
129+ 't' -> string "rue" *> pure (Bool True)
130+ 'n' -> string "ull" *> pure Null
131+ _ -> error "attoparsec panic! the impossible happened!"
132+
82doubleQuote, backslash :: Word8
133doubleQuote, backslash :: Word8
83doubleQuote = 34
134doubleQuote = 34
84backslash = 92
135backslash = 92