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

module Convex.Action.Parser
  ( ConvexFunction (..),
    FuncType (..),
    parseActionFile,
    Schema.ConvexType (VVoid),
  )
where

import Control.Monad (void)
import qualified Convex.Schema.Parser as Schema
import Data.Functor (($>))
import Text.Parsec
import qualified Text.Parsec.Token as Token

type SchemaParser a = ParsecT String Schema.ParserState IO a

data FuncType = Query | Mutation | Action
  deriving (Int -> FuncType -> ShowS
[FuncType] -> ShowS
FuncType -> String
(Int -> FuncType -> ShowS)
-> (FuncType -> String) -> ([FuncType] -> ShowS) -> Show FuncType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FuncType -> ShowS
showsPrec :: Int -> FuncType -> ShowS
$cshow :: FuncType -> String
show :: FuncType -> String
$cshowList :: [FuncType] -> ShowS
showList :: [FuncType] -> ShowS
Show, FuncType -> FuncType -> Bool
(FuncType -> FuncType -> Bool)
-> (FuncType -> FuncType -> Bool) -> Eq FuncType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FuncType -> FuncType -> Bool
== :: FuncType -> FuncType -> Bool
$c/= :: FuncType -> FuncType -> Bool
/= :: FuncType -> FuncType -> Bool
Eq)

data ConvexFunction = ConvexFunction
  { ConvexFunction -> String
funcName :: String,
    ConvexFunction -> String
funcPath :: String,
    ConvexFunction -> FuncType
funcType :: FuncType,
    ConvexFunction -> [(String, ConvexType)]
funcArgs :: [(String, Schema.ConvexType)],
    ConvexFunction -> ConvexType
funcReturn :: Schema.ConvexType
  }
  deriving (Int -> ConvexFunction -> ShowS
[ConvexFunction] -> ShowS
ConvexFunction -> String
(Int -> ConvexFunction -> ShowS)
-> (ConvexFunction -> String)
-> ([ConvexFunction] -> ShowS)
-> Show ConvexFunction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConvexFunction -> ShowS
showsPrec :: Int -> ConvexFunction -> ShowS
$cshow :: ConvexFunction -> String
show :: ConvexFunction -> String
$cshowList :: [ConvexFunction] -> ShowS
showList :: [ConvexFunction] -> ShowS
Show, ConvexFunction -> ConvexFunction -> Bool
(ConvexFunction -> ConvexFunction -> Bool)
-> (ConvexFunction -> ConvexFunction -> Bool) -> Eq ConvexFunction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConvexFunction -> ConvexFunction -> Bool
== :: ConvexFunction -> ConvexFunction -> Bool
$c/= :: ConvexFunction -> ConvexFunction -> Bool
/= :: ConvexFunction -> ConvexFunction -> Bool
Eq)

-- Slightly different lexer for Actions.
langDef :: Token.GenLanguageDef String Schema.ParserState IO
langDef :: GenLanguageDef String ParserState IO
langDef =
  Token.LanguageDef
    { commentStart :: String
Token.commentStart = String
"/*",
      commentEnd :: String
Token.commentEnd = String
"*/",
      commentLine :: String
Token.commentLine = String
"//",
      nestedComments :: Bool
Token.nestedComments = Bool
True,
      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
'_',
      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 = [],
      reservedNames :: [String]
Token.reservedNames =
        [ String
"export",
          String
"declare",
          String
"const",
          String
"import",
          String
"from",
          String
"RegisteredQuery",
          String
"RegisteredMutation",
          String
"RegisteredAction",
          String
"Promise",
          String
"any",
          String
"string",
          String
"number",
          String
"boolean",
          String
"void",
          String
"GenericId",
          String
"DefaultFunctionArgs",
          String
"ArrayBuffer",
          String
"bigint"
        ],
      caseSensitive :: Bool
Token.caseSensitive = Bool
True
    }

lexer :: Token.GenTokenParser String Schema.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

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

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

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

angles :: SchemaParser a -> SchemaParser a
angles :: forall a. SchemaParser a -> SchemaParser a
angles SchemaParser a
p = 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 a -> SchemaParser a
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 a
p SchemaParser a
-> ParsecT String ParserState IO Char -> SchemaParser a
forall a b.
ParsecT String ParserState IO a
-> ParsecT String ParserState IO b
-> ParsecT String ParserState IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* 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
'>')

dtsTypeParser :: SchemaParser Schema.ConvexType
dtsTypeParser :: SchemaParser ConvexType
dtsTypeParser = do
  -- A type can be a union of other types
  [ConvexType]
