{-|
Module: IHP.IDE.SchemaDesigner.Types
Description: Parser for Application/Schema.sql
Copyright: (c) digitally induced GmbH, 2020
-}
module IHP.IDE.SchemaDesigner.Parser
( parseSchemaSql
, schemaFilePath
, parseDDL
, expression
, sqlType
) where

import IHP.Prelude
import IHP.IDE.SchemaDesigner.Types
import qualified Prelude
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import Text.Megaparsec
import Data.Void
import Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as Lexer
import Data.Char
import IHP.IDE.SchemaDesigner.Compiler (compileSql)
import Control.Monad.Combinators.Expr

schemaFilePath :: FilePath
schemaFilePath = FilePath
"Application/Schema.sql"

parseSchemaSql :: IO (Either ByteString [Statement])
parseSchemaSql :: IO (Either ByteString [Statement])
parseSchemaSql = do
    Text
schemaSql <- FilePath -> IO Text
Text.readFile FilePath
schemaFilePath
    let result :: Either (ParseErrorBundle Text Void) [Statement]
result = Parsec Void Text [Statement]
-> FilePath
-> Text
-> Either (ParseErrorBundle Text Void) [Statement]
forall e s a.
Parsec e s a -> FilePath -> s -> Either (ParseErrorBundle s e) a
runParser Parsec Void Text [Statement]
parseDDL (FilePath -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs FilePath
schemaFilePath) Text
schemaSql
    case Either (ParseErrorBundle Text Void) [Statement]
result of
        Left ParseErrorBundle Text Void
error -> Either ByteString [Statement] -> IO (Either ByteString [Statement])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Either ByteString [Statement]
forall a b. a -> Either a b
Left (FilePath -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text Void -> FilePath
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> FilePath
errorBundlePretty ParseErrorBundle Text Void
error))
        Right [Statement]
r -> Either ByteString [Statement] -> IO (Either ByteString [Statement])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Statement] -> Either ByteString [Statement]
forall a b. b -> Either a b
Right [Statement]
r)

type Parser = Parsec Void Text

spaceConsumer :: Parser ()
spaceConsumer :: Parser ()
spaceConsumer = Parser () -> Parser () -> Parser () -> Parser ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
Lexer.space
    Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space1
    (Tokens Text -> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> m ()
Lexer.skipLineComment Tokens Text
"//")
    (Tokens Text -> Tokens Text -> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> Tokens s -> m ()
Lexer.skipBlockComment Tokens Text
"/*" Tokens Text
"*/")

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

symbol :: Text -> Parser Text
symbol :: Text -> Parser Text
symbol = Parser ()
-> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
Lexer.symbol Parser ()
spaceConsumer

symbol' :: Text -> Parser Text
symbol' :: Text -> Parser Text
symbol' = Parser ()
-> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
m () -> Tokens s -> m (Tokens s)
Lexer.symbol' Parser ()
spaceConsumer

stringLiteral :: Parser String
stringLiteral :: Parser FilePath
stringLiteral = Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\'' ParsecT Void Text Identity Char
-> Parser FilePath -> Parser FilePath
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char -> Parser FilePath
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Char
Lexer.charLiteral (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\'')

parseDDL :: Parser [Statement]
parseDDL :: Parsec Void Text [Statement]
parseDDL = ParsecT Void Text Identity Statement
-> Parser () -> Parsec Void Text [Statement]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT Void Text Identity Statement
statement Parser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof

statement :: ParsecT Void Text Identity Statement
statement = do
    Statement
s <- ParsecT Void Text Identity Statement
-> ParsecT Void Text Identity Statement
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Statement
createExtension ParsecT Void Text Identity Statement
-> ParsecT Void Text Identity Statement
-> ParsecT Void Text Identity Statement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Statement
-> ParsecT Void Text Identity Statement
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (CreateTable -> Statement
StatementCreateTable (CreateTable -> Statement)
-> ParsecT Void Text Identity CreateTable
-> ParsecT Void Text Identity Statement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity CreateTable
createTable) ParsecT Void Text Identity Statement
-> ParsecT Void Text Identity Statement
-> ParsecT Void Text Identity Statement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Statement
-> ParsecT Void Text Identity Statement
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Statement
createIndex ParsecT Void Text Identity Statement
-> ParsecT Void Text Identity Statement
-> ParsecT Void Text Identity Statement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Statement
createEnumType ParsecT Void Text Identity Statement
-> ParsecT Void Text Identity Statement
-> ParsecT Void Text Identity Statement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Statement
addConstraint ParsecT Void Text Identity Statement
-> ParsecT Void Text Identity Statement
-> ParsecT Void Text Identity Statement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Statement
comment
    Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
    Statement -> ParsecT Void Text Identity Statement
forall (f :: * -> *) a. Applicative f => a -> f a
pure Statement
s


createExtension :: ParsecT Void Text Identity Statement
createExtension = do
    Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"CREATE"
    Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"EXTENSION"
    Bool
ifNotExists <- Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Text -> Bool)
-> ParsecT Void Text Identity (Maybe Text)
-> ParsecT Void Text Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text -> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"IF" Parser Text -> Parser Text -> Parser Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"NOT" Parser Text -> Parser Text -> Parser Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"EXISTS")
    Text
