diff --git a/IHP/IDE/SchemaDesigner/Controller/Columns.hs b/IHP/IDE/SchemaDesigner/Controller/Columns.hs index 969ab2bbd..9af20a9b6 100644 --- a/IHP/IDE/SchemaDesigner/Controller/Columns.hs +++ b/IHP/IDE/SchemaDesigner/Controller/Columns.hs @@ -71,39 +71,24 @@ instance Controller ColumnsController where let tableName = param "tableName" let columnName = param "name" let validationResult = columnName |> validateColumn + case validationResult of Failure message -> setErrorMessage message Success -> do - let defaultValue = param "defaultValue" - let table = findStatementByName tableName statements - let columns = maybe [] (get #columns . unsafeGetCreateTable) table - let columnId = param "columnId" - let column = Column - { name = columnName - , columnType = SchemaOperations.arrayifytype (param "isArray") (param "columnType") - , defaultValue = defaultValue - , notNull = (not (param "allowNull")) + let options = SchemaOperations.UpdateColumnOptions + { tableName + , columnName + , columnId = param "columnId" + , defaultValue = param "defaultValue" + , isArray = param "isArray" + , columnType = param "columnType" + , allowNull = param "allowNull" , isUnique = param "isUnique" - , generator = Nothing + , primaryKey = param "primaryKey" } - when ((get #name column) == "") do - setErrorMessage ("Column Name can not be empty") - redirectTo ShowTableAction { tableName } - updateSchema (map (updateColumnInTable tableName column (param "primaryKey") columnId)) - - -- Update Foreign Key Reference - let oldColumn = columns !! columnId - let oldColumnName = get #name oldColumn - let maybeConstraint = referencingColumnForeignKeyConstraints tableName oldColumnName statements - case maybeConstraint of - Just constraint -> do - let Just constraintId = elemIndex constraint statements - let constraintName = tableName <> "_ref_" <> columnName - let referenceTable = Text.splitOn "_id" columnName |> head |> Maybe.fromJust |> pluralize - let Just onDelete = get #onDelete (get #constraint constraint) - updateSchema (updateForeignKeyConstraint tableName columnName constraintName referenceTable onDelete constraintId) - Nothing -> pure () + + updateSchema $ SchemaOperations.updateColumn options redirectTo ShowTableAction { .. } action DeleteColumnAction { .. } = do @@ -185,24 +170,6 @@ instance Controller ColumnsController where updateSchema (deleteForeignKeyConstraint constraintName) redirectTo ShowTableAction { .. } -updateColumnInTable :: Text -> Column -> Bool -> Int -> Statement -> Statement -updateColumnInTable tableName column isPrimaryKey columnId (StatementCreateTable table@CreateTable { name, columns, primaryKeyConstraint }) - | name == tableName = StatementCreateTable $ - table - { columns = (replace columnId column columns) - , primaryKeyConstraint = updatePrimaryKeyConstraint column isPrimaryKey primaryKeyConstraint - } -updateColumnInTable tableName column isPrimaryKey columnId statement = statement - --- | Add or remove a column from the primary key constraint -updatePrimaryKeyConstraint :: Column -> Bool -> PrimaryKeyConstraint -> PrimaryKeyConstraint -updatePrimaryKeyConstraint Column { name } isPrimaryKey primaryKeyConstraint@PrimaryKeyConstraint { primaryKeyColumnNames } = - case (isPrimaryKey, name `elem` primaryKeyColumnNames) of - (False, False) -> primaryKeyConstraint - (False, True) -> PrimaryKeyConstraint (filter (/= name) primaryKeyColumnNames) - (True, False) -> PrimaryKeyConstraint (primaryKeyColumnNames <> [name]) - (True, True) -> primaryKeyConstraint - toggleUniqueInColumn :: Text -> Int -> Statement -> Statement toggleUniqueInColumn tableName columnId (StatementCreateTable table@CreateTable { name, columns }) | name == tableName = StatementCreateTable $ diff --git a/IHP/IDE/SchemaDesigner/SchemaOperations.hs b/IHP/IDE/SchemaDesigner/SchemaOperations.hs index 409b7bf53..8957a931f 100644 --- a/IHP/IDE/SchemaDesigner/SchemaOperations.hs +++ b/IHP/IDE/SchemaDesigner/SchemaOperations.hs @@ -9,6 +9,7 @@ import IHP.Prelude import IHP.IDE.SchemaDesigner.Types import Data.Maybe (fromJust) import qualified Data.List as List +import qualified Data.Text as Text -- | A Schema.sql basically is just a list of sql DDL statements type Schema = [Statement] @@ -100,6 +101,99 @@ addColumn options@(AddColumnOptions { .. }) = then addUpdatedAtTrigger tableName else \schema -> schema) +data UpdateColumnOptions = UpdateColumnOptions + { tableName :: !Text + , columnName :: !Text + , columnType :: !PostgresType + , defaultValue :: !(Maybe Expression) + , isArray :: !Bool + , allowNull :: !Bool + , isUnique :: !Bool + , primaryKey :: !Bool + , columnId :: !Int + } +updateColumn :: UpdateColumnOptions -> Schema -> Schema +updateColumn options@(UpdateColumnOptions { .. }) schema = + let + updateColumnAtIndex :: [Column] -> [Column] + updateColumnAtIndex columns = mapWithIndex updateColumnAtIndex' columns + + mapWithIndex :: (a -> Int -> b) -> [a] -> [b] + mapWithIndex mapFn items = mapWithIndex' mapFn items 0 + where + mapWithIndex' :: (a -> Int -> b) -> [a] -> Int -> [b] + mapWithIndex' mapFn [] _ = [] + mapWithIndex' mapFn (item:rest) i = (mapFn item i):(mapWithIndex' mapFn rest (i + 1)) + + updateColumnAtIndex' :: Column -> Int -> Column + updateColumnAtIndex' column index | index == columnId = column + { name = columnName + , columnType = arrayifytype isArray columnType + , defaultValue = defaultValue + , notNull = not allowNull + , isUnique + } + updateColumnAtIndex' column index = column + + updateTableOp :: [Statement] -> [Statement] + updateTableOp = map \case + (StatementCreateTable table@(CreateTable { name, columns, primaryKeyConstraint })) | name == tableName -> + let + oldColumn :: Column + oldColumn = columns + |> (\c -> zip c [0..]) + |> find ((\(c, index) -> index == columnId)) + |> fromMaybe (error "could not find column with id") + |> fst + in StatementCreateTable $ (table :: CreateTable) + { columns = updateColumnAtIndex columns + , primaryKeyConstraint = updatePrimaryKeyConstraint oldColumn primaryKey primaryKeyConstraint + } + otherwise -> otherwise + + -- | Add or remove a column from the primary key constraint + updatePrimaryKeyConstraint :: Column -> Bool -> PrimaryKeyConstraint -> PrimaryKeyConstraint + updatePrimaryKeyConstraint Column { name } isPrimaryKey primaryKeyConstraint@PrimaryKeyConstraint { primaryKeyColumnNames } = + case (isPrimaryKey, name `elem` primaryKeyColumnNames) of + (False, False) -> primaryKeyConstraint + (False, True) -> PrimaryKeyConstraint (filter (/= name) primaryKeyColumnNames) + (True, False) -> PrimaryKeyConstraint (primaryKeyColumnNames <> [name]) + (True, True) -> primaryKeyConstraint + + updateForeignKeyConstraints = map \case + statement@(AddConstraint { tableName = constraintTable, constraint = constraint@(ForeignKeyConstraint { name = fkName, columnName = fkColumnName }) }) | constraintTable == tableName && fkColumnName == (get #name oldColumn) -> + let newName = Text.replace (get #name oldColumn) columnName <$> fkName + in statement { constraint = constraint { columnName, name = newName } } + index@(CreateIndex { indexName, tableName = indexTable, columns = indexColumns }) | indexTable == tableName -> + let + updateIndexColumn :: IndexColumn -> IndexColumn + updateIndexColumn indexColumn@(IndexColumn { column = VarExpression varName }) | varName == (get #name oldColumn) = indexColumn { column = VarExpression columnName } + updateIndexColumn otherwise = otherwise + in + (index :: Statement) { columns = map updateIndexColumn indexColumns, indexName = Text.replace (get #name oldColumn) columnName indexName } + otherwise -> otherwise + findOldColumn statements = mapMaybe findOldColumn' statements + |> head + |> fromMaybe (error "Could not find old column") + findOldColumn' (StatementCreateTable table@(CreateTable { name, columns, primaryKeyConstraint })) | name == tableName = + let + oldColumn :: Column + oldColumn = columns + |> (\c -> zip c [0..]) + |> find ((\(c, index) -> index == columnId)) + |> fromMaybe (error "could not find column with id") + |> fst + in + Just oldColumn + findOldColumn' _ = Nothing + + oldColumn :: Column + oldColumn = findOldColumn schema + in + schema + |> updateTableOp + |> updateForeignKeyConstraints + newColumn :: AddColumnOptions -> Column newColumn AddColumnOptions { .. } = Column { name = columnName diff --git a/Test/IDE/SchemaDesigner/SchemaOperationsSpec.hs b/Test/IDE/SchemaDesigner/SchemaOperationsSpec.hs index f1445f608..cb3d1790b 100644 --- a/Test/IDE/SchemaDesigner/SchemaOperationsSpec.hs +++ b/Test/IDE/SchemaDesigner/SchemaOperationsSpec.hs @@ -409,6 +409,206 @@ tests = do } (SchemaOperations.deleteColumn options inputSchema) `shouldBe` expectedSchema + describe "update" do + it "update a column's name, type, default value and not null" do + let tableAWithCreatedAt = StatementCreateTable CreateTable + { name = "a" + , columns = [ + Column + { name = "updated_at" + , columnType = PTimestampWithTimezone + , defaultValue = Just (CallExpression "NOW" []) + , notNull = True + , isUnique = False + , generator = Nothing + } + ] + , primaryKeyConstraint = PrimaryKeyConstraint [] + , constraints = [] + } + + let tableAWithUpdatedColumn = StatementCreateTable CreateTable + { name = "a" + , columns = [ + Column + { name = "created_at2" + , columnType = PText + , defaultValue = Nothing + , notNull = False + , isUnique = False + , generator = Nothing + } + ] + , primaryKeyConstraint = PrimaryKeyConstraint [] + , constraints = [] + } + + let inputSchema = [tableAWithCreatedAt] + let expectedSchema = [tableAWithUpdatedColumn] + + let options = SchemaOperations.UpdateColumnOptions + { tableName = "a" + , columnName = "created_at2" + , columnType = PText + , defaultValue = Nothing + , isArray = False + , allowNull = True + , isUnique = False + , primaryKey = False + , columnId = 0 + } + + (SchemaOperations.updateColumn options inputSchema) `shouldBe` expectedSchema + it "updates a primary key" do + let tableWithPK = StatementCreateTable CreateTable + { name = "a" + , columns = [ + Column + { name = "id2" + , columnType = PUUID + , defaultValue = Nothing + , notNull = True + , isUnique = False + , generator = Nothing + } + ] + , primaryKeyConstraint = PrimaryKeyConstraint ["id"] + , constraints = [] + } + + let tableWithoutPK = StatementCreateTable CreateTable + { name = "a" + , columns = [ + Column + { name = "id" + , columnType = PUUID + , defaultValue = Nothing + , notNull = True + , isUnique = False + , generator = Nothing + } + ] + , primaryKeyConstraint = PrimaryKeyConstraint [] + , constraints = [] + } + + let inputSchema = [tableWithoutPK] + let expectedSchema = [tableWithPK] + + let options = SchemaOperations.UpdateColumnOptions + { tableName = "a" + , columnName = "id2" + , columnType = PUUID + , defaultValue = Nothing + , isArray = False + , allowNull = False + , isUnique = False + , primaryKey = True + , columnId = 0 + } + + (SchemaOperations.updateColumn options inputSchema) `shouldBe` expectedSchema + it "updates referenced foreign key constraints" do + let tasksTable = StatementCreateTable CreateTable + { name = "tasks" + , columns = + [ Column { name = "task_list_id", columnType = PUUID, defaultValue = Nothing, notNull = True, isUnique = False, generator = Nothing } + ] + , primaryKeyConstraint = PrimaryKeyConstraint [] + , constraints = [] + } + let taskListsTable = StatementCreateTable CreateTable + { name = "task_lists" + , columns = + [ Column { name = "user_id", columnType = PUUID, defaultValue = Nothing, notNull = True, isUnique = False, generator = Nothing } + ] + , primaryKeyConstraint = PrimaryKeyConstraint [] + , constraints = [] + } + let inputSchema = + [ tasksTable + , taskListsTable + , AddConstraint { tableName = "tasks", constraint = ForeignKeyConstraint { name = "tasks_ref_task_lists", columnName = "task_list_id", referenceTable = "task_lists", referenceColumn = Nothing, onDelete = Nothing }, deferrable = Nothing, deferrableType = Nothing } + ] + + let tasksTable' = StatementCreateTable CreateTable + { name = "tasks" + , columns = + [ Column { name = "list_id", columnType = PUUID, defaultValue = Nothing, notNull = True, isUnique = False, generator = Nothing } + ] + , primaryKeyConstraint = PrimaryKeyConstraint [] + , constraints = [] + } + let expectedSchema = + [ tasksTable' + , taskListsTable + , AddConstraint { tableName = "tasks", constraint = ForeignKeyConstraint { name = "tasks_ref_task_lists", columnName = "list_id", referenceTable = "task_lists", referenceColumn = Nothing, onDelete = Nothing }, deferrable = Nothing, deferrableType = Nothing } + ] + + let options = SchemaOperations.UpdateColumnOptions + { tableName = "tasks" + , columnName = "list_id" + , columnType = PUUID + , defaultValue = Nothing + , isArray = False + , allowNull = False + , isUnique = False + , primaryKey = False + , columnId = 0 + } + + (SchemaOperations.updateColumn options inputSchema) `shouldBe` expectedSchema + it "update a column's indexes" do + let tableAWithCreatedAt = StatementCreateTable CreateTable + { name = "a" + , columns = [ + Column + { name = "updated_at" + , columnType = PTimestampWithTimezone + , defaultValue = Just (CallExpression "NOW" []) + , notNull = True + , isUnique = False + , generator = Nothing + } + ] + , primaryKeyConstraint = PrimaryKeyConstraint [] + , constraints = [] + } + let index = CreateIndex { indexName = "a_updated_at_index", unique = False, tableName = "a", columns = [IndexColumn { column = VarExpression "updated_at", columnOrder = [] }], whereClause = Nothing, indexType = Nothing } + + let tableAWithUpdatedColumn = StatementCreateTable CreateTable + { name = "a" + , columns = [ + Column + { name = "created_at" + , columnType = PText + , defaultValue = Nothing + , notNull = False + , isUnique = False + , generator = Nothing + } + ] + , primaryKeyConstraint = PrimaryKeyConstraint [] + , constraints = [] + } + let indexUpdated = CreateIndex { indexName = "a_created_at_index", unique = False, tableName = "a", columns = [IndexColumn { column = VarExpression "created_at", columnOrder = [] }], whereClause = Nothing, indexType = Nothing } + + let inputSchema = [tableAWithCreatedAt, index] + let expectedSchema = [tableAWithUpdatedColumn, indexUpdated] + + let options = SchemaOperations.UpdateColumnOptions + { tableName = "a" + , columnName = "created_at" + , columnType = PText + , defaultValue = Nothing + , isArray = False + , allowNull = True + , isUnique = False + , primaryKey = False + , columnId = 0 + } + + (SchemaOperations.updateColumn options inputSchema) `shouldBe` expectedSchema parseSqlStatements :: Text -> [Statement] parseSqlStatements sql =