{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}

{- HLINT ignore structField "Reduce duplication" -}
{- HLINT ignore typeRef "Use <$>" -}

module FlatBuffers.Internal.Compiler.Parser where

import           Control.Monad                            ( when )
import qualified Control.Monad.Combinators.NonEmpty       as NE

import qualified Data.ByteString                          as BS
import           Data.Coerce                              ( coerce )
import           Data.Functor                             ( (<&>), void )
import           Data.List.NonEmpty                       ( NonEmpty((:|)) )
import qualified Data.List.NonEmpty                       as NE
import qualified Data.Map.Strict                          as Map
import           Data.Maybe                               ( catMaybes )
import           Data.Scientific                          ( Scientific )
import           Data.Text                                ( Text )
import qualified Data.Text                                as T
import qualified Data.Text.Encoding                       as T
import           Data.Void                                ( Void )
import           Data.Word                                ( Word8 )

import           FlatBuffers.Internal.Compiler.SyntaxTree
import           FlatBuffers.Internal.Constants           ( fileIdentifierSize )

import           Text.Megaparsec
import           Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer               as L
import           Text.Read                                ( readMaybe )


type Parser = Parsec Void String

-- | Roughly based on: https://google.github.io/flatbuffers/flatbuffers_grammar.html.
-- Differences between this parser and the above grammar:
--
--   * Unions members now support aliases.
--   * An enum's underlying type used to be optional (defaulting to @short@), but now it's mandatory.
--   * Attributes can be reffered to either as an identifier or as a string literal (e.g. @attr@ or @"attr"@).
--   * Struct fields can't have default values.
--   * The grammar states that table/struct field defaults can only be scalars (integer/floating point constants),
--     when in reality, it could be also be a boolean or an enum identifier.
--   * The grammar says attribute values can be integers, floats or string literals.
--     Flatc only allows integers and string literals. To make things simpler, we decided to go with flatc's
--     approach and disallow floats.
--   * The grammar says namespaces must include at least one fragment, but an empty namespace
--     (i.e. @namespace ;@) is perfectly valid.
--   * This supports @native_include@ statements
--     (see: https://google.github.io/flatbuffers/flatbuffers_guide_use_cpp.html#flatbuffers_cpp_object_based_api)
schema :: Parser Schema
schema :: Parser Schema
schema = do
  Parser ()
sc
  [Include]
includes <- [Maybe Include] -> [Include]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Include] -> [Include])
-> ParsecT Void String Identity [Maybe Include]
-> ParsecT Void String Identity [Include]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity (Maybe Include)
-> ParsecT Void String Identity [Maybe Include]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Include -> Maybe Include
forall a. a -> Maybe a
Just (Include -> Maybe Include)
-> ParsecT Void String Identity Include
-> ParsecT Void String Identity (Maybe Include)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity Include
include ParsecT Void String Identity (Maybe Include)
-> ParsecT Void String Identity (Maybe Include)
-> ParsecT Void String Identity (Maybe Include)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Include
forall a. Maybe a
Nothing Maybe Include
-> Parser () -> ParsecT Void String Identity (Maybe Include)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
nativeInclude)
  [Maybe Decl]
decls <- ParsecT Void String Identity (Maybe Decl)
-> ParsecT Void String Identity [Maybe Decl]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT Void String Identity (Maybe Decl)
decl ParsecT Void String Identity (Maybe Decl)
-> ParsecT Void String Identity (Maybe Decl)
-> ParsecT Void String Identity (Maybe Decl)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void String Identity (Maybe Decl)
forall a. ParsecT Void String Identity a
failOnInclude)
  Parser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
  Schema -> Parser Schema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Schema -> Parser Schema) -> Schema -> Parser Schema
forall a b. (a -> b) -> a -> b
$ [Include] -> [Decl] -> Schema
Schema [Include]
includes ([Maybe Decl] -> [Decl]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Decl]
decls)
  where
    failOnInclude :: ParsecT Void String Identity a
failOnInclude =
      String -> Parser ()
rword String
"include" Parser ()
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> ParsecT Void String Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"\"include\" statements must be at the beginning of the file."
      ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> Parser ()
rword String
"native_include" Parser ()
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> ParsecT Void String Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"\"native_include\" statements must be at the beginning of the file.")

decl :: Parser (Maybe Decl)
decl :: ParsecT Void String Identity (Maybe Decl)
decl =
  [ParsecT Void String Identity (Maybe Decl)]
-> ParsecT Void String Identity (Maybe Decl)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Decl -> Maybe Decl
forall a. a -> Maybe a
Just (Decl -> Maybe Decl)
-> (NamespaceDecl -> Decl) -> NamespaceDecl -> Maybe Decl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamespaceDecl -> Decl
DeclN (NamespaceDecl -> Maybe Decl)
-> ParsecT Void String Identity NamespaceDecl
-> ParsecT Void String Identity (Maybe Decl)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity NamespaceDecl
namespaceDecl
    , Decl -> Maybe Decl
forall a. a -> Maybe a
Just (Decl -> Maybe Decl)
-> (TableDecl -> Decl) -> TableDecl -> Maybe Decl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableDecl -> Decl
DeclT (TableDecl -> Maybe Decl)
-> ParsecT Void String Identity TableDecl
-> ParsecT Void String Identity (Maybe Decl)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity TableDecl
tableDecl
    , Decl -> Maybe Decl