types <- 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]
sepBy1 SchemaParser ConvexType
singleType (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
'|'))
  let baseType :: ConvexType
baseType = if [ConvexType] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ConvexType]
types Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then [ConvexType] -> ConvexType
forall a. HasCallStack => [a] -> a
head [ConvexType]
types else [ConvexType] -> ConvexType
Schema.VUnion [ConvexType]
types
  -- After parsing the base type, check for array suffixes `[]`
  Int
arrayCount <- [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> Int)
-> ParsecT String ParserState IO [String]
-> ParsecT String ParserState IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SchemaParser String -> ParsecT String ParserState IO [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (SchemaParser String -> SchemaParser String
forall a. SchemaParser a -> SchemaParser a
lexeme (String -> SchemaParser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"[]"))
  -- Wrap the base type in VArray for each `[]` found
  ConvexType -> SchemaParser ConvexType
forall a. a -> ParsecT String ParserState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConvexType -> SchemaParser ConvexType)
-> ConvexType -> SchemaParser ConvexType
forall a b. (a -> b) -> a -> b
$ (() -> ConvexType -> ConvexType)
-> ConvexType -> [()] -> ConvexType
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\()
_ ConvexType
acc -> ConvexType -> ConvexType
Schema.VArray ConvexType
acc) ConvexType
baseType (Int -> () -> [()]
forall a. Int -> a -> [a]
replicate Int
arrayCount ())
  where
    -- Parses both single identifiers (like `RoleEnum`)
    -- and qualified identifiers (like `Stripe.Subscription`).
    qualifiedIdentifierParser :: SchemaParser Schema.ConvexType
    qualifiedIdentifierParser :: SchemaParser ConvexType
qualifiedIdentifierParser = do
      [String]
parts <- SchemaParser String
-> ParsecT String ParserState IO Char
-> ParsecT String ParserState IO [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]
sepBy1 SchemaParser String
identifier (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
'.'))
      if [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
parts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
        then -- If there's a dot, it's definitely an external type.
          ConvexType -> SchemaParser ConvexType
forall a. a -> ParsecT String ParserState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ConvexType
Schema.VAny
        else -- Otherwise, it's a single-word identifier, treat as a reference.
          ConvexType -> SchemaParser ConvexType
forall a. a -> ParsecT String ParserState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ConvexType
Schema.VReference ([String] -> String
forall a. HasCallStack => [a] -> a
head [String]
parts))

    singleType :: SchemaParser ConvexType
singleType =
      (ConvexType
Schema.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 s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> SchemaParser ()
reserved String
"string"))
        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
<|> (ConvexType
Schema.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 s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> SchemaParser ()
reserved String
"number"))
        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
<|> (ConvexType
Schema.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 s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> SchemaParser ()
reserved String
"boolean"))
        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
<|> (ConvexType
Schema.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 s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> SchemaParser ()
reserved String
"ArrayBuffer"))
        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
<|> (ConvexType
Schema.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 s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> SchemaParser ()
reserved String
"bigint"))
        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
<|> (ConvexType
Schema.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 s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> SchemaParser ()
reserved String
"any"))
        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
Schema.VLiteral (String -> ConvexType)
-> SchemaParser String -> SchemaParser ConvexType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SchemaParser String -> SchemaParser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try SchemaParser String
stringLiteral)
        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
Schema.VId (String -> ConvexType)
-> SchemaParser String -> SchemaParser ConvexType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SchemaParser String -> SchemaParser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try SchemaParser String
genericIdParser)
        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)] -> ConvexType