name <- FilePath -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (FilePath -> Text) -> Parser FilePath -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"' ParsecT Void Text Identity Char
-> Parser FilePath -> Parser FilePath
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char -> Parser FilePath
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Char
Lexer.charLiteral (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"'))
    Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
';'
    Statement -> ParsecT Void Text Identity Statement
forall (f :: * -> *) a. Applicative f => a -> f a
pure CreateExtension :: Text -> Bool -> Statement
CreateExtension { Text
$sel:name:StatementCreateTable :: Text
name :: Text
name, $sel:ifNotExists:StatementCreateTable :: Bool
ifNotExists = Bool
True }

createTable :: ParsecT Void Text Identity CreateTable
createTable = do
    Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"CREATE"
    Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"TABLE"
    ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional do
        Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"public"
        Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'.'
    Text
name <- Parser Text
identifier

    -- Process columns (tagged if they're primary key) and table constraints
    -- together, as they can be in any order
    ([(Bool, Column)]
taggedColumns, [Either PrimaryKeyConstraint Constraint]
allConstraints) <- Parser ()
-> Parser ()
-> ParsecT
     Void
     Text
     Identity
     ([(Bool, Column)], [Either PrimaryKeyConstraint Constraint])
-> ParsecT
     Void
     Text
     Identity
     ([(Bool, Column)], [Either PrimaryKeyConstraint Constraint])
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'(' ParsecT Void Text Identity Char -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space) (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
')' ParsecT Void Text Identity Char -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space) do
        [Either (Bool, Column) (Either PrimaryKeyConstraint Constraint)]
columnsAndConstraints <- ((Either PrimaryKeyConstraint Constraint
-> Either (Bool, Column) (Either PrimaryKeyConstraint Constraint)
forall a b. b -> Either a b
Right (Either PrimaryKeyConstraint Constraint
 -> Either (Bool, Column) (Either PrimaryKeyConstraint Constraint))
-> ParsecT
     Void Text Identity (Either PrimaryKeyConstraint Constraint)
-> ParsecT
     Void
     Text
     Identity
     (Either (Bool, Column) (Either PrimaryKeyConstraint Constraint))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity (Either PrimaryKeyConstraint Constraint)
parseTableConstraint) ParsecT
  Void
  Text
  Identity
  (Either (Bool, Column) (Either PrimaryKeyConstraint Constraint))
-> ParsecT
     Void
     Text
     Identity
     (Either (Bool, Column) (Either PrimaryKeyConstraint Constraint))
-> ParsecT
     Void
     Text
     Identity
     (Either (Bool, Column) (Either PrimaryKeyConstraint Constraint))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Bool, Column)
-> Either (Bool, Column) (Either PrimaryKeyConstraint Constraint)
forall a b. a -> Either a b
Left ((Bool, Column)
 -> Either (Bool, Column) (Either PrimaryKeyConstraint Constraint))
-> ParsecT Void Text Identity (Bool, Column)
-> ParsecT
     Void
     Text
     Identity
     (Either (Bool, Column) (Either PrimaryKeyConstraint Constraint))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity (Bool, Column)
column)) ParsecT
  Void
  Text
  Identity
  (Either (Bool, Column) (Either PrimaryKeyConstraint Constraint))
-> Parser ()
-> ParsecT
     Void
     Text
     Identity
     [Either (Bool, Column) (Either PrimaryKeyConstraint Constraint)]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
',' ParsecT Void Text Identity Char -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space)
        ([(Bool, Column)], [Either PrimaryKeyConstraint Constraint])
-> ParsecT
     Void
     Text
     Identity
     ([(Bool, Column)], [Either PrimaryKeyConstraint Constraint])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Either (Bool, Column) (Either PrimaryKeyConstraint Constraint)]
-> [(Bool, Column)]
forall a b. [Either a b] -> [a]
lefts [Either (Bool, Column) (Either PrimaryKeyConstraint Constraint)]
columnsAndConstraints, [Either (Bool, Column) (Either PrimaryKeyConstraint Constraint)]
-> [Either PrimaryKeyConstraint Constraint]
forall a b. [Either a b] -> [b]
rights [Either (Bool, Column) (Either PrimaryKeyConstraint Constraint)]
columnsAndConstraints)

    Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
';'

    -- Check that either there is a single column with a PRIMARY KEY constraint,
    -- or there is a single PRIMARY KEY table constraint
    let
        columns :: [Column]
columns = ((Bool, Column) -> Column) -> [(Bool, Column)] -> [Column]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, Column) -> Column
forall a b. (a, b) -> b
snd [(Bool, Column)]
taggedColumns
        constraints :: [Constraint]
constraints = [Either PrimaryKeyConstraint Constraint] -> [Constraint]
forall a b. [Either a b] -> [b]
rights [Either PrimaryKeyConstraint Constraint]
allConstraints

    PrimaryKeyConstraint
primaryKeyConstraint <- case ((Bool, Column) -> Bool) -> [(Bool, Column)] -> [(Bool, Column)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool, Column) -> Bool
forall a b. (a, b) -> a
fst [(Bool, Column)]
taggedColumns of
        [] -> case [Either PrimaryKeyConstraint Constraint] -> [PrimaryKeyConstraint]
forall a b. [Either a b] -> [a]
lefts [Either PrimaryKeyConstraint Constraint]
allConstraints of
            [] -> PrimaryKeyConstraint
-> ParsecT Void Text Identity PrimaryKeyConstraint
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrimaryKeyConstraint
 -> ParsecT Void Text Identity PrimaryKeyConstraint)
-> PrimaryKeyConstraint
-> ParsecT Void Text Identity PrimaryKeyConstraint
forall a b. (a -> b) -> a -> b
$ [Text] -> PrimaryKeyConstraint
PrimaryKeyConstraint []
            [PrimaryKeyConstraint
primaryKeyConstraint] -> PrimaryKeyConstraint
-> ParsecT Void Text Identity PrimaryKeyConstraint
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrimaryKeyConstraint
primaryKeyConstraint
            [PrimaryKeyConstraint]
