Handle default value changes in migrations

IHP/IDE/CodeGen/MigrationGenerator.hs

@@ -155,6 +155,7 @@ migrateTable StatementCreateTable { unsafeGetCreateTable = targetTable } Stateme
                 (map dropColumn dropColumns <> map createColumn createColumns)
                     |> applyRenameColumn
                     |> applyMakeUnique
+                    |> applySetDefault
                     |> applyToggleNull
             where
 
@@ -220,7 +221,43 @@ migrateTable StatementCreateTable { unsafeGetCreateTable = targetTable } Stateme
                         isMatchingCreateColumn otherwise                        = False
                 applyMakeUnique (statement:rest) = statement:(applyMakeUnique rest)
                 applyMakeUnique [] = []
-
+
+                -- | Emits "ALTER TABLE table ALTER COLUMN column SET DEFAULT 'value'"
+                --
+                -- This function substitutes the following queries:
+                --
+                -- > ALTER TABLE table DROP COLUMN column;
+                -- > ALTER TABLE table ADD COLUMN column;
+                --
+                -- With a more natural @SET DEFAULT@:
+                --
+                -- > ALTER TABLE table ALTER COLUMN column SET DEFAULT 'value'
+                --
+                applySetDefault (s@(DropColumn { columnName }):statements) = case matchingDefaultValue of
+                        Just (matchingCreateColumn, value) -> SetDefaultValue { tableName, columnName, value }:(applySetDefault (filter ((/=) matchingCreateColumn) statements))
+                        Nothing -> s:(applySetDefault statements)
+                    where
+                        dropColumn :: Column
+                        (Just dropColumn) = actualColumns
+                                |> find \case
+                                    Column { name } -> name == columnName
+                                    otherwise       -> False                                
+
+                        matchingDefaultValue :: Maybe (Statement, Expression)
+                        matchingDefaultValue = do
+                                matchingCreateColumn <- matchingCreateColumn
+                                value <- get #defaultValue (get #column matchingCreateColumn)
+                                pure (matchingCreateColumn, value)
+
+                        matchingCreateColumn :: Maybe Statement
+                        matchingCreateColumn = find isMatchingCreateColumn statements
+
+                        isMatchingCreateColumn :: Statement -> Bool
+                        isMatchingCreateColumn AddColumn { column = addColumn } = (addColumn { defaultValue = Nothing } :: Column) == (dropColumn { defaultValue = Nothing } :: Column)
+                        isMatchingCreateColumn otherwise                        = False
+                applySetDefault (statement:rest) = statement:(applySetDefault rest)
+                applySetDefault [] = []
+
                 -- | Emits 'ALTER TABLE table ALTER COLUMN column DROP NOT NULL'
                 --
                 -- This function substitutes the following queries:

IHP/IDE/SchemaDesigner/Compiler.hs

@@ -44,6 +44,7 @@ compileStatement DropNotNull { tableName, columnName } = "ALTER TABLE " <> compi
 compileStatement SetNotNull { tableName, columnName } = "ALTER TABLE " <> compileIdentifier tableName <> " ALTER COLUMN " <> compileIdentifier columnName <> " SET NOT NULL;"
 compileStatement RenameTable { from, to } = "ALTER TABLE " <> compileIdentifier from <> " RENAME TO " <> compileIdentifier to <> ";"
 compileStatement DropPolicy { tableName, policyName } =  "DROP POLICY " <> compileIdentifier policyName <> " ON " <> compileIdentifier tableName <> ";"
+compileStatement SetDefaultValue { tableName, columnName, value } = "ALTER TABLE " <> compileIdentifier tableName <> " ALTER COLUMN " <> compileIdentifier columnName <> " SET DEFAULT " <> compileExpression value <> ";"
 compileStatement UnknownStatement { raw } = raw <> ";"
 
 -- | Emit a PRIMARY KEY constraint when there are multiple primary key columns

IHP/IDE/SchemaDesigner/Parser.hs

@@ -546,6 +546,7 @@ alterType = do
 
 -- | ALTER TABLE users ALTER COLUMN email DROP NOT NULL;
 --  ALTER TABLE users ALTER COLUMN email SET NOT NULL;
+--  ALTER TABLE users ALTER COLUMN email SET DEFAULT 'value';
 alterColumn tableName = do
     lexeme "COLUMN"
     columnName <- identifier
@@ -557,14 +558,21 @@ alterColumn tableName = do
             char ';'
             pure DropNotNull { tableName, columnName }
 
-    let setNotNull = do
+    let set = do
             lexeme "SET"
-            lexeme "NOT"
-            lexeme "NULL"
-            char ';'
-            pure SetNotNull { tableName, columnName }
+            let notNull = do
+                    lexeme "NOT"
+                    lexeme "NULL"
+                    char ';'
+                    pure SetNotNull { tableName, columnName }
+            let defaultValue = do
+                    lexeme "DEFAULT"
+                    value <- expression
+                    char ';'
+                    pure SetDefaultValue { tableName, columnName, value }
+            notNull <|> defaultValue
 
-    dropNotNull <|> setNotNull
+    dropNotNull <|> set
 
 
 

IHP/IDE/SchemaDesigner/Types.hs

@@ -58,6 +58,8 @@ data Statement
     | RenameTable { from :: Text, to :: Text }
     -- | DROP POLICY policyName ON tableName;
     | DropPolicy { tableName :: Text, policyName :: Text }
+    -- ALTER TABLE tableName ALTER COLUMN columnName SET DEFAULT 'value';
+    | SetDefaultValue { tableName :: Text, columnName :: Text, value :: Expression }
     deriving (Eq, Show)
 
 data CreateTable

Test/IDE/CodeGeneration/MigrationGenerator.hs

@@ -137,7 +137,24 @@ tests = do
                 let migration = sql [i|ALTER TABLE users ADD CONSTRAINT "users_full_name_key" UNIQUE (full_name);|]
 
                 diffSchemas targetSchema actualSchema `shouldBe` migration
-
+
+            it "should handle changing default values for columns" do
+                let targetSchema = sql [i|
+                    CREATE TABLE users (
+                        id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
+                        full_name TEXT DEFAULT 'new value' NOT NULL
+                    );
+                |]
+                let actualSchema = sql [i|
+                    CREATE TABLE users (
+                        id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
+                        full_name TEXT DEFAULT 'old value' NOT NULL
+                    );
+                |]
+                let migration = sql [i|ALTER TABLE users ALTER COLUMN full_name SET DEFAULT 'new value';|]
+
+                diffSchemas targetSchema actualSchema `shouldBe` migration
+
             it "should handle UNIQUE constraints removed from columns" do
                 let targetSchema = sql [i|
                     CREATE TABLE users (