{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}

module Convex.Schema.Parser
  ( parseSchema,
    ParsedFile (..),
    Schema (..),
    Table (..),
    Index (..),
    Field (..),
    ConvexType (..),
    ParserState (..),
    initialState,
    getLiteralString,
    isLiteral,
    sanitizeUnionValues,
  )
where

import Control.Monad
import Data.Map (Map)
import qualified Data.Map as Map
import Text.Parsec
import qualified Text.Parsec.Language as Token
import qualified Text.Parsec.Token as Token

type SchemaParser a = ParsecT String ParserState IO a

data ParserState = ParserState
  { ParserState -> Map String ConvexType
psConstants :: Map String ConvexType
  }
  deriving (Int -> ParserState -> ShowS
[ParserState] -> ShowS
ParserState -> String
(Int -> ParserState -> ShowS)
-> (ParserState -> String)
-> ([ParserState] -> ShowS)
-> Show ParserState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParserState -> ShowS
showsPrec :: Int -> ParserState -> ShowS
$cshow :: ParserState -> String
show :: ParserState -> String
$cshowList :: [ParserState] -> ShowS
showList :: [ParserState] -> ShowS
Show, ParserState -> ParserState -> Bool
(ParserState -> ParserState -> Bool)
-> (ParserState -> ParserState -> Bool) -> Eq ParserState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParserState -> ParserState -> Bool
== :: ParserState -> ParserState -> Bool
$c/= :: ParserState -> ParserState -> Bool
/= :: ParserState -> ParserState -> Bool
Eq)

initialState :: ParserState
initialState :: ParserState
initialState = ParserState {psConstants :: Map String ConvexType
psConstants = Map String ConvexType
forall k a. Map k a
Map.empty}

data ParsedFile = ParsedFile
  { ParsedFile -> Map String ConvexType
parsedConstants :: Map String ConvexType,
    ParsedFile -> Schema
parsedSchema :: Schema
  }
  deriving (Int -> ParsedFile -> ShowS
[ParsedFile] -> ShowS
ParsedFile -> String
(Int -> ParsedFile -> ShowS)
-> (ParsedFile -> String)
-> ([ParsedFile] -> ShowS)
-> Show ParsedFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParsedFile -> ShowS
showsPrec :: Int -> ParsedFile -> ShowS
$cshow :: ParsedFile -> String
show :: ParsedFile -> String
$cshowList :: [ParsedFile] -> ShowS
showList :: [ParsedFile] -> ShowS
Show, ParsedFile -> ParsedFile -> Bool
(ParsedFile -> ParsedFile -> Bool)
-> (ParsedFile -> ParsedFile -> Bool) -> Eq ParsedFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParsedFile -> ParsedFile -> Bool
== :: ParsedFile -> ParsedFile -> Bool
$c/= :: ParsedFile -> ParsedFile -> Bool
/= :: ParsedFile -> ParsedFile -> Bool
Eq)

newtype Schema = Schema {Schema -> [Table]
getTables :: [Table]}
  deriving (Int -> Schema -> ShowS
[Schema] -> ShowS
Schema -> String
(Int -> Schema -> ShowS)
-> (Schema -> String) -> ([Schema] -> ShowS) -> Show Schema
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Schema -> ShowS
showsPrec :: Int -> Schema -> ShowS
$cshow :: Schema -> String
show :: Schema -> String
$cshowList :: [Schema] -> ShowS
showList :: [Schema] -> ShowS
Show, Schema -> Schema -> Bool
(Schema -> Schema -> Bool)
-> (Schema -> Schema -> Bool) -> Eq Schema
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Schema -> Schema -> Bool
== :: Schema -> Schema -> Bool
$c/= :: Schema -> Schema -> Bool
/= :: Schema -> Schema -> Bool
Eq)

data Index = Index
  { Index -> String
indexName :: String,
    Index -> [String]
indexFields :: [String]
  }
  deriving (Int -> Index -> ShowS
[Index] -> ShowS
Index -> String
(Int -> Index -> ShowS)
-> (Index -> String) -> ([Index] -> ShowS) -> Show Index
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Index -> ShowS
showsPrec :: Int -> Index -> ShowS
$cshow :: Index -> String
show :: Index -> String
$cshowList :: [Index] -> ShowS
showList :: [Index] -> ShowS
Show, Index -> Index -> Bool
(Index -> Index -> Bool) -> (Index -> Index -> Bool) -> Eq Index
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Index -> Index -> Bool
== :: Index -> Index -> Bool
$c/= :: Index -> Index -> Bool
/= :: Index -> Index -> Bool
Eq)

data Table = Table
  { Table -> String
tableName :: String,
    Table -> [Field]
tableFields :: [Field],
    Table -> [Index]
tableIndexes :: [Index]
  }
  deriving (Int -> Table -> ShowS
[Table] -> ShowS
Table -> String
(Int -> Table -> ShowS)
-> (Table -> String) -> ([Table] -> ShowS) -> Show Table
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Table -> ShowS
showsPrec :: Int -> Table -> ShowS
$cshow :: Table -> String
show :: Table -> String
$cshowList :: [Table] -> ShowS
showList :: [Table] -> ShowS
Show, Table -> Table -> Bool
(Table -> Table -> Bool) -> (Table -> Table -> Bool) -> Eq Table
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Table -> Table -> Bool
== :: Table -> Table -> Bool
$c/= :: Table -> Table -> Bool
/= :: Table -> Table -> Bool
Eq)