_ -> FilePath -> ParsecT Void Text Identity PrimaryKeyConstraint
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
Prelude.fail (FilePath
"Multiple PRIMARY KEY constraints on table " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs Text
name)
        [(Bool
_, Column { Text
$sel:name:Column :: Column -> Text
name :: Text
name })] -> case [Either PrimaryKeyConstraint Constraint] -> [PrimaryKeyConstraint]
forall a b. [Either a b] -> [a]
lefts [Either PrimaryKeyConstraint Constraint]
allConstraints of
            [] -> PrimaryKeyConstraint
-> ParsecT Void Text Identity PrimaryKeyConstraint
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrimaryKeyConstraint
 -> ParsecT Void Text Identity PrimaryKeyConstraint)
-> PrimaryKeyConstraint
-> ParsecT Void Text Identity PrimaryKeyConstraint
forall a b. (a -> b) -> a -> b
$ [Text] -> PrimaryKeyConstraint
PrimaryKeyConstraint [Text
name]
            [PrimaryKeyConstraint]
_ -> FilePath -> ParsecT Void Text Identity PrimaryKeyConstraint
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
Prelude.fail (FilePath
"Primary key defined in both column and table constraints on table " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs Text
name)
        [(Bool, Column)]
_ -> FilePath -> ParsecT Void Text Identity PrimaryKeyConstraint
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
Prelude.fail FilePath
"Multiple columns with PRIMARY KEY constraint"

    CreateTable -> ParsecT Void Text Identity CreateTable
forall (f :: * -> *) a. Applicative f => a -> f a
pure CreateTable :: Text
-> [Column] -> PrimaryKeyConstraint -> [Constraint] -> CreateTable
CreateTable { Text
$sel:name:CreateTable :: Text
name :: Text
name, [Column]
$sel:columns:CreateTable :: [Column]
columns :: [Column]
columns, PrimaryKeyConstraint
$sel:primaryKeyConstraint:CreateTable :: PrimaryKeyConstraint
primaryKeyConstraint :: PrimaryKeyConstraint
primaryKeyConstraint, [Constraint]
$sel:constraints:CreateTable :: [Constraint]
constraints :: [Constraint]
constraints }

createEnumType :: ParsecT Void Text Identity Statement
createEnumType = do
    Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"CREATE"
    Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"TYPE"
    Text
name <- Parser Text
identifier
    Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"AS"
    Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"ENUM"
    [Text]
values <- Parser ()
-> Parser ()
-> ParsecT Void Text Identity [Text]
-> ParsecT Void Text Identity [Text]
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'(' ParsecT Void Text Identity Char -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space) (Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space Parser ()
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
')' ParsecT Void Text Identity Char -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space) (Parser Text
textExpr' Parser Text -> Parser () -> ParsecT Void Text Identity [Text]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
',' ParsecT Void Text Identity Char -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space))
    Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
    Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
';'
    Statement -> ParsecT Void Text Identity Statement
forall (f :: * -> *) a. Applicative f => a -> f a
pure CreateEnumType :: Text -> [Text] -> Statement
CreateEnumType { Text
name :: Text
$sel:name:StatementCreateTable :: Text
name, [Text]
$sel:values:StatementCreateTable :: [Text]
values :: [Text]
values }

addConstraint :: ParsecT Void Text Identity Statement
addConstraint = do
    Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"ALTER"
    Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"TABLE"
    Text
tableName <- Parser Text
identifier
    Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"ADD"
    Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"CONSTRAINT"
    Text
constraintName <- Parser Text
identifier
    Constraint
constraint <- ParsecT Void Text Identity (Either PrimaryKeyConstraint Constraint)
parseTableConstraint ParsecT Void Text Identity (Either PrimaryKeyConstraint Constraint)
-> (Either PrimaryKeyConstraint Constraint
    -> ParsecT Void Text Identity Constraint)
-> ParsecT Void Text Identity Constraint
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left PrimaryKeyConstraint
_ -> FilePath -> ParsecT Void Text Identity Constraint
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
Prelude.fail FilePath
"Cannot add new PRIMARY KEY constraint to table"
      Right Constraint
constraint -> Constraint -> ParsecT Void Text Identity Constraint
forall (f :: * -> *) a. Applicative f => a -> f a
pure Constraint
constraint
    Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
';'
    Statement -> ParsecT Void Text Identity Statement
forall (f :: * -> *) a. Applicative f => a -> f a
pure AddConstraint :: Text -> Text -> Constraint -> Statement
AddConstraint { Text
$sel:tableName:StatementCreateTable :: Text
tableName :: Text
tableName, Text
$sel:constraintName:StatementCreateTable :: Text
constraintName :: Text
constraintName, Constraint
$sel:constraint:StatementCreateTable :: Constraint
constraint :: Constraint
constraint }

parseTableConstraint :: ParsecT Void Text Identity (Either PrimaryKeyConstraint Constraint)
parseTableConstraint = do
    Parser Text -> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional do
        Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"CONSTRAINT"
        Parser Text
