module Haddock.Utils.Json.Parser
( parseJSONValue
) where
import Control.Applicative (Alternative (..))
import Control.Monad (MonadPlus (..))
import qualified Data.ByteString.Lazy.Char8 as BSCL
import Data.Char (isHexDigit)
import Data.Functor (($>))
import qualified Data.List as List
import Numeric
import Text.Parsec.ByteString.Lazy (Parser)
import Text.ParserCombinators.Parsec ((<?>))
import qualified Text.ParserCombinators.Parsec as Parsec
import Prelude hiding (null)
import Haddock.Utils.Json.Types hiding (object)
parseJSONValue :: Parser Value
parseJSONValue :: Parser Value
parseJSONValue = ParsecT ByteString () Identity ()
forall s (m :: Type -> Type) u. Stream s m Char => ParsecT s u m ()
Parsec.spaces ParsecT ByteString () Identity () -> Parser Value -> Parser Value
forall a b.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
-> ParsecT ByteString () Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> Parser Value
parseValue
tok :: Parser a -> Parser a
tok :: forall a. Parser a -> Parser a
tok Parser a
p = Parser a
p Parser a -> ParsecT ByteString () Identity () -> Parser a
forall a b.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
-> ParsecT ByteString () Identity a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* ParsecT ByteString () Identity ()
forall s (m :: Type -> Type) u. Stream s m Char => ParsecT s u m ()
Parsec.spaces
parseValue :: Parser Value
parseValue :: Parser Value
parseValue =
Parser Value
parseNull
Parser Value -> Parser Value -> Parser Value
forall a.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> Bool -> Value
Bool
(Bool -> Value)
-> ParsecT ByteString () Identity Bool -> Parser Value
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString () Identity Bool
parseBoolean
Parser Value -> Parser Value -> Parser Value
forall a.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> [Value] -> Value
Array
([Value] -> Value)
-> ParsecT ByteString () Identity [Value] -> Parser Value
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString () Identity [Value]
parseArray
Parser Value -> Parser Value -> Parser Value
forall a.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> String -> Value
String
(String -> Value)
-> ParsecT ByteString () Identity String -> Parser Value
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString () Identity String
parseString
Parser Value -> Parser Value -> Parser Value
forall a.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> Object -> Value
Object
(Object -> Value)
-> ParsecT ByteString () Identity Object -> Parser Value
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString () Identity Object
parseObject
Parser Value -> Parser Value -> Parser Value
forall a.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> Double -> Value
Number
(Double -> Value)
-> ParsecT ByteString () Identity Double -> Parser Value
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString () Identity Double
parseNumber
Parser Value -> String -> Parser Value
forall s u (m :: Type -> Type) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"JSON value"
parseNull :: Parser Value
parseNull :: Parser Value
parseNull =
Parser Value -> Parser Value
forall a. Parser a -> Parser a
tok (Parser Value -> Parser Value) -> Parser Value -> Parser Value
forall a b. (a -> b) -> a -> b
$
String -> ParsecT ByteString () Identity String
forall s (m :: Type -> Type) u.
Stream s m Char =>
String -> ParsecT s u m String
Parsec.string String
"null"
ParsecT ByteString () Identity String -> Value -> Parser Value
forall (f :: Type -> Type) a b. Functor f => f a -> b -> f b
$> Value
Null
parseBoolean :: Parser Bool
parseBoolean :: ParsecT ByteString () Identity Bool
parseBoolean =
ParsecT ByteString () Identity Bool
-> ParsecT ByteString () Identity Bool
forall a. Parser a -> Parser a
tok (ParsecT ByteString () Identity Bool
-> ParsecT ByteString () Identity Bool)
-> ParsecT ByteString () Identity Bool
-> ParsecT ByteString () Identity Bool
forall a b. (a -> b) -> a -> b
$
String -> ParsecT ByteString () Identity String
forall s (m :: Type -> Type) u.
Stream s m Char =>
String -> ParsecT s u m String
Parsec.string String
"true"
ParsecT ByteString () Identity String
-> Bool -> ParsecT ByteString () Identity Bool
forall (f :: Type -> Type) a b. Functor f => f a -> b -> f b
$> Bool
True
ParsecT ByteString () Identity Bool
-> ParsecT ByteString () Identity Bool
-> ParsecT ByteString () Identity Bool
forall a.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> String -> ParsecT ByteString () Identity String
forall s (m :: Type -> Type) u.
Stream s m Char =>
String -> ParsecT s u m String
Parsec.string String
"false"
ParsecT ByteString () Identity String
-> Bool -> ParsecT ByteString () Identity Bool
forall (f :: Type -> Type) a b. Functor f => f a -> b -> f b
$> Bool
False
parseArray :: Parser [Value]
parseArray :: ParsecT ByteString () Identity [Value]
parseArray =
ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity [Value]
-> ParsecT ByteString () Identity [Value]
forall s (m :: Type -> Type) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
Parsec.between
(ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
forall a. Parser a -> Parser a
tok (Char -> ParsecT ByteString () Identity Char
forall s (m :: Type -> Type) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'['))
(ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
forall a. Parser a -> Parser a
tok (Char -> ParsecT ByteString () Identity Char
forall s (m :: Type -> Type) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
']'))
(Parser Value
parseValue Parser Value
-> ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity [Value]
forall s (m :: Type -> Type) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`Parsec.sepBy` ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
forall a. Parser a -> Parser a
tok (Char -> ParsecT ByteString () Identity Char
forall s (m :: Type -> Type) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
','))
parseString :: Parser String
parseString :: ParsecT ByteString () Identity String
parseString =
ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity String
-> ParsecT ByteString () Identity String
forall s (m :: Type -> Type) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
Parsec.between
(ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
forall a. Parser a -> Parser a
tok (Char -> ParsecT ByteString () Identity Char
forall s (m :: Type -> Type) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'"'))
(ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
forall a. Parser a -> Parser a
tok (Char -> ParsecT ByteString () Identity Char
forall s (m :: Type -> Type) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'"'))
(ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity String
forall a.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity [a]
forall (f :: Type -> Type) a. Alternative f => f a -> f [a]
many ParsecT ByteString () Identity Char
char)
where
char :: ParsecT ByteString () Identity Char
char =
(Char -> ParsecT ByteString () Identity Char
forall s (m :: Type -> Type) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'\\' ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
forall a b.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
-> ParsecT ByteString () Identity b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> ParsecT ByteString () Identity Char
escapedChar)
ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
forall a.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool) -> ParsecT ByteString () Identity Char
forall s (m :: Type -> Type) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
Parsec.satisfy (\Char
x -> Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\\')
escapedChar :: ParsecT ByteString () Identity Char
escapedChar =
Char -> ParsecT ByteString () Identity Char
forall s (m :: Type -> Type) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'"'
ParsecT ByteString () Identity Char
-> Char -> ParsecT ByteString () Identity Char
forall (f :: Type -> Type) a b. Functor f => f a -> b -> f b
$> Char
'"'
ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
forall a.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT ByteString () Identity Char
forall s (m :: Type -> Type) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'\\'
ParsecT ByteString () Identity Char
-> Char -> ParsecT ByteString () Identity Char
forall (f :: Type -> Type) a b. Functor f => f a -> b -> f b
$> Char
'\\'
ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
forall a.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT ByteString () Identity Char
forall s (m :: Type -> Type) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'/'
ParsecT ByteString () Identity Char
-> Char -> ParsecT ByteString () Identity Char
forall (f :: Type -> Type) a b. Functor f => f a -> b -> f b
$> Char
'/'
ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
forall a.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT ByteString () Identity Char
forall s (m :: Type -> Type) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'b'
ParsecT ByteString () Identity Char
-> Char -> ParsecT ByteString () Identity Char
forall (f :: Type -> Type) a b. Functor f => f a -> b -> f b
$> Char
'\b'
ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
forall a.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT ByteString () Identity Char
forall s (m :: Type -> Type) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'f'
ParsecT ByteString () Identity Char
-> Char -> ParsecT ByteString () Identity Char
forall (f :: Type -> Type) a b. Functor f => f a -> b -> f b
$> Char
'\f'
ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
forall a.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT ByteString () Identity Char
forall s (m :: Type -> Type) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'n'
ParsecT ByteString () Identity Char
-> Char -> ParsecT ByteString () Identity Char
forall (f :: Type -> Type) a b. Functor f => f a -> b -> f b
$> Char
'\n'
ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
forall a.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT ByteString () Identity Char
forall s (m :: Type -> Type) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'r'
ParsecT ByteString () Identity Char
-> Char -> ParsecT ByteString () Identity Char
forall (f :: Type -> Type) a b. Functor f => f a -> b -> f b
$> Char
'\r'
ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
forall a.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT ByteString () Identity Char
forall s (m :: Type -> Type) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
't'
ParsecT ByteString () Identity Char
-> Char -> ParsecT ByteString () Identity Char
forall (f :: Type -> Type) a b. Functor f => f a -> b -> f b
$> Char
'\t'
ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
forall a.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT ByteString () Identity Char
forall s (m :: Type -> Type) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'u'
ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
forall a b.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
-> ParsecT ByteString () Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> ParsecT ByteString () Identity Char
uni
ParsecT ByteString () Identity Char
-> String -> ParsecT ByteString () Identity Char
forall s u (m :: Type -> Type) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"escape character"
uni :: ParsecT ByteString () Identity Char
uni = String -> ParsecT ByteString () Identity Char
forall a. Enum a => String -> Parser a
check (String -> ParsecT ByteString () Identity Char)
-> ParsecT ByteString () Identity String
-> ParsecT ByteString () Identity Char
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int
-> ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity String
forall s (m :: Type -> Type) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
Parsec.count Int
4 ((Char -> Bool) -> ParsecT ByteString () Identity Char
forall s (m :: Type -> Type) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
Parsec.satisfy Char -> Bool
isHexDigit)
where
check :: Enum a => String -> Parser a
check :: forall a. Enum a => String -> Parser a
check String
x = do
code <- String -> Parser Int
parseHex String
x
if code <= max_char
then pure (toEnum code)
else mzero
parseHex :: String -> Parser Int
parseHex :: String -> Parser Int
parseHex String
c =
case [(Int, String)] -> Maybe ((Int, String), [(Int, String)])
forall a. [a] -> Maybe (a, [a])
List.uncons (ReadS Int
forall a. (Eq a, Num a) => ReadS a
readHex String
c) of
Maybe ((Int, String), [(Int, String)])
Nothing -> Parser Int
forall a. ParsecT ByteString () Identity a
forall (m :: Type -> Type) a. MonadPlus m => m a
mzero
Just ((Int, String)
result, [(Int, String)]
_) -> Int -> Parser Int
forall a. a -> ParsecT ByteString () Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Int -> Parser Int) -> Int -> Parser Int
forall a b. (a -> b) -> a -> b
$ (Int, String) -> Int
forall a b. (a, b) -> a
fst (Int, String)
result
max_char :: Int
max_char :: Int
max_char = Char -> Int
forall a. Enum a => a -> Int
fromEnum (Char
forall a. Bounded a => a
maxBound :: Char)
parseObject :: Parser Object
parseObject :: ParsecT ByteString () Identity Object
parseObject =
ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Object
-> ParsecT ByteString () Identity Object
forall s (m :: Type -> Type) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
Parsec.between
(ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
forall a. Parser a -> Parser a
tok (Char -> ParsecT ByteString () Identity Char
forall s (m :: Type -> Type) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'{'))
(ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
forall a. Parser a -> Parser a
tok (Char -> ParsecT ByteString () Identity Char
forall s (m :: Type -> Type) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'}'))
(Parser (String, Value)
field Parser (String, Value)
-> ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Object
forall s (m :: Type -> Type) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`Parsec.sepBy` ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
forall a. Parser a -> Parser a
tok (Char -> ParsecT ByteString () Identity Char
forall s (m :: Type -> Type) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
','))
where
field :: Parser (String, Value)
field :: Parser (String, Value)
field =
(,)
(String -> Value -> (String, Value))
-> ParsecT ByteString () Identity String
-> ParsecT ByteString () Identity (Value -> (String, Value))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString () Identity String
parseString
ParsecT ByteString () Identity (Value -> (String, Value))
-> ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity (Value -> (String, Value))
forall a b.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
-> ParsecT ByteString () Identity a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
forall a. Parser a -> Parser a
tok (Char -> ParsecT ByteString () Identity Char
forall s (m :: Type -> Type) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
':')
ParsecT ByteString () Identity (Value -> (String, Value))
-> Parser Value -> Parser (String, Value)
forall a b.
ParsecT ByteString () Identity (a -> b)
-> ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Parser Value
parseValue
parseNumber :: Parser Double
parseNumber :: ParsecT ByteString () Identity Double
parseNumber = ParsecT ByteString () Identity Double
-> ParsecT ByteString () Identity Double
forall a. Parser a -> Parser a
tok (ParsecT ByteString () Identity Double
-> ParsecT ByteString () Identity Double)
-> ParsecT ByteString () Identity Double
-> ParsecT ByteString () Identity Double
forall a b. (a -> b) -> a -> b
$ do
s <- ByteString -> String
BSCL.unpack (ByteString -> String)
-> ParsecT ByteString () Identity ByteString
-> ParsecT ByteString () Identity String
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString () Identity ByteString
forall (m :: Type -> Type) s u. Monad m => ParsecT s u m s
Parsec.getInput
case readSigned readFloat s of
[(Double
n, String
s')] -> ByteString -> ParsecT ByteString () Identity ()
forall (m :: Type -> Type) s u. Monad m => s -> ParsecT s u m ()
Parsec.setInput (String -> ByteString
BSCL.pack String
s') ParsecT ByteString () Identity ()
-> Double -> ParsecT ByteString () Identity Double
forall (f :: Type -> Type) a b. Functor f => f a -> b -> f b
$> Double
n
[(Double, String)]
_ -> ParsecT ByteString () Identity Double
forall a. ParsecT ByteString () Identity a
forall (m :: Type -> Type) a. MonadPlus m => m a
mzero