#if MIN_VERSION_ghc_prim(0,3,1)
#endif
module Data.Aeson.Parser.Internal
(
json, jsonEOF
, value
, jstring
, json', jsonEOF'
, value'
, decodeWith
, decodeStrictWith
, eitherDecodeWith
, eitherDecodeStrictWith
) where
import Prelude ()
import Prelude.Compat
import Data.Aeson.Types.Internal (IResult(..), JSONPath, Result(..), Value(..))
import Data.Attoparsec.ByteString.Char8 (Parser, char, endOfInput, scientific, skipSpace, string)
import Data.Text (Text)
import Data.Vector as Vector (Vector, empty, fromListN, reverse)
import qualified Data.Attoparsec.ByteString as A
import qualified Data.Attoparsec.Lazy as L
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import qualified Data.HashMap.Strict as H
import Data.Aeson.Parser.Unescape
#if MIN_VERSION_ghc_prim(0,3,1)
import GHC.Base (Int#, (==#), isTrue#, word2Int#)
import GHC.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
json :: Parser Value
json = value
json' :: Parser Value
json' = value'
object_ :: Parser Value
object_ = Object <$> objectValues jstring value
object_' :: Parser Value
object_' = do
!vals <- objectValues jstring' value'
return (Object vals)
where
jstring' = do
!s <- jstring
return s
objectValues :: Parser Text -> Parser Value -> Parser (H.HashMap Text Value)
objectValues str val = do
skipSpace
w <- A.peekWord8'
if w == CLOSE_CURLY
then A.anyWord8 >> return H.empty
else loop []
where
loop acc = do
k <- str <* skipSpace <* char ':'
v <- val <* skipSpace
ch <- A.satisfy $ \w -> w == COMMA || w == CLOSE_CURLY
let acc' = (k, v) : acc
if ch == COMMA
then skipSpace >> loop acc'
else return (H.fromList acc')
array_ :: Parser Value
array_ = Array <$> arrayValues value
array_' :: Parser Value
array_' = do
!vals <- arrayValues value'
return (Array vals)
arrayValues :: Parser Value -> Parser (Vector Value)
arrayValues val = do
skipSpace
w <- A.peekWord8'
if w == CLOSE_SQUARE
then A.anyWord8 >> return Vector.empty
else loop [] 1
where
loop acc !len = do
v <- val <* skipSpace
ch <- A.satisfy $ \w -> w == COMMA || w == CLOSE_SQUARE
if ch == COMMA
then skipSpace >> loop (v:acc) (len+1)
else return (Vector.reverse (Vector.fromListN len (v:acc)))
value :: Parser Value
value = do
skipSpace
w <- A.peekWord8'
case w of
DOUBLE_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" *> pure Null
_ | w >= 48 && w <= 57 || w == 45
-> Number <$> scientific
| otherwise -> fail "not a valid json value"
value' :: Parser Value
value' = do
skipSpace
w <- A.peekWord8'
case w of
DOUBLE_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" *> pure Null
_ | w >= 48 && w <= 57 || w == 45
-> do
!n <- scientific
return (Number n)
| otherwise -> fail "not a valid json value"
jstring :: Parser Text
jstring = A.word8 DOUBLE_QUOTE *> jstring_
jstring_ :: Parser Text
jstring_ = do
s <- A.scan startState go <* A.anyWord8
case unescapeText s of
Right r -> return r
Left err -> fail $ show err
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
| otherwise = let a' = word2Int# c ==# 92#
in Just (S a')
data S = S Int#
#else
startState = False
go a c
| a = Just False
| c == DOUBLE_QUOTE = Nothing
| otherwise = let a' = c == backslash
in Just a'
where backslash = BACKSLASH
#endif
decodeWith :: Parser Value -> (Value -> Result a) -> L.ByteString -> Maybe a
decodeWith p to s =
case L.parse p s of
L.Done _ v -> case to v of
Success a -> Just a
_ -> Nothing
_ -> Nothing
decodeStrictWith :: Parser Value -> (Value -> Result a) -> B.ByteString
-> Maybe a
decodeStrictWith p to s =
case either Error to (A.parseOnly p s) of
Success a -> Just a
_ -> Nothing
eitherDecodeWith :: Parser Value -> (Value -> IResult a) -> L.ByteString
-> Either (JSONPath, String) a
eitherDecodeWith p to s =
case L.parse p s of
L.Done _ v -> case to v of
ISuccess a -> Right a
IError path msg -> Left (path, msg)
L.Fail _ _ msg -> Left ([], msg)
eitherDecodeStrictWith :: Parser Value -> (Value -> IResult a) -> B.ByteString
-> Either (JSONPath, String) a
eitherDecodeStrictWith p to s =
case either (IError []) to (A.parseOnly p s) of
ISuccess a -> Right a
IError path msg -> Left (path, msg)
jsonEOF :: Parser Value
jsonEOF = json <* skipSpace <* endOfInput
jsonEOF' :: Parser Value
jsonEOF' = json' <* skipSpace <* endOfInput