data Field = Field
  { Field -> String
fieldName :: String,
    Field -> ConvexType
fieldType :: ConvexType
  }
  deriving (Int -> Field -> ShowS
[Field] -> ShowS
Field -> String
(Int -> Field -> ShowS)
-> (Field -> String) -> ([Field] -> ShowS) -> Show Field
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Field -> ShowS
showsPrec :: Int -> Field -> ShowS
$cshow :: Field -> String
show :: Field -> String
$cshowList :: [Field] -> ShowS
showList :: [Field] -> ShowS
Show, Field -> Field -> Bool
(Field -> Field -> Bool) -> (Field -> Field -> Bool) -> Eq Field
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Field -> Field -> Bool
== :: Field -> Field -> Bool
$c/= :: Field -> Field -> Bool
/= :: Field -> Field -> Bool
Eq)

data ConvexType
  = VString
  | VNumber
  | VInt64
  | VFloat64
  | VBoolean
  | VBytes
  | VNull
  | VAny
  | VId String
  | VArray ConvexType
  | VObject [(String, ConvexType)]
  | VOptional ConvexType
  | VUnion [ConvexType]
  | VLiteral String
  | VReference String
  | VVoid
  deriving (Int -> ConvexType -> ShowS
[ConvexType] -> ShowS
ConvexType -> String
(Int -> ConvexType -> ShowS)
-> (ConvexType -> String)
-> ([ConvexType] -> ShowS)
-> Show ConvexType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConvexType -> ShowS
showsPrec :: Int -> ConvexType -> ShowS
$cshow :: ConvexType -> String
show :: ConvexType -> String
$cshowList :: [ConvexType] -> ShowS
showList :: [ConvexType] -> ShowS
Show, ConvexType -> ConvexType -> Bool
(ConvexType -> ConvexType -> Bool)
-> (ConvexType -> ConvexType -> Bool) -> Eq ConvexType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConvexType -> ConvexType -> Bool
== :: ConvexType -> ConvexType -> Bool
$c/= :: ConvexType -> ConvexType -> Bool
/= :: ConvexType -> ConvexType -> Bool
Eq, Eq ConvexType
Eq ConvexType =>
(ConvexType -> ConvexType -> Ordering)
-> (ConvexType -> ConvexType -> Bool)
-> (ConvexType -> ConvexType -> Bool)
-> (ConvexType -> ConvexType -> Bool)
-> (ConvexType -> ConvexType -> Bool)
-> (ConvexType -> ConvexType -> ConvexType)
-> (ConvexType -> ConvexType -> ConvexType)
-> Ord ConvexType
ConvexType -> ConvexType -> Bool
ConvexType -> ConvexType -> Ordering
ConvexType -> ConvexType -> ConvexType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ConvexType -> ConvexType -> Ordering
compare :: ConvexType -> ConvexType -> Ordering
$c< :: ConvexType -> ConvexType -> Bool
< :: ConvexType -> ConvexType -> Bool
$c<= :: ConvexType -> ConvexType -> Bool
<= :: ConvexType -> ConvexType -> Bool
$c> :: ConvexType -> ConvexType -> Bool
> :: ConvexType -> ConvexType -> Bool
$c>= :: ConvexType -> ConvexType -> Bool
>= :: ConvexType -> ConvexType -> Bool
$cmax :: ConvexType -> ConvexType -> ConvexType
max :: ConvexType -> ConvexType -> ConvexType
$cmin :: ConvexType -> ConvexType -> ConvexType
min :: ConvexType -> ConvexType -> ConvexType
Ord)

getLiteralString :: ConvexType -> String
getLiteralString :: ConvexType -> String
getLiteralString (VLiteral String
str) = String
str
getLiteralString ConvexType
_ = ShowS
forall a. HasCallStack => String -> a
error String
"Expected a literal type"

isLiteral :: ConvexType -> Bool
isLiteral :: ConvexType -> Bool
isLiteral (VLiteral String
_) = Bool
True
isLiteral ConvexType
_ = Bool
False

langDef :: Token.GenLanguageDef String ParserState IO
langDef :: GenLanguageDef String ParserState IO
langDef =
  Token.LanguageDef
    { commentStart :: String
Token.commentStart = String
"/*",
      nestedComments :: Bool
Token.nestedComments = Bool
True,
      commentEnd :: String
Token.commentEnd = String
"*/",
      commentLine :: String
Token.commentLine = String
"//",
      opStart :: ParsecT String ParserState IO Char
Token.opStart = String -> ParsecT String ParserState IO Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
":!#$%&*+./<=>?@\\^|-~",
      opLetter :: ParsecT String ParserState IO Char
Token.opLetter = String -> ParsecT String ParserState IO Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
":!#$%&*+./<=>?@\\^|-~",
      reservedOpNames :: [String]
Token.reservedOpNames = [],
      identStart :: ParsecT String ParserState IO Char
Token.identStart = ParsecT String ParserState IO Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter ParsecT String ParserState IO Char
-> ParsecT String ParserState IO Char
-> ParsecT String ParserState IO Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT String ParserState IO Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_',
      identLetter :: ParsecT String ParserState IO Char
Token.identLetter = ParsecT String ParserState IO Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum ParsecT String ParserState IO Char
-> ParsecT String ParserState IO Char
-> ParsecT String ParserState IO Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT String ParserState IO Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_',
      reservedNames :: [String]
Token.reservedNames =
        [ String
"defineSchema",
          String
"defineSchema(",
          String
"defineTable",
          String
"v",
          String
"export",
          String
"default",
          String
"import",
          String
"from",
          String
"const",
          String
"type",
          String
"keyof",
          String
"typeof"
        ],
      caseSensitive :: Bool
Token.caseSensitive = Bool
True
    }