identifier
    (PrimaryKeyConstraint -> Either PrimaryKeyConstraint Constraint
forall a b. a -> Either a b
Left (PrimaryKeyConstraint -> Either PrimaryKeyConstraint Constraint)
-> ParsecT Void Text Identity PrimaryKeyConstraint
-> ParsecT
     Void Text Identity (Either PrimaryKeyConstraint Constraint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity PrimaryKeyConstraint
parsePrimaryKeyConstraint) ParsecT Void Text Identity (Either PrimaryKeyConstraint Constraint)
-> ParsecT
     Void Text Identity (Either PrimaryKeyConstraint Constraint)
-> ParsecT
     Void Text Identity (Either PrimaryKeyConstraint Constraint)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      (Constraint -> Either PrimaryKeyConstraint Constraint
forall a b. b -> Either a b
Right (Constraint -> Either PrimaryKeyConstraint Constraint)
-> ParsecT Void Text Identity Constraint
-> ParsecT
     Void Text Identity (Either PrimaryKeyConstraint Constraint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text Identity Constraint
parseForeignKeyConstraint ParsecT Void Text Identity Constraint
-> ParsecT Void Text Identity Constraint
-> ParsecT Void Text Identity Constraint
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Constraint
parseUniqueConstraint ParsecT Void Text Identity Constraint
-> ParsecT Void Text Identity Constraint
-> ParsecT Void Text Identity Constraint
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Constraint
parseCheckConstraint))

parsePrimaryKeyConstraint :: ParsecT Void Text Identity PrimaryKeyConstraint
parsePrimaryKeyConstraint = do
    Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"PRIMARY"
    Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"KEY"
    [Text]
primaryKeyColumnNames <- Parser ()
-> Parser ()
-> ParsecT Void Text Identity [Text]
-> ParsecT Void Text Identity [Text]
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'(' ParsecT Void Text Identity Char -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space) (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
')' ParsecT Void Text Identity Char -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space) (Parser Text
identifier Parser Text -> Parser () -> ParsecT Void Text Identity [Text]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy1` (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
',' ParsecT Void Text Identity Char -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space))
    PrimaryKeyConstraint
-> ParsecT Void Text Identity PrimaryKeyConstraint
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrimaryKeyConstraint :: [Text] -> PrimaryKeyConstraint
PrimaryKeyConstraint { [Text]
$sel:primaryKeyColumnNames:PrimaryKeyConstraint :: [Text]
primaryKeyColumnNames :: [Text]
primaryKeyColumnNames }

parseForeignKeyConstraint :: ParsecT Void Text Identity Constraint
parseForeignKeyConstraint = do
    Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"FOREIGN"
    Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"KEY"
    Text
columnName <- Parser () -> Parser () -> Parser Text -> Parser Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'(' ParsecT Void Text Identity Char -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space) (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
')' ParsecT Void Text Identity Char -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space) Parser Text
identifier
    Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"REFERENCES"
    Text
referenceTable <- Parser Text
identifier
    Maybe Text
referenceColumn <- Parser Text -> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Text -> ParsecT Void Text Identity (Maybe Text))
-> Parser Text -> ParsecT Void Text Identity (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Parser () -> Parser () -> Parser Text -> Parser Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'(' ParsecT Void Text Identity Char -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space) (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
')' ParsecT Void Text Identity Char -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space) Parser Text
identifier
    Maybe OnDelete
onDelete <- ParsecT Void Text Identity OnDelete
-> ParsecT Void Text Identity (Maybe OnDelete)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional do
        Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"ON"
        Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"DELETE"
        ParsecT Void Text Identity OnDelete
parseOnDelete
    Constraint -> ParsecT Void Text Identity Constraint
forall (f :: * -> *) a. Applicative f => a -> f a
pure ForeignKeyConstraint :: Text -> Text -> Maybe Text -> Maybe OnDelete -> Constraint
ForeignKeyConstraint { Text
$sel:columnName:ForeignKeyConstraint :: Text
columnName :: Text
columnName, Text
$sel:referenceTable:ForeignKeyConstraint :: Text
referenceTable :: Text
referenceTable, Maybe Text
$sel:referenceColumn:ForeignKeyConstraint :: Maybe Text
referenceColumn :: Maybe Text
referenceColumn, Maybe OnDelete
$sel:onDelete:ForeignKeyConstraint :: Maybe OnDelete
onDelete :: Maybe OnDelete
onDelete }

parseUniqueConstraint :: ParsecT Void Text Identity Constraint
parseUniqueConstraint = do
    Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"UNIQUE"
    [Text]
columnNames <- Parser ()
-> Parser ()
-> ParsecT Void Text Identity [Text]
-> ParsecT Void Text Identity [Text]
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'(' ParsecT Void Text Identity Char -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space) (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
')' ParsecT Void Text Identity Char -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space) (Parser Text
identifier Parser Text -> Parser () -> ParsecT Void Text Identity [Text]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy1` (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
',' ParsecT Void Text Identity Char -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space))
    Constraint -> ParsecT Void Text Identity Constraint
forall (f :: * -> *) a. Applicative f => a -> f a
pure UniqueConstraint :: [Text] -> Constraint
UniqueConstraint { [Text]
$sel:columnNames:ForeignKeyConstraint :: [Text]
columnNames :: [Text]
columnNames }

parseCheckConstraint :: ParsecT Void Text Identity Constraint
parseCheckConstraint = do
    Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"CHECK"
    Expression
checkExpression <- Parser ()
-> Parser ()
-> ParsecT Void Text Identity Expression
-> ParsecT Void Text Identity Expression
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'(' ParsecT Void Text Identity Char -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space) (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
')' ParsecT Void Text Identity Char -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space) ParsecT Void Text Identity Expression
expression
    Constraint -> ParsecT Void Text Identity Constraint
forall (f :: * -> *) a. Applicative f => a -> f a
pure CheckConstraint :: Expression -> Constraint
CheckConstraint { Expression
$sel:checkExpression:ForeignKeyConstraint :: Expression
checkExpression :: Expression
checkExpression }

