support postgres event trigger in schema.sql

digitallyinduced · Nov 12, 2024 · e2360aa · e2360aa
1 parent 51d17d2
commit e2360aa
Show file tree

Hide file tree

Showing 6 changed files with 91 additions and 2 deletions.
diff --git a/Test/IDE/SchemaDesigner/CompilerSpec.hs b/Test/IDE/SchemaDesigner/CompilerSpec.hs
@@ -998,6 +998,17 @@ tests = do
                     } ]
             compileSql statements `shouldBe` sql
 
+        it "should compile 'CREATE EVENT TRIGGER ..' statements" do
+            let sql = "CREATE EVENT TRIGGER trigger_update_schema ON ddl_command_end WHEN TAG IN ('CREATE TABLE', 'ALTER TABLE', 'DROP TABLE') EXECUTE FUNCTION update_tables_and_columns();\n"
+            let statements = [ CreateEventTrigger
+                    { name = "trigger_update_schema"
+                    , eventOn = "ddl_command_end"
+                    , whenCondition =  Just (InExpression (VarExpression "TAG") (InArrayExpression [TextExpression "CREATE TABLE", TextExpression "ALTER TABLE", TextExpression "DROP TABLE"]))
+                    , functionName = "update_tables_and_columns"
+                    , arguments = []
+                    } ]
+            compileSql statements `shouldBe` sql
+
         it "should compile 'BEGIN;' statements" do
             let sql = "BEGIN;\n"
             let statements = [ Begin ]

diff --git a/Test/IDE/SchemaDesigner/ParserSpec.hs b/Test/IDE/SchemaDesigner/ParserSpec.hs
@@ -1102,6 +1102,21 @@ COMMENT ON EXTENSION "uuid-ossp" IS 'generate universally unique identifiers (UU
                     , arguments = [TextExpression "hello"]
                     }
 
+        it "should parse 'CREATE EVENT TRIGGER ..' statements" do
+            let sql = cs [plain|
+                CREATE EVENT TRIGGER trigger_update_schema
+                ON ddl_command_end
+                WHEN TAG IN ('CREATE TABLE', 'ALTER TABLE', 'DROP TABLE')
+                EXECUTE FUNCTION update_tables_and_columns();
+            |]
+            parseSql sql `shouldBe` CreateEventTrigger
+                    { name = "trigger_update_schema"
+                    , eventOn = "ddl_command_end"
+                    , whenCondition =  Just (InExpression (VarExpression "TAG") (InArrayExpression [TextExpression "CREATE TABLE", TextExpression "ALTER TABLE", TextExpression "DROP TABLE"]))
+                    , functionName = "update_tables_and_columns"
+                    , arguments = []
+                    }
+
         it "should parse 'ALTER SEQUENCE ..' statements" do
             let sql = cs [plain|ALTER SEQUENCE public.a OWNED BY public.b.serial_number;|]
             parseSql sql `shouldBe` UnknownStatement { raw = "ALTER SEQUENCE public.a OWNED BY public.b.serial_number" }

diff --git a/ihp-ide/IHP/IDE/CodeGen/MigrationGenerator.hs b/ihp-ide/IHP/IDE/CodeGen/MigrationGenerator.hs
@@ -168,6 +168,7 @@ diffSchemas targetSchema' actualSchema' = (drop <> create)
         toDropStatement CreatePolicy { tableName, name } = Just DropPolicy { tableName, policyName = name }
         toDropStatement CreateFunction { functionName } = Just DropFunction { functionName }
         toDropStatement CreateTrigger { name, tableName } = Just DropTrigger { name, tableName }
+        toDropStatement CreateEventTrigger { name } = Just DropEventTrigger { name }
         toDropStatement otherwise = Nothing
 
 

diff --git a/ihp-ide/IHP/IDE/SchemaDesigner/Compiler.hs b/ihp-ide/IHP/IDE/SchemaDesigner/Compiler.hs
@@ -55,6 +55,8 @@ compileStatement UnknownStatement { raw } = raw <> ";"
 compileStatement Set { name, value } = "SET " <> compileIdentifier name <> " = " <> compileExpression value <> ";"
 compileStatement SelectStatement { query } = "SELECT " <> query <> ";"
 compileStatement DropTrigger { name, tableName } = "DROP TRIGGER " <> compileIdentifier name <> " ON " <> compileIdentifier tableName <> ";"
+compileStatement CreateEventTrigger { name, eventOn, whenCondition, functionName, arguments } = "CREATE EVENT TRIGGER " <> compileIdentifier name <> " ON " <> compileIdentifier eventOn <> " " <> (maybe "" (\expression -> "WHEN " <> compileExpression expression) whenCondition) <> " EXECUTE FUNCTION " <> compileExpression (CallExpression functionName arguments) <> ";"
+compileStatement DropEventTrigger { name } = "DROP EVENT TRIGGER " <> compileIdentifier name <> ";"
 
 -- | Emit a PRIMARY KEY constraint when there are multiple primary key columns
 compilePrimaryKeyConstraint :: PrimaryKeyConstraint -> Maybe Text
@@ -132,6 +134,7 @@ compileExpression (EqExpression a b) = compileExpressionWithOptionalParenthese a
 compileExpression (IsExpression a (NotExpression b)) = compileExpressionWithOptionalParenthese a <> " IS NOT " <> compileExpressionWithOptionalParenthese b -- 'IS (NOT NULL)' => 'IS NOT NULL'
 compileExpression (IsExpression a b) = compileExpressionWithOptionalParenthese a <> " IS " <> compileExpressionWithOptionalParenthese b
 compileExpression (InExpression a b) = compileExpressionWithOptionalParenthese a <> " IN " <> compileExpressionWithOptionalParenthese b