lexer :: Token.GenTokenParser String ParserState IO
lexer :: GenTokenParser String ParserState IO
lexer = GenLanguageDef String ParserState IO
-> GenTokenParser String ParserState IO
forall s (m :: * -> *) u.
Stream s m Char =>
GenLanguageDef s u m -> GenTokenParser s u m
Token.makeTokenParser GenLanguageDef String ParserState IO
langDef

whiteSpace :: SchemaParser ()
whiteSpace :: SchemaParser ()
whiteSpace = GenTokenParser String ParserState IO -> SchemaParser ()
forall s u (m :: * -> *). GenTokenParser s u m -> ParsecT s u m ()
Token.whiteSpace GenTokenParser String ParserState IO
lexer

lexeme :: SchemaParser a -> SchemaParser a
lexeme :: forall a. SchemaParser a -> SchemaParser a
lexeme = GenTokenParser String ParserState IO
-> forall a. SchemaParser a -> SchemaParser a
forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
Token.lexeme GenTokenParser String ParserState IO
lexer

identifier :: SchemaParser String
identifier :: SchemaParser String
identifier = GenTokenParser String ParserState IO -> SchemaParser String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
Token.identifier GenTokenParser String ParserState IO
lexer

stringLiteral :: SchemaParser String
stringLiteral :: SchemaParser String
stringLiteral = GenTokenParser String ParserState IO -> SchemaParser String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
Token.stringLiteral GenTokenParser String ParserState IO
lexer

reserved :: String -> SchemaParser ()
reserved :: String -> SchemaParser ()
reserved = GenTokenParser String ParserState IO -> String -> SchemaParser ()
forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m ()
Token.reserved GenTokenParser String ParserState IO
lexer

parens :: SchemaParser a -> SchemaParser a
parens :: forall a. SchemaParser a -> SchemaParser a
parens = GenTokenParser String ParserState IO
-> forall a. SchemaParser a -> SchemaParser a
forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
Token.parens GenTokenParser String ParserState IO
lexer

braces :: SchemaParser a -> SchemaParser a
braces :: forall a. SchemaParser a -> SchemaParser a
braces = GenTokenParser String ParserState IO
-> forall a. SchemaParser a -> SchemaParser a
forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
Token.braces GenTokenParser String ParserState IO
lexer

brackets :: SchemaParser a -> SchemaParser a
brackets :: forall a. SchemaParser a -> SchemaParser a
brackets = GenTokenParser String ParserState IO
-> forall a. SchemaParser a -> SchemaParser a
forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
Token.brackets GenTokenParser String ParserState IO
lexer

topLevelStatementEnd :: SchemaParser ()
topLevelStatementEnd :: SchemaParser ()
topLevelStatementEnd = SchemaParser () -> SchemaParser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String ParserState IO Char -> SchemaParser ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (ParsecT String ParserState IO Char
-> ParsecT String ParserState IO Char
forall a. SchemaParser a -> SchemaParser a
lexeme (Char -> ParsecT String ParserState IO Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
';'))) SchemaParser () -> SchemaParser () -> SchemaParser ()
forall a b.
ParsecT String ParserState IO a
-> ParsecT String ParserState IO b
-> ParsecT String ParserState IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> SchemaParser ()
whiteSpace

itemEnd :: SchemaParser ()
itemEnd :: SchemaParser ()
itemEnd = do
  ParsecT String ParserState IO Char -> SchemaParser ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (ParsecT String ParserState IO Char
-> ParsecT String ParserState IO Char
forall a. SchemaParser a -> SchemaParser a
lexeme (Char -> ParsecT String ParserState IO Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
','))
  ParsecT String ParserState IO Char -> SchemaParser ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (ParsecT String ParserState IO Char
-> ParsecT String ParserState IO Char
forall a. SchemaParser a -> SchemaParser a
lexeme (Char -> ParsecT String ParserState IO Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
';'))
  SchemaParser ()
whiteSpace

fieldToTuple :: Field -> (String, ConvexType)
fieldToTuple :: Field -> (String, ConvexType)
fieldToTuple (Field String
name ConvexType
typ) = (String
name, ConvexType
typ)

fieldParser :: SchemaParser Field
fieldParser :: SchemaParser Field
fieldParser = SchemaParser Field -> SchemaParser Field
forall a. SchemaParser a -> SchemaParser a
lexeme (SchemaParser Field -> SchemaParser Field)
-> SchemaParser Field -> SchemaParser Field
forall a b. (a -> b) -> a -> b
$ do
  String
key <- SchemaParser String
identifier SchemaParser String -> SchemaParser String -> SchemaParser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> SchemaParser String
stringLiteral
  ParsecT String ParserState IO Char -> SchemaParser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String ParserState IO Char -> SchemaParser ())
-> ParsecT String ParserState IO Char -> SchemaParser ()
forall a b. (a -> b) -> a -> b
$ ParsecT String ParserState IO Char
-> ParsecT String ParserState IO Char
forall a. SchemaParser a -> SchemaParser a
lexeme (ParsecT String ParserState IO Char
 -> ParsecT String ParserState IO Char)
-> ParsecT String ParserState IO Char
-> ParsecT String ParserState IO Char
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String ParserState IO Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
  ConvexType
value <- SchemaParser ConvexType
convexTypeParser
  Field -> SchemaParser Field
