Normalize table constraints before making diff for auto generated mig…

…rations

IHP/IDE/CodeGen/MigrationGenerator.hs

@@ -137,7 +137,9 @@ diffSchemas targetSchema' actualSchema' = (drop <> create)
         toDropStatement StatementCreateTable { unsafeGetCreateTable = table } = Just DropTable { tableName = get #name table }
         toDropStatement CreateEnumType { name } = Just DropEnumType { name }
         toDropStatement CreateIndex { indexName } = Just DropIndex { indexName }
-        toDropStatement AddConstraint { tableName, constraintName } = Just DropConstraint { tableName, constraintName }
+        toDropStatement AddConstraint { tableName, constraint } = case get #name constraint of
+                Just constraintName -> Just DropConstraint { tableName, constraintName }
+                Nothing -> Nothing
         toDropStatement CreatePolicy { tableName, name } = Just DropPolicy { tableName, policyName = name }
         toDropStatement otherwise = Nothing
 
@@ -211,7 +213,7 @@ migrateTable StatementCreateTable { unsafeGetCreateTable = targetTable } Stateme
 
                         updateConstraint = if get #isUnique dropColumn
                             then DropConstraint { tableName, constraintName = tableName <> "_" <> (get #name dropColumn) <> "_key" }
-                            else AddConstraint { tableName, constraintName = "",  constraint = UniqueConstraint { columnNames = [get #name dropColumn] } }
+                            else AddConstraint { tableName, constraint = UniqueConstraint { name = Nothing, columnNames = [get #name dropColumn] } }
 
                         matchingCreateColumn :: Maybe Statement
                         matchingCreateColumn = find isMatchingCreateColumn statements
@@ -334,28 +336,63 @@ normalizeStatement :: Statement -> [Statement]
 normalizeStatement StatementCreateTable { unsafeGetCreateTable = table } = StatementCreateTable { unsafeGetCreateTable = normalizedTable } : normalizeTableRest
     where 
         (normalizedTable, normalizeTableRest) = normalizeTable table
-normalizeStatement AddConstraint { tableName, constraintName, constraint } = [ AddConstraint { tableName, constraintName, constraint = normalizeConstraint constraint } ]
+normalizeStatement AddConstraint { tableName, constraint } = [ AddConstraint { tableName, constraint = normalizeConstraint constraint } ]
 normalizeStatement CreateEnumType { name, values } = [ CreateEnumType { name = Text.toLower name, values = map Text.toLower values } ]
 normalizeStatement CreatePolicy { name, tableName, using, check } = [ CreatePolicy { name, tableName, using = normalizeExpression <$> using, check = normalizeExpression <$> check } ]
 normalizeStatement otherwise = [otherwise]
 
 normalizeTable :: CreateTable -> (CreateTable, [Statement])
-normalizeTable table@(CreateTable { .. }) = ( CreateTable { columns = fst normalizedColumns, .. }, concat $ snd normalizedColumns )
+normalizeTable table@(CreateTable { .. }) = ( CreateTable { columns = fst normalizedColumns, constraints = normalizedTableConstraints, .. }, (concat $ (snd normalizedColumns)) <> normalizedConstraintsStatements )
     where
         normalizedColumns = columns
                 |> map (normalizeColumn table)
                 |> unzip
 
+        -- pg_dump typically inlines the table constraints into the CREATE TABLE statement like this:
+        --
+        -- > CREATE TABLE public.a (
+        -- >     id uuid DEFAULT public.uuid_generate_v4() NOT NULL,
+        -- >     CONSTRAINT c CHECK 1=1
+        -- > );
+        --
+        -- In IHP we typically split this into a 'CREATE TABLE' statement and into a 'ALTER TABLE .. ADD CONSTRAINT ..' statement.
+        --
+        -- We normalize the above statement to this:
+        --
+        -- > CREATE TABLE public.a (
+        -- >     id uuid DEFAULT public.uuid_generate_v4() NOT NULL
+        -- > );
+        -- > ALTER TABLE a ADD CONSTRAINT c CHECK 1=1;
+        normalizedCheckConstraints :: [Either Statement Constraint]
+        normalizedCheckConstraints = constraints
+                |> map \case
+                    checkConstraint@(CheckConstraint {}) -> Left AddConstraint { tableName = name, constraint = checkConstraint }
+                    otherConstraint -> Right otherConstraint
+
+        normalizedTableConstraints :: [Constraint]
+        normalizedTableConstraints = 
+            normalizedCheckConstraints
+            |> mapMaybe \case
+                Left _ -> Nothing
+                Right c -> Just c
+
+        normalizedConstraintsStatements :: [Statement]
+        normalizedConstraintsStatements = 
+            normalizedCheckConstraints
+            |> mapMaybe \case
+                Right _ -> Nothing
+                Left c -> Just c
+
 normalizeConstraint :: Constraint -> Constraint
-normalizeConstraint ForeignKeyConstraint { columnName, referenceTable, referenceColumn, onDelete } = ForeignKeyConstraint { columnName = Text.toLower columnName, referenceTable = Text.toLower referenceTable, referenceColumn = fmap Text.toLower referenceColumn, onDelete = Just (fromMaybe NoAction onDelete) }
+normalizeConstraint ForeignKeyConstraint { name, columnName, referenceTable, referenceColumn, onDelete } = ForeignKeyConstraint { name, columnName = Text.toLower columnName, referenceTable = Text.toLower referenceTable, referenceColumn = fmap Text.toLower referenceColumn, onDelete = Just (fromMaybe NoAction onDelete) }
 normalizeConstraint otherwise = otherwise
 
 normalizeColumn :: CreateTable -> Column -> (Column, [Statement])
 normalizeColumn table Column { name, columnType, defaultValue, notNull, isUnique } = (Column { name = normalizeName name, columnType = normalizeSqlType columnType, defaultValue = normalizedDefaultValue, notNull, isUnique = False }, uniqueConstraint)
     where
         uniqueConstraint =
             if isUnique
-                then [ AddConstraint { tableName = get #name table, constraintName = (get #name table) <>"_" <> name <> "_key", constraint = UniqueConstraint [name] } ]
+                then [ AddConstraint { tableName = get #name table, constraint = UniqueConstraint (Just $ (get #name table) <>"_" <> name <> "_key") [name] } ]
                 else []
 
         normalizeName :: Text -> Text
@@ -432,7 +469,7 @@ migrationPathFromPlan plan =
 normalizePrimaryKeys :: [Statement] -> [Statement]
 normalizePrimaryKeys statements = reverse $ normalizePrimaryKeys' [] statements
     where
-        normalizePrimaryKeys' normalizedStatements ((AddConstraint { tableName, constraintName, constraint = AlterTableAddPrimaryKey { primaryKeyConstraint } }):rest) =
+        normalizePrimaryKeys' normalizedStatements ((AddConstraint { tableName, constraint = AlterTableAddPrimaryKey { primaryKeyConstraint } }):rest) =
             normalizePrimaryKeys'
                 (normalizedStatements
                     |> map \case

IHP/IDE/SchemaDesigner/Compiler.hs

@@ -25,8 +25,8 @@ compileStatement :: Statement -> Text
 compileStatement (StatementCreateTable CreateTable { name, columns, primaryKeyConstraint, constraints }) = "CREATE TABLE " <> compileIdentifier name <> " (\n" <> intercalate ",\n" (map (\col -> "    " <> compileColumn primaryKeyConstraint col) columns <> maybe [] ((:[]) . indent) (compilePrimaryKeyConstraint primaryKeyConstraint) <> map (indent . compileConstraint) constraints) <> "\n);"
 compileStatement CreateEnumType { name, values } = "CREATE TYPE " <> compileIdentifier name <> " AS ENUM (" <> intercalate ", " (values |> map TextExpression |> map compileExpression) <> ");"
 compileStatement CreateExtension { name, ifNotExists } = "CREATE EXTENSION " <> (if ifNotExists then "IF NOT EXISTS " else "") <> compileIdentifier name <> ";"
-compileStatement AddConstraint { tableName, constraintName = "", constraint = UniqueConstraint { columnNames } } = "ALTER TABLE " <> compileIdentifier tableName <> " ADD UNIQUE (" <> intercalate ", " columnNames <> ")" <> ";"
-compileStatement AddConstraint { tableName, constraintName, constraint } = "ALTER TABLE " <> compileIdentifier tableName <> " ADD CONSTRAINT " <> compileIdentifier constraintName <> " " <> compileConstraint constraint <> ";"
+compileStatement AddConstraint { tableName, constraint = UniqueConstraint { name = Nothing, columnNames } } = "ALTER TABLE " <> compileIdentifier tableName <> " ADD UNIQUE (" <> intercalate ", " columnNames <> ")" <> ";"
+compileStatement AddConstraint { tableName, constraint } = "ALTER TABLE " <> compileIdentifier tableName <> " ADD CONSTRAINT " <> compileIdentifier (fromMaybe (error "compileStatement: Expected constraint name") (get #name constraint)) <> " " <> compileConstraint constraint <> ";"
 compileStatement AddColumn { tableName, column } = "ALTER TABLE " <> compileIdentifier tableName <> " ADD COLUMN " <> (compileColumn (PrimaryKeyConstraint []) column) <> ";"
 compileStatement DropColumn { tableName, columnName } = "ALTER TABLE " <> compileIdentifier tableName <> " DROP COLUMN " <> compileIdentifier columnName <> ";"
 compileStatement RenameColumn { tableName, from, to } = "ALTER TABLE " <> compileIdentifier tableName <> " RENAME COLUMN " <> compileIdentifier from <> " TO " <> compileIdentifier to <> ";"

IHP/IDE/SchemaDesigner/Parser.hs

@@ -130,28 +130,26 @@ createEnumType = do
     pure CreateEnumType { name, values }
 
 addConstraint tableName = do
-    lexeme "CONSTRAINT"
-    constraintName <- identifier
     constraint <- parseTableConstraint >>= \case
-      Left primaryKeyConstraint -> pure AlterTableAddPrimaryKey { primaryKeyConstraint }
+      Left primaryKeyConstraint -> pure AlterTableAddPrimaryKey { name = Nothing, primaryKeyConstraint }
       Right constraint -> pure constraint
     char ';'
-    pure AddConstraint { tableName, constraintName, constraint }
+    pure AddConstraint { tableName, constraint }
 
 parseTableConstraint = do
-    optional do
+    name <- optional do
         lexeme "CONSTRAINT"
         identifier
     (Left <$> parsePrimaryKeyConstraint) <|>
-      (Right <$> (parseForeignKeyConstraint <|> parseUniqueConstraint <|> parseCheckConstraint))
+      (Right <$> (parseForeignKeyConstraint name <|> parseUniqueConstraint name <|> parseCheckConstraint name))
 
 parsePrimaryKeyConstraint = do
     lexeme "PRIMARY"
     lexeme "KEY"
     primaryKeyColumnNames <- between (char '(' >> space) (char ')' >> space) (identifier `sepBy1` (char ',' >> space))
     pure PrimaryKeyConstraint { primaryKeyColumnNames }
 
-parseForeignKeyConstraint = do
+parseForeignKeyConstraint name = do
     lexeme "FOREIGN"
     lexeme "KEY"
     columnName <- between (char '(' >> space) (char ')' >> space) identifier
@@ -162,17 +160,17 @@ parseForeignKeyConstraint = do
         lexeme "ON"
         lexeme "DELETE"
         parseOnDelete
-    pure ForeignKeyConstraint { columnName, referenceTable, referenceColumn, onDelete }
+    pure ForeignKeyConstraint { name, columnName, referenceTable, referenceColumn, onDelete }
 
-parseUniqueConstraint = do
+parseUniqueConstraint name = do
     lexeme "UNIQUE"
     columnNames <- between (char '(' >> space) (char ')' >> space) (identifier `sepBy1` (char ',' >> space))
-    pure UniqueConstraint { columnNames }
+    pure UniqueConstraint { name, columnNames }
 
-parseCheckConstraint = do
+parseCheckConstraint name = do
     lexeme "CHECK"
     checkExpression <- between (char '(' >> space) (char ')' >> space) expression
-    pure CheckConstraint { checkExpression }
+    pure CheckConstraint { name, checkExpression }
 
 parseOnDelete = choice
         [ (lexeme "NO" >> lexeme "ACTION") >> pure NoAction
@@ -524,9 +522,9 @@ alterTable = do
     let add = do
             lexeme "ADD"
             let addUnique = do
-                    unique <- parseUniqueConstraint
+                    unique <- parseUniqueConstraint Nothing
                     char ';'
-                    pure (AddConstraint tableName "" unique)
+                    pure (AddConstraint tableName unique)
             addConstraint tableName <|> addColumn tableName <|> addUnique
     let drop = do
             lexeme "DROP"

IHP/IDE/SchemaDesigner/SchemaOperations.hs

@@ -82,9 +82,9 @@ newForeignKeyConstraint :: Text -> Text -> Text -> Statement
 newForeignKeyConstraint tableName columnName referenceTable =
     AddConstraint
     { tableName
-    , constraintName = tableName <> "_ref_" <> columnName
     , constraint = ForeignKeyConstraint
-        { columnName = columnName
+        { name = Just $ tableName <> "_ref_" <> columnName
+        , columnName = columnName
         , referenceTable = referenceTable
         , referenceColumn = "id"
         , onDelete = (Just NoAction)
@@ -111,7 +111,7 @@ arrayifytype False coltype = coltype
 arrayifytype True  coltype = PArray coltype
 
 addForeignKeyConstraint :: Text -> Text -> Text -> Text -> OnDelete -> [Statement] -> [Statement]
-addForeignKeyConstraint tableName columnName constraintName referenceTable onDelete list = list <> [AddConstraint { tableName = tableName, constraintName = constraintName, constraint = ForeignKeyConstraint { columnName = columnName, referenceTable = referenceTable, referenceColumn = "id", onDelete = (Just onDelete) } }]
+addForeignKeyConstraint tableName columnName constraintName referenceTable onDelete list = list <> [AddConstraint { tableName = tableName, constraint = ForeignKeyConstraint { name = Just constraintName, columnName = columnName, referenceTable = referenceTable, referenceColumn = "id", onDelete = (Just onDelete) } }]
 
 addTableIndex :: Text -> Bool -> Text -> [Text] -> [Statement] -> [Statement]
 addTableIndex indexName unique tableName columnNames list = list <> [CreateIndex { indexName, unique, tableName, expressions = map VarExpression columnNames, whereClause = Nothing }]

IHP/IDE/SchemaDesigner/Types.hs

@@ -17,8 +17,8 @@ data Statement
     | DropEnumType { name :: Text }
     -- | CREATE EXTENSION IF NOT EXISTS "name";
     | CreateExtension { name :: Text, ifNotExists :: Bool }
-    -- | ALTER TABLE tableName ADD CONSTRAINT constraintName constraint;
-    | AddConstraint { tableName :: Text, constraintName :: Text, constraint :: Constraint }
+    -- | ALTER TABLE tableName ADD CONSTRAINT constraint;
+    | AddConstraint { tableName :: Text, constraint :: Constraint }
     -- | ALTER TABLE tableName DROP CONSTRAINT constraintName;
     | DropConstraint { tableName, constraintName :: Text }
     -- | ALTER TABLE tableName ADD COLUMN column;
@@ -97,15 +97,24 @@ newtype PrimaryKeyConstraint
 data Constraint
     -- | FOREIGN KEY (columnName) REFERENCES referenceTable (referenceColumn) ON DELETE onDelete;
     = ForeignKeyConstraint
-        { columnName :: Text
-        , referenceTable :: Text
-        , referenceColumn :: Maybe Text
-        , onDelete :: Maybe OnDelete
+        { name :: !(Maybe Text)
+        , columnName :: !Text
+        , referenceTable :: !Text
+        , referenceColumn :: !(Maybe Text)
+        , onDelete :: !(Maybe OnDelete)
         }
     | UniqueConstraint
-        { columnNames :: [Text] }
-    | CheckConstraint { checkExpression :: Expression }
-    | AlterTableAddPrimaryKey { primaryKeyConstraint :: PrimaryKeyConstraint }
+        { name :: !(Maybe Text)
+        , columnNames :: ![Text]
+        }
+    | CheckConstraint
+        { name :: !(Maybe Text)
+        , checkExpression :: !Expression
+        }
+    | AlterTableAddPrimaryKey
+        { name :: !(Maybe Text)
+        , primaryKeyConstraint :: !PrimaryKeyConstraint
+        }
     deriving (Eq, Show)
 
 data Expression =

IHP/IDE/SchemaDesigner/View/Layout.hs

@@ -417,9 +417,9 @@ findForeignKey :: [Statement] -> Text -> Text -> Maybe Statement
 findForeignKey statements tableName columnName =
     find (\statement -> statement == AddConstraint
         { tableName = tableName
-        , constraintName = (get #constraintName statement)
         , constraint = ForeignKeyConstraint
-            { columnName = columnName
+            { name = Just (get #constraintName statement)
+            , columnName = columnName
             , referenceTable = (get #referenceTable (get #constraint statement))
             , referenceColumn = (get #referenceColumn (get #constraint statement))
             , onDelete = (get #onDelete (get #constraint statement))  }

Test/IDE/CodeGeneration/MigrationGenerator.hs

@@ -712,6 +712,23 @@ tests = do
 
                 diffSchemas targetSchema actualSchema `shouldBe` []
 
+            it "should normalize check constraints" do
+                let targetSchema = sql [i|
+                    CREATE TABLE public.a (
+                        id uuid DEFAULT public.uuid_generate_v4() NOT NULL
+                    );
+                    ALTER TABLE a ADD CONSTRAINT contact_email_or_url CHECK (contact_email IS NOT NULL OR source_url IS NOT NULL);
+                |]
+
+                let actualSchema = sql [i|
+                    CREATE TABLE public.a (
+                        id uuid DEFAULT public.uuid_generate_v4() NOT NULL,
+                        CONSTRAINT contact_email_or_url CHECK (((contact_email IS NOT NULL) OR (source_url IS NOT NULL)))
+                    );
+                |]
+
+                diffSchemas targetSchema actualSchema `shouldBe` []
+
 
 sql :: Text -> [Statement]
 sql code = case Megaparsec.runParser Parser.parseDDL "" code of