forall a. a -> Maybe a
Just (Decl -> Maybe Decl)
-> (StructDecl -> Decl) -> StructDecl -> Maybe Decl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructDecl -> Decl
DeclS (StructDecl -> Maybe Decl)
-> ParsecT Void String Identity StructDecl
-> ParsecT Void String Identity (Maybe Decl)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity StructDecl
structDecl
    , Decl -> Maybe Decl
forall a. a -> Maybe a
Just (Decl -> Maybe Decl)
-> (EnumDecl -> Decl) -> EnumDecl -> Maybe Decl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumDecl -> Decl
DeclE (EnumDecl -> Maybe Decl)
-> ParsecT Void String Identity EnumDecl
-> ParsecT Void String Identity (Maybe Decl)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity EnumDecl
enumDecl
    , Decl -> Maybe Decl
forall a. a -> Maybe a
Just (Decl -> Maybe Decl)
-> (UnionDecl -> Decl) -> UnionDecl -> Maybe Decl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnionDecl -> Decl
DeclU (UnionDecl -> Maybe Decl)
-> ParsecT Void String Identity UnionDecl
-> ParsecT Void String Identity (Maybe Decl)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity UnionDecl
unionDecl
    , Decl -> Maybe Decl
forall a. a -> Maybe a
Just (Decl -> Maybe Decl)
-> (RootDecl -> Decl) -> RootDecl -> Maybe Decl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RootDecl -> Decl
DeclR (RootDecl -> Maybe Decl)
-> ParsecT Void String Identity RootDecl
-> ParsecT Void String Identity (Maybe Decl)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity RootDecl
rootDecl
    , Decl -> Maybe Decl
forall a. a -> Maybe a
Just (Decl -> Maybe Decl)
-> (FileIdentifierDecl -> Decl) -> FileIdentifierDecl -> Maybe Decl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileIdentifierDecl -> Decl
DeclFI (FileIdentifierDecl -> Maybe Decl)
-> ParsecT Void String Identity FileIdentifierDecl
-> ParsecT Void String Identity (Maybe Decl)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity FileIdentifierDecl
fileIdentifierDecl
    , Decl -> Maybe Decl
forall a. a -> Maybe a
Just (Decl -> Maybe Decl)
-> (AttributeDecl -> Decl) -> AttributeDecl -> Maybe Decl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttributeDecl -> Decl
DeclA (AttributeDecl -> Maybe Decl)
-> ParsecT Void String Identity AttributeDecl
-> ParsecT Void String Identity (Maybe Decl)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity AttributeDecl
attributeDecl
    , Maybe Decl
forall a. Maybe a
Nothing Maybe Decl
-> Parser () -> ParsecT Void String Identity (Maybe Decl)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
fileExtensionDecl
    , Maybe Decl
forall a. Maybe a
Nothing Maybe Decl
-> Parser () -> ParsecT Void String Identity (Maybe Decl)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
jsonObj
    , Maybe Decl
forall a. Maybe a
Nothing Maybe Decl
-> Parser () -> ParsecT Void String Identity (Maybe Decl)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
rpcDecl
    ]

-- | space consumer - this consumes and ignores any whitespace + comments
sc :: Parser ()
sc :: Parser ()
sc = Parser () -> Parser () -> Parser () -> Parser ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
L.space Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space1 Parser ()
lineCmnt Parser ()
blockCmnt
  where
    lineCmnt :: Parser ()
lineCmnt  = Tokens String -> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> m ()
L.skipLineComment Tokens String
"//"
    blockCmnt :: Parser ()
blockCmnt = Tokens String -> Tokens String -> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> Tokens s -> m ()
L.skipBlockComment Tokens String
"/*" Tokens String
"*/"

lexeme :: Parser a -> Parser a
lexeme :: Parser a -> Parser a
lexeme = Parser () -> Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme Parser ()
sc

symbol :: String -> Parser String
symbol :: String -> Parser String
symbol = Parser ()
-> Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
L.symbol Parser ()
sc

rword :: String -> Parser ()
rword :: String -> Parser ()
rword String
w = (Parser () -> Parser ()
forall a. Parser a -> Parser a
lexeme (Parser () -> Parser ())
-> (Parser () -> Parser ()) -> Parser () -> Parser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser () -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try) (Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
w Parser String -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity Char -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (ParsecT Void String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity 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
'_'))

curly, square, parens :: Parser a -> Parser a
curly :: Parser a -> Parser a
curly = Parser String -> Parser String -> Parser a -> Parser a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (String -> Parser String
symbol String
"{") (String -> Parser String
symbol String
"}")
square :: Parser a -> Parser a
square = Parser String -> Parser String -> Parser a -> Parser a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (String -> Parser String
symbol String
"[") (String -> Parser String
symbol String
"]")
parens :: Parser a -> Parser a
parens = Parser String -> Parser String -> Parser a -> Parser a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (String -> Parser String
symbol String
"(") (String -> Parser String
symbol String
")")


commaSep :: Parser a -> Parser [a]
commaSep :: Parser a -> Parser [a]
commaSep Parser a
p = Parser a -> Parser String -> Parser [a]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy Parser a
p (String -> Parser String
symbol String
",")

commaSep1 :: Parser a -> Parser (NonEmpty a)
commaSep1 :: Parser a -> Parser (NonEmpty a)
commaSep1 Parser a
p = Parser a -> Parser String -> Parser (NonEmpty a)
forall (m :: * -> *) a sep.
MonadPlus m =>
m a -> m sep -> m (NonEmpty a)
NE.sepBy1 Parser a
p (String -> Parser String
symbol String
",")