forall a. a -> ParsecT String ParserState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Field -> SchemaParser Field) -> Field -> SchemaParser Field
forall a b. (a -> b) -> a -> b
$ String -> ConvexType -> Field
Field String
key ConvexType
value

indexParser :: SchemaParser Index
indexParser :: SchemaParser Index
indexParser = SchemaParser Index -> SchemaParser Index
forall a. SchemaParser a -> SchemaParser a
lexeme (SchemaParser Index -> SchemaParser Index)
-> SchemaParser Index -> SchemaParser Index
forall a b. (a -> b) -> a -> b
$ do
  ParsecT String ParserState IO Char -> SchemaParser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String ParserState IO Char -> SchemaParser ())
-> ParsecT String ParserState IO Char -> SchemaParser ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String ParserState IO Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
  String -> SchemaParser ()
reserved String
"index"
  (String
iName, [String]
iFields) <- SchemaParser (String, [String]) -> SchemaParser (String, [String])
forall a. SchemaParser a -> SchemaParser a
parens (SchemaParser (String, [String])
 -> SchemaParser (String, [String]))
-> SchemaParser (String, [String])
-> SchemaParser (String, [String])
forall a b. (a -> b) -> a -> b
$ do
    String
name <- SchemaParser String
stringLiteral
    ParsecT String ParserState IO Char -> SchemaParser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String ParserState IO Char -> SchemaParser ())
-> ParsecT String ParserState IO Char -> SchemaParser ()
forall a b. (a -> b) -> a -> b
$ ParsecT String ParserState IO Char
-> ParsecT String ParserState IO Char
forall a. SchemaParser a -> SchemaParser a
lexeme (ParsecT String ParserState IO Char
 -> ParsecT String ParserState IO Char)
-> ParsecT String ParserState IO Char
-> ParsecT String ParserState IO Char
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String ParserState IO Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
','
    [String]
fields <- SchemaParser [String] -> SchemaParser [String]
forall a. SchemaParser a -> SchemaParser a
brackets (SchemaParser [String] -> SchemaParser [String])
-> SchemaParser [String] -> SchemaParser [String]
forall a b. (a -> b) -> a -> b
$ SchemaParser String
-> ParsecT String ParserState IO Char -> SchemaParser [String]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepEndBy SchemaParser String
stringLiteral (ParsecT String ParserState IO Char
-> ParsecT String ParserState IO Char
forall a. SchemaParser a -> SchemaParser a
lexeme (ParsecT String ParserState IO Char
 -> ParsecT String ParserState IO Char)
-> ParsecT String ParserState IO Char
-> ParsecT String ParserState IO Char
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String ParserState IO Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',')
    (String, [String]) -> SchemaParser (String, [String])
forall a. a -> ParsecT String ParserState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
name, [String]
fields)
  Index -> SchemaParser Index
forall a. a -> ParsecT String ParserState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Index -> SchemaParser Index) -> Index -> SchemaParser Index
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Index
Index String
iName [String]
iFields

tableParser :: SchemaParser Table
tableParser :: SchemaParser Table
tableParser = SchemaParser Table -> SchemaParser Table
forall a. SchemaParser a -> SchemaParser a
lexeme (SchemaParser Table -> SchemaParser Table)
-> SchemaParser Table -> SchemaParser Table
forall a b. (a -> b) -> a -> b
$ do
  String
tName <- SchemaParser String
identifier SchemaParser String -> SchemaParser String -> SchemaParser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> SchemaParser String
stringLiteral
  ParsecT String ParserState IO Char -> SchemaParser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String ParserState IO Char -> SchemaParser ())
-> ParsecT String ParserState IO Char -> SchemaParser ()
forall a b. (a -> b) -> a -> b
$ ParsecT String ParserState IO Char
-> ParsecT String ParserState IO Char
forall a. SchemaParser a -> SchemaParser a
lexeme (ParsecT String ParserState IO Char
 -> ParsecT String ParserState IO Char)
-> ParsecT String ParserState IO Char
-> ParsecT String ParserState IO Char
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String ParserState IO Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
  String -> SchemaParser ()
reserved String
"defineTable"
  -- First, parse the table definition itself inside the parentheses.
  [Field]
fields <- SchemaParser [Field] -> SchemaParser [Field]
forall a. SchemaParser a -> SchemaParser a
parens (SchemaParser [Field] -> SchemaParser [Field])
-> SchemaParser [Field] -> SchemaParser [Field]
forall a b. (a -> b) -> a -> b
$ do
    ConvexType
tableDef <- (SchemaParser ConvexType -> SchemaParser ConvexType
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([(String, ConvexType)] -> ConvexType
VObject ([(String, ConvexType)] -> ConvexType)
-> ([Field] -> [(String, ConvexType)]) -> [Field] -> ConvexType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Field -> (String, ConvexType))
-> [Field] -> [(String, ConvexType)]
forall a b. (a -> b) -> [a] -> [b]
map Field -> (String, ConvexType)
fieldToTuple ([Field] -> ConvexType)
-> SchemaParser [Field] -> SchemaParser ConvexType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SchemaParser [Field] -> SchemaParser [Field]
forall a. SchemaParser a -> SchemaParser a
braces (SchemaParser Field
-> ParsecT String ParserState IO Char -> SchemaParser [Field]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepEndBy SchemaParser Field
fieldParser (ParsecT String ParserState IO Char
-> ParsecT String ParserState IO Char
forall a. SchemaParser a -> SchemaParser a
lexeme (ParsecT String ParserState IO Char
 -> ParsecT String ParserState IO Char)
-> ParsecT String ParserState IO Char
-> ParsecT String ParserState IO Char
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String ParserState IO Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',')))) SchemaParser ConvexType
-> SchemaParser ConvexType -> SchemaParser ConvexType
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> ConvexType
VReference (String -> ConvexType)
-> SchemaParser String -> SchemaParser ConvexType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SchemaParser String
identifier)
    case ConvexType