+compileExpression (InArrayExpression values) = "(" <> intercalate ", " (map compileExpression values) <> ")"
 compileExpression (NotExpression a) = "NOT " <> compileExpressionWithOptionalParenthese a
 compileExpression (AndExpression a b) = compileExpressionWithOptionalParenthese a <> " AND " <> compileExpressionWithOptionalParenthese b
 compileExpression (OrExpression a b) = compileExpressionWithOptionalParenthese a <> " OR " <> compileExpressionWithOptionalParenthese b
@@ -161,6 +164,7 @@ compileExpressionWithOptionalParenthese expr@(IntExpression {}) = compileExpress
 compileExpressionWithOptionalParenthese expr@(DoubleExpression {}) = compileExpression expr
 compileExpressionWithOptionalParenthese expr@(DotExpression (VarExpression {}) b) = compileExpression expr
 compileExpressionWithOptionalParenthese expr@(ConcatenationExpression a b ) = compileExpression expr
+compileExpressionWithOptionalParenthese expr@(InArrayExpression values) = compileExpression expr
 compileExpressionWithOptionalParenthese expression = "(" <> compileExpression expression <> ")"
 
 compareStatement (CreateEnumType {}) _ = LT

diff --git a/ihp-ide/IHP/IDE/SchemaDesigner/Parser.hs b/ihp-ide/IHP/IDE/SchemaDesigner/Parser.hs
@@ -464,7 +464,7 @@ table = [
             , binary "||" ConcatenationExpression
 
             , binary "IS" IsExpression
-            , binary "IN" InExpression
+            , inExpr
             , prefix "NOT" NotExpression
             , prefix "EXISTS" ExistsExpression
             , typeCast
@@ -488,6 +488,11 @@ table = [
             char '.'
             name <- identifier
             pure $ \expr -> DotExpression expr name
+
+        inExpr = Postfix do
+            lexeme "IN"
+            right <- try inArrayExpression <|> expression
+            pure $ \expr -> InExpression expr right
 
 -- | Parses a SQL expression
 --
@@ -548,7 +553,10 @@ selectExpr = do
 
     whereClause Nothing <|> explicitAs <|> implicitAs
 
-
+inArrayExpression :: Parser Expression
+inArrayExpression = do
+    values <- between (char '(') (char ')') (expression `sepBy` (char ',' >> space))
+    pure (InArrayExpression values)
 
 
 
@@ -630,6 +638,38 @@ createFunction = do
 
 createTrigger = do
     lexeme "CREATE"
+    createEventTrigger <|> createTrigger'
+
+createEventTrigger = do
+    lexeme "EVENT"
+    lexeme "TRIGGER"
+
+    name <- qualifiedIdentifier
+    lexeme "ON"
+    eventOn <- identifier
+
+    whenCondition <- optional do
+        lexeme "WHEN"
+        expression
+
+    lexeme "EXECUTE"
+    (lexeme "FUNCTION") <|> (lexeme "PROCEDURE")
+
+    (CallExpression functionName arguments) <- callExpr
+
+    char ';'
+
+    pure CreateEventTrigger
+        { name
+        , eventOn
+        , whenCondition
+        , functionName
+        , arguments
+        }
+
+
+
+createTrigger' = do
     lexeme "TRIGGER"
 
     name <- qualifiedIdentifier
@@ -875,13 +915,25 @@ dropPolicy = do
 
 dropTrigger = do
     lexeme "DROP"
+
+    dropEventTrigger <|> dropTrigger'
+
+dropTrigger' = do
     lexeme "TRIGGER"
     name <- qualifiedIdentifier
     lexeme "ON"
     tableName <- qualifiedIdentifier
     char ';'
     pure DropTrigger { name, tableName }
 
+
+dropEventTrigger = do
+    lexeme "EVENT"
+    lexeme "TRIGGER"
+    name <- qualifiedIdentifier
+    char ';'
+    pure DropEventTrigger { name }
+
 createSequence = do
     lexeme "CREATE"
     lexeme "SEQUENCE"

diff --git a/ihp-ide/IHP/IDE/SchemaDesigner/Types.hs b/ihp-ide/IHP/IDE/SchemaDesigner/Types.hs
@@ -64,8 +64,12 @@ data Statement
     | DropDefaultValue { tableName :: Text, columnName :: Text }
     -- | CREATE TRIGGER ..;
     | CreateTrigger { name :: !Text, eventWhen :: !TriggerEventWhen, event :: !TriggerEvent, tableName :: !Text, for :: !TriggerFor, whenCondition :: Maybe Expression, functionName :: !Text, arguments :: ![Expression] }
+    -- | CREATE EVENT TRIGGER ..;
+    | CreateEventTrigger { name :: !Text, eventOn :: !Text, whenCondition :: Maybe Expression, functionName :: !Text, arguments :: ![Expression] }
     -- | DROP TRIGGER .. ON ..;
     | DropTrigger { name :: !Text, tableName :: !Text }
+    -- | DROP EVENT TRIGGER ..;
+    | DropEventTrigger { name :: !Text }
     -- | BEGIN;
     | Begin
     -- | COMMIT;
@@ -165,6 +169,8 @@ data Expression =
     | IsExpression Expression Expression
     -- | a IN b
     | InExpression Expression Expression
+    -- | ('a', 'b')
+    | InArrayExpression [Expression]
     -- | NOT a
     | NotExpression Expression
     -- | EXISTS a