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 :: [Char] -> Either ParseError JsonValue
parsedJson = Parsec [Char] () JsonValue
-> [Char] -> [Char] -> Either ParseError JsonValue
forall s t a.
Stream s Identity t =>
Parsec s () a -> [Char] -> s -> Either ParseError a
parse (Parsec [Char] () JsonValue
jpValue Parsec [Char] () JsonValue
-> ParsecT [Char] () Identity () -> Parsec [Char] () JsonValue
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Char] () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof) [Char]
"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
$c== :: JsonValue -> JsonValue -> Bool
== :: JsonValue -> JsonValue -> Bool
$c/= :: JsonValue -> JsonValue -> Bool
/= :: JsonValue -> JsonValue -> Bool
Eq, Int -> JsonValue -> ShowS
[JsonValue] -> ShowS
JsonValue -> [Char]
(Int -> JsonValue -> ShowS)
-> (JsonValue -> [Char])
-> ([JsonValue] -> ShowS)
-> Show JsonValue
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JsonValue -> ShowS
showsPrec :: Int -> JsonValue -> ShowS
$cshow :: JsonValue -> [Char]
show :: JsonValue -> [Char]
$cshowList :: [JsonValue] -> ShowS
showList :: [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
$c== :: HashKey -> HashKey -> Bool
== :: HashKey -> HashKey -> Bool
$c/= :: HashKey -> HashKey -> Bool
/= :: HashKey -> HashKey -> Bool
Eq, Int -> HashKey -> ShowS
[HashKey] -> ShowS
HashKey -> [Char]
(Int -> HashKey -> ShowS)
-> (HashKey -> [Char]) -> ([HashKey] -> ShowS) -> Show HashKey
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HashKey -> ShowS
showsPrec :: Int -> HashKey -> ShowS
$cshow :: HashKey -> [Char]
show :: HashKey -> [Char]
$cshowList :: [HashKey] -> ShowS
showList :: [HashKey] -> ShowS
Show)

type JsonParser = Parser JsonValue

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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