tableDef of
      VReference String
refName -> do
        ParserState
st <- ParsecT String ParserState IO ParserState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
        case String -> Map String ConvexType -> Maybe ConvexType
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
refName (ParserState -> Map String ConvexType
psConstants ParserState
st) of
          Just (VObject [(String, ConvexType)]
fs) -> [Field] -> SchemaParser [Field]
forall a. a -> ParsecT String ParserState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Field] -> SchemaParser [Field])
-> [Field] -> SchemaParser [Field]
forall a b. (a -> b) -> a -> b
$ ((String, ConvexType) -> Field)
-> [(String, ConvexType)] -> [Field]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
n, ConvexType
t) -> String -> ConvexType -> Field
Field String
n ConvexType
t) [(String, ConvexType)]
fs
          Maybe ConvexType
_ -> String -> SchemaParser [Field]
forall a. String -> ParsecT String ParserState IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> SchemaParser [Field]) -> String -> SchemaParser [Field]
forall a b. (a -> b) -> a -> b
$ String
"Table '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
tName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' references an unknown or non-object constant: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
refName
      VObject [(String, ConvexType)]
fs -> [Field] -> SchemaParser [Field]
forall a. a -> ParsecT String ParserState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Field] -> SchemaParser [Field])
-> [Field] -> SchemaParser [Field]
forall a b. (a -> b) -> a -> b
$ ((String, ConvexType) -> Field)
-> [(String, ConvexType)] -> [Field]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
n, ConvexType
t) -> String -> ConvexType -> Field
Field String
n ConvexType
t) [(String, ConvexType)]
fs
      ConvexType
_ -> String -> SchemaParser [Field]
forall a. String -> ParsecT String ParserState IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid table definition: expected an object or a reference."

  -- After parsing defineTable(...), now look for zero or more chained .index() calls.
  [Index]
indexes <- SchemaParser Index -> ParsecT String ParserState IO [Index]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many SchemaParser Index
indexParser

  SchemaParser ()
itemEnd
  Table -> SchemaParser Table
forall a. a -> ParsecT String ParserState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Table -> SchemaParser Table) -> Table -> SchemaParser Table
forall a b. (a -> b) -> a -> b
$ String -> [Field] -> [Index] -> Table
Table String
tName [Field]
fields [Index]
indexes

structParser :: SchemaParser ConvexType
structParser :: SchemaParser ConvexType
structParser = do
  ConvexType
res <- [(String, ConvexType)] -> ConvexType
VObject ([(String, ConvexType)] -> ConvexType)
-> ([Field] -> [(String, ConvexType)]) -> [Field] -> ConvexType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Field -> (String, ConvexType))
-> [Field] -> [(String, ConvexType)]
forall a b. (a -> b) -> [a] -> [b]
map Field -> (String, ConvexType)
fieldToTuple ([Field] -> ConvexType)
-> SchemaParser [Field] -> SchemaParser ConvexType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SchemaParser [Field] -> SchemaParser [Field]
forall a. SchemaParser a -> SchemaParser a
braces (SchemaParser Field
-> ParsecT String ParserState IO Char -> SchemaParser [Field]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepEndBy SchemaParser Field
fieldParser (ParsecT String ParserState IO Char
-> ParsecT String ParserState IO Char
forall a. SchemaParser a -> SchemaParser a
lexeme (ParsecT String ParserState IO Char
 -> ParsecT String ParserState IO Char)
-> ParsecT String ParserState IO Char
-> ParsecT String ParserState IO Char
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String ParserState IO Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
','))
  SchemaParser ()
itemEnd
  ConvexType -> SchemaParser ConvexType
forall a. a -> ParsecT String ParserState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ConvexType
res

convexTypeParser :: SchemaParser ConvexType
convexTypeParser :: SchemaParser ConvexType
convexTypeParser =
  [SchemaParser ConvexType] -> SchemaParser ConvexType
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([SchemaParser ConvexType] -> SchemaParser ConvexType)
-> ([SchemaParser ConvexType] -> [SchemaParser ConvexType])
-> [SchemaParser ConvexType]
-> SchemaParser ConvexType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SchemaParser ConvexType -> SchemaParser ConvexType)
-> [SchemaParser ConvexType] -> [SchemaParser ConvexType]
forall a b. (a -> b) -> [a] -> [b]
map SchemaParser ConvexType -> SchemaParser ConvexType
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([SchemaParser ConvexType] -> SchemaParser ConvexType)
-> [SchemaParser ConvexType] -> SchemaParser ConvexType
forall a b. (a -> b) -> a -> b
$
    [ SchemaParser ConvexType
vParser,
      SchemaParser ConvexType
structParser,
      SchemaParser ConvexType
referenceParser
    ]
  where
    vParser :: SchemaParser ConvexType
vParser = do
      SchemaParser () -> SchemaParser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (SchemaParser () -> SchemaParser ())
-> SchemaParser () -> SchemaParser ()
forall a b. (a -> b) -> a -> b
$ SchemaParser () -> SchemaParser ()
forall a. SchemaParser a -> SchemaParser a
lexeme (SchemaParser () -> SchemaParser ())
-> SchemaParser () -> SchemaParser ()
forall a b. (a -> b) -> a -> b
$ String -> SchemaParser ()
reserved String
"v"
      ParsecT String ParserState IO Char -> SchemaParser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String ParserState IO Char -> SchemaParser ())