commaSepEndBy1 :: Parser a -> Parser (NonEmpty a)
commaSepEndBy1 :: Parser a -> Parser (NonEmpty a)
commaSepEndBy1 Parser a
p = Parser a -> Parser String -> Parser (NonEmpty a)
forall (m :: * -> *) a sep.
MonadPlus m =>
m a -> m sep -> m (NonEmpty a)
NE.sepEndBy1 Parser a
p (String -> Parser String
symbol String
",")

semi, colon :: Parser ()
semi :: Parser ()
semi = Parser String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser String -> Parser ()) -> Parser String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> Parser String
symbol String
";"
colon :: Parser ()
colon = Parser String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser String -> Parser ()) -> Parser String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> Parser String
symbol String
":"

ident :: Parser Ident
ident :: Parser Ident
ident = String -> Parser Ident -> Parser Ident
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"identifier" (Parser Ident -> Parser Ident) -> Parser Ident -> Parser Ident
forall a b. (a -> b) -> a -> b
$ (Parser Ident -> Parser Ident
forall a. Parser a -> Parser a
lexeme (Parser Ident -> Parser Ident)
-> (Parser Ident -> Parser Ident) -> Parser Ident -> Parser Ident
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Ident -> Parser Ident
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try) Parser Ident
identifier
  where
    identifier :: Parser Ident
identifier = (String -> Ident) -> Parser String -> Parser Ident
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Ident
Ident (Text -> Ident) -> (String -> Text) -> String -> Ident
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) (Parser String -> Parser Ident) -> Parser String -> Parser Ident
forall a b. (a -> b) -> a -> b
$ (:) (Char -> String -> String)
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
letterChar ParsecT Void String Identity (String -> String)
-> Parser String -> Parser String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void String Identity Char -> Parser String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT Void String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity 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
'_')

typ :: Parser Type
typ :: Parser Type
typ =
  Type
TInt8 Type -> Parser () -> Parser Type
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (String -> Parser ()
rword String
"int8" Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser ()
rword String
"byte") Parser Type -> Parser Type -> Parser Type
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Type
TInt16 Type -> Parser () -> Parser Type
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (String -> Parser ()
rword String
"int16" Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser ()
rword String
"short") Parser Type -> Parser Type -> Parser Type
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Type
TInt32 Type -> Parser () -> Parser Type
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (String -> Parser ()
rword String
"int32" Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser ()
rword String
"int") Parser Type -> Parser Type -> Parser Type
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Type
TInt64 Type -> Parser () -> Parser Type
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (String -> Parser ()
rword String
"int64" Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser ()
rword String
"long") Parser Type -> Parser Type -> Parser Type
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Type
TWord8 Type -> Parser () -> Parser Type
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (String -> Parser ()
rword String
"uint8" Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser ()
rword String
"ubyte") Parser Type -> Parser Type -> Parser Type
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Type
TWord16 Type -> Parser () -> Parser Type
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (String -> Parser ()
rword String
"uint16" Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser ()
rword String
"ushort") Parser Type -> Parser Type -> Parser Type
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Type
TWord32 Type -> Parser () -> Parser Type
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (String -> Parser ()
rword String
"uint32" Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser ()
rword String
"uint") Parser Type -> Parser Type -> Parser Type
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Type
TWord64 Type -> Parser () -> Parser Type
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (String -> Parser ()
rword String
"uint64" Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser ()
rword String
"ulong") Parser Type -> Parser Type -> Parser Type
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>

  Type
TFloat Type -> Parser () -> Parser Type
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (String -> Parser ()
rword String
"float32" Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser ()
rword String
"float") Parser Type -> Parser Type -> Parser Type
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Type
TDouble Type -> Parser () -> Parser Type
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (String -> Parser ()
rword String
"float64" Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser ()
rword String
"double") Parser Type -> Parser Type -> Parser Type
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>

  Type
TBool Type -> Parser () -> Parser Type
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
rword String
"bool" Parser Type -> Parser Type -> Parser Type
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Type
TString Type -> Parser () -> Parser Type
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
rword String
"string" Parser Type -> Parser Type -> Parser Type
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  String -> Parser Type -> Parser Type
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"type identifier" (TypeRef -> Type
TRef (TypeRef -> Type)
-> ParsecT Void String Identity TypeRef -> Parser Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity TypeRef
typeRef) Parser Type -> Parser Type -> Parser Type
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  String -> Parser Type -> Parser Type
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"vector type" Parser Type
vector
  where
    vector :: Parser Type
vector = Type -> Type
TVector (Type -> Type) -> Parser Type -> Parser Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser () -> Parser String -> Parser Type -> Parser Type
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between
              (String -> Parser String
symbol String
"[" Parser String -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser String -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (String -> Parser String
symbol String
"[") Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"nested vector types not supported" ))
              (String -> Parser String
symbol String
"]")
              Parser Type
typ

typeRef :: Parser TypeRef
typeRef :: ParsecT Void String Identity TypeRef
typeRef = do
  [Ident]
idents <- Parser Ident -> ParsecT Void String Identity [Ident]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Parser Ident -> Parser Ident
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser Ident
ident Parser Ident -> Parser String -> Parser Ident
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> Parser String
symbol String
"."))
  Ident
i <- Parser Ident
ident
  TypeRef -> ParsecT Void String Identity TypeRef
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeRef -> ParsecT Void String Identity TypeRef)
-> TypeRef -> ParsecT Void String Identity TypeRef
forall a b. (a -> b) -> a -> b
$ Namespace -> Ident -> TypeRef
TypeRef ([Text] -> Namespace
Namespace ([Ident] -> [Text]
coerce [Ident]
idents)) Ident
i

