{-# LANGUAGE CPP #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RecordWildCards #-}
module Data.Aeson.Schema.TH.Parse where
import Control.Monad (MonadPlus, void)
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail (MonadFail)
#endif
import Data.Functor (($>))
import Data.List (intercalate)
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NonEmpty
import Data.Void (Void)
import Text.Megaparsec hiding (sepBy1, sepEndBy1, some)
import qualified Text.Megaparsec as Megaparsec
import Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as L
type Parser = Parsec Void String
#if !MIN_VERSION_megaparsec(7,0,0)
errorBundlePretty :: (Ord t, ShowToken t, ShowErrorComponent e) => ParseError t e -> String
errorBundlePretty = parseErrorPretty
#endif
runParserFail :: MonadFail m => Parser a -> String -> m a
runParserFail :: Parser a -> String -> m a
runParserFail Parser a
parser String
s = (ParseErrorBundle String Void -> m a)
-> (a -> m a) -> Either (ParseErrorBundle String Void) a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a)
-> (ParseErrorBundle String Void -> String)
-> ParseErrorBundle String Void
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle String Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty) a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (ParseErrorBundle String Void) a -> m a)
-> Either (ParseErrorBundle String Void) a -> m a
forall a b. (a -> b) -> a -> b
$ Parser a
-> String -> String -> Either (ParseErrorBundle String Void) a
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser Parser a
parser String
s String
s
data SchemaDef
= SchemaDefType String
| SchemaDefMaybe SchemaDef
| SchemaDefTry SchemaDef
| SchemaDefList SchemaDef
| SchemaDefInclude String
| SchemaDefObj (NonEmpty SchemaDefObjItem)
| SchemaDefUnion (NonEmpty SchemaDef)
deriving (Int -> SchemaDef -> ShowS
[SchemaDef] -> ShowS
SchemaDef -> String
(Int -> SchemaDef -> ShowS)
-> (SchemaDef -> String)
-> ([SchemaDef] -> ShowS)
-> Show SchemaDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SchemaDef] -> ShowS
$cshowList :: [SchemaDef] -> ShowS
show :: SchemaDef -> String
$cshow :: SchemaDef -> String
showsPrec :: Int -> SchemaDef -> ShowS
$cshowsPrec :: Int -> SchemaDef -> ShowS
Show)
data SchemaDefObjItem
= SchemaDefObjPair (SchemaDefObjKey, SchemaDef)
| SchemaDefObjExtend String
deriving (Int -> SchemaDefObjItem -> ShowS
[SchemaDefObjItem] -> ShowS
SchemaDefObjItem -> String
(Int -> SchemaDefObjItem -> ShowS)
-> (SchemaDefObjItem -> String)
-> ([SchemaDefObjItem] -> ShowS)
-> Show SchemaDefObjItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SchemaDefObjItem] -> ShowS
$cshowList :: [SchemaDefObjItem] -> ShowS
show :: SchemaDefObjItem -> String
$cshow :: SchemaDefObjItem -> String
showsPrec :: Int -> SchemaDefObjItem -> ShowS
$cshowsPrec :: Int -> SchemaDefObjItem -> ShowS
Show)
data SchemaDefObjKey
= SchemaDefObjKeyNormal String
| SchemaDefObjKeyPhantom String
deriving (Int -> SchemaDefObjKey -> ShowS
[SchemaDefObjKey] -> ShowS
SchemaDefObjKey -> String
(Int -> SchemaDefObjKey -> ShowS)
-> (SchemaDefObjKey -> String)
-> ([SchemaDefObjKey] -> ShowS)
-> Show SchemaDefObjKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SchemaDefObjKey] -> ShowS
$cshowList :: [SchemaDefObjKey] -> ShowS
show :: SchemaDefObjKey -> String
$cshow :: SchemaDefObjKey -> String
showsPrec :: Int -> SchemaDefObjKey -> ShowS
$cshowsPrec :: Int -> SchemaDefObjKey -> ShowS
Show)
parseSchemaDef :: MonadFail m => String -> m SchemaDef
parseSchemaDef :: String -> m SchemaDef
parseSchemaDef = Parser SchemaDef -> String -> m SchemaDef
forall (m :: * -> *) a. MonadFail m => Parser a -> String -> m a
runParserFail (Parser SchemaDef -> String -> m SchemaDef)
-> Parser SchemaDef -> String -> m SchemaDef
forall a b. (a -> b) -> a -> b
$ do
ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
SchemaDef
def <- Parser SchemaDef
parseSchemaDefWithUnions
ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
ParsecT Void String Identity () -> ParsecT Void String Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void String Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
SchemaDef -> Parser SchemaDef
forall (m :: * -> *) a. Monad m => a -> m a
return SchemaDef
def
where
parseSchemaDefWithUnions :: Parser SchemaDef
parseSchemaDefWithUnions =
let parseSchemaUnion :: NonEmpty SchemaDef -> SchemaDef
parseSchemaUnion NonEmpty SchemaDef
schemaDefs
| NonEmpty SchemaDef -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty SchemaDef
schemaDefs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = NonEmpty SchemaDef -> SchemaDef
forall a. NonEmpty a -> a
NonEmpty.head NonEmpty SchemaDef
schemaDefs
| Bool
otherwise = NonEmpty SchemaDef -> SchemaDef
SchemaDefUnion NonEmpty SchemaDef
schemaDefs
in (NonEmpty SchemaDef -> SchemaDef)
-> ParsecT Void String Identity (NonEmpty SchemaDef)
-> Parser SchemaDef
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty SchemaDef -> SchemaDef
parseSchemaUnion (ParsecT Void String Identity (NonEmpty SchemaDef)
-> Parser SchemaDef)
-> ParsecT Void String Identity (NonEmpty SchemaDef)
-> Parser SchemaDef
forall a b. (a -> b) -> a -> b
$ Parser SchemaDef
parseSchemaDefWithoutUnions Parser SchemaDef
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity (NonEmpty SchemaDef)
forall (f :: * -> *) a sep.
MonadPlus f =>
f a -> f sep -> f (NonEmpty a)
`sepBy1` String -> ParsecT Void String Identity ()
lexeme String
"|"
parseSchemaDefWithoutUnions :: Parser SchemaDef
parseSchemaDefWithoutUnions = [Parser SchemaDef] -> Parser SchemaDef
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
-> Parser SchemaDef
-> Parser SchemaDef
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (String -> ParsecT Void String Identity ()
lexeme String
"{") (String -> ParsecT Void String Identity ()
lexeme String
"}") (Parser SchemaDef -> Parser SchemaDef)
-> Parser SchemaDef -> Parser SchemaDef
forall a b. (a -> b) -> a -> b
$ NonEmpty SchemaDefObjItem -> SchemaDef
SchemaDefObj (NonEmpty SchemaDefObjItem -> SchemaDef)
-> ParsecT Void String Identity (NonEmpty SchemaDefObjItem)
-> Parser SchemaDef
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity (NonEmpty SchemaDefObjItem)
parseSchemaDefObjItems
, ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
-> Parser SchemaDef
-> Parser SchemaDef
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (String -> ParsecT Void String Identity ()
lexeme String
"(") (String -> ParsecT Void String Identity ()
lexeme String
")") Parser SchemaDef
parseSchemaDefWithUnions
, String -> ParsecT Void String Identity ()
lexeme String
"Maybe" ParsecT Void String Identity ()
-> Parser SchemaDef -> Parser SchemaDef
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (SchemaDef -> SchemaDef
SchemaDefMaybe (SchemaDef -> SchemaDef) -> Parser SchemaDef -> Parser SchemaDef
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SchemaDef
parseSchemaDefWithoutUnions)
, String -> ParsecT Void String Identity ()
lexeme String
"Try" ParsecT Void String Identity ()
-> Parser SchemaDef -> Parser SchemaDef
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (SchemaDef -> SchemaDef
SchemaDefTry (SchemaDef -> SchemaDef) -> Parser SchemaDef -> Parser SchemaDef
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SchemaDef
parseSchemaDefWithoutUnions)
, String -> ParsecT Void String Identity ()
lexeme String
"List" ParsecT Void String Identity ()
-> Parser SchemaDef -> Parser SchemaDef
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (SchemaDef -> SchemaDef
SchemaDefList (SchemaDef -> SchemaDef) -> Parser SchemaDef -> Parser SchemaDef
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SchemaDef
parseSchemaDefWithoutUnions)
, String -> SchemaDef
SchemaDefType (String -> SchemaDef)
-> ParsecT Void String Identity String -> Parser SchemaDef
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char -> ParsecT Void String Identity String
identifier Parser Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
upperChar
, String -> SchemaDef
SchemaDefInclude (String -> SchemaDef)
-> ParsecT Void String Identity String -> Parser SchemaDef
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity String
parseSchemaReference
] Parser SchemaDef
-> ParsecT Void String Identity () -> Parser SchemaDef
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
parseSchemaDefObjItems :: ParsecT Void String Identity (NonEmpty SchemaDefObjItem)
parseSchemaDefObjItems = ParsecT Void String Identity SchemaDefObjItem
parseSchemaDefObjItem ParsecT Void String Identity SchemaDefObjItem
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity (NonEmpty SchemaDefObjItem)
forall (f :: * -> *) a sep.
MonadPlus f =>
f a -> f sep -> f (NonEmpty a)
`sepEndBy1` String -> ParsecT Void String Identity ()
lexeme String
","
parseSchemaDefObjItem :: ParsecT Void String Identity SchemaDefObjItem
parseSchemaDefObjItem = [ParsecT Void String Identity SchemaDefObjItem]
-> ParsecT Void String Identity SchemaDefObjItem
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ (SchemaDefObjKey, SchemaDef) -> SchemaDefObjItem
SchemaDefObjPair ((SchemaDefObjKey, SchemaDef) -> SchemaDefObjItem)
-> ParsecT Void String Identity (SchemaDefObjKey, SchemaDef)
-> ParsecT Void String Identity SchemaDefObjItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity (SchemaDefObjKey, SchemaDef)
parseSchemaDefPair
, String -> SchemaDefObjItem
SchemaDefObjExtend (String -> SchemaDefObjItem)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity SchemaDefObjItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity String
parseSchemaReference
] ParsecT Void String Identity SchemaDefObjItem
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity SchemaDefObjItem
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
parseSchemaDefPair :: ParsecT Void String Identity (SchemaDefObjKey, SchemaDef)
parseSchemaDefPair = do
SchemaDefObjKey
key <- [ParsecT Void String Identity SchemaDefObjKey]
-> ParsecT Void String Identity SchemaDefObjKey
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ String -> SchemaDefObjKey
SchemaDefObjKeyNormal (String -> SchemaDefObjKey)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity SchemaDefObjKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity String
jsonKey
, String -> SchemaDefObjKey
SchemaDefObjKeyPhantom (String -> SchemaDefObjKey)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity SchemaDefObjKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (String -> ParsecT Void String Identity ()
lexeme' String
"[") (String -> ParsecT Void String Identity ()
lexeme' String
"]") ParsecT Void String Identity String
jsonKey'
]
String -> ParsecT Void String Identity ()
lexeme String
":"
SchemaDef
value <- Parser SchemaDef
parseSchemaDefWithUnions
(SchemaDefObjKey, SchemaDef)
-> ParsecT Void String Identity (SchemaDefObjKey, SchemaDef)
forall (m :: * -> *) a. Monad m => a -> m a
return (SchemaDefObjKey
key, SchemaDef
value)
parseSchemaReference :: ParsecT Void String Identity String
parseSchemaReference = Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'#' Parser Char
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Char -> ParsecT Void String Identity String
namespacedIdentifier Parser Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
upperChar
data GetterExp = GetterExp
{ GetterExp -> Maybe String
start :: Maybe String
, GetterExp -> GetterOps
getterOps :: GetterOps
} deriving (Int -> GetterExp -> ShowS
[GetterExp] -> ShowS
GetterExp -> String
(Int -> GetterExp -> ShowS)
-> (GetterExp -> String)
-> ([GetterExp] -> ShowS)
-> Show GetterExp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetterExp] -> ShowS
$cshowList :: [GetterExp] -> ShowS
show :: GetterExp -> String
$cshow :: GetterExp -> String
showsPrec :: Int -> GetterExp -> ShowS
$cshowsPrec :: Int -> GetterExp -> ShowS
Show)
parseGetterExp :: MonadFail m => String -> m GetterExp
parseGetterExp :: String -> m GetterExp
parseGetterExp = Parser GetterExp -> String -> m GetterExp
forall (m :: * -> *) a. MonadFail m => Parser a -> String -> m a
runParserFail (Parser GetterExp -> String -> m GetterExp)
-> Parser GetterExp -> String -> m GetterExp
forall a b. (a -> b) -> a -> b
$ do
ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
Maybe String
start <- ParsecT Void String Identity String
-> ParsecT Void String Identity (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void String Identity String
-> ParsecT Void String Identity (Maybe String))
-> ParsecT Void String Identity String
-> ParsecT Void String Identity (Maybe String)
forall a b. (a -> b) -> a -> b
$ Parser Char -> ParsecT Void String Identity String
namespacedIdentifier Parser Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
lowerChar
GetterOps
getterOps <- Parser GetterOps
parseGetterOps
ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
ParsecT Void String Identity () -> ParsecT Void String Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void String Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
GetterExp -> Parser GetterExp
forall (m :: * -> *) a. Monad m => a -> m a
return GetterExp :: Maybe String -> GetterOps -> GetterExp
GetterExp{Maybe String
GetterOps
getterOps :: GetterOps
start :: Maybe String
$sel:getterOps:GetterExp :: GetterOps
$sel:start:GetterExp :: Maybe String
..}
data UnwrapSchema = UnwrapSchema
{ UnwrapSchema -> String
startSchema :: String
, UnwrapSchema -> GetterOps
getterOps :: GetterOps
} deriving (Int -> UnwrapSchema -> ShowS
[UnwrapSchema] -> ShowS
UnwrapSchema -> String
(Int -> UnwrapSchema -> ShowS)
-> (UnwrapSchema -> String)
-> ([UnwrapSchema] -> ShowS)
-> Show UnwrapSchema
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnwrapSchema] -> ShowS
$cshowList :: [UnwrapSchema] -> ShowS
show :: UnwrapSchema -> String
$cshow :: UnwrapSchema -> String
showsPrec :: Int -> UnwrapSchema -> ShowS
$cshowsPrec :: Int -> UnwrapSchema -> ShowS
Show)
parseUnwrapSchema :: MonadFail m => String -> m UnwrapSchema
parseUnwrapSchema :: String -> m UnwrapSchema
parseUnwrapSchema = Parser UnwrapSchema -> String -> m UnwrapSchema
forall (m :: * -> *) a. MonadFail m => Parser a -> String -> m a
runParserFail (Parser UnwrapSchema -> String -> m UnwrapSchema)
-> Parser UnwrapSchema -> String -> m UnwrapSchema
forall a b. (a -> b) -> a -> b
$ do
ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
String
startSchema <- Parser Char -> ParsecT Void String Identity String
namespacedIdentifier Parser Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
upperChar
GetterOps
getterOps <- Parser GetterOps
parseGetterOps
ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
ParsecT Void String Identity () -> ParsecT Void String Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void String Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
UnwrapSchema -> Parser UnwrapSchema
forall (m :: * -> *) a. Monad m => a -> m a
return UnwrapSchema :: String -> GetterOps -> UnwrapSchema
UnwrapSchema{String
GetterOps
getterOps :: GetterOps
startSchema :: String
$sel:getterOps:UnwrapSchema :: GetterOps
$sel:startSchema:UnwrapSchema :: String
..}
type GetterOps = NonEmpty GetterOperation
parseGetterOps :: Parser GetterOps
parseGetterOps :: Parser GetterOps
parseGetterOps = [ParsecT Void String Identity GetterOperation] -> Parser GetterOps
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[m a] -> m (NonEmpty a)
someWith [ParsecT Void String Identity GetterOperation
parseGetterOp, ParsecT Void String Identity GetterOperation
parseGetterOpSuffix]
data GetterOperation
= GetterKey String
| GetterBang
| GetterMapList
| GetterMapMaybe
| GetterBranch Int
| GetterList (NonEmpty GetterOps)
| GetterTuple (NonEmpty GetterOps)
deriving (Int -> GetterOperation -> ShowS
[GetterOperation] -> ShowS
GetterOperation -> String
(Int -> GetterOperation -> ShowS)
-> (GetterOperation -> String)
-> ([GetterOperation] -> ShowS)
-> Show GetterOperation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetterOperation] -> ShowS
$cshowList :: [GetterOperation] -> ShowS
show :: GetterOperation -> String
$cshow :: GetterOperation -> String
showsPrec :: Int -> GetterOperation -> ShowS
$cshowsPrec :: Int -> GetterOperation -> ShowS
Show)
parseGetterOp :: Parser GetterOperation
parseGetterOp :: ParsecT Void String Identity GetterOperation
parseGetterOp = [ParsecT Void String Identity GetterOperation]
-> ParsecT Void String Identity GetterOperation
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ String -> ParsecT Void String Identity ()
lexeme String
"!" ParsecT Void String Identity ()
-> GetterOperation -> ParsecT Void String Identity GetterOperation
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> GetterOperation
GetterBang
, String -> ParsecT Void String Identity ()
lexeme String
"[]" ParsecT Void String Identity ()
-> GetterOperation -> ParsecT Void String Identity GetterOperation
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> GetterOperation
GetterMapList
, String -> ParsecT Void String Identity ()
lexeme String
"?" ParsecT Void String Identity ()
-> GetterOperation -> ParsecT Void String Identity GetterOperation
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> GetterOperation
GetterMapMaybe
, String -> ParsecT Void String Identity ()
lexeme String
"@" ParsecT Void String Identity ()
-> ParsecT Void String Identity GetterOperation
-> ParsecT Void String Identity GetterOperation
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int -> GetterOperation
GetterBranch (Int -> GetterOperation)
-> (NonEmpty Char -> Int) -> NonEmpty Char -> GetterOperation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall a. Read a => String -> a
read (String -> Int)
-> (NonEmpty Char -> String) -> NonEmpty Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Char -> String
forall a. NonEmpty a -> [a]
NonEmpty.toList (NonEmpty Char -> GetterOperation)
-> ParsecT Void String Identity (NonEmpty Char)
-> ParsecT Void String Identity GetterOperation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char -> ParsecT Void String Identity (NonEmpty Char)
forall (f :: * -> *) a. MonadPlus f => f a -> f (NonEmpty a)
some Parser Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar)
, ParsecT Void String Identity ()
-> ParsecT Void String Identity (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (String -> ParsecT Void String Identity ()
lexeme String
".") ParsecT Void String Identity (Maybe ())
-> ParsecT Void String Identity GetterOperation
-> ParsecT Void String Identity GetterOperation
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (String -> GetterOperation
GetterKey (String -> GetterOperation)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity GetterOperation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity String
jsonKey)
]
parseGetterOpSuffix :: Parser GetterOperation
parseGetterOpSuffix :: ParsecT Void String Identity GetterOperation
parseGetterOpSuffix = ParsecT Void String Identity ()
-> ParsecT Void String Identity (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (String -> ParsecT Void String Identity ()
lexeme String
".") ParsecT Void String Identity (Maybe ())
-> ParsecT Void String Identity GetterOperation
-> ParsecT Void String Identity GetterOperation
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [ParsecT Void String Identity GetterOperation]
-> ParsecT Void String Identity GetterOperation
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ (NonEmpty GetterOps -> GetterOperation)
-> ParsecT Void String Identity (NonEmpty GetterOps)
-> ParsecT Void String Identity GetterOperation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty GetterOps -> GetterOperation
GetterList (ParsecT Void String Identity (NonEmpty GetterOps)
-> ParsecT Void String Identity GetterOperation)
-> ParsecT Void String Identity (NonEmpty GetterOps)
-> ParsecT Void String Identity GetterOperation
forall a b. (a -> b) -> a -> b
$ ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity (NonEmpty GetterOps)
-> ParsecT Void String Identity (NonEmpty GetterOps)
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (String -> ParsecT Void String Identity ()
lexeme String
"[") (String -> ParsecT Void String Identity ()
lexeme String
"]") (ParsecT Void String Identity (NonEmpty GetterOps)
-> ParsecT Void String Identity (NonEmpty GetterOps))
-> ParsecT Void String Identity (NonEmpty GetterOps)
-> ParsecT Void String Identity (NonEmpty GetterOps)
forall a b. (a -> b) -> a -> b
$ Parser GetterOps
parseGetterOps Parser GetterOps
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity (NonEmpty GetterOps)
forall (f :: * -> *) a sep.
MonadPlus f =>
f a -> f sep -> f (NonEmpty a)
`sepBy1` String -> ParsecT Void String Identity ()
lexeme String
","
, (NonEmpty GetterOps -> GetterOperation)
-> ParsecT Void String Identity (NonEmpty GetterOps)
-> ParsecT Void String Identity GetterOperation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty GetterOps -> GetterOperation
GetterTuple (ParsecT Void String Identity (NonEmpty GetterOps)
-> ParsecT Void String Identity GetterOperation)
-> ParsecT Void String Identity (NonEmpty GetterOps)
-> ParsecT Void String Identity GetterOperation
forall a b. (a -> b) -> a -> b
$ ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity (NonEmpty GetterOps)
-> ParsecT Void String Identity (NonEmpty GetterOps)
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (String -> ParsecT Void String Identity ()
lexeme String
"(") (String -> ParsecT Void String Identity ()
lexeme String
")") (ParsecT Void String Identity (NonEmpty GetterOps)
-> ParsecT Void String Identity (NonEmpty GetterOps))
-> ParsecT Void String Identity (NonEmpty GetterOps)
-> ParsecT Void String Identity (NonEmpty GetterOps)
forall a b. (a -> b) -> a -> b
$ Parser GetterOps
parseGetterOps Parser GetterOps
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity (NonEmpty GetterOps)
forall (f :: * -> *) a sep.
MonadPlus f =>
f a -> f sep -> f (NonEmpty a)
`sepBy1` String -> ParsecT Void String Identity ()
lexeme String
","
]
identifier :: Parser Char -> Parser String
identifier :: Parser Char -> ParsecT Void String Identity String
identifier Parser Char
start = (:) (Char -> ShowS)
-> Parser Char -> ParsecT Void String Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char
start ParsecT Void String Identity ShowS
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Char -> ParsecT Void String Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Parser Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar Parser Char -> Parser Char -> Parser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'\'')
lexeme :: String -> Parser ()
lexeme :: String -> ParsecT Void String Identity ()
lexeme = ParsecT Void String Identity ()
-> String -> ParsecT Void String Identity ()
lexemeUsingLineComment (ParsecT Void String Identity ()
-> String -> ParsecT Void String Identity ())
-> ParsecT Void String Identity ()
-> String
-> ParsecT Void String Identity ()
forall a b. (a -> b) -> a -> b
$ Tokens String -> ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> m ()
L.skipLineComment String
Tokens String
"//"
lexeme' :: String -> Parser ()
lexeme' :: String -> ParsecT Void String Identity ()
lexeme' = ParsecT Void String Identity ()
-> String -> ParsecT Void String Identity ()
lexemeUsingLineComment ParsecT Void String Identity ()
forall (f :: * -> *) a. Alternative f => f a
empty
lexemeUsingLineComment :: Parser () -> String -> Parser ()
ParsecT Void String Identity ()
lineComment = ParsecT Void String Identity String
-> ParsecT Void String Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void String Identity String
-> ParsecT Void String Identity ())
-> (String -> ParsecT Void String Identity String)
-> String
-> ParsecT Void String Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void String Identity ()
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme (ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
L.space ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space1 ParsecT Void String Identity ()
lineComment ParsecT Void String Identity ()
forall (f :: * -> *) a. Alternative f => f a
empty) (ParsecT Void String Identity String
-> ParsecT Void String Identity String)
-> (String -> ParsecT Void String Identity String)
-> String
-> ParsecT Void String Identity String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParsecT Void String Identity String
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string
namespacedIdentifier :: Parser Char -> Parser String
namespacedIdentifier :: Parser Char -> ParsecT Void String Identity String
namespacedIdentifier Parser Char
start = [ParsecT Void String Identity String]
-> ParsecT Void String Identity String
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [String -> ParsecT Void String Identity ()
lexeme String
"(" ParsecT Void String Identity ()
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity String
namespaced ParsecT Void String Identity String
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> ParsecT Void String Identity ()
lexeme String
")", ParsecT Void String Identity String
ident]
where
ident :: ParsecT Void String Identity String
ident = Parser Char -> ParsecT Void String Identity String
identifier Parser Char
start
namespaced :: ParsecT Void String Identity String
namespaced = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." ([String] -> String)
-> ParsecT Void String Identity [String]
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity [String]
forall (m :: * -> *) e s a.
MonadParsec e s m =>
m a -> m a -> m [a]
manyAndEnd (Parser Char -> ParsecT Void String Identity String
identifier Parser Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
upperChar ParsecT Void String Identity String
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> ParsecT Void String Identity ()
lexeme String
".") ParsecT Void String Identity String
ident
manyAndEnd :: m a -> m a -> m [a]
manyAndEnd m a
p m a
end = [m [a]] -> m [a]
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ m [a] -> m [a]
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m [a] -> m [a]) -> m [a] -> m [a]
forall a b. (a -> b) -> a -> b
$ m a
p m a -> (a -> m [a]) -> m [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x -> (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> m [a] -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a -> m a -> m [a]
manyAndEnd m a
p m a
end
, (a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[]) (a -> [a]) -> m a -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
end
]
jsonKey :: Parser String
jsonKey :: ParsecT Void String Identity String
jsonKey = [ParsecT Void String Identity String]
-> ParsecT Void String Identity String
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'"' Parser Char
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity String
jsonKey' ParsecT Void String Identity String
-> Parser Char -> ParsecT Void String Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'"', ParsecT Void String Identity String
jsonKey']
jsonKey' :: Parser String
jsonKey' :: ParsecT Void String Identity String
jsonKey' = (NonEmpty Char -> String)
-> ParsecT Void String Identity (NonEmpty Char)
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty Char -> String
forall a. NonEmpty a -> [a]
NonEmpty.toList (ParsecT Void String Identity (NonEmpty Char)
-> ParsecT Void String Identity String)
-> ParsecT Void String Identity (NonEmpty Char)
-> ParsecT Void String Identity String
forall a b. (a -> b) -> a -> b
$ Parser Char -> ParsecT Void String Identity (NonEmpty Char)
forall (f :: * -> *) a. MonadPlus f => f a -> f (NonEmpty a)
some (Parser Char -> ParsecT Void String Identity (NonEmpty Char))
-> Parser Char -> ParsecT Void String Identity (NonEmpty Char)
forall a b. (a -> b) -> a -> b
$ [Parser Char] -> Parser Char
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ Parser Char -> Parser Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser Char -> Parser Char) -> Parser Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'\\' Parser Char -> Parser Char -> Parser Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Char
ParsecT Void String Identity (Token String)
anySingle'
, [Token String] -> ParsecT Void String Identity (Token String)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf ([Token String] -> ParsecT Void String Identity (Token String))
-> [Token String] -> ParsecT Void String Identity (Token String)
forall a b. (a -> b) -> a -> b
$ [Char
' ', Char
'\\', Char
'"'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
schemaChars String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
getChars
]
where
#if MIN_VERSION_megaparsec(7,0,0)
anySingle' :: ParsecT Void String Identity (Token String)
anySingle' = ParsecT Void String Identity (Token String)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle
#else
anySingle' = anyChar
#endif
getChars :: String
getChars = String
"!?[](),.@"
schemaChars :: String
schemaChars = String
":{}#"
some :: MonadPlus f => f a -> f (NonEmpty a)
some :: f a -> f (NonEmpty a)
some f a
p = [a] -> NonEmpty a
forall a. [a] -> NonEmpty a
NonEmpty.fromList ([a] -> NonEmpty a) -> f [a] -> f (NonEmpty a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> f [a]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
Megaparsec.some f a
p
sepBy1 :: MonadPlus f => f a -> f sep -> f (NonEmpty a)
sepBy1 :: f a -> f sep -> f (NonEmpty a)
sepBy1 f a
p f sep
sep = [a] -> NonEmpty a
forall a. [a] -> NonEmpty a
NonEmpty.fromList ([a] -> NonEmpty a) -> f [a] -> f (NonEmpty a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> f sep -> f [a]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
Megaparsec.sepBy1 f a
p f sep
sep
sepEndBy1 :: MonadPlus f => f a -> f sep -> f (NonEmpty a)
sepEndBy1 :: f a -> f sep -> f (NonEmpty a)
sepEndBy1 f a
p f sep
sep = [a] -> NonEmpty a
forall a. [a] -> NonEmpty a
NonEmpty.fromList ([a] -> NonEmpty a) -> f [a] -> f (NonEmpty a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> f sep -> f [a]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
Megaparsec.sepEndBy1 f a
p f sep
sep
someWith :: MonadParsec e s m => [m a] -> m (NonEmpty a)
someWith :: [m a] -> m (NonEmpty a)
someWith [m a]
ps = do
[a]
as <- (m a -> m [a]) -> [m a] -> m [a]
forall (t :: * -> *) (f :: * -> *) a a.
(Traversable t, Monad f) =>
(a -> f [a]) -> t a -> f [a]
concatMapM (m a -> m [a]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (m a -> m [a]) -> (m a -> m a) -> m a -> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try) [m a]
ps
m (NonEmpty a)
-> (NonEmpty a -> m (NonEmpty a))
-> Maybe (NonEmpty a)
-> m (NonEmpty a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m (NonEmpty a)
forall (f :: * -> *) a. Alternative f => f a
empty NonEmpty a -> m (NonEmpty a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (NonEmpty a) -> m (NonEmpty a))
-> Maybe (NonEmpty a) -> m (NonEmpty a)
forall a b. (a -> b) -> a -> b
$ [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty [a]
as
where
concatMapM :: (a -> f [a]) -> t a -> f [a]
concatMapM a -> f [a]
f = (t [a] -> [a]) -> f (t [a]) -> f [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap t [a] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (f (t [a]) -> f [a]) -> (t a -> f (t [a])) -> t a -> f [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f [a]) -> t a -> f (t [a])
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> f [a]
f