Schema.VObject ([(String, ConvexType)] -> ConvexType)
-> ParsecT String ParserState IO [(String, ConvexType)]
-> SchemaParser ConvexType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String ParserState IO [(String, ConvexType)]
-> ParsecT String ParserState IO [(String, ConvexType)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String ParserState IO [(String, ConvexType)]
-> ParsecT String ParserState IO [(String, ConvexType)]
forall a. SchemaParser a -> SchemaParser a
braces (ParsecT String ParserState IO (String, ConvexType)
-> ParsecT String ParserState IO Char
-> ParsecT String ParserState IO [(String, 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 ParsecT String ParserState IO (String, ConvexType)
dtsFieldParser (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 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 -> SchemaParser ConvexType
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (SchemaParser ConvexType -> SchemaParser ConvexType
forall a. SchemaParser a -> SchemaParser a
parens SchemaParser ConvexType
dtsTypeParser)
        -- This is now the last option, which correctly handles all remaining identifiers.
        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
qualifiedIdentifierParser

-- A parser for a single field inside an argument or object type
dtsFieldParser :: SchemaParser (String, Schema.ConvexType)
dtsFieldParser :: ParsecT String ParserState IO (String, ConvexType)
dtsFieldParser = ParsecT String ParserState IO (String, ConvexType)
-> ParsecT String ParserState IO (String, ConvexType)
forall a. SchemaParser a -> SchemaParser a
lexeme (ParsecT String ParserState IO (String, ConvexType)
 -> ParsecT String ParserState IO (String, ConvexType))
-> ParsecT String ParserState IO (String, ConvexType)
-> ParsecT String ParserState IO (String, ConvexType)
forall a b. (a -> b) -> a -> b
$ do
  String
name <- SchemaParser String
identifier
  Maybe Char
isOptional <- ParsecT String ParserState IO Char
-> ParsecT String ParserState IO (Maybe Char)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe (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 (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
typ <- SchemaParser ConvexType
dtsTypeParser
  -- If the `?` was present, wrap the final type in VOptional
  let finalType :: ConvexType
finalType = ConvexType -> (Char -> ConvexType) -> Maybe Char -> ConvexType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ConvexType
typ (ConvexType -> Char -> ConvexType
forall a b. a -> b -> a
const (ConvexType -> Char -> ConvexType)
-> ConvexType -> Char -> ConvexType
forall a b. (a -> b) -> a -> b
$ ConvexType -> ConvexType
Schema.VOptional ConvexType
typ) Maybe Char
isOptional
  (String, ConvexType)
-> ParsecT String ParserState IO (String, ConvexType)
forall a. a -> ParsecT String ParserState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
name, ConvexType
finalType)

-- A parser for `import("...").GenericId<"...">`
genericIdParser :: SchemaParser String
genericIdParser :: SchemaParser String
genericIdParser = do
  SchemaParser () -> SchemaParser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (SchemaParser () -> SchemaParser ())
-> SchemaParser () -> SchemaParser ()
forall a b. (a -> b) -> a -> b
$ String -> SchemaParser ()
reserved String
"import"
  SchemaParser String -> SchemaParser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (SchemaParser String -> SchemaParser ())
-> SchemaParser String -> SchemaParser ()
forall a b. (a -> b) -> a -> b
$ SchemaParser String -> SchemaParser String
forall a. SchemaParser a -> SchemaParser a
parens 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
'.'
  SchemaParser () -> SchemaParser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (SchemaParser () -> SchemaParser ())
-> SchemaParser () -> SchemaParser ()
forall a b. (a -> b) -> a -> b
$ String -> SchemaParser ()
reserved String
"GenericId"
  SchemaParser String -> SchemaParser String
forall a. SchemaParser a -> SchemaParser a
angles SchemaParser String
stringLiteral

-- A parser for `import("...").DefaultFunctionArgs`
defaultFuncArgsParser :: SchemaParser ()
defaultFuncArgsParser :: SchemaParser ()
defaultFuncArgsParser = do
  SchemaParser () -> SchemaParser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (SchemaParser () -> SchemaParser ())
-> SchemaParser () -> SchemaParser ()
forall a b. (a -> b) -> a -> b
$ String -> SchemaParser ()
reserved String
"import"
  SchemaParser String -> SchemaParser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (SchemaParser String -> SchemaParser ())
-> SchemaParser String -> SchemaParser ()
forall a b. (a -> b) -> a -> b
$ SchemaParser String -> SchemaParser String
forall a. SchemaParser a -> SchemaParser a
parens 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
'.'
  SchemaParser () -> SchemaParser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (SchemaParser () -> SchemaParser ())
-> SchemaParser () -> SchemaParser ()
forall a b. (a -> b) -> a -> b
$ String -> SchemaParser ()
reserved String
"DefaultFunctionArgs"

registeredFunctionParser :: String -> SchemaParser (Maybe ConvexFunction)
registeredFunctionParser :: String -> SchemaParser (Maybe ConvexFunction)
registeredFunctionParser String
fPath = SchemaParser (Maybe ConvexFunction)
-> SchemaParser (Maybe ConvexFunction)
forall a. SchemaParser a -> SchemaParser a
lexeme (SchemaParser (Maybe ConvexFunction)
 -> SchemaParser (Maybe ConvexFunction))
-> SchemaParser (Maybe ConvexFunction)
-> SchemaParser (Maybe ConvexFunction)
forall a b. (a -> b) -> a -> b
$ do
  SchemaParser String -> SchemaParser ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (SchemaParser String -> SchemaParser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (SchemaParser String -> SchemaParser String
forall a. SchemaParser a -> SchemaParser a
lexeme (String -> SchemaParser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"/**") SchemaParser String -> SchemaParser String -> SchemaParser String
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 Char
-> SchemaParser String -> 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 String -> SchemaParser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> SchemaParser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"*/"))))
  SchemaParser ()
whiteSpace

  String -> SchemaParser ()
reserved String
"export"
  String -> SchemaParser ()
reserved String
"declare"
  String -> SchemaParser ()
reserved String
"const"
  String
fName <- 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 (f :: * -> *) a. Functor f => f a -> f ()
void (SchemaParser () -> SchemaParser ())
-> SchemaParser () -> SchemaParser ()
forall a b. (a -> b) -> a -> b
$ String -> SchemaParser ()
reserved String
"import"
  SchemaParser String -> SchemaParser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (SchemaParser String -> SchemaParser ())
-> SchemaParser String -> SchemaParser ()
forall a b. (a -> b) -> a -> b
$ SchemaParser String -> SchemaParser String
forall a. SchemaParser a -> SchemaParser a
parens 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
fTypeStr <-
    [SchemaParser String] -> SchemaParser String
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
      [ SchemaParser String -> SchemaParser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> SchemaParser ()
reserved String
"RegisteredQuery" SchemaParser () -> SchemaParser String -> SchemaParser String
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
>> String -> SchemaParser String
forall a. a -> ParsecT String ParserState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"RegisteredQuery"),
        SchemaParser String -> SchemaParser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> SchemaParser ()
reserved String
"RegisteredMutation" SchemaParser () -> SchemaParser String -> SchemaParser String
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
>> String -> SchemaParser String
forall a. a -> ParsecT String ParserState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"RegisteredMutation"),
        SchemaParser String -> SchemaParser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> SchemaParser ()
reserved String
"RegisteredAction" SchemaParser () -> SchemaParser String -> SchemaParser String
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
>> String -> SchemaParser String
forall a. a -> ParsecT String ParserState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"RegisteredAction")
      ]

  let fType :: FuncType
fType = case String
fTypeStr of
        String
"RegisteredQuery" -> FuncType
Query
        String
"RegisteredMutation" -> FuncType
Mutation
        String
"RegisteredAction" -> FuncType
Action
        String
_ -> String -> FuncType
forall a. HasCallStack => String -> a
error String
"This case is unreachable due to the parser above"

  -- Parse the generic parameters
  (String
visibility, [(String, ConvexType)]
fArgs, ConvexType
fReturn) <- SchemaParser (String, [(String, ConvexType)], ConvexType)
-> SchemaParser (String, [(String, ConvexType)], ConvexType)
forall a. SchemaParser a -> SchemaParser a
angles (SchemaParser (String, [(String, ConvexType)], ConvexType)
 -> SchemaParser (String, [(String, ConvexType)], ConvexType))
-> SchemaParser (String, [(String, ConvexType)], ConvexType)
-> SchemaParser (String, [(String, ConvexType)], ConvexType)
forall a b. (a -> b) -> a -> b
$ do
    String
vis <- 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, ConvexType)]
args <-
      (ParsecT String ParserState IO [(String, ConvexType)]
-> ParsecT String ParserState IO [(String, ConvexType)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String ParserState IO [(String, ConvexType)]
-> ParsecT String ParserState IO [(String, ConvexType)]
forall a. SchemaParser a -> SchemaParser a
braces (ParsecT String ParserState IO (String, ConvexType)
-> ParsecT String ParserState IO Char
-> ParsecT String ParserState IO [(String, 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 ParsecT String ParserState IO (String, ConvexType)
dtsFieldParser (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 [(String, ConvexType)]
-> ParsecT String ParserState IO [(String, ConvexType)]
-> ParsecT String ParserState IO [(String, ConvexType)]
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 ()
defaultFuncArgsParser SchemaParser ()
-> [(String, ConvexType)]
-> ParsecT String ParserState IO [(String, ConvexType)]
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> [])
    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 (f :: * -> *) a. Functor f => f a -> f ()
void (SchemaParser () -> SchemaParser ())
-> SchemaParser () -> SchemaParser ()
forall a b. (a -> b) -> a -> b
$ String -> SchemaParser ()
reserved String
"Promise"
    ConvexType
ret <- SchemaParser ConvexType -> SchemaParser ConvexType
forall a. SchemaParser a -> SchemaParser a
angles ((String -> SchemaParser ()
reserved String
"void" SchemaParser () -> ConvexType -> SchemaParser ConvexType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ConvexType
Schema.VVoid) 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
dtsTypeParser)
    (String, [(String, ConvexType)], ConvexType)
-> SchemaParser (String, [(String, ConvexType)], ConvexType)
forall a. a -> ParsecT String ParserState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
vis, [(String, ConvexType)]
args, ConvexType
ret)

  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
';'

  case String
visibility of
    String
"public" -> Maybe ConvexFunction -> SchemaParser (Maybe ConvexFunction)
forall a. a -> ParsecT String ParserState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ConvexFunction -> SchemaParser (Maybe ConvexFunction))
-> Maybe ConvexFunction -> SchemaParser (Maybe ConvexFunction)
forall a b. (a -> b) -> a -> b
$ ConvexFunction -> Maybe ConvexFunction
forall a. a -> Maybe a
Just (String
-> String
-> FuncType
-> [(String, ConvexType)]
-> ConvexType
-> ConvexFunction
ConvexFunction String
fName String
fPath FuncType
fType [(String, ConvexType)]
fArgs ConvexType
fReturn)
    String
"internal" -> Maybe ConvexFunction -> SchemaParser (Maybe ConvexFunction)
forall a. a -> ParsecT String ParserState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ConvexFunction
forall a. Maybe a
Nothing
    String
other -> String -> SchemaParser (Maybe ConvexFunction)
forall a. String -> ParsecT String ParserState IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> SchemaParser (Maybe ConvexFunction))
-> String -> SchemaParser (Maybe ConvexFunction)
forall a b. (a -> b) -> a -> b
$ String
"Unknown or unhandled visibility in d.ts file: \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
other String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\""

mapMaybe :: (a -> Maybe b) -> [a] -> [b]
mapMaybe :: forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe a -> Maybe b
_ [] = []
mapMaybe a -> Maybe b
f (a
x : [a]
xs) =
  case a -> Maybe b
f a
x of
    Just b
v -> b
v b -> [b] -> [b]
forall a. a -> [a] -> [a]
: (a -> Maybe b) -> [a] -> [b]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe a -> Maybe b
f [a]
xs
    Maybe b
Nothing -> (a -> Maybe b) -> [a] -> [b]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe a -> Maybe b
f [a]
xs

-- | A helper to parse and ignore statements that we don't care about.
ignoredStatementParser :: SchemaParser ()
ignoredStatementParser :: SchemaParser ()
ignoredStatementParser =
  [SchemaParser ()] -> SchemaParser ()
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([SchemaParser ()] -> SchemaParser ())
-> ([SchemaParser ()] -> [SchemaParser ()])
-> [SchemaParser ()]
-> SchemaParser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SchemaParser () -> SchemaParser ())
-> [SchemaParser ()] -> [SchemaParser ()]
forall a b. (a -> b) -> [a] -> [b]
map SchemaParser () -> SchemaParser ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([SchemaParser ()] -> SchemaParser ())
-> [SchemaParser ()] -> SchemaParser ()
forall a b. (a -> b) -> a -> b
$
    [ SchemaParser ()
importStatement,
      SchemaParser ()
forall {u}. ParsecT String u IO ()
lineComment,
      SchemaParser ()
forall {u}. ParsecT String u IO ()
blockComment,
      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 ()
skipMany1 (String -> ParsecT String ParserState IO Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
" \t\n\r"))
    ]
  where
    importStatement :: SchemaParser ()