-> ParsecT String ParserState IO Char -> SchemaParser ()
forall a b. (a -> b) -> a -> b
$ ParsecT String ParserState IO Char
-> ParsecT String ParserState IO Char
forall a. SchemaParser a -> SchemaParser a
lexeme (ParsecT String ParserState IO Char
 -> ParsecT String ParserState IO Char)
-> ParsecT String ParserState IO Char
-> ParsecT String ParserState IO Char
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String ParserState IO Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
      String
typeName <- SchemaParser String
identifier
      case String
typeName of
        String
"string" -> ConvexType
VString ConvexType -> SchemaParser () -> SchemaParser ConvexType
forall a b.
a
-> ParsecT String ParserState IO b
-> ParsecT String ParserState IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SchemaParser () -> SchemaParser ()
forall a. SchemaParser a -> SchemaParser a
parens (() -> SchemaParser ()
forall a. a -> ParsecT String ParserState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
        String
"number" -> ConvexType
VNumber ConvexType -> SchemaParser () -> SchemaParser ConvexType
forall a b.
a
-> ParsecT String ParserState IO b
-> ParsecT String ParserState IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SchemaParser () -> SchemaParser ()
forall a. SchemaParser a -> SchemaParser a
parens (() -> SchemaParser ()
forall a. a -> ParsecT String ParserState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
        String
"boolean" -> ConvexType
VBoolean ConvexType -> SchemaParser () -> SchemaParser ConvexType
forall a b.
a
-> ParsecT String ParserState IO b
-> ParsecT String ParserState IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SchemaParser () -> SchemaParser ()
forall a. SchemaParser a -> SchemaParser a
parens (() -> SchemaParser ()
forall a. a -> ParsecT String ParserState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
        String
"bytes" -> ConvexType
VBytes ConvexType -> SchemaParser () -> SchemaParser ConvexType
forall a b.
a
-> ParsecT String ParserState IO b
-> ParsecT String ParserState IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SchemaParser () -> SchemaParser ()
forall a. SchemaParser a -> SchemaParser a
parens (() -> SchemaParser ()
forall a. a -> ParsecT String ParserState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
        String
"int64" -> ConvexType
VInt64 ConvexType -> SchemaParser () -> SchemaParser ConvexType
forall a b.
a
-> ParsecT String ParserState IO b
-> ParsecT String ParserState IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SchemaParser () -> SchemaParser ()
forall a. SchemaParser a -> SchemaParser a
parens (() -> SchemaParser ()
forall a. a -> ParsecT String ParserState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
        String
"float64" -> ConvexType
VFloat64 ConvexType -> SchemaParser () -> SchemaParser ConvexType
forall a b.
a
-> ParsecT String ParserState IO b
-> ParsecT String ParserState IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SchemaParser () -> SchemaParser ()
forall a. SchemaParser a -> SchemaParser a
parens (() -> SchemaParser ()
forall a. a -> ParsecT String ParserState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
        String
"null" -> ConvexType
VNull ConvexType -> SchemaParser () -> SchemaParser ConvexType
forall a b.
a
-> ParsecT String ParserState IO b
-> ParsecT String ParserState IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SchemaParser () -> SchemaParser ()
forall a. SchemaParser a -> SchemaParser a
parens (() -> SchemaParser ()
forall a. a -> ParsecT String ParserState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
        String
"any" -> ConvexType
VAny ConvexType -> SchemaParser () -> SchemaParser ConvexType
forall a b.
a
-> ParsecT String ParserState IO b
-> ParsecT String ParserState IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SchemaParser () -> SchemaParser ()
forall a. SchemaParser a -> SchemaParser a
parens (() -> SchemaParser ()
forall a. a -> ParsecT String ParserState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
        String
"id" -> String -> ConvexType
VId (String -> ConvexType)
-> SchemaParser String -> SchemaParser ConvexType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SchemaParser String -> SchemaParser String
forall a. SchemaParser a -> SchemaParser a
parens SchemaParser String
stringLiteral
        String
"array" -> ConvexType -> ConvexType
VArray (ConvexType -> ConvexType)
-> SchemaParser ConvexType -> SchemaParser ConvexType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SchemaParser ConvexType -> SchemaParser ConvexType
forall a. SchemaParser a -> SchemaParser a
parens SchemaParser ConvexType
convexTypeParser
        String
"object" -> SchemaParser ConvexType -> SchemaParser ConvexType
forall a. SchemaParser a -> SchemaParser a
parens SchemaParser ConvexType
structParser
        String
"optional" -> ConvexType -> ConvexType
VOptional (ConvexType -> ConvexType)
-> SchemaParser ConvexType -> SchemaParser ConvexType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SchemaParser ConvexType -> SchemaParser ConvexType
forall a. SchemaParser a -> SchemaParser a
parens SchemaParser ConvexType
convexTypeParser
        String
"union" -> [ConvexType] -> ConvexType
VUnion ([ConvexType] -> ConvexType)
-> ParsecT String ParserState IO [ConvexType]
-> SchemaParser ConvexType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String ParserState IO [ConvexType]
-> ParsecT String ParserState IO [ConvexType]
forall a. SchemaParser a -> SchemaParser a
parens (SchemaParser ConvexType
-> ParsecT String ParserState IO Char
-> ParsecT String ParserState IO [ConvexType]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepEndBy SchemaParser ConvexType
convexTypeParser (ParsecT String ParserState IO Char
-> ParsecT String ParserState IO Char
forall a. SchemaParser a -> SchemaParser a
lexeme (ParsecT String ParserState IO Char
 -> ParsecT String ParserState IO Char)
-> ParsecT String ParserState IO Char
-> ParsecT String ParserState IO Char
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String ParserState IO Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
','))
        String
"literal" -> String -> ConvexType
VLiteral (String -> ConvexType)
-> SchemaParser String -> SchemaParser ConvexType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SchemaParser String -> SchemaParser String
forall a. SchemaParser a -> SchemaParser a
parens SchemaParser String
stringLiteral
        String
_ -> String -> SchemaParser ConvexType
forall a. String -> ParsecT String ParserState IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> SchemaParser ConvexType)
-> String -> SchemaParser ConvexType
forall a b. (a -> b) -> a -> b
$ String
"Unknown v-dot type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
typeName
    referenceParser :: SchemaParser ConvexType
referenceParser = String -> ConvexType
VReference (String -> ConvexType)
-> SchemaParser String -> SchemaParser ConvexType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SchemaParser String
identifier

-- | Sanitizes union literals. It might be that a union like this is defined:
-- export const instruction_mime_type = v.union(
--   v.literal("application/pdf"),
--   v.literal("text/html"),
--   v.literal("text/plain")
-- );
--
-- And `application/pdf` would be translated into a type `Application/pdf`, which
-- is invalid in most languages. After sanitization, it would become `application_pdf`.
sanitizeUnionValues :: String -> String
sanitizeUnionValues :: ShowS
sanitizeUnionValues = (Char -> String) -> ShowS
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Char
c -> if Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'/', Char
'@', Char
'\\'] then [Char
'_'] else [Char
c])

topLevelConstParser :: SchemaParser ()
topLevelConstParser :: SchemaParser ()
topLevelConstParser = SchemaParser () -> SchemaParser ()
forall a. SchemaParser a -> SchemaParser a
lexeme (SchemaParser () -> SchemaParser ())
-> SchemaParser () -> SchemaParser ()
forall a b. (a -> b) -> a -> b
$ do
  SchemaParser () -> SchemaParser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (SchemaParser () -> SchemaParser ())
-> SchemaParser () -> SchemaParser ()
forall a b. (a -> b) -> a -> b
$ SchemaParser () -> SchemaParser ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (String -> SchemaParser ()
reserved String
"export")
  String -> SchemaParser ()
reserved String
"const"
  String
constName <- SchemaParser String
identifier
  ParsecT String ParserState IO Char -> SchemaParser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String ParserState IO Char -> SchemaParser ())
-> ParsecT String ParserState IO Char -> SchemaParser ()
forall a b. (a -> b) -> a -> b
$ ParsecT String ParserState IO Char
-> ParsecT String ParserState IO Char
forall a. SchemaParser a -> SchemaParser a
lexeme (ParsecT String ParserState IO Char
 -> ParsecT String ParserState IO Char)
-> ParsecT String ParserState IO Char
-> ParsecT String ParserState IO Char
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String ParserState IO Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'='
  ConvexType
constType <-
    SchemaParser ConvexType -> SchemaParser ConvexType
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> SchemaParser ()
reserved String
"defineTable" SchemaParser ()
-> SchemaParser ConvexType -> SchemaParser ConvexType
forall a b.
ParsecT String ParserState IO a
-> ParsecT String ParserState IO b
-> ParsecT String ParserState IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([(String, ConvexType)] -> ConvexType
VObject ([(String, ConvexType)] -> ConvexType)
-> ([Field] -> [(String, ConvexType)]) -> [Field] -> ConvexType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Field -> (String, ConvexType))
-> [Field] -> [(String, ConvexType)]
forall a b. (a -> b) -> [a] -> [b]
map Field -> (String, ConvexType)
fieldToTuple ([Field] -> ConvexType)
-> SchemaParser [Field] -> SchemaParser ConvexType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SchemaParser [Field] -> SchemaParser [Field]
forall a. SchemaParser a -> SchemaParser a
parens (SchemaParser [Field] -> SchemaParser [Field]
forall a. SchemaParser a -> SchemaParser a
braces (SchemaParser Field -> SchemaParser [Field]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many SchemaParser Field
fieldParser))))
      SchemaParser ConvexType
-> SchemaParser ConvexType -> SchemaParser ConvexType
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> SchemaParser ConvexType
convexTypeParser
  SchemaParser ()
topLevelStatementEnd
  (ParserState -> ParserState) -> SchemaParser ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
modifyState (\ParserState
s -> ParserState
s {psConstants = Map.insert constName constType (psConstants s)})

topLevelTypeParser :: SchemaParser ()
topLevelTypeParser :: SchemaParser ()
topLevelTypeParser = SchemaParser () -> SchemaParser ()
forall a. SchemaParser a -> SchemaParser a
lexeme (SchemaParser () -> SchemaParser ())
-> SchemaParser () -> SchemaParser ()
forall a b. (a -> b) -> a -> b
$ do
  SchemaParser () -> SchemaParser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (SchemaParser () -> SchemaParser ())
-> SchemaParser () -> SchemaParser ()
forall a b. (a -> b) -> a -> b
$ SchemaParser () -> SchemaParser ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (String -> SchemaParser ()
reserved String
"export")
  String -> SchemaParser ()
reserved String
"type"
  String
typeName <- SchemaParser String
identifier
  ParsecT String ParserState IO Char -> SchemaParser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String ParserState IO Char -> SchemaParser ())
-> ParsecT String ParserState IO Char -> SchemaParser ()
forall a b. (a -> b) -> a -> b
$ ParsecT String ParserState IO Char
-> ParsecT String ParserState IO Char
forall a. SchemaParser a -> SchemaParser a
lexeme (ParsecT String ParserState IO Char
 -> ParsecT String ParserState IO Char)
-> ParsecT String ParserState IO Char
-> ParsecT String ParserState IO Char
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String ParserState IO Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'='
  SchemaParser () -> SchemaParser ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (String -> SchemaParser ()
reserved String
"typeof")
  ConvexType
refType <- SchemaParser ConvexType
convexTypeParser
  SchemaParser ()
topLevelStatementEnd
  (ParserState -> ParserState) -> SchemaParser ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
modifyState (\ParserState
s -> ParserState
s {psConstants = Map.insert typeName refType (psConstants s)})

parseSchema :: String -> IO (Either ParseError ParsedFile)
parseSchema :: String -> IO (Either ParseError ParsedFile)
parseSchema String
input = do
  -- First Pass: Collect all top-level definitions (consts and types).
  let definitionsPassParser :: ParsecT String ParserState IO [()]
definitionsPassParser = SchemaParser () -> ParsecT String ParserState IO [()]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (SchemaParser () -> SchemaParser ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try SchemaParser ()
topLevelConstParser SchemaParser () -> SchemaParser () -> SchemaParser ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> SchemaParser () -> SchemaParser ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try SchemaParser ()
topLevelTypeParser SchemaParser () -> SchemaParser () -> SchemaParser ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT String ParserState IO Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ParsecT String ParserState IO Char
-> SchemaParser () -> SchemaParser ()
forall a b.
ParsecT String ParserState IO a
-> ParsecT String ParserState IO b
-> ParsecT String ParserState IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> SchemaParser ()
forall a. a -> ParsecT String ParserState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()))
  ParserState
