-- | Json "Parsec" parser, based on
-- [json](https://hackage.haskell.org/package/json) package.
--
module Haddock.Utils.Json.Parser
  ( parseJSONValue
  ) where

import Prelude hiding (null)

import Control.Applicative (Alternative (..))
import Control.Monad (MonadPlus (..))
import Data.Char (isHexDigit)
import Data.Functor (($>))
import qualified Data.ByteString.Lazy.Char8 as BSCL
import Numeric
import Text.Parsec.ByteString.Lazy (Parser)
import Text.ParserCombinators.Parsec ((<?>))
import qualified Text.ParserCombinators.Parsec as Parsec

import Haddock.Utils.Json.Types hiding (object)

parseJSONValue :: Parser Value
parseJSONValue :: Parser Value
parseJSONValue = ParsecT ByteString () Identity ()
forall s (m :: * -> *) 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 :: * -> *) 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 :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT ByteString () Identity ()
forall s (m :: * -> *) 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 :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Value
Bool   (Bool -> Value)
-> ParsecT ByteString () Identity Bool -> Parser Value
forall (f :: * -> *) 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 :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Value] -> Value
Array  ([Value] -> Value)
-> ParsecT ByteString () Identity [Value] -> Parser Value
forall (f :: * -> *) 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 :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Value
String (String -> Value)
-> ParsecT ByteString () Identity String -> Parser Value
forall (f :: * -> *) 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 :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object -> Value
Object (Object -> Value)
-> ParsecT ByteString () Identity Object -> Parser Value
forall (f :: * -> *) 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 :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Double -> Value
Number (Double -> Value)
-> ParsecT ByteString () Identity Double -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString () Identity Double
parseNumber
     Parser Value -> String -> Parser Value
forall s u (m :: * -> *) 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 :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
Parsec.string String
"null"
     ParsecT ByteString () Identity String -> Value -> Parser Value
forall (f :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ParsecT ByteString () Identity String
forall s (m :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT ByteString () Identity Char
forall {u}. ParsecT ByteString u Identity Char
char)
  where
    char :: ParsecT ByteString u Identity Char
char = (Char -> ParsecT ByteString u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'\\' ParsecT ByteString u Identity Char
-> ParsecT ByteString u Identity Char
-> ParsecT ByteString u Identity Char
forall a b.
ParsecT ByteString u Identity a
-> ParsecT ByteString u Identity b
-> ParsecT ByteString u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT ByteString u Identity Char
forall {u}. ParsecT ByteString u Identity Char
escapedChar)
       ParsecT ByteString u Identity Char
-> ParsecT ByteString u Identity Char
-> ParsecT ByteString u Identity Char
forall a.
ParsecT ByteString u Identity a
-> ParsecT ByteString u Identity a
-> ParsecT ByteString u Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool) -> ParsecT ByteString u Identity Char
forall s (m :: * -> *) 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 u Identity Char
escapedChar =
          Char -> ParsecT ByteString u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'"'  ParsecT ByteString u Identity Char
-> Char -> ParsecT ByteString u Identity Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'"'
      ParsecT ByteString u Identity Char
-> ParsecT ByteString u Identity Char
-> ParsecT ByteString u Identity Char
forall a.
ParsecT ByteString u Identity a
-> ParsecT ByteString u Identity a
-> ParsecT ByteString u Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT ByteString u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'\\' ParsecT ByteString u Identity Char
-> Char -> ParsecT ByteString u Identity Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\\'
      ParsecT ByteString u Identity Char
-> ParsecT ByteString u Identity Char
-> ParsecT ByteString u Identity Char
forall a.
ParsecT ByteString u Identity a
-> ParsecT ByteString u Identity a
-> ParsecT ByteString u Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT ByteString u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'/'  ParsecT ByteString u Identity Char
-> Char -> ParsecT ByteString u Identity Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'/'
      ParsecT ByteString u Identity Char
