module IHP.IDE.SchemaDesigner.View.Columns.NewForeignKey where
import IHP.ViewPrelude
import IHP.IDE.SchemaDesigner.Types
import IHP.IDE.ToolServer.Types
import IHP.IDE.SchemaDesigner.View.Layout
data NewForeignKeyView = NewForeignKeyView
{ statements :: [Statement]
, tableName :: Text
, columnName :: Text
, tableNames :: [Text]
}
instance View NewForeignKeyView where
html NewForeignKeyView { .. } = [hsx|
{renderObjectSelector (zip [0..] statements) (Just tableName)}
{renderColumnSelector tableName (zip [0..] columns) statements}
{migrationStatus}
{renderModal modal}
|]
where
table = findStatementByName tableName statements
columns = maybe [] ((.columns) . unsafeGetCreateTable) table
modalContent = [hsx|
{select2}
|]
where
onDeleteSelector option = if option == "NoAction"
then preEscapedToHtml [plain||]
else preEscapedToHtml [plain||]
renderTableNameSelector tableName = [hsx||]
select2 = preEscapedToHtml [plain|
|]
modalFooter = mempty
modalCloseUrl = pathTo ShowTableAction { tableName }
modalTitle = "New Foreign Key Constraint"
modal = Modal { modalContent, modalFooter, modalCloseUrl, modalTitle }