{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Jordan.FromJSON.Megaparsec
    where

import Control.Applicative
import Control.Applicative.Combinators (sepBy)
import qualified Data.ByteString as ByteString
import Data.Char (chr, digitToInt, isControl, isHexDigit, ord)
import Data.Foldable (asum, traverse_)
import Data.Functor (void, ($>))
import Data.List (intercalate)
import Data.Monoid (Alt(..))
import Data.Scientific (Scientific(..))
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Encoding
import Data.Void (Void)
import Data.Word (Word8)
import Debug.Trace (trace, traceM)
import Jordan.FromJSON.Class
import Jordan.FromJSON.ParseInternal
import Numeric (showHex)
import Text.Megaparsec ((<?>))
import qualified Text.Megaparsec as T
import qualified Text.Megaparsec.Char as Char
import qualified Text.Megaparsec.Char.Lexer as Lexer

type Parser = T.Parsec ErrorContext Text.Text
type ParseError = T.ParseErrorBundle Text.Text ErrorContext

newtype ErrorContext
  = ErrorContext { ErrorContext -> [Text]
getErrorContext :: [Text.Text] }
  deriving (Int -> ErrorContext -> ShowS
[ErrorContext] -> ShowS
ErrorContext -> String
(Int -> ErrorContext -> ShowS)
-> (ErrorContext -> String)
-> ([ErrorContext] -> ShowS)
-> Show ErrorContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrorContext] -> ShowS
$cshowList :: [ErrorContext] -> ShowS
show :: ErrorContext -> String
$cshow :: ErrorContext -> String
showsPrec :: Int -> ErrorContext -> ShowS
$cshowsPrec :: Int -> ErrorContext -> ShowS
Show, ErrorContext -> ErrorContext -> Bool
(ErrorContext -> ErrorContext -> Bool)
-> (ErrorContext -> ErrorContext -> Bool) -> Eq ErrorContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrorContext -> ErrorContext -> Bool
$c/= :: ErrorContext -> ErrorContext -> Bool
== :: ErrorContext -> ErrorContext -> Bool
$c== :: ErrorContext -> ErrorContext -> Bool
Eq, Eq ErrorContext
Eq ErrorContext
-> (ErrorContext -> ErrorContext -> Ordering)
-> (ErrorContext -> ErrorContext -> Bool)
-> (ErrorContext -> ErrorContext -> Bool)
-> (ErrorContext -> ErrorContext -> Bool)
-> (ErrorContext -> ErrorContext -> Bool)
-> (ErrorContext -> ErrorContext -> ErrorContext)
-> (ErrorContext -> ErrorContext -> ErrorContext)
-> Ord ErrorContext
ErrorContext -> ErrorContext -> Bool
ErrorContext -> ErrorContext -> Ordering
ErrorContext -> ErrorContext -> ErrorContext
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ErrorContext -> ErrorContext -> ErrorContext
$cmin :: ErrorContext -> ErrorContext -> ErrorContext
max :: ErrorContext -> ErrorContext -> ErrorContext
$cmax :: ErrorContext -> ErrorContext -> ErrorContext
>= :: ErrorContext -> ErrorContext -> Bool
$c>= :: ErrorContext -> ErrorContext -> Bool
> :: ErrorContext -> ErrorContext -> Bool
$c> :: ErrorContext -> ErrorContext -> Bool
<= :: ErrorContext -> ErrorContext -> Bool
$c<= :: ErrorContext -> ErrorContext -> Bool
< :: ErrorContext -> ErrorContext -> Bool
$c< :: ErrorContext -> ErrorContext -> Bool
compare :: ErrorContext -> ErrorContext -> Ordering
$ccompare :: ErrorContext -> ErrorContext -> Ordering
$cp1Ord :: Eq ErrorContext
Ord)

instance T.ShowErrorComponent ErrorContext where
  showErrorComponent :: ErrorContext -> String
showErrorComponent
    = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", "
    ([String] -> String)
-> (ErrorContext -> [String]) -> ErrorContext -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String
"in " String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack)
    ([Text] -> [String])
-> (ErrorContext -> [Text]) -> ErrorContext -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorContext -> [Text]
getErrorContext

newtype ObjectParser a = ObjectParser { ObjectParser a -> Permutation Parser a
getObjectParser :: Permutation Parser a }
  deriving newtype (a -> ObjectParser b -> ObjectParser a
(a -> b) -> ObjectParser a -> ObjectParser b
(forall a b. (a -> b) -> ObjectParser a -> ObjectParser b)
-> (forall a b. a -> ObjectParser b -> ObjectParser a)
-> Functor ObjectParser
forall a b. a -> ObjectParser b -> ObjectParser a
forall a b. (a -> b) -> ObjectParser a -> ObjectParser b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ObjectParser b -> ObjectParser a
$c<$ :: forall a b. a -> ObjectParser b -> ObjectParser a
fmap :: (a -> b) -> ObjectParser a -> ObjectParser b
$cfmap :: forall a b. (a -> b) -> ObjectParser a -> ObjectParser b
Functor, Functor ObjectParser
a -> ObjectParser a
Functor ObjectParser
-> (forall a. a -> ObjectParser a)
-> (forall a b.
    ObjectParser (a -> b) -> ObjectParser a -> ObjectParser b)
-> (forall a b c.
    (a -> b -> c)
    -> ObjectParser a -> ObjectParser b -> ObjectParser c)
-> (forall a b. ObjectParser a -> ObjectParser b -> ObjectParser b)
-> (forall a b. ObjectParser a -> ObjectParser b -> ObjectParser a)
-> Applicative ObjectParser
ObjectParser a -> ObjectParser b -> ObjectParser b
ObjectParser a -> ObjectParser b -> ObjectParser a
ObjectParser (a -> b) -> ObjectParser a -> ObjectParser b
(a -> b -> c) -> ObjectParser a -> ObjectParser b -> ObjectParser c
forall a. a -> ObjectParser a
forall a b. ObjectParser a -> ObjectParser b -> ObjectParser a
forall a b. ObjectParser a -> ObjectParser b -> ObjectParser b
forall a b.
ObjectParser (a -> b) -> ObjectParser a -> ObjectParser b
forall a b c.
(a -> b -> c) -> ObjectParser a -> ObjectParser b -> ObjectParser c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: ObjectParser a -> ObjectParser b -> ObjectParser a
$c<* :: forall a b. ObjectParser a -> ObjectParser b -> ObjectParser a
*> :: ObjectParser a -> ObjectParser b -> ObjectParser b
$c*> :: forall a b. ObjectParser a -> ObjectParser b -> ObjectParser b
liftA2 :: (a -> b -> c) -> ObjectParser a -> ObjectParser b -> ObjectParser c
$cliftA2 :: forall a b c.
(a -> b -> c) -> ObjectParser a -> ObjectParser b -> ObjectParser c
<*> :: ObjectParser (a -> b) -> ObjectParser a -> ObjectParser b
$c<*> :: forall a b.
ObjectParser (a -> b) -> ObjectParser a -> ObjectParser b
pure :: a -> ObjectParser a
$cpure :: forall a. a -> ObjectParser a
$cp1Applicative :: Functor ObjectParser
Applicative)