tableField :: Parser TableField
tableField :: Parser TableField
tableField = do
  Ident
i <- Parser Ident
ident
  Parser ()
colon
  Type
t <- Parser Type
typ
  Maybe DefaultVal
def <- ParsecT Void String Identity DefaultVal
-> ParsecT Void String Identity (Maybe DefaultVal)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (String -> Parser String
symbol String
"=" Parser String
-> ParsecT Void String Identity DefaultVal
-> ParsecT Void String Identity DefaultVal
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity DefaultVal
defaultVal)
  Metadata
md <- Parser Metadata
metadata
  Parser ()
semi
  TableField -> Parser TableField
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TableField -> Parser TableField)
-> TableField -> Parser TableField
forall a b. (a -> b) -> a -> b
$ Ident -> Type -> Maybe DefaultVal -> Metadata -> TableField
TableField Ident
i Type
t Maybe DefaultVal
def Metadata
md

structField :: Parser StructField
structField :: Parser StructField
structField = do
  Ident
i <- Parser Ident
ident
  Parser ()
colon
  Type
t <- Parser Type
typ
  Metadata
md <- Parser Metadata
metadata
  Parser ()
semi
  StructField -> Parser StructField
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StructField -> Parser StructField)
-> StructField -> Parser StructField
forall a b. (a -> b) -> a -> b
$ Ident -> Type -> Metadata -> StructField
StructField Ident
i Type
t Metadata
md

tableDecl :: Parser TableDecl
tableDecl :: ParsecT Void String Identity TableDecl
tableDecl = do
  String -> Parser ()
rword String
"table"
  Ident
i <- Parser Ident
ident
  Metadata
md <- Parser Metadata
metadata
  [TableField]
fs <- Parser [TableField] -> Parser [TableField]
forall a. Parser a -> Parser a
curly (Parser TableField -> Parser [TableField]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser TableField
tableField)
  TableDecl -> ParsecT Void String Identity TableDecl
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TableDecl -> ParsecT Void String Identity TableDecl)
-> TableDecl -> ParsecT Void String Identity TableDecl
forall a b. (a -> b) -> a -> b
$ Ident -> Metadata -> [TableField] -> TableDecl
TableDecl Ident
i Metadata
md [TableField]
fs

structDecl :: Parser StructDecl
structDecl :: ParsecT Void String Identity StructDecl
structDecl = do
  String -> Parser ()
rword String
"struct"
  Ident
i <- Parser Ident
ident
  Metadata
md <- Parser Metadata
metadata
  NonEmpty StructField
fs <- Parser (NonEmpty StructField) -> Parser (NonEmpty StructField)
forall a. Parser a -> Parser a
curly (Parser StructField -> Parser (NonEmpty StructField)
forall (m :: * -> *) a. MonadPlus m => m a -> m (NonEmpty a)
NE.some Parser StructField
structField)
  StructDecl -> ParsecT Void String Identity StructDecl
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StructDecl -> ParsecT Void String Identity StructDecl)
-> StructDecl -> ParsecT Void String Identity StructDecl
forall a b. (a -> b) -> a -> b
$ Ident -> Metadata -> NonEmpty StructField -> StructDecl
StructDecl Ident
i Metadata
md NonEmpty StructField
fs

enumDecl :: Parser EnumDecl
enumDecl :: ParsecT Void String Identity EnumDecl
enumDecl = do
  String -> Parser ()
rword String
"enum"
  Ident
i <- Parser Ident
ident
  Parser ()
colon
  Type
t <- Parser Type
typ
  Metadata
md <- Parser Metadata
metadata
  NonEmpty EnumVal
v <- Parser (NonEmpty EnumVal) -> Parser (NonEmpty EnumVal)
forall a. Parser a -> Parser a
curly (Parser EnumVal -> Parser (NonEmpty EnumVal)
forall a. Parser a -> Parser (NonEmpty a)
commaSepEndBy1 Parser EnumVal
enumVal)
  EnumDecl -> ParsecT Void String Identity EnumDecl
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EnumDecl -> ParsecT Void String Identity EnumDecl)
-> EnumDecl -> ParsecT Void String Identity EnumDecl
forall a b. (a -> b) -> a -> b
$ Ident -> Type -> Metadata -> NonEmpty EnumVal -> EnumDecl
EnumDecl Ident
i Type
t Metadata
md NonEmpty EnumVal
v

enumVal :: Parser EnumVal
enumVal :: Parser EnumVal
enumVal = Ident -> Maybe IntLiteral -> EnumVal
EnumVal (Ident -> Maybe IntLiteral -> EnumVal)
-> Parser Ident
-> ParsecT Void String Identity (Maybe IntLiteral -> EnumVal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Ident
ident ParsecT Void String Identity (Maybe IntLiteral -> EnumVal)
-> ParsecT Void String Identity (Maybe IntLiteral)
-> Parser EnumVal
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void String Identity IntLiteral
-> ParsecT Void String Identity (Maybe IntLiteral)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (String -> Parser String
symbol String
"=" Parser String
-> ParsecT Void String Identity IntLiteral
-> ParsecT Void String Identity IntLiteral
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity IntLiteral
intLiteral)

unionDecl :: Parser UnionDecl
unionDecl :: ParsecT Void String Identity UnionDecl
unionDecl = do
  String -> Parser ()
rword String
"union"
  Ident
i <- Parser Ident
ident
  Metadata
md <- Parser Metadata
metadata
  NonEmpty UnionVal
v <- Parser (NonEmpty UnionVal) -> Parser (NonEmpty UnionVal)
forall a. Parser a -> Parser a
curly (Parser UnionVal -> Parser (NonEmpty UnionVal)
forall a. Parser a -> Parser (NonEmpty a)
commaSepEndBy1 Parser UnionVal
unionVal)
  UnionDecl -> ParsecT Void String Identity UnionDecl
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UnionDecl -> ParsecT Void String Identity UnionDecl)
-> UnionDecl -> ParsecT Void String Identity UnionDecl
forall a b. (a -> b) -> a -> b
$ Ident -> Metadata -> NonEmpty UnionVal -> UnionDecl
UnionDecl Ident
i Metadata
md NonEmpty UnionVal
v

