Added support for sql triggers

IHP/IDE/SchemaDesigner/Compiler.hs

@@ -47,6 +47,7 @@ compileStatement DropPolicy { tableName, policyName } =  "DROP POLICY " <> compi
 compileStatement SetDefaultValue { tableName, columnName, value } = "ALTER TABLE " <> compileIdentifier tableName <> " ALTER COLUMN " <> compileIdentifier columnName <> " SET DEFAULT " <> compileExpression value <> ";"
 compileStatement DropDefaultValue { tableName, columnName } = "ALTER TABLE " <> compileIdentifier tableName <> " ALTER COLUMN " <> compileIdentifier columnName <> " DROP DEFAULT;"
 compileStatement AddValueToEnumType { enumName, newValue } = "ALTER TYPE " <> compileIdentifier enumName <> " ADD VALUE " <> compileExpression (TextExpression newValue) <> ";"
+compileStatement CreateTrigger { name, eventWhen, event, tableName, for, whenCondition, functionName, arguments } = "CREATE TRIGGER " <> compileIdentifier name <> " " <> compileTriggerEventWhen eventWhen <> " " <> compileTriggerEvent event <> " ON " <> compileIdentifier tableName <> " " <> compileTriggerFor for <> " EXECUTE FUNCTION " <> compileExpression (CallExpression functionName arguments) <> ";"
 compileStatement UnknownStatement { raw } = raw <> ";"
 
 -- | Emit a PRIMARY KEY constraint when there are multiple primary key columns
@@ -413,4 +414,19 @@ compileIdentifier identifier = if identifierNeedsQuoting then tshow identifier e
             , "VARCHAR"
             ]
 
-indent text = "    " <> text
+indent text = "    " <> text
+
+compileTriggerEventWhen :: TriggerEventWhen -> Text
+compileTriggerEventWhen Before = "BEFORE"
+compileTriggerEventWhen After = "AFTER"
+compileTriggerEventWhen InsteadOf = "INSTEAD OF"
+
+compileTriggerEvent :: TriggerEvent -> Text
+compileTriggerEvent Insert = "INSERT"
+compileTriggerEvent Update = "UPDATE"
+compileTriggerEvent Delete = "DELETE"
+compileTriggerEvent Truncate = "TRUNCATE"
+
+compileTriggerFor :: TriggerFor -> Text
+compileTriggerFor ForEachRow = "FOR EACH ROW"
+compileTriggerFor ForEachStatement = "FOR EACH STATEMENT"

IHP/IDE/SchemaDesigner/Parser.hs

@@ -507,13 +507,43 @@ createFunction = do
     char ';'
     pure CreateFunction { functionName, functionBody, orReplace, returns, language }
 
--- | Triggers are not currently used by IHP, therefore they're implemented using UnknownStatement
--- This avoid errors when having custom triggers in Schema.sql
 createTrigger = do
     lexeme "CREATE"
     lexeme "TRIGGER"
-    raw <- cs <$> someTill (anySingle) (char ';')
-    pure UnknownStatement { raw = "CREATE TRIGGER " <> raw }
+
+    name <- qualifiedIdentifier
+    eventWhen <- (lexeme "AFTER" >> pure After) <|> (lexeme "BEFORE" >> pure Before) <|> (lexeme "INSTEAD OF" >> pure InsteadOf)
+    event <- (lexeme "INSERT" >> pure Insert) <|> (lexeme "UPDATE" >> pure Update) <|> (lexeme "DELETE" >> pure Delete) <|> (lexeme "TRUNCATE" >> pure Truncate)
+
+    lexeme "ON"
+    tableName <- qualifiedIdentifier
+
+    lexeme "FOR"
+    optional (lexeme "EACH")
+
+    for <- (lexeme "ROW" >> pure ForEachRow) <|> (lexeme "STATEMENT" >> pure ForEachStatement)
+
+    whenCondition <- optional do
+        lexeme "WHEN"
+        expression
+
+    lexeme "EXECUTE"
+    optional (lexeme "FUNCTION" <|> lexeme "PROCEDURE")
+
+    (CallExpression functionName arguments) <- callExpr
+
+    char ';'
+
+    pure CreateTrigger
+        { name
+        , eventWhen
+        , event
+        , tableName
+        , for
+        , whenCondition
+        , functionName
+        , arguments
+        }
 
 alterTable = do
     lexeme "TABLE"

