module Data.JSON.QQ (JsonValue (..), HashKey (..), parsedJson) where

import           Control.Applicative
import           Language.Haskell.TH
import           Text.ParserCombinators.Parsec hiding (many, (<|>))
import           Language.Haskell.Meta.Parse
import qualified Data.Attoparsec.Text as A
import           Data.Scientific (Scientific)
import qualified Data.Text as T

parsedJson :: String -> Either ParseError JsonValue
parsedJson :: String -> Either ParseError JsonValue
parsedJson = Parsec String () JsonValue
-> String -> String -> Either ParseError JsonValue
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (Parsec String () JsonValue
jpValue Parsec String () JsonValue
-> ParsecT String () Identity () -> Parsec String () JsonValue
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof) String
"txt"

-------
-- Internal representation

data JsonValue =
    JsonNull
  | JsonString String
  | JsonNumber Scientific
  | JsonObject [(HashKey,JsonValue)]
  | JsonArray [JsonValue]
  | JsonBool Bool
  | JsonCode Exp
  deriving (JsonValue -> JsonValue -> Bool
(JsonValue -> JsonValue -> Bool)
-> (JsonValue -> JsonValue -> Bool) -> Eq JsonValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JsonValue -> JsonValue -> Bool
$c/= :: JsonValue -> JsonValue -> Bool
== :: JsonValue -> JsonValue -> Bool
$c== :: JsonValue -> JsonValue -> Bool
Eq, Int -> JsonValue -> ShowS
[JsonValue] -> ShowS
JsonValue -> String
(Int -> JsonValue -> ShowS)
-> (JsonValue -> String)
-> ([JsonValue] -> ShowS)
-> Show JsonValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JsonValue] -> ShowS
$cshowList :: [JsonValue] -> ShowS
show :: JsonValue -> String
$cshow :: JsonValue -> String
showsPrec :: Int -> JsonValue -> ShowS
$cshowsPrec :: Int -> JsonValue -> ShowS
Show)

data HashKey =
    HashVarKey String
  | HashStringKey String
  deriving (HashKey -> HashKey -> Bool
(HashKey -> HashKey -> Bool)
-> (HashKey -> HashKey -> Bool) -> Eq HashKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HashKey -> HashKey -> Bool
$c/= :: HashKey -> HashKey -> Bool
== :: HashKey -> HashKey -> Bool
$c== :: HashKey -> HashKey -> Bool
Eq, Int -> HashKey -> ShowS
[HashKey] -> ShowS
HashKey -> String
(Int -> HashKey -> ShowS)
-> (HashKey -> String) -> ([HashKey] -> ShowS) -> Show HashKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HashKey] -> ShowS
$cshowList :: [HashKey] -> ShowS
show :: HashKey -> String
$cshow :: HashKey -> String
showsPrec :: Int -> HashKey -> ShowS
$cshowsPrec :: Int -> HashKey -> ShowS
Show)

type JsonParser = Parser JsonValue

jpValue :: JsonParser
jpValue :: Parsec String () JsonValue
jpValue = do
  ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  JsonValue
res <- Parsec String () JsonValue
jpBool Parsec String () JsonValue
-> Parsec String () JsonValue -> Parsec String () JsonValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec String () JsonValue
jpNull Parsec String () JsonValue
-> Parsec String () JsonValue -> Parsec String () JsonValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec String () JsonValue
jpString Parsec String () JsonValue
-> Parsec String () JsonValue -> Parsec String () JsonValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec String () JsonValue
jpObject Parsec String () JsonValue
-> Parsec String () JsonValue -> Parsec String () JsonValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec String () JsonValue
jpNumber  Parsec String () JsonValue
-> Parsec String () JsonValue -> Parsec String () JsonValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec String () JsonValue
jpArray Parsec String () JsonValue
-> Parsec String () JsonValue -> Parsec String () JsonValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec String () JsonValue
jpCode
  ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  JsonValue -> Parsec String () JsonValue
forall (m :: * -> *) a. Monad m => a -> m a
return JsonValue
res

jpBool :: JsonParser
jpBool :: Parsec String () JsonValue
jpBool = Bool -> JsonValue
JsonBool (Bool -> JsonValue)
-> ParsecT String () Identity Bool -> Parsec String () JsonValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"true" ParsecT String () Identity String
-> ParsecT String () Identity Bool
-> ParsecT String () Identity Bool
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> ParsecT String () Identity Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True ParsecT String () Identity Bool
-> ParsecT String () Identity Bool
-> ParsecT String () Identity Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"false" ParsecT String () Identity String
-> ParsecT String () Identity Bool
-> ParsecT String () Identity Bool
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> ParsecT String () Identity Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)

jpCode :: JsonParser
jpCode :: Parsec String () JsonValue
jpCode = Exp -> JsonValue
JsonCode (Exp -> JsonValue)
-> ParsecT String () Identity Exp -> Parsec String () JsonValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"#{" ParsecT String () Identity String
-> ParsecT String () Identity Exp -> ParsecT String () Identity Exp
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String () Identity Exp
forall u. ParsecT String u Identity Exp
parseExp')
  where
    parseExp' :: ParsecT String u Identity Exp