unionVal :: Parser UnionVal
unionVal :: Parser UnionVal
unionVal = Maybe Ident -> TypeRef -> UnionVal
UnionVal (Maybe Ident -> TypeRef -> UnionVal)
-> ParsecT Void String Identity (Maybe Ident)
-> ParsecT Void String Identity (TypeRef -> UnionVal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Ident -> ParsecT Void String Identity (Maybe Ident)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Ident -> Parser Ident
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser Ident
ident Parser Ident -> Parser () -> Parser Ident
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
colon)) ParsecT Void String Identity (TypeRef -> UnionVal)
-> ParsecT Void String Identity TypeRef -> Parser UnionVal
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void String Identity TypeRef
typeRef

namespaceDecl :: Parser NamespaceDecl
namespaceDecl :: ParsecT Void String Identity NamespaceDecl
namespaceDecl =
  Namespace -> NamespaceDecl
NamespaceDecl (Namespace -> NamespaceDecl)
-> ([Ident] -> Namespace) -> [Ident] -> NamespaceDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Namespace
Namespace ([Text] -> Namespace)
-> ([Ident] -> [Text]) -> [Ident] -> Namespace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ident] -> [Text]
coerce ([Ident] -> NamespaceDecl)
-> ParsecT Void String Identity [Ident]
-> ParsecT Void String Identity NamespaceDecl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    (String -> Parser ()
rword String
"namespace" Parser ()
-> ParsecT Void String Identity [Ident]
-> ParsecT Void String Identity [Ident]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Ident
-> Parser String -> ParsecT Void String Identity [Ident]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy Parser Ident
ident (String -> Parser String
symbol String
".") ParsecT Void String Identity [Ident]
-> Parser () -> ParsecT Void String Identity [Ident]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
semi)

stringLiteral :: Parser StringLiteral
stringLiteral :: Parser StringLiteral
stringLiteral =
  String -> Parser StringLiteral -> Parser StringLiteral
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"string literal" (Parser StringLiteral -> Parser StringLiteral)
-> Parser StringLiteral -> Parser StringLiteral
forall a b. (a -> b) -> a -> b
$
    (String -> StringLiteral) -> Parser String -> Parser StringLiteral
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> StringLiteral
StringLiteral (Text -> StringLiteral)
-> (String -> Text) -> String -> StringLiteral
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) (Parser String -> Parser StringLiteral)
-> (Parser String -> Parser String)
-> Parser String
-> Parser StringLiteral
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser String -> Parser String
forall a. Parser a -> Parser a
lexeme (Parser String -> Parser StringLiteral)
-> Parser String -> Parser StringLiteral
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
'"' ParsecT Void String Identity Char -> Parser String -> Parser String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void String Identity Char
-> ParsecT Void String Identity Char -> Parser String
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
manyTill ParsecT Void String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Char
L.charLiteral (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
'"')

intLiteral :: Parser IntLiteral
intLiteral :: ParsecT Void String Identity IntLiteral
intLiteral =
  String
-> ParsecT Void String Identity IntLiteral
-> ParsecT Void String Identity IntLiteral
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"integer literal" (ParsecT Void String Identity IntLiteral
 -> ParsecT Void String Identity IntLiteral)
-> (ParsecT Void String Identity IntLiteral
    -> ParsecT Void String Identity IntLiteral)
-> ParsecT Void String Identity IntLiteral
-> ParsecT Void String Identity IntLiteral
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void String Identity IntLiteral
-> ParsecT Void String Identity IntLiteral
forall a. Parser a -> Parser a
lexeme (ParsecT Void String Identity IntLiteral
 -> ParsecT Void String Identity IntLiteral)
-> ParsecT Void String Identity IntLiteral
-> ParsecT Void String Identity IntLiteral
forall a b. (a -> b) -> a -> b
$
    Parser ()
-> ParsecT Void String Identity IntLiteral
-> ParsecT Void String Identity IntLiteral
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
L.signed Parser ()
sc ParsecT Void String Identity IntLiteral
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal

attributeVal :: Parser AttributeVal
attributeVal :: Parser AttributeVal
attributeVal =
  [Parser AttributeVal] -> Parser AttributeVal
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Integer -> AttributeVal
AttrI (Integer -> AttributeVal)
-> (IntLiteral -> Integer) -> IntLiteral -> AttributeVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntLiteral -> Integer
unIntLiteral (IntLiteral -> AttributeVal)
-> ParsecT Void String Identity IntLiteral -> Parser AttributeVal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity IntLiteral
intLiteral
    , Text -> AttributeVal