importStatement =
      String -> SchemaParser ()
reserved String
"import"
        SchemaParser () -> SchemaParser String -> SchemaParser String
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 Char
-> 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]
manyTill ParsecT String ParserState IO Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (Char -> ParsecT String ParserState IO Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
';')
        SchemaParser String -> 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 ()
forall a. a -> ParsecT String ParserState IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    lineComment :: ParsecT String u IO ()
lineComment =
      String -> ParsecT String u IO String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (GenLanguageDef String ParserState IO -> String
forall s u (m :: * -> *). GenLanguageDef s u m -> String
Token.commentLine GenLanguageDef String ParserState IO
langDef) ParsecT String u IO String
-> ParsecT String u IO String -> ParsecT String u IO String
forall a b.
ParsecT String u IO a
-> ParsecT String u IO b -> ParsecT String u IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String u IO Char
-> ParsecT String u IO Char -> ParsecT String u IO 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 u IO Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (ParsecT String u IO Char -> ParsecT String u IO Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String u IO Char -> ParsecT String u IO Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (Char -> ParsecT String u IO Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\n'))) ParsecT String u IO String
-> ParsecT String u IO () -> ParsecT String u IO ()
forall a b.
ParsecT String u IO a
-> ParsecT String u IO b -> ParsecT String u IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> () -> ParsecT String u IO ()
forall a. a -> ParsecT String u IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    blockComment :: ParsecT String u IO ()
blockComment =
      String -> ParsecT String u IO String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (GenLanguageDef String ParserState IO -> String
forall s u (m :: * -> *). GenLanguageDef s u m -> String
Token.commentStart GenLanguageDef String ParserState IO
langDef)
        ParsecT String u IO String
-> ParsecT String u IO String -> ParsecT String u IO String
forall a b.
ParsecT String u IO a
-> ParsecT String u IO b -> ParsecT String u IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String u IO Char
-> ParsecT String u IO String -> ParsecT String u IO 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 u IO Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (ParsecT String u IO String -> ParsecT String u IO String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String u IO String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (GenLanguageDef String ParserState IO -> String
forall s u (m :: * -> *). GenLanguageDef s u m -> String
Token.commentEnd GenLanguageDef String ParserState IO
langDef)))
        ParsecT String u IO String
-> ParsecT String u IO () -> ParsecT String u IO ()
forall a b.
ParsecT String u IO a
-> ParsecT String u IO b -> ParsecT String u IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> () -> ParsecT String u IO ()
forall a. a -> ParsecT String u IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

parseActionFile :: String -> SchemaParser [ConvexFunction]
parseActionFile :: String -> SchemaParser [ConvexFunction]
parseActionFile String
path = do
  SchemaParser ()
whiteSpace
  -- FIX: In a loop, consume either a function or an ignored statement,
  -- effectively skipping over comments and imports between functions.
  [Either () (Maybe ConvexFunction)]
results <-
    ParsecT String ParserState IO (Either () (Maybe ConvexFunction))
-> ParsecT String ParserState IO [Either () (Maybe ConvexFunction)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many
      ( (ParsecT String ParserState IO (Either () (Maybe ConvexFunction))
-> ParsecT String ParserState IO (Either () (Maybe ConvexFunction))
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Maybe ConvexFunction -> Either () (Maybe ConvexFunction)
forall a b. b -> Either a b
Right (Maybe ConvexFunction -> Either () (Maybe ConvexFunction))
-> SchemaParser (Maybe ConvexFunction)
-> ParsecT String ParserState IO (Either () (Maybe ConvexFunction))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> SchemaParser (Maybe ConvexFunction)
registeredFunctionParser String
path))
          ParsecT String ParserState IO (Either () (Maybe ConvexFunction))
-> ParsecT String ParserState IO (Either () (Maybe ConvexFunction))
-> ParsecT String ParserState IO (Either () (Maybe ConvexFunction))
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT String ParserState IO (Either () (Maybe ConvexFunction))
-> ParsecT String ParserState IO (Either () (Maybe ConvexFunction))
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (() -> Either () (Maybe ConvexFunction)
forall a b. a -> Either a b
Left (() -> Either () (Maybe ConvexFunction))
-> SchemaParser ()
-> ParsecT String ParserState IO (Either () (Maybe ConvexFunction))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SchemaParser ()
ignoredStatementParser))
      )
  -- Filter out the ignored statements (Lefts) and keep only the functions (Rights).
  [ConvexFunction] -> SchemaParser [ConvexFunction]
forall a. a -> ParsecT String ParserState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ConvexFunction] -> SchemaParser [ConvexFunction])
-> [ConvexFunction] -> SchemaParser [ConvexFunction]
forall a b. (a -> b) -> a -> b
$ (Either () (Maybe ConvexFunction) -> Maybe ConvexFunction)
-> [Either () (Maybe ConvexFunction)] -> [ConvexFunction]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((() -> Maybe ConvexFunction)
-> (Maybe ConvexFunction -> Maybe ConvexFunction)
-> Either () (Maybe ConvexFunction)
-> Maybe ConvexFunction
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe ConvexFunction -> () -> Maybe ConvexFunction
forall a b. a -> b -> a
const Maybe ConvexFunction
forall a. Maybe a
Nothing) Maybe ConvexFunction -> Maybe ConvexFunction
forall a. a -> a
id) [Either () (Maybe ConvexFunction)]
results