newtype ArrayParser a
  = ArrayParser { ArrayParser a -> Parser a
getArrayParser :: Parser a }
  deriving (a -> ArrayParser b -> ArrayParser a
(a -> b) -> ArrayParser a -> ArrayParser b
(forall a b. (a -> b) -> ArrayParser a -> ArrayParser b)
-> (forall a b. a -> ArrayParser b -> ArrayParser a)
-> Functor ArrayParser
forall a b. a -> ArrayParser b -> ArrayParser a
forall a b. (a -> b) -> ArrayParser a -> ArrayParser b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ArrayParser b -> ArrayParser a
$c<$ :: forall a b. a -> ArrayParser b -> ArrayParser a
fmap :: (a -> b) -> ArrayParser a -> ArrayParser b
$cfmap :: forall a b. (a -> b) -> ArrayParser a -> ArrayParser b
Functor)

instance Applicative ArrayParser where
  pure :: a -> ArrayParser a
pure = Parser a -> ArrayParser a
forall a. Parser a -> ArrayParser a
ArrayParser (Parser a -> ArrayParser a)
-> (a -> Parser a) -> a -> ArrayParser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  (ArrayParser Parser (a -> b)
f) <*> :: ArrayParser (a -> b) -> ArrayParser a -> ArrayParser b
<*> (ArrayParser Parser a
a) = Parser b -> ArrayParser b
forall a. Parser a -> ArrayParser a
ArrayParser (Parser b -> ArrayParser b) -> Parser b -> ArrayParser b
forall a b. (a -> b) -> a -> b
$
    (Parser (a -> b)
f Parser (a -> b)
-> ParsecT ErrorContext Text Identity () -> Parser (a -> b)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT ErrorContext Text Identity ()
comma) Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
a

lexeme :: Parser a -> Parser a
lexeme :: Parser a -> Parser a
lexeme = ParsecT ErrorContext Text Identity () -> Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
Lexer.lexeme (ParsecT ErrorContext Text Identity () -> Parser a -> Parser a)
-> ParsecT ErrorContext Text Identity () -> Parser a -> Parser a
forall a b. (a -> b) -> a -> b
$ ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
Lexer.space ParsecT ErrorContext Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
Char.space1 ParsecT ErrorContext Text Identity ()
forall (f :: * -> *) a. Alternative f => f a
empty ParsecT ErrorContext Text Identity ()
forall (f :: * -> *) a. Alternative f => f a
empty

takeSpace :: Parser ()
takeSpace :: ParsecT ErrorContext Text Identity ()
takeSpace = ParsecT ErrorContext Text Identity [()]
-> ParsecT ErrorContext Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT ErrorContext Text Identity [()]
 -> ParsecT ErrorContext Text Identity ())
-> ParsecT ErrorContext Text Identity [()]
-> ParsecT ErrorContext Text Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity [()]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT ErrorContext Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
Char.space1

parseAnyField :: Parser ()
parseAnyField :: ParsecT ErrorContext Text Identity ()
parseAnyField = String
-> ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
T.label String
"an extraneous object field we do not care about" (ParsecT ErrorContext Text Identity ()
 -> ParsecT ErrorContext Text Identity ())
-> ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
forall a b. (a -> b) -> a -> b
$ do
  String
-> ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
T.label String
"ignored object key" ParsecT ErrorContext Text Identity Text
parseJSONText
  Parser Char -> Parser Char
forall a. Parser a -> Parser a
lexeme (Parser Char -> Parser Char) -> Parser Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT ErrorContext Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
Char.char Char
Token Text
':'
  ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
forall a. Parser a -> Parser a
lexeme ParsecT ErrorContext Text Identity ()
consumeJunkValue

objectKey :: Text.Text -> Parser ()
objectKey :: Text -> ParsecT ErrorContext Text Identity ()
objectKey Text
k = String
-> ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
T.label (String
"object key '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
k String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"'") (ParsecT ErrorContext Text Identity ()
 -> ParsecT ErrorContext Text Identity ())
-> ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
forall a. Parser a -> Parser a
lexeme (ParsecT ErrorContext Text Identity ()
 -> ParsecT ErrorContext Text Identity ())
-> ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
forall a b. (a -> b) -> a -> b
$ do
  Token Text -> ParsecT ErrorContext Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
Char.char Char
Token Text
'"'
  String
-> ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
T.label String
"object label" (ParsecT ErrorContext Text Identity ()
 -> ParsecT ErrorContext Text Identity ())
-> ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
forall a b. (a -> b) -> a -> b
$
    (Char
 -> ParsecT ErrorContext Text Identity ()
 -> ParsecT ErrorContext Text Identity ())
-> ParsecT ErrorContext Text Identity ()
-> Text
-> ParsecT ErrorContext Text Identity ()
forall a. (Char -> a -> a) -> a -> Text -> a
Text.foldr (\Char
c ParsecT ErrorContext Text Identity ()
a -> Char -> ParsecT ErrorContext Text Identity ()
parseCharInText Char
c ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT ErrorContext Text Identity ()
a) (() -> ParsecT ErrorContext Text Identity ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) Text
k
  Token Text -> ParsecT ErrorContext Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