parseOnDelete :: ParsecT Void Text Identity OnDelete
parseOnDelete = [ParsecT Void Text Identity OnDelete]
-> ParsecT Void Text Identity OnDelete
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ (Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"NO" Parser Text -> Parser Text -> Parser Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"ACTION") Parser Text
-> ParsecT Void Text Identity OnDelete
-> ParsecT Void Text Identity OnDelete
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> OnDelete -> ParsecT Void Text Identity OnDelete
forall (f :: * -> *) a. Applicative f => a -> f a
pure OnDelete
NoAction
        , (Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"RESTRICT" Parser Text
-> ParsecT Void Text Identity OnDelete
-> ParsecT Void Text Identity OnDelete
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> OnDelete -> ParsecT Void Text Identity OnDelete
forall (f :: * -> *) a. Applicative f => a -> f a
pure OnDelete
Restrict)
        , (Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"SET" Parser Text
-> ParsecT Void Text Identity OnDelete
-> ParsecT Void Text Identity OnDelete
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ((Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"NULL" Parser Text
-> ParsecT Void Text Identity OnDelete
-> ParsecT Void Text Identity OnDelete
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> OnDelete -> ParsecT Void Text Identity OnDelete
forall (f :: * -> *) a. Applicative f => a -> f a
pure OnDelete
SetNull) ParsecT Void Text Identity OnDelete
-> ParsecT Void Text Identity OnDelete
-> ParsecT Void Text Identity OnDelete
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"DEFAULT" Parser Text
-> ParsecT Void Text Identity OnDelete
-> ParsecT Void Text Identity OnDelete
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> OnDelete -> ParsecT Void Text Identity OnDelete
forall (f :: * -> *) a. Applicative f => a -> f a
pure OnDelete
SetDefault)))
        , (Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"CASCADE" Parser Text
-> ParsecT Void Text Identity OnDelete
-> ParsecT Void Text Identity OnDelete
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> OnDelete -> ParsecT Void Text Identity OnDelete
forall (f :: * -> *) a. Applicative f => a -> f a
pure OnDelete
Cascade)
        ]

column :: ParsecT Void Text Identity (Bool, Column)
column = do
    Text
name <- Parser Text
identifier
    PostgresType
columnType <- Parser PostgresType
sqlType
    Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
    Maybe Expression
defaultValue <- ParsecT Void Text Identity Expression
-> ParsecT Void Text Identity (Maybe Expression)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional do
        Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"DEFAULT"
        ParsecT Void Text Identity Expression
expression
    Bool
primaryKey <- Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Text -> Bool)
-> ParsecT Void Text Identity (Maybe Text)
-> ParsecT Void Text Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text -> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"PRIMARY" Parser Text -> Parser Text -> Parser Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"KEY")
    Bool
notNull <- Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Text -> Bool)
-> ParsecT Void Text Identity (Maybe Text)
-> ParsecT Void Text Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text -> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"NOT" Parser Text -> Parser Text -> Parser Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"NULL")
    Bool
isUnique <- Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Text -> Bool)
-> ParsecT Void Text Identity (Maybe Text)
-> ParsecT Void Text Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text -> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"UNIQUE")
    (Bool, Column) -> ParsecT Void Text Identity (Bool, Column)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
primaryKey, Column :: Text -> PostgresType -> Maybe Expression -> Bool -> Bool -> Column
Column { Text
name :: Text
$sel:name:Column :: Text
name, PostgresType
$sel:columnType:Column :: PostgresType
columnType :: PostgresType
columnType, Maybe Expression
$sel:defaultValue:Column :: Maybe Expression
defaultValue :: Maybe Expression
defaultValue, Bool
$sel:notNull:Column :: Bool
notNull :: Bool
notNull, Bool
$sel:isUnique:Column :: Bool
isUnique :: Bool
isUnique })

sqlType :: Parser PostgresType
sqlType :: Parser PostgresType
sqlType = [Parser PostgresType] -> Parser PostgresType
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([Parser PostgresType] -> Parser PostgresType)
-> [Parser PostgresType] -> Parser PostgresType
forall a b. (a -> b) -> a -> b
$ (Parser PostgresType -> Parser PostgresType)
-> [Parser PostgresType] -> [Parser PostgresType]
forall a b. (a -> b) -> [a] -> [b]
map Parser PostgresType -> Parser PostgresType
optionalArray
        [ Parser PostgresType
uuid
        , Parser PostgresType
text
        , Parser PostgresType
bigint
        , Parser PostgresType
smallint
        , Parser PostgresType
int   -- order int after smallint/bigint because symbol INT is prefix og INT2, INT8
        , Parser PostgresType
bool
        , Parser PostgresType
timestamp
        , Parser PostgresType
timestampZ
        , Parser PostgresType
timestampZ'
        , Parser PostgresType
timestamp'
        , Parser PostgresType
real
        , Parser PostgresType
double
        , Parser PostgresType
point
        , Parser PostgresType
date
        , Parser PostgresType
binary
        , Parser PostgresType
time
        , Parser PostgresType
numericPS
        , Parser PostgresType
numeric
        , Parser PostgresType
character
        , Parser PostgresType
varchar
        , Parser PostgresType
serial
        , Parser PostgresType
bigserial
        , Parser PostgresType
jsonb
        , Parser PostgresType
inet
        , Parser PostgresType
customType
        ]
            where
                timestamp :: Parser PostgresType
timestamp = do
                    Parser Text -> Parser Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol' Text
"TIMESTAMP" Parser Text -> Parser Text -> Parser Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Parser Text
symbol' Text
"WITHOUT" Parser Text -> Parser Text -> Parser Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Parser Text
symbol' Text
"TIME" Parser Text -> Parser Text -> Parser Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Parser Text
symbol' Text
"ZONE")
                    PostgresType -> Parser PostgresType
forall (f :: * -> *) a. Applicative f => a -> f a
pure PostgresType
PTimestamp

                timestampZ :: Parser PostgresType
timestampZ = do
                    Parser Text -> Parser Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol' Text
"TIMESTAMP" Parser Text -> Parser Text -> Parser Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Parser Text
symbol' Text
"WITH" Parser Text -> Parser Text -> Parser Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Parser Text
symbol' Text
"TIME" Parser Text -> Parser Text -> Parser Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Parser Text
symbol' Text
"ZONE")
                    PostgresType -> Parser PostgresType
forall (f :: * -> *) a. Applicative f => a -> f a
pure PostgresType
PTimestampWithTimezone

                timestampZ' :: Parser PostgresType
