{-# 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 '�'