{-# 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 <- forall t e. Parser t e => (Char -> Bool) -> Parser t Char
satisfyChar (\Char
c -> Char
'0' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'9')
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
c 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 <- forall t e. Parser t e => (Char -> Bool) -> Parser t Char
satisfyChar (\Char
c -> Char
'a' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'z')
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
c forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'a' 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 <- forall t e. Parser t e => (Char -> Bool) -> Parser t Char
satisfyChar (\Char
c -> Char
'A' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'Z')
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
c forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'A' 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 = forall t u. Parser t u => Parser t Int
parseHexDigitNumeric forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall t u. Parser t u => Parser t Int
parseHexDigitAlphaLower forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 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
_ <- forall t e. Parser t e => t -> Parser t t
string t
"\""
  String
value <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser t Char
verbatimChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser t Char
escapedChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser t Char
escapedCode)
  t
_ <- forall t e. Parser t e => t -> Parser t t
string t
"\""
  forall (m :: * -> *) a. Monad m => a -> m a
return String
value
  where
    verbatimChar :: Parser t Char
verbatimChar  = forall t e. Parser t e => (Char -> Bool) -> Parser t Char
satisfyChar (String -> Char -> Bool
ABC.notInClass String
"\"\\") forall t e. Parser t e => Parser t Char -> String -> Parser t Char
<?> String
"invalid string character"
    escapedChar :: Parser t Char
escapedChar   = do
      t
_ <- forall t e. Parser t e => t -> Parser t t
string t
"\\"
      (   forall t e. Parser t e => Char -> Parser t Char
char Char
'"'  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'"'  ) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        ( forall t e. Parser t e => Char -> Parser t Char
char Char
'b'  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\b' ) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        ( forall t e. Parser t e => Char -> Parser t Char
char Char
'n'  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\n' ) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        ( forall t e. Parser t e => Char -> Parser t Char
char Char
'f'  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\f' ) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        ( forall t e. Parser t e => Char -> Parser t Char
char Char
'r'  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\r' ) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        ( forall t e. Parser t e => Char -> Parser t Char
char Char
't'  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\t' ) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        ( forall t e. Parser t e => Char -> Parser t Char
char Char
'\\' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\\' ) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        ( forall t e. Parser t e => Char -> Parser t Char
char Char
'\'' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\'' ) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        ( forall t e. Parser t e => Char -> Parser t Char
char Char
'/'  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'/'  )
    escapedCode :: Parser t Char
escapedCode   = do
      t
_ <- forall t e. Parser t e => t -> Parser t t
string t
"\\u"
      Int
a <- forall t u. Parser t u => Parser t Int
parseHexDigit
      Int
b <- forall t u. Parser t u => Parser t Int
parseHexDigit
      Int
c <- forall t u. Parser t u => Parser t Int
parseHexDigit
      Int
d <- forall t u. Parser t u => Parser t Int
parseHexDigit
      let res :: Int
res =  Int
a forall a. Bits a => a -> Int -> a
`shift` Int
12 forall a. Bits a => a -> a -> a
.|. Int
b forall a. Bits a => a -> Int -> a
`shift` Int
8 forall a. Bits a => a -> a -> a
.|. Int
c forall a. Bits a => a -> Int -> a
`shift` Int
4 forall a. Bits a => a -> a -> a
.|. Int
d
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Int
res forall a. Ord a => a -> a -> Bool
<= Int
0x10FFFF
                then Int -> Char
chr Int
res
                else Char
'�'