parseExp' = do
      String
str <- ParsecT String u Identity Char -> ParsecT String u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"}") ParsecT String u Identity String
-> ParsecT String u Identity Char
-> ParsecT String u Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}'
      case (String -> Either String Exp
parseExp String
str) of
        Left String
l -> String -> ParsecT String u Identity Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
l
        Right Exp
r -> Exp -> ParsecT String u Identity Exp
forall (m :: * -> *) a. Monad m => a -> m a
return Exp
r

jpNull :: JsonParser
jpNull :: Parsec String () JsonValue
jpNull = String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"null" ParsecT String () Identity String
-> Parsec String () JsonValue -> Parsec String () JsonValue
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> JsonValue -> Parsec String () JsonValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure JsonValue
JsonNull

jpString :: JsonParser
jpString :: Parsec String () JsonValue
jpString = ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity [String]
-> ParsecT String () 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
between (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"') (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"') ([String]
-> ParsecT String () Identity [String]
-> ParsecT String () Identity [String]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [String
""] (ParsecT String () Identity [String]
 -> ParsecT String () Identity [String])
-> ParsecT String () Identity [String]
-> ParsecT String () Identity [String]
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity String
-> ParsecT String () Identity [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT String () Identity String
chars) ParsecT String () Identity [String]
-> ([String] -> Parsec String () JsonValue)
-> Parsec String () JsonValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JsonValue -> Parsec String () JsonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (JsonValue -> Parsec String () JsonValue)
-> ([String] -> JsonValue)
-> [String]
-> Parsec String () JsonValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> JsonValue
JsonString (String -> JsonValue)
-> ([String] -> String) -> [String] -> JsonValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat -- do

jpNumber :: JsonParser
jpNumber :: Parsec String () JsonValue
jpNumber = Scientific -> JsonValue
JsonNumber (Scientific -> JsonValue)
-> ParsecT String () Identity Scientific
-> Parsec String () JsonValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
  String
isMinus <- String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"-")
  String
d <- ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
  String
o <- String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" ParsecT String () Identity String
forall u. ParsecT String u Identity String
withDot
  String
e <- String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" ParsecT String () Identity String
forall u. ParsecT String u Identity String
withE
  String -> ParsecT String () Identity Scientific
convert (String
isMinus String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
o String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e)
  where
    withE :: ParsecT String u Identity String
withE = do
      Char
e <- Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'e' ParsecT String u Identity Char
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'E'
      String
plusMinus <- String
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" (String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"+" ParsecT String u Identity String
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"-")
      String
d <- ParsecT String u Identity Char -> ParsecT String u Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
      String -> ParsecT String u Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT String u Identity String)
-> String -> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ Char
e Char -> ShowS
forall a. a -> [a] -> [a]
: String
plusMinus String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
d

    withDot :: ParsecT String u Identity String
withDot = do
      Char
o <- Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
      String
d <- ParsecT String u Identity Char -> ParsecT String u Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
      String -> ParsecT String u Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT String u Identity String)
-> String -> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ Char
oChar -> ShowS
forall a. a -> [a] -> [a]
:String
d

    convert :: String -> Parser Scientific
    convert :: String -> ParsecT String () Identity Scientific
convert = (String -> ParsecT String () Identity Scientific)
-> (Scientific -> ParsecT String () Identity Scientific)
-> Either String Scientific
-> ParsecT String () Identity Scientific
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> ParsecT String () Identity Scientific
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Scientific -> ParsecT String () Identity Scientific
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Scientific -> ParsecT String () Identity Scientific)
-> (String -> Either String Scientific)
-> String
-> ParsecT String () Identity Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Scientific -> Text -> Either String Scientific
forall a. Parser a -> Text -> Either String a
A.parseOnly (Parser Scientific
A.scientific Parser Scientific -> Parser Text () -> Parser Scientific
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
A.endOfInput) (Text -> Either String Scientific)
-> (String -> Text) -> String -> Either String Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

jpObject :: JsonParser
jpObject :: Parsec String () JsonValue
jpObject = do
  [(HashKey, JsonValue)]