AttrS (Text -> AttributeVal)
-> (StringLiteral -> Text) -> StringLiteral -> AttributeVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringLiteral -> Text
unStringLiteral (StringLiteral -> AttributeVal)
-> Parser StringLiteral -> Parser AttributeVal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser StringLiteral
stringLiteral
    ]

defaultVal :: Parser DefaultVal
defaultVal :: ParsecT Void String Identity DefaultVal
defaultVal =
  [ParsecT Void String Identity DefaultVal]
-> ParsecT Void String Identity DefaultVal
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Bool -> DefaultVal
DefaultBool Bool
True DefaultVal -> Parser () -> ParsecT Void String Identity DefaultVal
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
rword String
"true"
    , Bool -> DefaultVal
DefaultBool Bool
False DefaultVal -> Parser () -> ParsecT Void String Identity DefaultVal
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
rword String
"false"
    , Scientific -> DefaultVal
DefaultNum (Scientific -> DefaultVal)
-> ParsecT Void String Identity Scientific
-> ParsecT Void String Identity DefaultVal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> ParsecT Void String Identity Scientific
-> ParsecT Void String Identity Scientific
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"number literal" (ParsecT Void String Identity Scientific
-> ParsecT Void String Identity Scientific
forall a. Parser a -> Parser a
lexeme (Parser ()
-> ParsecT Void String Identity Scientific
-> ParsecT Void String Identity Scientific
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
L.signed Parser ()
sc ParsecT Void String Identity Scientific
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Scientific
L.scientific))
    , Parser Ident
ident Parser Ident
-> (Ident -> DefaultVal) -> ParsecT Void String Identity DefaultVal
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Ident Text
ref) -> NonEmpty Text -> DefaultVal
DefaultRef (Text
ref Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:| [])
    , Parser StringLiteral
stringLiteral Parser StringLiteral
-> (StringLiteral -> ParsecT Void String Identity DefaultVal)
-> ParsecT Void String Identity DefaultVal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(StringLiteral Text
str) ->
        case Text -> Text
T.strip Text
str of
          Text
"true"  -> DefaultVal -> ParsecT Void String Identity DefaultVal
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DefaultVal -> ParsecT Void String Identity DefaultVal)
-> DefaultVal -> ParsecT Void String Identity DefaultVal
forall a b. (a -> b) -> a -> b
$ Bool -> DefaultVal
DefaultBool Bool
True
          Text
"false" -> DefaultVal -> ParsecT Void String Identity DefaultVal
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DefaultVal -> ParsecT Void String Identity DefaultVal)
-> DefaultVal -> ParsecT Void String Identity DefaultVal
forall a b. (a -> b) -> a -> b
$ Bool -> DefaultVal
DefaultBool Bool
False
          Text
other ->
            case String -> Maybe Scientific
forall a. Read a => String -> Maybe a
readMaybe @Scientific (Text -> String
T.unpack Text
other) of
              Just Scientific
n  -> DefaultVal -> ParsecT Void String Identity DefaultVal
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DefaultVal -> ParsecT Void String Identity DefaultVal)
-> DefaultVal -> ParsecT Void String Identity DefaultVal
forall a b. (a -> b) -> a -> b
$ Scientific -> DefaultVal
DefaultNum Scientific
n
              Maybe Scientific
Nothing ->
                case [Text] -> Maybe (NonEmpty Text)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty (Text -> [Text]
T.words Text
str) of
                  Just NonEmpty Text
refs -> DefaultVal -> ParsecT Void String Identity DefaultVal
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DefaultVal -> ParsecT Void String Identity DefaultVal)
-> DefaultVal -> ParsecT Void String Identity DefaultVal
forall a b. (a -> b) -> a -> b
$ NonEmpty Text -> DefaultVal
DefaultRef NonEmpty Text
refs
                  Maybe (NonEmpty Text)
Nothing   -> String -> ParsecT Void String Identity DefaultVal
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected 'true', 'false', a number, or one or more identifiers"
    ]

metadata :: Parser Metadata
metadata :: Parser Metadata
metadata =
  String -> Parser Metadata -> Parser Metadata
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"metadata"
    (Parser Metadata -> Parser Metadata)
-> (Parser (Text, Maybe AttributeVal) -> Parser Metadata)
-> Parser (Text, Maybe AttributeVal)
-> Parser Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (NonEmpty (Text, Maybe AttributeVal)) -> Metadata)
-> ParsecT
     Void String Identity (Maybe (NonEmpty (Text, Maybe AttributeVal)))
-> Parser Metadata
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map Text (Maybe AttributeVal) -> Metadata
Metadata (Map Text (Maybe AttributeVal) -> Metadata)
-> (Maybe (NonEmpty (Text, Maybe AttributeVal))
    -> Map Text (Maybe AttributeVal))
-> Maybe (NonEmpty (Text, Maybe AttributeVal))
-> Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Maybe AttributeVal)] -> Map Text (Maybe AttributeVal)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, Maybe AttributeVal)] -> Map Text (Maybe AttributeVal))
-> (Maybe (NonEmpty (Text, Maybe AttributeVal))
    -> [(Text, Maybe AttributeVal)])
-> Maybe (NonEmpty (Text, Maybe AttributeVal))
-> Map Text (Maybe AttributeVal)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Maybe AttributeVal)]
-> (NonEmpty (Text, Maybe AttributeVal)
    -> [(Text, Maybe AttributeVal)])
