Anonymous avatar Anonymous committed bd286b4

Add strict parsers variants of `json` and `value`

This changeset builds on top of
dab1302e9b0fcb464e8db2910fe4e2f77697979f, and just strictifies the
monadic `return`s used in the attoparsec `Parser`s monad to avoid
leaving thunks behind during parsing.

This addresses issue #37

Comments (0)

Files changed (1)

Data/Aeson/Parser.hs

 module Data.Aeson.Parser
     (
       json
+    , json'
     , value
+    , value'
     , jstring
     ) where
 
     then object_
     else array_
 
+-- | Parse a top-level JSON value.  This must be either an object or
+-- an array.
+--
+-- This is a strict parser version of 'json' which avoids
+-- building up thunks during parsing. Prefer this version if most of
+-- the JSON data needs to be accessed.
+json' :: Parser Value
+json' = do
+  c <- skipSpace *> satisfy (`B8.elem` "{[")
+  if c == '{'
+    then object_'
+    else array_'
+
 object_ :: Parser Value
 object_ = {-# SCC "object_" #-} do
   skipSpace
   vals <- ((pair <* skipSpace) `sepBy` (char ',' *> skipSpace)) <* char '}'
   return . Object $ H.fromList vals
 
+object_' :: Parser Value
+object_' = {-# SCC "object_'" #-} do
+  skipSpace
+  let pair = do
+        a <- jstring <* skipSpace
+        b <- char ':' *> skipSpace *> value'
+        return (a,b)
+  vals <- ((pair <* skipSpace) `sepBy` (char ',' *> skipSpace)) <* char '}'
+  return $! Object $ H.fromList vals
+
 array_ :: Parser Value
 array_ = {-# SCC "array_" #-} do
   skipSpace
   vals <- ((value <* skipSpace) `sepBy` (char ',' *> skipSpace)) <* char ']'
   return . Array $ Vector.fromList vals
 
+array_' :: Parser Value
+array_' = {-# SCC "array_'" #-} do
+  skipSpace
+  vals <- ((value' <* skipSpace) `sepBy` (char ',' *> skipSpace)) <* char ']'
+  return $! Array $ Vector.fromList vals
+
 -- | Parse any JSON value.  Use 'json' in preference to this function
 -- if you are parsing data from an untrusted source.
 value :: Parser Value
       'n' -> string "ull" *> pure Null
       _   -> error "attoparsec panic! the impossible happened!"
 
+-- | Strict version of 'value'. See also 'json''.
+value' :: Parser Value
+value' = most <|> num
+ where
+  num = do
+    n <- number
+    return $! Number n
+  most = do
+    c <- satisfy (`B8.elem` "{[\"ftn")
+    case c of
+      '{' -> object_'
+      '[' -> array_'
+      '"' -> do
+          s <- jstring_
+          return $! String s
+      'f' -> string "alse" *> pure (Bool False)
+      't' -> string "rue" *> pure (Bool True)
+      'n' -> string "ull" *> pure Null
+      _   -> error "attoparsec panic! the impossible happened!"
+
 doubleQuote, backslash :: Word8
 doubleQuote = 34
 backslash = 92
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.