list <- ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity [(HashKey, JsonValue)]
-> ParsecT String () Identity [(HashKey, JsonValue)]
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
between (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{') (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}') (ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String () Identity ()
-> ParsecT String () Identity [(HashKey, JsonValue)]
-> ParsecT String () Identity [(HashKey, JsonValue)]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> CharParser () (HashKey, JsonValue)
-> ParsecT String () Identity [(HashKey, JsonValue)]
forall a. CharParser () a -> CharParser () [a]
commaSep CharParser () (HashKey, JsonValue)
jpHash)
  JsonValue -> Parsec String () JsonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (JsonValue -> Parsec String () JsonValue)
-> JsonValue -> Parsec String () JsonValue
forall a b. (a -> b) -> a -> b
$ [(HashKey, JsonValue)] -> JsonValue
JsonObject ([(HashKey, JsonValue)] -> JsonValue)
-> [(HashKey, JsonValue)] -> JsonValue
forall a b. (a -> b) -> a -> b
$ [(HashKey, JsonValue)]
list
  where
    jpHash :: CharParser () (HashKey,JsonValue) -- (String,JsonValue)
    jpHash :: CharParser () (HashKey, JsonValue)
jpHash = do
      ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
      HashKey
name <- CharParser () HashKey
varKey CharParser () HashKey
-> CharParser () HashKey -> CharParser () HashKey
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CharParser () HashKey
symbolKey CharParser () HashKey
-> CharParser () HashKey -> CharParser () HashKey
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CharParser () HashKey
quotedStringKey
      ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
      Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
      ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
      JsonValue
value <- Parsec String () JsonValue
jpValue
      ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
      (HashKey, JsonValue) -> CharParser () (HashKey, JsonValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (HashKey
name,JsonValue
value)

symbolKey :: CharParser () HashKey
symbolKey :: CharParser () HashKey
symbolKey = String -> HashKey
HashStringKey (String -> HashKey)
-> ParsecT String () Identity String -> CharParser () HashKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity String
symbol

quotedStringKey :: CharParser () HashKey
quotedStringKey :: CharParser () HashKey
quotedStringKey = String -> HashKey
HashStringKey (String -> HashKey)
-> ParsecT String () Identity String -> CharParser () HashKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity String
quotedString

varKey :: CharParser () HashKey
varKey :: CharParser () HashKey
varKey = String -> HashKey
HashVarKey (String -> HashKey)
-> ParsecT String () Identity String -> CharParser () HashKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'$' ParsecT String () Identity Char
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String () Identity String
symbol)

jpArray :: CharParser () JsonValue
jpArray :: Parsec String () JsonValue
jpArray = [JsonValue] -> JsonValue
JsonArray ([JsonValue] -> JsonValue)
-> ParsecT String () Identity [JsonValue]
-> Parsec String () JsonValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity [JsonValue]
-> ParsecT String () Identity [JsonValue]
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
between (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'[') (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']') (ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String () Identity ()
-> ParsecT String () Identity [JsonValue]
-> ParsecT String () Identity [JsonValue]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec String () JsonValue
-> ParsecT String () Identity [JsonValue]
forall a. CharParser () a -> CharParser () [a]
commaSep Parsec String () JsonValue
jpValue)

-------
-- helpers for parser/grammar
quotedString :: CharParser () String
quotedString :: ParsecT String () Identity String
quotedString = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ParsecT String () Identity [String]
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity [String]
-> ParsecT String () 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
between (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"') (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"') ([String]
-> ParsecT String () Identity [String]
-> ParsecT String () Identity [String]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [String
""] (ParsecT String () Identity [String]
 -> ParsecT String () Identity [String])
-> ParsecT String () Identity [String]
-> ParsecT String () Identity [String]
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity String
-> ParsecT String () Identity [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT String () Identity String
chars)

symbol :: CharParser () String
symbol :: ParsecT String () Identity String
symbol = ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"\\ \":;><${}")

commaSep :: CharParser () a -> CharParser () [a]
commaSep :: CharParser () a -> CharParser () [a]
commaSep CharParser () a
p  = CharParser () a
p CharParser () a
-> ParsecT String () Identity Char -> CharParser () [a]
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]
`sepBy` (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',')

chars :: CharParser () String
chars :: ParsecT String () Identity String
chars = do
       ParsecT String () Identity String
-> ParsecT String () Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\\"" ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> ParsecT String () Identity String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"\"")
   ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT String () Identity String
-> ParsecT String () Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\\\" ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> ParsecT String () Identity String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"\\")
   ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT String () Identity String
-> ParsecT String () Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\/" ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> ParsecT String () Identity String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"/")
   ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT String () Identity String
-> ParsecT String () Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\b" ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> ParsecT String () Identity String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"\b")
   ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT String () Identity String
-> ParsecT String () Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\f" ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> ParsecT String () Identity String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"\f")
   ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT String () Identity String
-> ParsecT String () Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\n" ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> ParsecT String () Identity String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"\n")
   ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT String () Identity String
-> ParsecT String () Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\r" ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> ParsecT String () Identity String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"\r")
   ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT String () Identity String
-> ParsecT String () Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\t" ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> ParsecT String () Identity String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"\t")
   ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT String () Identity String
-> ParsecT String () Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String () Identity String
unicodeChars)
   ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"\\\"")

unicodeChars :: CharParser () String
unicodeChars :: ParsecT String () Identity String
unicodeChars = do
  String
u <- String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\u"
  Char
d1 <- ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit
  Char
d2 <- ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit
  Char
d3 <- ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit
  Char
d4 <- ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit
  String -> ParsecT String () Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT String () Identity String)
-> String -> ParsecT String () Identity String
forall a b. (a -> b) -> a -> b
$ String
u String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
d1] String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
d2] String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
d3] String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
d4]