Char.char Char
Token Text
'"'
  pure ()

parseCharInText :: Char -> Parser ()
parseCharInText :: Char -> ParsecT ErrorContext Text Identity ()
parseCharInText Char
a = Char -> ParsecT ErrorContext Text Identity ()
parseLit Char
a ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT ErrorContext Text Identity ()
escaped Char
a
  where
    parseLit :: Char -> Parser ()
    parseLit :: Char -> ParsecT ErrorContext Text Identity ()
parseLit = \case
      Char
'\\' -> ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT ErrorContext Text Identity Text
 -> ParsecT ErrorContext Text Identity ())
-> ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT ErrorContext Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
T.chunk Tokens Text
"\\\\"
      Char
'"' -> ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT ErrorContext Text Identity Text
 -> ParsecT ErrorContext Text Identity ())
-> ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT ErrorContext Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
T.chunk Tokens Text
"\\\""
      Char
'/' -> ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT ErrorContext Text Identity Text
 -> ParsecT ErrorContext Text Identity ())
-> ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT ErrorContext Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
T.chunk Tokens Text
"/" ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> ParsecT ErrorContext Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
T.chunk Tokens Text
"\\/"
      Char
'\b' -> ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT ErrorContext Text Identity Text
 -> ParsecT ErrorContext Text Identity ())
-> ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT ErrorContext Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
T.chunk Tokens Text
"\\b"
      Char
'\f' -> ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT ErrorContext Text Identity Text
 -> ParsecT ErrorContext Text Identity ())
-> ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT ErrorContext Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
T.chunk Tokens Text
"\\f"
      Char
'\n' -> ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT ErrorContext Text Identity Text
 -> ParsecT ErrorContext Text Identity ())
-> ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT ErrorContext Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
T.chunk Tokens Text
"\\n"
      Char
'\r' -> ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT ErrorContext Text Identity Text
 -> ParsecT ErrorContext Text Identity ())
-> ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT ErrorContext Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
T.chunk Tokens Text
"\\r"
      Char
'\t' -> ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT ErrorContext Text Identity Text
 -> ParsecT ErrorContext Text Identity ())
-> ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT ErrorContext Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
T.chunk Tokens Text
"\\t"
      Char
a -> if Char -> Bool
isControl Char
a then ParsecT ErrorContext Text Identity ()
forall (f :: * -> *) a. Alternative f => f a
empty else Parser Char -> ParsecT ErrorContext Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Char -> ParsecT ErrorContext Text Identity ())
-> Parser Char -> ParsecT ErrorContext Text Identity ()
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT ErrorContext Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
T.single Char
Token Text
a
    escaped :: Char -> Parser ()
    escaped :: Char -> ParsecT ErrorContext Text Identity ()
escaped Char
a = ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT ErrorContext Text Identity Text
 -> ParsecT ErrorContext Text Identity ())
-> ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT ErrorContext Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
T.chunk (Tokens Text -> ParsecT ErrorContext Text Identity (Tokens Text))
-> Tokens Text -> ParsecT ErrorContext Text Identity (Tokens Text)
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
withEscaped ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (Int -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex (Int -> ShowS) -> Int -> ShowS
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
a) []
    withEscaped :: String -> String
    withEscaped :: ShowS
withEscaped a :: String
a@[Char
_] = String
"\\u000" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
a
    withEscaped a :: String
a@[Char
_,Char
_] = String
"\\u00" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
a
    withEscaped a :: String
a@[Char
_,Char
_,Char
_] = String
"\\u0" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
a
    withEscaped String
r = String
"\\u" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
r

parseDictField
  :: Parser a
  -> Parser (Text.Text, a)
parseDictField :: Parser a -> Parser (Text, a)
parseDictField Parser a
valParser = do
  Text
key <- ParsecT ErrorContext Text Identity Text
parseJSONText
  ParsecT ErrorContext Text Identity ()
labelSep
  a
val <- Parser a
valParser
  pure (Text
key, a
val)

parseObjectField
  :: Text.Text
  -> Parser a
  -> Parser a
parseObjectField :: Text -> Parser a -> Parser a
parseObjectField Text
t Parser a
f = do
  ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
T.try (ParsecT ErrorContext Text Identity ()
 -> ParsecT ErrorContext Text Identity ())
-> ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
forall a b. (a -> b) -> a -> b
$ Text -> ParsecT ErrorContext Text Identity ()
objectKey Text
t
  ParsecT ErrorContext Text Identity ()
labelSep
  Parser a -> Parser a
forall a. Parser a -> Parser a
lexeme Parser a
f

parseJSONText :: Parser Text.Text
parseJSONText :: ParsecT ErrorContext Text Identity Text
parseJSONText = ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity Text
forall a. Parser a -> Parser a
lexeme (ParsecT ErrorContext Text Identity Text
 -> ParsecT ErrorContext Text Identity Text)
-> ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity Text
forall a b. (a -> b) -> a -> b
$ do
  Parser Char -> Parser Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
T.try (Parser Char -> Parser Char) -> Parser Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT ErrorContext Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
Char.char Char
Token Text
'"'
  ParsecT ErrorContext Text Identity Text
innerText

innerText :: Parser Text.Text
innerText :: ParsecT ErrorContext Text Identity Text
innerText = do
  Text
chunk <- Maybe String
-> (Token Text -> Bool)
-> ParsecT ErrorContext Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
T.takeWhileP Maybe String
forall a. Maybe a
Nothing ((Token Text -> Bool)
 -> ParsecT ErrorContext Text Identity (Tokens Text))
-> (Token Text -> Bool)
-> ParsecT ErrorContext Text Identity (Tokens Text)
forall a b. (a -> b) -> a -> b
$ \Token Text
char -> Char
Token Text
char Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\\' Bool -> Bool -> Bool
&& Char
Token Text
char Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"'
  Maybe Char