-> Maybe (NonEmpty (Text, Maybe AttributeVal))
-> [(Text, Maybe AttributeVal)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] NonEmpty (Text, Maybe AttributeVal) -> [(Text, Maybe AttributeVal)]
forall a. NonEmpty a -> [a]
NE.toList)
    (ParsecT
   Void String Identity (Maybe (NonEmpty (Text, Maybe AttributeVal)))
 -> Parser Metadata)
-> (Parser (Text, Maybe AttributeVal)
    -> ParsecT
         Void String Identity (Maybe (NonEmpty (Text, Maybe AttributeVal))))
-> Parser (Text, Maybe AttributeVal)
-> Parser Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void String Identity (NonEmpty (Text, Maybe AttributeVal))
-> ParsecT
     Void String Identity (Maybe (NonEmpty (Text, Maybe AttributeVal)))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
    (ParsecT Void String Identity (NonEmpty (Text, Maybe AttributeVal))
 -> ParsecT
      Void String Identity (Maybe (NonEmpty (Text, Maybe AttributeVal))))
-> (Parser (Text, Maybe AttributeVal)
    -> ParsecT
         Void String Identity (NonEmpty (Text, Maybe AttributeVal)))
-> Parser (Text, Maybe AttributeVal)
-> ParsecT
     Void String Identity (Maybe (NonEmpty (Text, Maybe AttributeVal)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void String Identity (NonEmpty (Text, Maybe AttributeVal))
-> ParsecT
     Void String Identity (NonEmpty (Text, Maybe AttributeVal))
forall a. Parser a -> Parser a
parens
    (ParsecT Void String Identity (NonEmpty (Text, Maybe AttributeVal))
 -> ParsecT
      Void String Identity (NonEmpty (Text, Maybe AttributeVal)))
-> (Parser (Text, Maybe AttributeVal)
    -> ParsecT
         Void String Identity (NonEmpty (Text, Maybe AttributeVal)))
-> Parser (Text, Maybe AttributeVal)
-> ParsecT
     Void String Identity (NonEmpty (Text, Maybe AttributeVal))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (Text, Maybe AttributeVal)
-> ParsecT
     Void String Identity (NonEmpty (Text, Maybe AttributeVal))
forall a. Parser a -> Parser (NonEmpty a)
commaSep1 (Parser (Text, Maybe AttributeVal) -> Parser Metadata)
-> Parser (Text, Maybe AttributeVal) -> Parser Metadata
forall a b. (a -> b) -> a -> b
$
  (,) (Text -> Maybe AttributeVal -> (Text, Maybe AttributeVal))
-> ParsecT Void String Identity Text
-> ParsecT
     Void
     String
     Identity
     (Maybe AttributeVal -> (Text, Maybe AttributeVal))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity Text
attributeName ParsecT
  Void
  String
  Identity
  (Maybe AttributeVal -> (Text, Maybe AttributeVal))
-> ParsecT Void String Identity (Maybe AttributeVal)
-> Parser (Text, Maybe AttributeVal)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser AttributeVal
-> ParsecT Void String Identity (Maybe AttributeVal)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ()
colon Parser () -> Parser AttributeVal -> Parser AttributeVal
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser AttributeVal
attributeVal)

include :: Parser Include
include :: ParsecT Void String Identity Include
include = StringLiteral -> Include
Include (StringLiteral -> Include)
-> Parser StringLiteral -> ParsecT Void String Identity Include
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Parser ()
rword String
"include" Parser () -> Parser StringLiteral -> Parser StringLiteral
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser StringLiteral
stringLiteral Parser StringLiteral -> Parser () -> Parser StringLiteral
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
semi)

-- | See: https://google.github.io/flatbuffers/flatbuffers_guide_use_cpp.html#flatbuffers_cpp_object_based_api
nativeInclude :: Parser ()
nativeInclude :: Parser ()
nativeInclude = Parser () -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> Parser ()
rword String
"native_include" Parser () -> Parser StringLiteral -> Parser StringLiteral
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser StringLiteral
stringLiteral Parser StringLiteral -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
semi)

rootDecl :: Parser RootDecl
rootDecl :: ParsecT Void String Identity RootDecl
rootDecl = TypeRef -> RootDecl
RootDecl (TypeRef -> RootDecl)
-> ParsecT Void String Identity TypeRef
-> ParsecT Void String Identity RootDecl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Parser ()
rword String
"root_type" Parser ()
-> ParsecT Void String Identity TypeRef
-> ParsecT Void String Identity TypeRef
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity TypeRef
typeRef ParsecT Void String Identity TypeRef
-> Parser () -> ParsecT Void String Identity TypeRef
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
semi)

fileExtensionDecl :: Parser ()
fileExtensionDecl :: Parser ()
fileExtensionDecl = Parser StringLiteral -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> Parser ()
rword String
"file_extension" Parser () -> Parser StringLiteral -> Parser StringLiteral
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser StringLiteral
stringLiteral Parser StringLiteral -> Parser () -> Parser StringLiteral
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
semi)

fileIdentifierDecl :: Parser FileIdentifierDecl
fileIdentifierDecl :: ParsecT Void String Identity FileIdentifierDecl
fileIdentifierDecl = do
  String -> Parser ()
rword String
"file_identifier"
  Text
fi <- Parser StringLiteral -> ParsecT Void String Identity Text
coerce Parser StringLiteral
stringLiteral

  let byteCount :: Int
byteCount = ByteString -> Int
BS.length (Text -> ByteString
T.encodeUtf8 Text
fi)
  let codePointCount :: Int
codePointCount = Text -> Int
T.length Text
fi

  Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
byteCount Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
forall a. Num a => a
fileIdentifierSize) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$
    if Int