constsState <- ParsecT String ParserState IO ParserState
-> ParserState -> String -> String -> IO ParserState
forall a. SchemaParser a -> ParserState -> String -> String -> IO a
execParser (ParsecT String ParserState IO [()]
definitionsPassParser ParsecT String ParserState IO [()]
-> ParsecT String ParserState IO ParserState
-> ParsecT String ParserState IO ParserState
forall a b.
ParsecT String ParserState IO a
-> ParsecT String ParserState IO b
-> ParsecT String ParserState IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String ParserState IO ParserState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState) ParserState
initialState String
"(schema.ts)" String
input

  -- Second Pass: Parse the schema, using the constants we just found.
  let schemaPassParser :: ParsecT String ParserState IO Schema
schemaPassParser = do
        String
_ <- ParsecT String ParserState IO Char
-> SchemaParser () -> SchemaParser String
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
manyTill ParsecT String ParserState IO Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (SchemaParser () -> SchemaParser ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (SchemaParser () -> SchemaParser ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> SchemaParser ()
reserved String
"defineSchema(")))
        String -> SchemaParser ()
reserved String
"defineSchema"
        [Table]
tables <- SchemaParser [Table] -> SchemaParser [Table]
forall a. SchemaParser a -> SchemaParser a
parens (SchemaParser [Table] -> SchemaParser [Table])
-> SchemaParser [Table] -> SchemaParser [Table]
forall a b. (a -> b) -> a -> b
$ SchemaParser [Table] -> SchemaParser [Table]
forall a. SchemaParser a -> SchemaParser a
braces (SchemaParser [Table] -> SchemaParser [Table])
-> SchemaParser [Table] -> SchemaParser [Table]
forall a b. (a -> b) -> a -> b
$ SchemaParser Table -> SchemaParser [Table]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many SchemaParser Table
tableParser
        Schema -> ParsecT String ParserState IO Schema
