{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}

module HaskellWorks.Data.Json.Internal.Value where

import Control.Applicative
import Data.Bits
import Data.Char
import Data.String
import HaskellWorks.Data.Parser as P

import qualified Data.Attoparsec.ByteString.Char8 as ABC
import qualified Data.Attoparsec.Types            as T

parseHexDigitNumeric :: P.Parser t u => T.Parser t Int
parseHexDigitNumeric :: forall t u. Parser t u => Parser t Int
parseHexDigitNumeric = do
  Char
c <- (Char -> Bool) -> Parser t Char
forall t e. Parser t e => (Char -> Bool) -> Parser t Char
satisfyChar (\Char
c -> Char
'0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9')
  Int -> Parser t Int
forall a. a -> Parser t a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Parser t Int) -> Int -> Parser t Int
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0'

parseHexDigitAlphaLower :: P.Parser t u => T.Parser t Int
parseHexDigitAlphaLower :: forall t u. Parser t u => Parser t Int
parseHexDigitAlphaLower = do
  Char
c <- (Char -> Bool) -> Parser t Char
forall t e. Parser t e => (Char -> Bool) -> Parser t Char
satisfyChar (\Char
c -> Char
'a' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z')
  Int -> Parser t Int
forall a. a -> Parser t a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Parser t Int) -> Int -> Parser t Int
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'a' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10

parseHexDigitAlphaUpper :: P.Parser t u => T.Parser t Int
parseHexDigitAlphaUpper :: forall t u. Parser t u => Parser t Int
parseHexDigitAlphaUpper = do
  Char
c <- (Char -> Bool) -> Parser t Char
forall t e. Parser t e => (Char -> Bool) -> Parser t Char
satisfyChar (\Char
c -> Char
'A' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z')
  Int -> Parser t Int
forall a. a -> Parser t a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Parser t Int) -> Int -> Parser t Int
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'A' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10

parseHexDigit :: P.Parser t u => T.Parser t Int
parseHexDigit :: forall t u. Parser t u => Parser t Int
parseHexDigit = Parser t Int
forall t u. Parser t u => Parser t Int
parseHexDigitNumeric Parser t Int -> Parser t Int -> Parser t Int
forall a. Parser t a -> Parser t a -> Parser t a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser t Int
forall t u. Parser t u => Parser t Int
parseHexDigitAlphaLower Parser t Int -> Parser t Int -> Parser t Int
forall a. Parser t a -> Parser t a -> Parser t a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser t Int
forall t u. Parser t u => Parser t Int
parseHexDigitAlphaUpper

parseJsonString :: (P.Parser t u, IsString t) => T.Parser t String
parseJsonString :: forall t u. (Parser t u, IsString t) => Parser t String
parseJsonString = do
  t
_ <- t -> Parser t t
forall t e. Parser t e => t -> Parser t t
string t
"\""
  String
value <- Parser t Char -> Parser t String
forall a. Parser t a -> Parser t [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser t Char
verbatimChar Parser t Char -> Parser t Char -> Parser t Char
forall a. Parser t a -> Parser t a -> Parser t a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser t Char
escapedChar Parser t Char -> Parser t Char -> Parser t Char
forall a. Parser t a -> Parser t a -> Parser t a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser t Char
escapedCode)
  t
_ <- t -> Parser t t
forall t e. Parser t e => t -> Parser t t
string t
"\""
  String -> Parser t String
forall a. a -> Parser t a
forall (m :: * -> *) a. Monad m => a -> m a
return String
value
  where
    verbatimChar :: Parser t Char
verbatimChar  = (Char -> Bool) -> Parser t Char
forall t e. Parser t e => (Char -> Bool) -> Parser t Char
satisfyChar (String -> Char -> Bool
ABC.notInClass String
"\"\\") Parser t Char -> String -> Parser t Char
forall t e. Parser t e => Parser t Char -> String -> Parser t Char
<?> String
"invalid string character"
    escapedChar :: Parser t Char
escapedChar   = do
      t
