Support "DROP FUNCTION" in migrations

Author: mpscholten

IHP/IDE/CodeGen/MigrationGenerator.hs

@@ -146,6 +146,7 @@ diffSchemas targetSchema' actualSchema' = (drop <> create)
                 Just constraintName -> Just DropConstraint { tableName, constraintName }
                 Nothing -> Nothing
         toDropStatement CreatePolicy { tableName, name } = Just DropPolicy { tableName, policyName = name }
+        toDropStatement CreateFunction { functionName } = Just DropFunction { functionName }
         toDropStatement otherwise = Nothing
 
 removeNoise = filter \case

IHP/IDE/SchemaDesigner/Compiler.hs

@@ -50,6 +50,7 @@ compileStatement AddValueToEnumType { enumName, newValue } = "ALTER TYPE " <> co
 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 Begin = "BEGIN;"
 compileStatement Commit = "COMMIT;"
+compileStatement DropFunction { functionName } = "DROP FUNCTION " <> compileIdentifier functionName <> ";"
 compileStatement UnknownStatement { raw } = raw <> ";"
 
 -- | Emit a PRIMARY KEY constraint when there are multiple primary key columns

IHP/IDE/SchemaDesigner/Parser.hs

@@ -67,7 +67,7 @@ statement = do
     let alter = do
             lexeme "ALTER"
             alterTable <|> alterType <|> alterSequence
-    s <- setStatement <|> create <|> alter <|> selectStatement <|> try dropTable <|> try dropIndex <|> try dropPolicy <|> dropType <|> commentStatement <|> comment <|> begin <|> commit
+    s <- setStatement <|> create <|> alter <|> selectStatement <|> try dropTable <|> try dropIndex <|> try dropPolicy <|> try dropFunction <|> dropType <|> commentStatement <|> comment <|> begin <|> commit
     space
     pure s
 
@@ -826,6 +826,13 @@ dropType = do
     char ';'
     pure DropEnumType { name }
 
+dropFunction = do
+    lexeme "DROP"
+    lexeme "FUNCTION"
+    functionName <- qualifiedIdentifier
+    char ';'
+    pure DropFunction { functionName }
+
 dropIndex = do
     lexeme "DROP"
     lexeme "INDEX"

IHP/IDE/SchemaDesigner/Types.hs

@@ -68,6 +68,7 @@ data Statement
     | Begin
     -- | COMMIT;
     | Commit
+    | DropFunction { functionName :: !Text }
     deriving (Eq, Show)
 
 data DeferrableType

Test/IDE/CodeGeneration/MigrationGenerator.hs

@@ -530,15 +530,6 @@ tests = do
                     COMMENT ON EXTENSION "uuid-ossp" IS 'generate universally unique identifiers (UUIDs)';
 
 
-                    --
-                    -- Name: ihp_user_id(); Type: FUNCTION; Schema: public; Owner: -
-                    --
-
-                    CREATE FUNCTION public.ihp_user_id() RETURNS uuid
-                        LANGUAGE sql
-                        AS $$ SELECT current_setting('rls.ihp_user_id')::uuid; $$;
-
-
                     SET default_tablespace = '';
 
                     SET default_table_access_method = heap;
@@ -631,16 +622,6 @@ tests = do
 
                     COMMENT ON EXTENSION "uuid-ossp" IS 'generate universally unique identifiers (UUIDs)';
 
-
-                    --
-                    -- Name: ihp_user_id(); Type: FUNCTION; Schema: public; Owner: -
-                    --
-
-                    CREATE FUNCTION public.ihp_user_id() RETURNS uuid
-                        LANGUAGE sql
-                        AS $$ SELECT current_setting('rls.ihp_user_id')::uuid; $$;
-
-
                     SET default_tablespace = '';
 
                     SET default_table_access_method = heap;
@@ -932,7 +913,7 @@ tests = do
                         NEW.updated_at = NOW();
                         RETURN NEW;
                     END;
-                    $$$$ language PLPGSQL;
+                    $$$$ language plpgsql;
                 |]
                 let actualSchema = sql [trimming|
                     --

Test/IDE/SchemaDesigner/CompilerSpec.hs

@@ -1017,3 +1017,7 @@ tests = do
                             }
                         ]
             compileSql statements `shouldBe` sql
+        it "should compile 'DROP FUNCTION ..;' statements" do
+            let sql = "DROP FUNCTION my_function;\n"
+            let statements = [ DropFunction { functionName = "my_function" } ]
+            compileSql statements `shouldBe` sql

Test/IDE/SchemaDesigner/ParserSpec.hs

@@ -1097,6 +1097,10 @@ COMMENT ON EXTENSION "uuid-ossp" IS 'generate universally unique identifiers (UU
         it "should parse 'COMMIT' statements" do
             let sql = cs [plain|COMMIT;|]
             parseSql sql `shouldBe` Commit
+        
+        it "should parse 'DROP FUNCTION ..' statements" do
+            let sql = cs [plain|DROP FUNCTION my_function;|]
+            parseSql sql `shouldBe` DropFunction { functionName = "my_function" }
 
 col :: Column
 col = Column