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