l <- ParsecT ErrorContext Text Identity (Maybe Char)
-> ParsecT ErrorContext Text Identity (Maybe Char)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
T.lookAhead (ParsecT ErrorContext Text Identity (Maybe Char)
 -> ParsecT ErrorContext Text Identity (Maybe Char))
-> ParsecT ErrorContext Text Identity (Maybe Char)
-> ParsecT ErrorContext Text Identity (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Maybe Char
-> ParsecT ErrorContext Text Identity (Maybe Char)
-> ParsecT ErrorContext Text Identity (Maybe Char)
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
T.option Maybe Char
forall a. Maybe a
Nothing (Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> Maybe Char)
-> Parser Char -> ParsecT ErrorContext Text Identity (Maybe Char)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
T.anySingle)
  case Maybe Char
l of
    Maybe Char
Nothing -> String -> ParsecT ErrorContext Text Identity Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"string without end"
    Just Char
'"' -> do
      String -> Parser Char -> Parser Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
T.label String
"quotation mark" Parser Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
T.anySingle
      pure Text
chunk
    Just Char
'\\' -> do
      Parser Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
T.anySingle
      Text
r <- ParsecT ErrorContext Text Identity Text
parseEscape
      Text
rest <- ParsecT ErrorContext Text Identity Text
innerText
      pure $ Text
chunk Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
r Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rest
    Just Char
_ -> String -> ParsecT ErrorContext Text Identity Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"IMPOSSIBLE"

parseEscape :: Parser Text.Text
parseEscape :: ParsecT ErrorContext Text Identity Text
parseEscape
  = ParsecT ErrorContext Text Identity Text
ParsecT ErrorContext Text Identity (Tokens Text)
quote
  ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT ErrorContext Text Identity Text
ParsecT ErrorContext Text Identity (Tokens Text)
backslash
  ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT ErrorContext Text Identity Text
solidus
  ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT ErrorContext Text Identity Text
backspace
  ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT ErrorContext Text Identity Text
formfeed
  ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT ErrorContext Text Identity Text
linefeed
  ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT ErrorContext Text Identity Text
carriage
  ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT ErrorContext Text Identity Text
tab
  ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT ErrorContext Text Identity Text
escapedUnicode
  where
    backslash :: ParsecT ErrorContext Text Identity (Tokens Text)
backslash = Tokens Text -> ParsecT ErrorContext Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
T.chunk Tokens Text
"\\"
    quote :: ParsecT ErrorContext Text Identity (Tokens Text)
quote = Tokens Text -> ParsecT ErrorContext Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
T.chunk Tokens Text
"\""
    solidus :: ParsecT ErrorContext Text Identity Text
solidus = Tokens Text -> ParsecT ErrorContext Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
T.chunk Tokens Text
"/" ParsecT ErrorContext Text Identity (Tokens Text)
-> Text -> ParsecT ErrorContext Text Identity Text
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Text
"/"
    backspace :: ParsecT ErrorContext Text Identity Text
backspace = Tokens Text -> ParsecT ErrorContext Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
T.chunk Tokens Text
"b" ParsecT ErrorContext Text Identity (Tokens Text)
-> Text -> ParsecT ErrorContext Text Identity Text
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Text
"\b"
    formfeed :: ParsecT ErrorContext Text Identity Text
formfeed = Tokens Text -> ParsecT ErrorContext Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
T.chunk Tokens Text
"f" ParsecT ErrorContext Text Identity (Tokens Text)
-> Text -> ParsecT ErrorContext Text Identity Text
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Text
"\f"
    linefeed :: ParsecT ErrorContext Text Identity Text
linefeed = Tokens Text -> ParsecT ErrorContext Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
T.chunk Tokens Text
"n" ParsecT ErrorContext Text Identity (Tokens Text)
-> Text -> ParsecT ErrorContext Text Identity Text
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Text
"\n"
    carriage :: ParsecT ErrorContext Text Identity Text
carriage = Tokens Text -> ParsecT ErrorContext Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
T.chunk Tokens Text
"r" ParsecT ErrorContext Text Identity (Tokens Text)
-> Text -> ParsecT ErrorContext Text Identity Text
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Text
"\r"
    tab :: ParsecT ErrorContext Text Identity Text
tab = Tokens Text -> ParsecT ErrorContext Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
T.chunk Tokens Text
"t" ParsecT ErrorContext Text Identity (Tokens Text)
-> Text -> ParsecT ErrorContext Text Identity Text
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Text
"\t"
    escapedUnicode :: ParsecT ErrorContext Text Identity Text
escapedUnicode = String
-> ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
T.label String
"unicode escape code" (ParsecT ErrorContext Text Identity Text
 -> ParsecT ErrorContext Text Identity Text)
-> ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity Text
forall a b. (a -> b) -> a -> b
$ do
      Token Text -> ParsecT ErrorContext Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
Char.char Char
Token Text
'u'
      Int
a <- Parser Int
parseHexDigit
      Int
b <- Parser Int
parseHexDigit
      Int
c <- Parser Int
parseHexDigit
      Int
d <- Parser Int
parseHexDigit
      let s :: Int
s = (((Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
b) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d
      pure $ String -> Text
Text.pack [Int -> Char
chr Int
s]

parseHexDigit :: Parser Int
parseHexDigit :: Parser Int
parseHexDigit = Char -> Int
digitToInt (Char -> Int) -> Parser Char -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token Text -> Bool)
-> ParsecT ErrorContext Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
T.satisfy Char -> Bool
Token Text -> Bool
isHexDigit

comma :: Parser ()
comma :: ParsecT ErrorContext Text Identity ()
comma = Parser Char -> ParsecT ErrorContext Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Char -> ParsecT ErrorContext Text Identity ())
-> Parser Char -> ParsecT ErrorContext Text Identity ()
forall a b. (a -> b) -> a -> b
$ Parser Char -> Parser Char
forall a. Parser a -> Parser a
lexeme (Parser Char -> Parser Char) -> Parser Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT ErrorContext Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
Char.char Char
Token Text
','

