Extracted column rename logic from Schema Designer action into Schema…

…Operations
digitallyinduced · May 11, 2022 · 3d7e071 · 3d7e071
1 parent 9b3e2c1
commit 3d7e071
Show file tree

Hide file tree

Showing 3 changed files with 306 additions and 45 deletions.
diff --git 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
@@ -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