-> ParsecT ByteString u Identity Char
-> ParsecT ByteString u Identity Char
forall a.
ParsecT ByteString u Identity a
-> ParsecT ByteString u Identity a
-> ParsecT ByteString u Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT ByteString u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'b'  ParsecT ByteString u Identity Char
-> Char -> ParsecT ByteString u Identity Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\b'
      ParsecT ByteString u Identity Char
-> ParsecT ByteString u Identity Char
-> ParsecT ByteString u Identity Char
forall a.
ParsecT ByteString u Identity a
-> ParsecT ByteString u Identity a
-> ParsecT ByteString u Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT ByteString u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'f'  ParsecT ByteString u Identity Char
-> Char -> ParsecT ByteString u Identity Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\f'
      ParsecT ByteString u Identity Char
-> ParsecT ByteString u Identity Char
-> ParsecT ByteString u Identity Char
forall a.
ParsecT ByteString u Identity a
-> ParsecT ByteString u Identity a
-> ParsecT ByteString u Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT ByteString u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'n'  ParsecT ByteString u Identity Char
-> Char -> ParsecT ByteString u Identity Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\n'
      ParsecT ByteString u Identity Char
-> ParsecT ByteString u Identity Char
-> ParsecT ByteString u Identity Char
forall a.
ParsecT ByteString u Identity a
-> ParsecT ByteString u Identity a
-> ParsecT ByteString u Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT ByteString u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'r'  ParsecT ByteString u Identity Char
-> Char -> ParsecT ByteString u Identity Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\r'
      ParsecT ByteString u Identity Char
-> ParsecT ByteString u Identity Char
-> ParsecT ByteString u Identity Char
forall a.
ParsecT ByteString u Identity a
-> ParsecT ByteString u Identity a
-> ParsecT ByteString u Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT ByteString u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
't'  ParsecT ByteString u Identity Char
-> Char -> ParsecT ByteString u Identity Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\t'
      ParsecT ByteString u Identity Char
-> ParsecT ByteString u Identity Char
-> ParsecT ByteString u Identity Char
forall a.
ParsecT ByteString u Identity a
-> ParsecT ByteString u Identity a
-> ParsecT ByteString u Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT ByteString u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Parsec.char Char
'u'  ParsecT ByteString u Identity Char
-> ParsecT ByteString u Identity Char
-> ParsecT ByteString u Identity Char
forall a b.
ParsecT ByteString u Identity a
-> ParsecT ByteString u Identity b
-> ParsecT ByteString u Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT ByteString u Identity Char
forall {u}. ParsecT ByteString u Identity Char
uni
      ParsecT ByteString u Identity Char
-> String -> ParsecT ByteString u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"escape character"

    uni :: ParsecT ByteString u Identity Char
uni = String -> ParsecT ByteString u Identity Char
forall {m :: * -> *} {a}. (Enum a, MonadPlus m) => String -> m a
check (String -> ParsecT ByteString u Identity Char)
-> ParsecT ByteString u Identity String
-> ParsecT ByteString u Identity Char
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int
-> ParsecT ByteString u Identity Char
-> ParsecT ByteString u Identity String
forall s (m :: * -> *) 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 u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
Parsec.satisfy Char -> Bool
isHexDigit)
      where
        check :: String -> m a
check String
x | Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
max_char = a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> a
forall a. Enum a => Int -> a
toEnum Int
code)
                | Bool
otherwise        = m a
forall a. m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
          where code :: Int
code      = (Int, String) -> Int
forall a b. (a, b) -> a
fst ((Int, String) -> Int) -> (Int, String) -> Int
forall a b. (a -> b) -> a -> b
$ [(Int, String)] -> (Int, String)
forall a. HasCallStack => [a] -> a
head ([(Int, String)] -> (Int, String))
-> [(Int, String)] -> (Int, String)
forall a b. (a -> b) -> a -> b
$ ReadS Int
forall a. (Eq a, Num a) => ReadS a
readHex String
x
                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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString () Identity ByteString
forall (m :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) a. MonadPlus m => m a
mzero