labelSep :: Parser ()
labelSep :: ParsecT ErrorContext Text Identity ()
labelSep = Parser Char -> ParsecT ErrorContext Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Char -> ParsecT ErrorContext Text Identity ())
-> Parser Char -> ParsecT ErrorContext Text Identity ()
forall a b. (a -> b) -> a -> b
$ Parser Char -> Parser Char
forall a. Parser a -> Parser a
lexeme (Parser Char -> Parser Char) -> Parser Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT ErrorContext Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
Char.char Char
Token Text
':'

parseAnyObject :: Parser ()
parseAnyObject :: ParsecT ErrorContext Text Identity ()
parseAnyObject = String
-> ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
T.label String
"Ignored object" (ParsecT ErrorContext Text Identity ()
 -> ParsecT ErrorContext Text Identity ())
-> ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
forall a b. (a -> b) -> a -> b
$ do
  Parser Char -> Parser Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
T.try (Parser Char -> Parser Char) -> Parser Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ Parser Char -> Parser Char
forall a. Parser a -> Parser a
lexeme (Parser Char -> Parser Char) -> Parser Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT ErrorContext Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
Char.char Char
Token Text
'{'
  ParsecT ErrorContext Text Identity ()
parseAnyField ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity [()]
forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
`sepBy` ParsecT ErrorContext Text Identity ()
comma
  Parser Char -> Parser Char
forall a. Parser a -> Parser a
lexeme (Parser Char -> Parser Char) -> Parser Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT ErrorContext Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
Char.char Char
Token Text
'}'
  pure ()

parseAnyArray :: Parser ()
parseAnyArray :: ParsecT ErrorContext Text Identity ()
parseAnyArray = String
-> ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
T.label String
"Ignored array" (ParsecT ErrorContext Text Identity ()
 -> ParsecT ErrorContext Text Identity ())
-> ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
forall a b. (a -> b) -> a -> b
$ do
  Parser Char -> Parser Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
T.try (Parser Char -> Parser Char) -> Parser Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ Parser Char -> Parser Char
forall a. Parser a -> Parser a
lexeme (Parser Char -> Parser Char) -> Parser Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT ErrorContext Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
Char.char Char
Token Text
'['
  ParsecT ErrorContext Text Identity ()
consumeJunkValue ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity [()]
forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
`sepBy` ParsecT ErrorContext Text Identity ()
comma
  Parser Char -> Parser Char
forall a. Parser a -> Parser a
lexeme (Parser Char -> Parser Char) -> Parser Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT ErrorContext Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
Char.char Char
Token Text
']'
  pure ()

consumeJunkValue :: Parser ()
consumeJunkValue :: ParsecT ErrorContext Text Identity ()
consumeJunkValue
  = ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT ErrorContext Text Identity ()
parseAnyObject
  ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT ErrorContext Text Identity ()
parseAnyArray
  ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT ErrorContext Text Identity Text
parseJSONText
  ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT ErrorContext Text Identity Scientific
-> ParsecT ErrorContext Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT ErrorContext Text Identity Scientific
parseJSONNumber
  ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT ErrorContext Text Identity ()
parseJSONNull

parseJSONNumber :: Parser Scientific
parseJSONNumber :: ParsecT ErrorContext Text Identity Scientific
parseJSONNumber = ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity Scientific
-> ParsecT ErrorContext Text Identity Scientific
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
Lexer.signed (() -> ParsecT ErrorContext Text Identity ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) ParsecT ErrorContext Text Identity Scientific
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Scientific
Lexer.scientific

parseJSONNull :: Parser ()
parseJSONNull :: ParsecT ErrorContext Text Identity ()
parseJSONNull = ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT ErrorContext Text Identity Text
 -> ParsecT ErrorContext Text Identity ())
-> ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity Text
forall a. Parser a -> Parser a
lexeme (ParsecT ErrorContext Text Identity Text
 -> ParsecT ErrorContext Text Identity Text)
-> ParsecT ErrorContext Text Identity Text
-> ParsecT ErrorContext Text Identity Text
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT ErrorContext Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
T.chunk Tokens Text
"null"

parseJSONBool :: Parser Bool
parseJSONBool :: Parser Bool
parseJSONBool = Parser Bool -> Parser Bool
forall a. Parser a -> Parser a
lexeme (Parser Bool -> Parser Bool) -> Parser Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$ (Tokens Text -> ParsecT ErrorContext Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
T.chunk Tokens Text
"true" ParsecT ErrorContext Text Identity Text -> Bool -> Parser Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True) Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Tokens Text -> ParsecT ErrorContext Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
T.chunk Tokens Text
"false" ParsecT ErrorContext Text Identity Text -> Bool -> Parser Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
False)

junkFieldsAtEnd :: Parser ()
junkFieldsAtEnd :: ParsecT ErrorContext Text Identity ()
junkFieldsAtEnd = String
-> ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
T.label String
"misc fields after parsing is done" (ParsecT ErrorContext Text Identity ()
 -> ParsecT ErrorContext Text Identity ())
-> ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
forall a b. (a -> b) -> a -> b
$ do
  ParsecT ErrorContext Text Identity ()
comma
  ParsecT ErrorContext Text Identity ()
parseAnyField ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity [()]
forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
`sepBy` ParsecT ErrorContext Text Identity ()
comma
  pure ()