IHP/IDE/SchemaDesigner/Types.hs

@@ -62,6 +62,8 @@ data Statement
     | SetDefaultValue { tableName :: Text, columnName :: Text, value :: Expression }
     -- ALTER TABLE tableName ALTER COLUMN columnName DROP DEFAULT;
     | 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] }
     deriving (Eq, Show)
 
 data CreateTable
@@ -189,3 +191,21 @@ data PostgresType
     | PTrigger
     | PCustomType Text
     deriving (Eq, Show)
+
+data TriggerEventWhen
+    = Before
+    | After
+    | InsteadOf
+    deriving (Eq, Show)
+
+data TriggerEvent
+    = Insert
+    | Update
+    | Delete
+    | Truncate
+    deriving (Eq, Show)
+
+data TriggerFor
+    = ForEachRow
+    | ForEachStatement
+    deriving (Eq, Show)

Test/IDE/SchemaDesigner/CompilerSpec.hs

@@ -609,3 +609,17 @@ tests = do
             let sql = "ALTER TYPE colors ADD VALUE 'blue';\n"
             let statements = [ AddValueToEnumType { enumName = "colors", newValue = "blue" } ]
             compileSql statements `shouldBe` sql
+
+        it "should compile 'CREATE TRIGGER .. AFTER INSERT ON .. FOR EACH ROW EXECUTE ..;' statements" do
+            let sql = "CREATE TRIGGER call_test_function_for_new_users AFTER INSERT ON users FOR EACH ROW EXECUTE FUNCTION call_test_function('hello');\n"
+            let statements = [ CreateTrigger
+                    { name = "call_test_function_for_new_users"
+                    , eventWhen = After
+                    , event = Insert
+                    , tableName = "users"
+                    , for = ForEachRow
+                    , whenCondition = Nothing
+                    , functionName = "call_test_function"
+                    , arguments = [TextExpression "hello"]
+                    } ]
+            compileSql statements `shouldBe` sql

Test/IDE/SchemaDesigner/ParserSpec.hs

@@ -485,16 +485,6 @@ $$;
                     , language = "plpgsql"
                     }
 
-
-        it "should parse unsupported SQL as a unknown statement" do
-            let sql = "CREATE TABLE a(); CREATE TRIGGER t AFTER INSERT ON x FOR EACH ROW EXECUTE PROCEDURE y(); CREATE TABLE b();"
-            let statements =
-                    [ StatementCreateTable CreateTable { name = "a", columns = [], primaryKeyConstraint = PrimaryKeyConstraint [], constraints = [] }
-                    , UnknownStatement { raw = "CREATE TRIGGER t AFTER INSERT ON x FOR EACH ROW EXECUTE PROCEDURE y()"  }
-                    , StatementCreateTable CreateTable { name = "b", columns = [], primaryKeyConstraint = PrimaryKeyConstraint [], constraints = [] }
-                    ]
-            parseSqlStatements sql `shouldBe` statements
-
         it "should parse a decimal default value with a type-cast" do
             let sql = "CREATE TABLE a(electricity_unit_price DOUBLE PRECISION DEFAULT 0.17::double precision NOT NULL);"
             let statements =
@@ -730,6 +720,18 @@ COMMENT ON EXTENSION "uuid-ossp" IS 'generate universally unique identifiers (UU
                     }
                 }
 
+        it "should parse 'CREATE TRIGGER .. AFTER INSERT ON .. FOR EACH ROW EXECUTE ..;' statements" do
+            parseSql "CREATE TRIGGER call_test_function_for_new_users AFTER INSERT ON public.users FOR EACH ROW EXECUTE FUNCTION call_test_function('hello');" `shouldBe` CreateTrigger
+                    { name = "call_test_function_for_new_users"
+                    , eventWhen = After
+                    , event = Insert
+                    , tableName = "users"
+                    , for = ForEachRow
+                    , whenCondition = Nothing
+                    , functionName = "call_test_function"
+                    , arguments = [TextExpression "hello"]
+                    }
+
 col :: Column
 col = Column
     { name = ""