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