newtype MegaparsecParser a
  = MegaparsecParser { MegaparsecParser a -> Parser a
getMegaparsecParser :: Parser a }
  deriving (a -> MegaparsecParser b -> MegaparsecParser a
(a -> b) -> MegaparsecParser a -> MegaparsecParser b
(forall a b. (a -> b) -> MegaparsecParser a -> MegaparsecParser b)
-> (forall a b. a -> MegaparsecParser b -> MegaparsecParser a)
-> Functor MegaparsecParser
forall a b. a -> MegaparsecParser b -> MegaparsecParser a
forall a b. (a -> b) -> MegaparsecParser a -> MegaparsecParser b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> MegaparsecParser b -> MegaparsecParser a
$c<$ :: forall a b. a -> MegaparsecParser b -> MegaparsecParser a
fmap :: (a -> b) -> MegaparsecParser a -> MegaparsecParser b
$cfmap :: forall a b. (a -> b) -> MegaparsecParser a -> MegaparsecParser b
Functor)
  deriving (Semigroup (MegaparsecParser a)
MegaparsecParser a
Semigroup (MegaparsecParser a)
-> MegaparsecParser a
-> (MegaparsecParser a -> MegaparsecParser a -> MegaparsecParser a)
-> ([MegaparsecParser a] -> MegaparsecParser a)
-> Monoid (MegaparsecParser a)
[MegaparsecParser a] -> MegaparsecParser a
MegaparsecParser a -> MegaparsecParser a -> MegaparsecParser a
forall a. Semigroup (MegaparsecParser a)
forall a. MegaparsecParser a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. [MegaparsecParser a] -> MegaparsecParser a
forall a.
MegaparsecParser a -> MegaparsecParser a -> MegaparsecParser a
mconcat :: [MegaparsecParser a] -> MegaparsecParser a
$cmconcat :: forall a. [MegaparsecParser a] -> MegaparsecParser a
mappend :: MegaparsecParser a -> MegaparsecParser a -> MegaparsecParser a
$cmappend :: forall a.
MegaparsecParser a -> MegaparsecParser a -> MegaparsecParser a
mempty :: MegaparsecParser a
$cmempty :: forall a. MegaparsecParser a
$cp1Monoid :: forall a. Semigroup (MegaparsecParser a)
Monoid) via (Alt Parser a)

instance Semigroup (MegaparsecParser a) where
  (MegaparsecParser Parser a
a) <> :: MegaparsecParser a -> MegaparsecParser a -> MegaparsecParser a
<> (MegaparsecParser Parser a
b) = Parser a -> MegaparsecParser a
forall a. Parser a -> MegaparsecParser a
MegaparsecParser (Parser a -> MegaparsecParser a) -> Parser a -> MegaparsecParser a
forall a b. (a -> b) -> a -> b
$ Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
T.try Parser a
a Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
T.try Parser a
b

instance JSONObjectParser ObjectParser where
  parseFieldWith :: Text
-> (forall (valueParser :: * -> *).
    JSONParser valueParser =>
    valueParser a)
-> ObjectParser a
parseFieldWith Text
label
    = Permutation Parser a -> ObjectParser a
forall a. Permutation Parser a -> ObjectParser a
ObjectParser
    (Permutation Parser a -> ObjectParser a)
-> (MegaparsecParser a -> Permutation Parser a)
-> MegaparsecParser a
-> ObjectParser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT ErrorContext Text Identity a -> Permutation Parser a
forall (f :: * -> *) a. Alternative f => f a -> Permutation f a
asPermutation
    (ParsecT ErrorContext Text Identity a -> Permutation Parser a)
-> (MegaparsecParser a -> ParsecT ErrorContext Text Identity a)
-> MegaparsecParser a
-> Permutation Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> ParsecT ErrorContext Text Identity a
-> ParsecT ErrorContext Text Identity a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
T.label (String
"field " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
label)
    (ParsecT ErrorContext Text Identity a
 -> ParsecT ErrorContext Text Identity a)
-> (MegaparsecParser a -> ParsecT ErrorContext Text Identity a)
-> MegaparsecParser a
-> ParsecT ErrorContext Text Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> ParsecT ErrorContext Text Identity a
-> ParsecT ErrorContext Text Identity a
forall a. Text -> Parser a -> Parser a
parseObjectField Text
label
    (ParsecT ErrorContext Text Identity a
 -> ParsecT ErrorContext Text Identity a)
-> (MegaparsecParser a -> ParsecT ErrorContext Text Identity a)
-> MegaparsecParser a
-> ParsecT ErrorContext Text Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MegaparsecParser a -> ParsecT ErrorContext Text Identity a
forall a. MegaparsecParser a -> Parser a
getMegaparsecParser

instance JSONTupleParser ArrayParser where
  consumeItemWith :: (forall (valueParser :: * -> *).
 JSONParser valueParser =>
 valueParser a)
-> ArrayParser a
consumeItemWith = Parser a -> ArrayParser a
forall a. Parser a -> ArrayParser a
ArrayParser (Parser a -> ArrayParser a)
-> (MegaparsecParser a -> Parser a)
-> MegaparsecParser a
-> ArrayParser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MegaparsecParser a -> Parser a
forall a. MegaparsecParser a -> Parser a
getMegaparsecParser

instance JSONParser MegaparsecParser where
  parseObject :: Text
-> (forall (objectParser :: * -> *).
    JSONObjectParser objectParser =>
    objectParser a)
-> MegaparsecParser a
parseObject Text
name forall (objectParser :: * -> *).
JSONObjectParser objectParser =>
objectParser a
p = Parser a -> MegaparsecParser a
forall a. Parser a -> MegaparsecParser a
MegaparsecParser (Parser a -> MegaparsecParser a) -> Parser a -> MegaparsecParser a
forall a b. (a -> b) -> a -> b
$ String -> Parser a -> Parser a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
T.label (Text -> String
Text.unpack Text
name String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" object") (Parser a -> Parser a) -> Parser a -> Parser a
forall a b. (a -> b) -> a -> b
$ do
    String -> Parser Char -> Parser Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
T.label String
"object start" (Parser Char -> Parser Char) -> Parser Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ Parser Char -> Parser Char
forall a. Parser a -> Parser a
lexeme (Parser Char -> Parser Char) -> Parser Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT ErrorContext Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
Char.char Char
Token Text
'{'
    a
r <- ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
-> Permutation Parser a
-> Parser a
forall (m :: * -> *) a b.
Alternative m =>
m b -> m b -> Permutation m a -> m a
wrapEffect ParsecT ErrorContext Text Identity ()
parseAnyField ParsecT ErrorContext Text Identity ()
comma (Permutation Parser a -> Parser a)
-> Permutation Parser a -> Parser a
forall a b. (a -> b) -> a -> b
$ ObjectParser a -> Permutation Parser a
forall a. ObjectParser a -> Permutation Parser a
getObjectParser ObjectParser a
forall (objectParser :: * -> *).
JSONObjectParser objectParser =>
objectParser a
p
    String