codePointCount Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
byteCount
      -- if the user is using ASCII characters
      then String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ()) -> String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String
"file_identifier must be exactly " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word8 -> String
forall a. Show a => a -> String
show (Num Word8 => Word8
forall a. Num a => a
fileIdentifierSize @Word8) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" characters"
      -- if the user is using multi UTF-8 code unit characters, show a more detailed error message
      else String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ()) -> String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String
"file_identifier must be exactly " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word8 -> String
forall a. Show a => a -> String
show (Num Word8 => Word8
forall a. Num a => a
fileIdentifierSize @Word8) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" UTF-8 code units"

  Parser ()
semi
  FileIdentifierDecl
-> ParsecT Void String Identity FileIdentifierDecl
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> FileIdentifierDecl
FileIdentifierDecl Text
fi)

attributeDecl :: Parser AttributeDecl
attributeDecl :: ParsecT Void String Identity AttributeDecl
attributeDecl = Text -> AttributeDecl
AttributeDecl (Text -> AttributeDecl)
-> ParsecT Void String Identity Text
-> ParsecT Void String Identity AttributeDecl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Parser ()
rword String
"attribute" Parser ()
-> ParsecT Void String Identity Text
-> ParsecT Void String Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void String Identity Text
attributeName ParsecT Void String Identity Text
-> Parser () -> ParsecT Void String Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
semi)

attributeName :: Parser Text
attributeName :: ParsecT Void String Identity Text
attributeName = Parser StringLiteral -> ParsecT Void String Identity Text
coerce Parser StringLiteral
stringLiteral ParsecT Void String Identity Text
-> ParsecT Void String Identity Text
-> ParsecT Void String Identity Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Ident -> ParsecT Void String Identity Text
coerce Parser Ident
ident

jsonObj :: Parser ()
jsonObj :: Parser ()
jsonObj =
  String -> Parser () -> Parser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"JSON object" (ParsecT Void String Identity [()] -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void String Identity [()]
jobject)
  where
    json :: Parser ()
json = [Parser ()] -> Parser ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [Parser StringLiteral -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser StringLiteral
jstring, ParsecT Void String Identity Scientific -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void String Identity Scientific
jnumber, Parser ()
jbool, Parser ()
jnull, ParsecT Void String Identity [()] -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void String Identity [()]
jarray, ParsecT Void String Identity [()] -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void String Identity [()]
jobject]
    jnull :: Parser ()
jnull = String -> Parser ()
rword String
"null"
    jbool :: Parser ()
jbool = String -> Parser ()
rword String
"true" Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser ()
rword String
"false"
    jstring :: Parser StringLiteral
jstring = Parser StringLiteral
stringLiteral
    jnumber :: ParsecT Void String Identity Scientific
jnumber = ParsecT Void String Identity Scientific
-> ParsecT Void String Identity Scientific
forall a. Parser a -> Parser a
lexeme (ParsecT Void String Identity Scientific
 -> ParsecT Void String Identity Scientific)
-> ParsecT Void String Identity Scientific
-> ParsecT Void String Identity Scientific
forall a b. (a -> b) -> a -> b
$ Parser ()
-> ParsecT Void String Identity Scientific
-> ParsecT Void String Identity Scientific
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
L.signed Parser ()
sc ParsecT Void String Identity Scientific
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Scientific
L.scientific
    jarray :: ParsecT Void String Identity [()]
jarray  = ParsecT Void String Identity [()]
-> ParsecT Void String Identity [()]
forall a. Parser a -> Parser a
square (Parser () -> ParsecT Void String Identity [()]
forall a. Parser a -> Parser [a]
commaSep Parser ()
json)
    jobject :: ParsecT Void String Identity [()]
jobject = ParsecT Void String Identity [()]
-> ParsecT Void String Identity [()]
forall a. Parser a -> Parser a
curly (Parser () -> ParsecT Void String Identity [()]
forall a. Parser a -> Parser [a]
commaSep Parser ()
keyValuePair)

    keyValuePair :: Parser ()
keyValuePair = do
      Parser StringLiteral -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser StringLiteral
stringLiteral Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Ident -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser Ident
ident
      Parser ()
colon
      Parser ()
json

rpcDecl :: Parser ()
rpcDecl :: Parser ()
rpcDecl = ParsecT Void String Identity (NonEmpty ()) -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void String Identity (NonEmpty ()) -> Parser ())
-> ParsecT Void String Identity (NonEmpty ()) -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ()
rword String
"rpc_service" Parser () -> Parser Ident -> Parser Ident
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Ident
ident Parser Ident
-> ParsecT Void String Identity (NonEmpty ())
-> ParsecT Void String Identity (NonEmpty ())
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void String Identity (NonEmpty ())
-> ParsecT Void String Identity (NonEmpty ())
forall a. Parser a -> Parser a
curly (Parser () -> ParsecT Void String Identity (NonEmpty ())
forall (m :: * -> *) a. MonadPlus m => m a -> m (NonEmpty a)
NE.some Parser ()
rpcMethod)

rpcMethod :: Parser ()
rpcMethod :: Parser ()
rpcMethod = Parser Ident
ident Parser Ident -> Parser Ident -> Parser Ident
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Ident -> Parser Ident
forall a. Parser a -> Parser a
parens Parser Ident
ident Parser Ident -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
colon Parser () -> Parser Ident -> Parser Ident
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Ident
ident Parser Ident -> Parser Metadata -> Parser Metadata
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Metadata
metadata Parser Metadata -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser () -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser ()
semi