timestampZ' = do
                    Parser Text -> Parser Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol' Text
"TIMESTAMPZ")
                    PostgresType -> Parser PostgresType
forall (f :: * -> *) a. Applicative f => a -> f a
pure PostgresType
PTimestampWithTimezone

                timestamp' :: Parser PostgresType
timestamp' = do
                    Parser Text -> Parser Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol' Text
"TIMESTAMP")
                    PostgresType -> Parser PostgresType
forall (f :: * -> *) a. Applicative f => a -> f a
pure PostgresType
PTimestamp

                uuid :: Parser PostgresType
uuid = do
                    Parser Text -> Parser Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol' Text
"UUID")
                    PostgresType -> Parser PostgresType
forall (f :: * -> *) a. Applicative f => a -> f a
pure PostgresType
PUUID

                text :: Parser PostgresType
text = do
                    Parser Text -> Parser Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol' Text
"TEXT")
                    PostgresType -> Parser PostgresType
forall (f :: * -> *) a. Applicative f => a -> f a
pure PostgresType
PText

                bigint :: Parser PostgresType
bigint = do
                    Parser Text -> Parser Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol' Text
"BIGINT") Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text -> Parser Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol' Text
"INT8")
                    PostgresType -> Parser PostgresType
forall (f :: * -> *) a. Applicative f => a -> f a
pure PostgresType
PBigInt

                smallint :: Parser PostgresType
smallint = do
                    Parser Text -> Parser Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol' Text
"SMALLINT") Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text -> Parser Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol' Text
"INT2")
                    PostgresType -> Parser PostgresType
forall (f :: * -> *) a. Applicative f => a -> f a
pure PostgresType
PSmallInt

                int :: Parser PostgresType
int = do
                    Parser Text -> Parser Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol' Text
"INTEGER") Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text -> Parser Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol' Text
"INT4") Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text -> Parser Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol' Text
"INT")
                    PostgresType -> Parser PostgresType
forall (f :: * -> *) a. Applicative f => a -> f a
pure PostgresType
PInt

                bool :: Parser PostgresType
bool = do
                    Parser Text -> Parser Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol' Text
"BOOLEAN") Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text -> Parser Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol' Text
"BOOL")
                    PostgresType -> Parser PostgresType
forall (f :: * -> *) a. Applicative f => a -> f a
pure PostgresType
PBoolean

                real :: Parser PostgresType
real = do
                    Parser Text -> Parser Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol' Text
"REAL") Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text -> Parser Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol' Text
"FLOAT4")
                    PostgresType -> Parser PostgresType
forall (f :: * -> *) a. Applicative f => a -> f a
pure PostgresType
PReal

                double :: Parser PostgresType
double = do
                    Parser Text -> Parser Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol' Text
"DOUBLE PRECISION") Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text -> Parser Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol' Text
"FLOAT8")
                    PostgresType -> Parser PostgresType
forall (f :: * -> *) a. Applicative f => a -> f a
pure PostgresType
PDouble

                point :: Parser PostgresType
point = do
                    Parser Text -> Parser Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol' Text
"POINT")
                    PostgresType -> Parser PostgresType
forall (f :: * -> *) a. Applicative f => a -> f a
pure PostgresType
PPoint

                date :: Parser PostgresType
date = do
                    Parser Text -> Parser Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol' Text
"DATE")
                    PostgresType -> Parser PostgresType
forall (f :: * -> *) a. Applicative f => a -> f a
pure PostgresType
PDate

                binary :: Parser PostgresType
binary = do
                    Parser Text -> Parser Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol' Text
"BYTEA")
                    PostgresType -> Parser PostgresType
forall (f :: * -> *) a. Applicative f => a -> f a
pure PostgresType
PBinary

                time :: Parser PostgresType
time = do
                    Parser Text -> Parser Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol' Text
"TIME")
                    PostgresType -> Parser PostgresType
forall (f :: * -> *) a. Applicative f => a -> f a
pure PostgresType
PTime

                numericPS :: Parser PostgresType
numericPS = do
                    Parser Text -> Parser Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol' Text
"NUMERIC(")
                    [Expression]
values <- Parser ()
-> Parser ()
-> ParsecT Void Text Identity [Expression]
-> ParsecT Void Text Identity [Expression]
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space) (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
')' ParsecT Void Text Identity Char -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space) (ParsecT Void Text Identity Expression
varExpr ParsecT Void Text Identity Expression
-> Parser () -> ParsecT Void Text Identity [Expression]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
',' ParsecT Void Text Identity Char -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space))
                    case [Expression]
values of
                        [VarExpression Text
precision, VarExpression Text
scale] -> do
                            let p :: Maybe Int
p = Text -> Maybe Int
textToInt Text
precision
                            let s :: Maybe Int
s = Text -> Maybe Int
textToInt Text
scale
                            Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int
p, Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int
s]) do
                                FilePath -> Parser ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
Prelude.fail FilePath
"Failed to parse NUMERIC(..) expression"
                            PostgresType -> Parser PostgresType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Int -> Maybe Int -> PostgresType
PNumeric Maybe Int
p Maybe Int
s)
                        [VarExpression Text
precision] -> do
                            let p :: Maybe Int
p = Text -> Maybe Int
textToInt Text
precision
                            Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int
p) do
                                FilePath -> Parser ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
Prelude.fail FilePath
"Failed to parse NUMERIC(..) expression"
                            PostgresType -> Parser PostgresType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Int -> Maybe Int -> PostgresType
PNumeric Maybe Int
p Maybe Int
forall a. Maybe a
Nothing)
                        [Expression]
_ -> FilePath -> Parser PostgresType
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
Prelude.fail FilePath
"Failed to parse NUMERIC(..) expression"

                numeric :: Parser PostgresType
numeric = do
                    Parser Text -> Parser Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol' Text