-> ParsecT ErrorContext Text Identity (Maybe ())
-> ParsecT ErrorContext Text Identity (Maybe ())
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
T.label String
"object end" (ParsecT ErrorContext Text Identity (Maybe ())
 -> ParsecT ErrorContext Text Identity (Maybe ()))
-> ParsecT ErrorContext Text Identity (Maybe ())
-> ParsecT ErrorContext Text Identity (Maybe ())
forall a b. (a -> b) -> a -> b
$ ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
T.optional ParsecT ErrorContext Text Identity ()
junkFieldsAtEnd
    Parser Char -> Parser Char
forall a. Parser a -> Parser a
lexeme (Parser Char -> Parser Char) -> Parser Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT ErrorContext Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
Char.char Char
Token Text
'}'
    pure a
r
  parseDictionary :: (forall (jsonParser :: * -> *).
 JSONParser jsonParser =>
 jsonParser a)
-> MegaparsecParser [(Text, a)]
parseDictionary forall (jsonParser :: * -> *).
JSONParser jsonParser =>
jsonParser a
valParser = Parser [(Text, a)] -> MegaparsecParser [(Text, a)]
forall a. Parser a -> MegaparsecParser a
MegaparsecParser (Parser [(Text, a)] -> MegaparsecParser [(Text, a)])
-> Parser [(Text, a)] -> MegaparsecParser [(Text, a)]
forall a b. (a -> b) -> a -> b
$ String -> Parser [(Text, a)] -> Parser [(Text, a)]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
T.label String
"dictionary" (Parser [(Text, a)] -> Parser [(Text, a)])
-> Parser [(Text, a)] -> Parser [(Text, a)]
forall a b. (a -> b) -> a -> b
$ do
    Parser Char -> Parser Char
forall a. Parser a -> Parser a
lexeme (Parser Char -> Parser Char) -> Parser Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT ErrorContext Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
Char.char Char
Token Text
'{'
    [(Text, a)]
r <- Parser a -> Parser (Text, a)
forall a. Parser a -> Parser (Text, a)
parseDictField (MegaparsecParser a -> Parser a
forall a. MegaparsecParser a -> Parser a
getMegaparsecParser MegaparsecParser a
forall (jsonParser :: * -> *).
JSONParser jsonParser =>
jsonParser a
valParser) Parser (Text, a)
-> ParsecT ErrorContext Text Identity () -> Parser [(Text, a)]
forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
`sepBy` ParsecT ErrorContext Text Identity ()
comma
    Parser Char -> Parser Char
forall a. Parser a -> Parser a
lexeme (Parser Char -> Parser Char) -> Parser Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT ErrorContext Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
Char.char Char
Token Text
'}'
    pure [(Text, a)]
r
  parseTuple :: (forall (arrayParser :: * -> *).
 JSONTupleParser arrayParser =>
 arrayParser o)
-> MegaparsecParser o
parseTuple forall (arrayParser :: * -> *).
JSONTupleParser arrayParser =>
arrayParser o
p = Parser o -> MegaparsecParser o
forall a. Parser a -> MegaparsecParser a
MegaparsecParser (Parser o -> MegaparsecParser o) -> Parser o -> MegaparsecParser o
forall a b. (a -> b) -> a -> b
$ do
    Parser Char -> Parser Char
forall a. Parser a -> Parser a
lexeme (Parser Char -> Parser Char) -> Parser Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ String -> Parser Char -> Parser Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
T.label String
"Array start" (Parser Char -> Parser Char) -> Parser Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT ErrorContext Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
Char.char Char
Token Text
'['
    o
r <- ArrayParser o -> Parser o
forall a. ArrayParser a -> Parser a
getArrayParser ArrayParser o
forall (arrayParser :: * -> *).
JSONTupleParser arrayParser =>
arrayParser o
p
    Parser Char -> Parser Char
forall a. Parser a -> Parser a
lexeme (Parser Char -> Parser Char) -> Parser Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ String -> Parser Char -> Parser Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
T.label String
"Array end" (Parser Char -> Parser Char) -> Parser Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT ErrorContext Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
Char.char Char
Token Text
']'
    pure o
r
  parseArrayWith :: (forall (jsonParser :: * -> *).
 JSONParser jsonParser =>
 jsonParser a)
-> MegaparsecParser [a]
parseArrayWith forall (jsonParser :: * -> *).
JSONParser jsonParser =>
jsonParser a
p = Parser [a] -> MegaparsecParser [a]
forall a. Parser a -> MegaparsecParser a
MegaparsecParser (Parser [a] -> MegaparsecParser [a])
-> Parser [a] -> MegaparsecParser [a]
forall a b. (a -> b) -> a -> b
$ do
    Parser Char -> Parser Char
forall a. Parser a -> Parser a
lexeme (Parser Char -> Parser Char) -> Parser Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ String -> Parser Char -> Parser Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
T.label String
"Array start" (Parser Char -> Parser Char) -> Parser Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT ErrorContext Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
Char.char Char
Token Text
'['
    [a]
r <- MegaparsecParser a -> Parser a
forall a. MegaparsecParser a -> Parser a
getMegaparsecParser MegaparsecParser a
forall (jsonParser :: * -> *).
JSONParser jsonParser =>
jsonParser a
p Parser a -> ParsecT ErrorContext Text Identity () -> Parser [a]
forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
`sepBy` ParsecT ErrorContext Text Identity ()
comma
    Parser Char -> Parser Char
forall a. Parser a -> Parser a
lexeme (Parser Char -> Parser Char) -> Parser Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ String -> Parser Char -> Parser Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
T.label String
"Array end" (Parser Char -> Parser Char) -> Parser Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT ErrorContext Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
Char.char Char
Token Text
']'
    pure [a]
r
  parseTextConstant :: Text -> MegaparsecParser ()