_ <- t -> Parser t t
forall t e. Parser t e => t -> Parser t t
string t
"\\"
      (   Char -> Parser t Char
forall t e. Parser t e => Char -> Parser t Char
char Char
'"'  Parser t Char -> Parser t Char -> Parser t Char
forall a b. Parser t a -> Parser t b -> Parser t b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Parser t Char
forall a. a -> Parser t a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'"'  ) Parser t Char -> Parser t Char -> Parser t Char
forall a. Parser t a -> Parser t a -> Parser t a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        ( Char -> Parser t Char
forall t e. Parser t e => Char -> Parser t Char
char Char
'b'  Parser t Char -> Parser t Char -> Parser t Char
forall a b. Parser t a -> Parser t b -> Parser t b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Parser t Char
forall a. a -> Parser t a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\b' ) Parser t Char -> Parser t Char -> Parser t Char
forall a. Parser t a -> Parser t a -> Parser t a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        ( Char -> Parser t Char
forall t e. Parser t e => Char -> Parser t Char
char Char
'n'  Parser t Char -> Parser t Char -> Parser t Char
forall a b. Parser t a -> Parser t b -> Parser t b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Parser t Char
forall a. a -> Parser t a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\n' ) Parser t Char -> Parser t Char -> Parser t Char
forall a. Parser t a -> Parser t a -> Parser t a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        ( Char -> Parser t Char
forall t e. Parser t e => Char -> Parser t Char
char Char
'f'  Parser t Char -> Parser t Char -> Parser t Char
forall a b. Parser t a -> Parser t b -> Parser t b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Parser t Char
forall a. a -> Parser t a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\f' ) Parser t Char -> Parser t Char -> Parser t Char
forall a. Parser t a -> Parser t a -> Parser t a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        ( Char -> Parser t Char
forall t e. Parser t e => Char -> Parser t Char
char Char
'r'  Parser t Char -> Parser t Char -> Parser t Char
forall a b. Parser t a -> Parser t b -> Parser t b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Parser t Char
forall a. a -> Parser t a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\r' ) Parser t Char -> Parser t Char -> Parser t Char
forall a. Parser t a -> Parser t a -> Parser t a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        ( Char -> Parser t Char
forall t e. Parser t e => Char -> Parser t Char
char Char
't'  Parser t Char -> Parser t Char -> Parser t Char
forall a b. Parser t a -> Parser t b -> Parser t b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Parser t Char
forall a. a -> Parser t a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\t' ) Parser t Char -> Parser t Char -> Parser t Char
forall a. Parser t a -> Parser t a -> Parser t a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        ( Char -> Parser t Char
forall t e. Parser t e => Char -> Parser t Char
char Char
'\\' Parser t Char -> Parser t Char -> Parser t Char
forall a b. Parser t a -> Parser t b -> Parser t b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Parser t Char
forall a. a -> Parser t a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\\' ) Parser t Char -> Parser t Char -> Parser t Char
forall a. Parser t a -> Parser t a -> Parser t a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        ( Char -> Parser t Char
forall t e. Parser t e => Char -> Parser t Char
char Char
'\'' Parser t Char -> Parser t Char -> Parser t Char
forall a b. Parser t a -> Parser t b -> Parser t b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Parser t Char
forall a. a -> Parser t a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\'' ) Parser t Char -> Parser t Char -> Parser t Char
forall a. Parser t a -> Parser t a -> Parser t a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        ( Char -> Parser t Char
forall t e. Parser t e => Char -> Parser t Char
char Char
'/'  Parser t Char -> Parser t Char -> Parser t Char
forall a b. Parser t a -> Parser t b -> Parser t b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Parser t Char
forall a. a -> Parser t a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'/'  )
    escapedCode :: Parser t Char
escapedCode   = do
      t
_ <- t -> Parser t t
forall t e. Parser t e => t -> Parser t t
string t
"\\u"
      Int
a <- Parser t Int
forall t u. Parser t u => Parser t Int
parseHexDigit
      Int
b <- Parser t Int
forall t u. Parser t u => Parser t Int
parseHexDigit
      Int
c <- Parser t Int
forall t u. Parser t u => Parser t Int
parseHexDigit
      Int
d <- Parser t Int
forall t u. Parser t u => Parser t Int
parseHexDigit
      let res :: Int
res =  Int
a Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shift` Int
12 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
b Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shift` Int
8 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
c Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shift` Int
4 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
d
      Char -> Parser t Char
forall a. a -> Parser t a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Parser t Char) -> Char -> Parser t Char
forall a b. (a -> b) -> a -> b
$ if Int
res Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x10FFFF
                then Int -> Char
chr Int
res
                else Char
'�'