"NUMERIC")
                    PostgresType -> Parser PostgresType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Int -> Maybe Int -> PostgresType
PNumeric Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing)

                varchar :: Parser PostgresType
varchar = do
                    Parser Text -> Parser Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol' Text
"CHARACTER VARYING(") Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text -> Parser Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol' Text
"VARCHAR(")
                    Expression
value <- Parser ()
-> Parser ()
-> ParsecT Void Text Identity Expression
-> ParsecT Void Text Identity Expression
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space) (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
')' ParsecT Void Text Identity Char -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space) (ParsecT Void Text Identity Expression
varExpr)
                    case Expression
value of
                        VarExpression Text
limit -> do
                            let l :: Maybe Int
l = Text -> Maybe Int
textToInt Text
limit
                            case Maybe Int
l of
                                Maybe Int
Nothing -> FilePath -> Parser PostgresType
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
Prelude.fail FilePath
"Failed to parse CHARACTER VARYING(..) expression"
                                Just Int
l -> PostgresType -> Parser PostgresType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> PostgresType
PVaryingN Int
l)
                        Expression
_ -> FilePath -> Parser PostgresType
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
Prelude.fail FilePath
"Failed to parse CHARACTER VARYING(..) expression"

                character :: Parser PostgresType
character = do
                    Parser Text -> Parser Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol' Text
"CHAR(") Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text -> Parser Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol' Text
"CHARACTER(")
                    Expression
value <- Parser ()
-> Parser ()
-> ParsecT Void Text Identity Expression
-> ParsecT Void Text Identity Expression
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space) (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
')' ParsecT Void Text Identity Char -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space) (ParsecT Void Text Identity Expression
varExpr)
                    case Expression
value of
                        VarExpression Text
length -> do
                            let l :: Maybe Int
l = Text -> Maybe Int
textToInt Text
length
                            case Maybe Int
l of
                                Maybe Int
Nothing -> FilePath -> Parser PostgresType
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
Prelude.fail FilePath
"Failed to parse CHARACTER VARYING(..) expression"
                                Just Int
l -> PostgresType -> Parser PostgresType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> PostgresType
PCharacterN Int
l)
                        Expression
_ -> FilePath -> Parser PostgresType
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
Prelude.fail FilePath
"Failed to parse CHARACTER VARYING(..) expression"

                serial :: Parser PostgresType
serial = do
                    Parser Text -> Parser Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol' Text
"SERIAL")
                    PostgresType -> Parser PostgresType
forall (f :: * -> *) a. Applicative f => a -> f a
pure PostgresType
PSerial

                bigserial :: Parser PostgresType
bigserial = do
                    Parser Text -> Parser Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol' Text
"BIGSERIAL")
                    PostgresType -> Parser PostgresType
forall (f :: * -> *) a. Applicative f => a -> f a
pure PostgresType
PBigserial

                jsonb :: Parser PostgresType
jsonb = do
                    Parser Text -> Parser Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol' Text
"JSONB")
                    PostgresType -> Parser PostgresType
forall (f :: * -> *) a. Applicative f => a -> f a
pure PostgresType
PJSONB

                inet :: Parser PostgresType
inet = do
                    Parser Text -> Parser Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol' Text
"INET")
                    PostgresType -> Parser PostgresType
forall (f :: * -> *) a. Applicative f => a -> f a
pure PostgresType
PInet

                optionalArray :: Parser PostgresType -> Parser PostgresType
optionalArray Parser PostgresType
typeParser= do
                    PostgresType
arrayType <- Parser PostgresType
typeParser;
                    (Parser PostgresType -> Parser PostgresType
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try do Text -> Parser Text
symbol' Text
"[]"; PostgresType -> Parser PostgresType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PostgresType -> Parser PostgresType)
-> PostgresType -> Parser PostgresType
forall a b. (a -> b) -> a -> b
$ PostgresType -> PostgresType
PArray PostgresType
arrayType) Parser PostgresType -> Parser PostgresType -> Parser PostgresType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PostgresType -> Parser PostgresType
forall (f :: * -> *) a. Applicative f => a -> f a
pure PostgresType
arrayType

                customType :: Parser PostgresType
customType = do
                    Text
theType <- Parser Text -> Parser Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Maybe FilePath
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe FilePath -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
"Custom type") (\Token Text
c -> Char -> Bool
isAlphaNum Char
Token Text
c Bool -> Bool -> Bool
|| Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'))
                    PostgresType -> Parser PostgresType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> PostgresType
PCustomType Text
theType)

term :: ParsecT Void Text Identity Expression
term = ParsecT Void Text Identity Expression
-> ParsecT Void Text Identity Expression
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char) =>
m a -> m a
parens ParsecT Void Text Identity Expression
expression ParsecT Void Text Identity Expression
-> ParsecT Void Text Identity Expression
-> ParsecT Void Text Identity Expression
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Expression
-> ParsecT Void Text Identity Expression
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Expression
callExpr ParsecT Void Text Identity Expression
-> ParsecT Void Text Identity Expression
-> ParsecT Void Text Identity Expression
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Expression
varExpr ParsecT Void Text Identity Expression
-> ParsecT Void Text Identity Expression
-> ParsecT Void Text Identity Expression
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Expression
textExpr
    where
        parens :: m a -> m a
parens m a
f = m () -> m () -> m a -> m a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'(' m Char -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space) (Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
')' m Char -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space) m a
f

table :: [[Operator (ParsecT Void Text Identity) Expression]]
table = [ [ Text
-> (Expression -> Expression -> Expression)
-> Operator (ParsecT Void Text Identity) Expression
forall a.
Text -> (a -> a -> a) -> Operator (ParsecT Void Text Identity) a
binary  Text
"<>"  Expression -> Expression -> Expression
NotEqExpression ] ]
    where
        binary :: Text -> (a -> a -> a) -> Operator (ParsecT Void Text Identity) a