parseTextConstant Text
t = ParsecT ErrorContext Text Identity () -> MegaparsecParser ()
forall a. Parser a -> MegaparsecParser a
MegaparsecParser (ParsecT ErrorContext Text Identity () -> MegaparsecParser ())
-> ParsecT ErrorContext Text Identity () -> MegaparsecParser ()
forall a b. (a -> b) -> a -> b
$ String
-> ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
T.label String
"text constant" (ParsecT ErrorContext Text Identity ()
 -> ParsecT ErrorContext Text Identity ())
-> ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
forall a b. (a -> b) -> a -> b
$ do
    Token Text -> ParsecT ErrorContext Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
Char.char Char
Token Text
'"'
    (Char
 -> ParsecT ErrorContext Text Identity ()
 -> ParsecT ErrorContext Text Identity ())
-> ParsecT ErrorContext Text Identity ()
-> Text
-> ParsecT ErrorContext Text Identity ()
forall a. (Char -> a -> a) -> a -> Text -> a
Text.foldr (\Char
c ParsecT ErrorContext Text Identity ()
a -> Char -> ParsecT ErrorContext Text Identity ()
parseCharInText Char
c ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT ErrorContext Text Identity ()
a) (() -> ParsecT ErrorContext Text Identity ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) Text
t
    Token Text -> ParsecT ErrorContext Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
Char.char Char
Token Text
'"'
    pure ()
  parseText :: MegaparsecParser Text
parseText = ParsecT ErrorContext Text Identity Text -> MegaparsecParser Text
forall a. Parser a -> MegaparsecParser a
MegaparsecParser ParsecT ErrorContext Text Identity Text
parseJSONText
  parseBool :: MegaparsecParser Bool
parseBool = Parser Bool -> MegaparsecParser Bool
forall a. Parser a -> MegaparsecParser a
MegaparsecParser Parser Bool
parseJSONBool
  parseNumber :: MegaparsecParser Scientific
parseNumber = ParsecT ErrorContext Text Identity Scientific
-> MegaparsecParser Scientific
forall a. Parser a -> MegaparsecParser a
MegaparsecParser ParsecT ErrorContext Text Identity Scientific
parseJSONNumber
  parseNull :: MegaparsecParser ()
parseNull = ParsecT ErrorContext Text Identity () -> MegaparsecParser ()
forall a. Parser a -> MegaparsecParser a
MegaparsecParser (ParsecT ErrorContext Text Identity () -> MegaparsecParser ())
-> ParsecT ErrorContext Text Identity () -> MegaparsecParser ()
forall a b. (a -> b) -> a -> b
$ String
-> ParsecT ErrorContext Text Identity ()
-> ParsecT ErrorContext Text Identity ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
T.label String
"null literal" ParsecT ErrorContext Text Identity ()
parseJSONNull
  validateJSON :: MegaparsecParser (Either Text a) -> MegaparsecParser a
validateJSON (MegaparsecParser Parser (Either Text a)
f) = Parser a -> MegaparsecParser a
forall a. Parser a -> MegaparsecParser a
MegaparsecParser (Parser a -> MegaparsecParser a) -> Parser a -> MegaparsecParser a
forall a b. (a -> b) -> a -> b
$ do
    Either Text a
r <- Parser (Either Text a)
f
    case Either Text a
r of
      Left Text
a -> String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Text -> String
Text.unpack Text
a)
      Right a
a -> a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

-- | Convert an abstract JSONParser to a Megaparsec parser.
convertParserToMegaparsecParser :: (forall parser. JSONParser parser => parser a) -> Parser a
convertParserToMegaparsecParser :: (forall (parser :: * -> *). JSONParser parser => parser a)
-> Parser a
convertParserToMegaparsecParser = (forall (parser :: * -> *). JSONParser parser => parser a)
-> Parser a
forall a. MegaparsecParser a -> Parser a
getMegaparsecParser

-- | Get a megaparsec parser for your JSON value.
-- This parser will not construct any intermediate maps or other structures - your object will be parsed directly!
--
-- Note: this parser, until the ones that are built into the class, can consume whitespace at the start of the JSON.
megaparsecParser :: (FromJSON val) => Parser val
megaparsecParser :: Parser val
megaparsecParser = ParsecT ErrorContext Text Identity ()
takeSpace ParsecT ErrorContext Text Identity () -> Parser val -> Parser val
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> MegaparsecParser val -> Parser val
forall a. MegaparsecParser a -> Parser a
getMegaparsecParser MegaparsecParser val
forall value (f :: * -> *).
(FromJSON value, JSONParser f) =>
f value
fromJSON

-- | Run an abstract JSONParser via Megaparsec.
runParserViaMegaparsec :: (forall parser. JSONParser parser => parser a) -> Text.Text -> Either String a
runParserViaMegaparsec :: (forall (parser :: * -> *). JSONParser parser => parser a)
-> Text -> Either String a
runParserViaMegaparsec forall (parser :: * -> *). JSONParser parser => parser a
p Text
t =
  case Parsec ErrorContext Text a
-> String -> Text -> Either (ParseErrorBundle Text ErrorContext) a
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
T.runParser ((forall (parser :: * -> *). JSONParser parser => parser a)
-> Parsec ErrorContext Text a
forall a.
(forall (parser :: * -> *). JSONParser parser => parser a)
-> Parser a
convertParserToMegaparsecParser forall (parser :: * -> *). JSONParser parser => parser a
p) String
"" Text
t of
    Left ParseErrorBundle Text ErrorContext
r -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text ErrorContext -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
T.errorBundlePretty ParseErrorBundle Text ErrorContext
r
    Right a
k -> a -> Either String a
forall a b. b -> Either a b
Right a
k

-- | Parse an object for which 'FromJSON' is defined via Megaparsec.
parseViaMegaparsec :: forall val. (FromJSON val) => Text.Text -> Either String val
parseViaMegaparsec :: Text -> Either String val
parseViaMegaparsec = (forall (parser :: * -> *). JSONParser parser => parser val)
-> Text -> Either String val
forall a.
(forall (parser :: * -> *). JSONParser parser => parser a)
-> Text -> Either String a
runParserViaMegaparsec forall value (f :: * -> *).
(FromJSON value, JSONParser f) =>
f value
forall (parser :: * -> *). JSONParser parser => parser val
fromJSON