forall a. a -> ParsecT String ParserState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Schema -> ParsecT String ParserState IO Schema)
-> Schema -> ParsecT String ParserState IO Schema
forall a b. (a -> b) -> a -> b
$ [Table] -> Schema
Schema [Table]
tables

  Schema
schemaResult <- ParsecT String ParserState IO Schema
-> ParserState -> String -> String -> IO Schema
forall a. SchemaParser a -> ParserState -> String -> String -> IO a
execParser ParsecT String ParserState IO Schema
schemaPassParser ParserState
constsState String
"(schema.ts)" String
input

  Either ParseError ParsedFile -> IO (Either ParseError ParsedFile)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ParseError ParsedFile -> IO (Either ParseError ParsedFile))
-> Either ParseError ParsedFile
-> IO (Either ParseError ParsedFile)
forall a b. (a -> b) -> a -> b
$ ParsedFile -> Either ParseError ParsedFile
forall a b. b -> Either a b
Right (Map String ConvexType -> Schema -> ParsedFile
ParsedFile (ParserState -> Map String ConvexType
psConstants ParserState
constsState) Schema
schemaResult)

-- | A helper to run a parser and return the result, simplifying error handling.
execParser :: SchemaParser a -> ParserState -> SourceName -> String -> IO a
execParser :: forall a. SchemaParser a -> ParserState -> String -> String -> IO a
execParser SchemaParser a
p ParserState
st String
name String
input = do
  Either ParseError a
result <- SchemaParser a
-> ParserState -> String -> String -> IO (Either ParseError a)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
runParserT SchemaParser a
p ParserState
st String
name String
input
  case Either ParseError a
result of
    Left ParseError
err -> String -> IO a
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (ParseError -> String
forall a. Show a => a -> String
show ParseError
err)
    Right a
res -> a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res