binary  Text
name a -> a -> a
f = ParsecT Void Text Identity (a -> a -> a)
-> Operator (ParsecT Void Text Identity) a
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixL  (a -> a -> a
f (a -> a -> a)
-> Parser Text -> ParsecT Void Text Identity (a -> a -> a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
symbol Text
name)
        prefix :: Text -> (a -> a) -> Operator (ParsecT Void Text Identity) a
prefix  Text
name a -> a
f = ParsecT Void Text Identity (a -> a)
-> Operator (ParsecT Void Text Identity) a
forall (m :: * -> *) a. m (a -> a) -> Operator m a
Prefix  (a -> a
f (a -> a) -> Parser Text -> ParsecT Void Text Identity (a -> a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
symbol Text
name)
        postfix :: Text -> (a -> a) -> Operator (ParsecT Void Text Identity) a
postfix Text
name a -> a
f = ParsecT Void Text Identity (a -> a)
-> Operator (ParsecT Void Text Identity) a
forall (m :: * -> *) a. m (a -> a) -> Operator m a
Postfix (a -> a
f (a -> a) -> Parser Text -> ParsecT Void Text Identity (a -> a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
symbol Text
name)

-- | Parses a SQL expression
--
-- This parser makes use of makeExprParser as described in https://hackage.haskell.org/package/parser-combinators-1.2.0/docs/Control-Monad-Combinators-Expr.html
expression :: Parser Expression
expression :: ParsecT Void Text Identity Expression
expression = do
    Expression
e <- ParsecT Void Text Identity Expression
-> [[Operator (ParsecT Void Text Identity) Expression]]
-> ParsecT Void Text Identity Expression
forall (m :: * -> *) a.
MonadPlus m =>
m a -> [[Operator m a]] -> m a
makeExprParser ParsecT Void Text Identity Expression
term [[Operator (ParsecT Void Text Identity) Expression]]
table ParsecT Void Text Identity Expression
-> FilePath -> ParsecT Void Text Identity Expression
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> FilePath -> m a
<?> FilePath
"expression"
    Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
    Expression -> ParsecT Void Text Identity Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expression
e

varExpr :: Parser Expression
varExpr :: ParsecT Void Text Identity Expression
varExpr = Text -> Expression
VarExpression (Text -> Expression)
-> Parser Text -> ParsecT Void Text Identity Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
identifier

callExpr :: Parser Expression
callExpr :: ParsecT Void Text Identity Expression
callExpr = do
    Text
func <- Parser Text
identifier
    [Expression]
args <- ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity [Expression]
-> ParsecT Void Text Identity [Expression]
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'(') (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
')') (ParsecT Void Text Identity Expression
expression ParsecT Void Text Identity Expression
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity [Expression]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy` Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
',')
    Expression -> ParsecT Void Text Identity Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [Expression] -> Expression
CallExpression Text
func [Expression]
args)

textExpr :: Parser Expression
textExpr :: ParsecT Void Text Identity Expression
textExpr = Text -> Expression
TextExpression (Text -> Expression)
-> Parser Text -> ParsecT Void Text Identity Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
textExpr'

textExpr' :: Parser Text
textExpr' :: Parser Text
textExpr' = FilePath -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (FilePath -> Text) -> Parser FilePath -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\'' ParsecT Void Text Identity Char
-> Parser FilePath -> Parser FilePath
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char -> Parser FilePath
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Char
Lexer.charLiteral (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\''))

identifier :: Parser Text
identifier :: Parser Text
identifier = do
    Text
i <- (ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char -> Parser Text -> Parser Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"') (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"') (Maybe FilePath
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe FilePath -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe FilePath
forall a. Maybe a
Nothing (\Token Text
c -> Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"'))) Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe FilePath
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe FilePath -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
"identifier") (\Token Text
c -> Char -> Bool
isAlphaNum Char
Token Text
c Bool -> Bool -> Bool
|| Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_')
    Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
    Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
i

comment :: ParsecT Void Text Identity Statement
comment = do
    Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"--" Parser Text -> FilePath -> Parser Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> FilePath -> m a
<?> FilePath
"Line comment"
    Text
content <- Maybe FilePath
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe FilePath -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe FilePath
forall a. Maybe a
Nothing (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')
    Statement -> ParsecT Void Text Identity Statement
forall (f :: * -> *) a. Applicative f => a -> f a
pure Comment :: Text -> Statement
Comment { Text
$sel:content:StatementCreateTable :: Text
content :: Text
content }

createIndex :: ParsecT Void Text Identity Statement
createIndex = do
    Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"CREATE"
    Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"INDEX"
    Text
indexName <- Parser Text
identifier
    Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
"ON"
    Text
tableName <- Parser Text
identifier
    [Text]
columnNames <- Parser ()
-> Parser ()
-> ParsecT Void Text Identity [Text]
-> ParsecT Void Text Identity [Text]
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'(' ParsecT Void Text Identity Char -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space) (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
')' ParsecT Void Text Identity Char -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space) (Parser Text
identifier Parser Text -> Parser () -> ParsecT Void Text Identity [Text]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`sepBy1` (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
',' ParsecT Void Text Identity Char -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space))
    Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
';'
    Statement -> ParsecT Void Text Identity Statement
forall (f :: * -> *) a. Applicative f => a -> f a
pure CreateIndex :: Text -> Text -> [Text] -> Statement
CreateIndex { Text
$sel:indexName:StatementCreateTable :: Text
indexName :: Text
indexName, Text
tableName :: Text
$sel:tableName:StatementCreateTable :: Text
tableName, [Text]
$sel:columnNames:StatementCreateTable :: [Text]
columnNames :: [Text]
columnNames }