table

module IHP.IDE.SchemaDesigner.View.Layout ( schemaDesignerLayout , findStatementByName , visualNav , renderColumnSelector , renderColumn , renderEnumSelector , renderValue , renderObjectSelector , removeQuotes , replace , findForeignKey , findTableIndex , migrationStatus , emptyColumnSelectorContainer ) where import IHP.ViewPrelude hiding (primaryKeyColumnNames) import IHP.IDE.SchemaDesigner.Types import IHP.IDE.ToolServer.Types import IHP.IDE.ToolServer.Helper.View import IHP.IDE.ToolServer.Layout hiding (tableIcon) import IHP.IDE.SchemaDesigner.Compiler (compilePostgresType, compileExpression) import qualified Data.List as List schemaDesignerLayout :: Html -> Html schemaDesignerLayout inner = toolServerLayout [hsx|

{visualNav}

{inner}

|] where (DatabaseNeedsMigration hasUnmigratedChanges) = fromFrozenContext @DatabaseNeedsMigration unmigratedChanges :: Html unmigratedChanges = [hsx|

Unmigrated Changes Your app database is not in sync with the Schema.sql

{databaseControls}

|] migrationStatus :: Html migrationStatus = if hasPendingMigrations then pendingMigrations else if databaseNeedsMigration then unmigratedChanges else mempty where (DatabaseNeedsMigration databaseNeedsMigration) = fromFrozenContext @DatabaseNeedsMigration hasPendingMigrations :: Bool hasPendingMigrations = False unmigratedChanges :: Html unmigratedChanges = [hsx|

{migrationStatusIcon}

Unmigrated Changes

Your app database is not in sync with the Schema

Migrate DB →

|] pendingMigrations :: Html pendingMigrations = [hsx|

{migrationStatusIcon}

Pending Changes

You have migrations that haven't been run yet

Run Migrations →

|] migrationStatusIcon :: Html migrationStatusIcon = preEscapedToHtml [plain| |] databaseControls :: Html databaseControls = [hsx|

|] findStatementByName statementName statements = find pred statements where pred (StatementCreateTable CreateTable { name }) | (toUpper name) == (toUpper statementName) = True pred (StatementCreateTable CreateTable { name }) | (toUpper name) == (toUpper (tshow statementName)) = True pred CreateEnumType { name } | (toUpper name) == (toUpper statementName) = True pred CreateEnumType { name } | (toUpper name) == (toUpper (tshow statementName)) = True pred _ = False visualNav :: Html visualNav = [hsx|

Schema Designer Code Editor Migrations

|] where codeEditorActive = isActivePath ShowCodeAction tableViewActive = not codeEditorActive && not migrationsActive migrationsActive = isActiveController @MigrationsController emptyColumnSelectorContainer = [hsx|

|] renderColumnSelector :: Text -> [(Int, Column)] -> [Statement] -> Html renderColumnSelector tableName columns statements = [hsx|

Columns

{addIcon}

{forEach columns (\column -> renderColumn (snd column) (fst column) tableName statements)}

{suggestedColumnsSection tableName columns}

{auth}

{columnIndexes}

|] where columnIndexes = case findTableIndex statements tableName of Just _ -> [hsx|

Indexes

{renderColumnIndexes tableName statements}

|] Nothing -> [hsx||] auth :: Html auth = renderPolicies tableName statements suggestedColumnsSection :: Text -> [(Int, Column)] -> Html suggestedColumnsSection tableName indexAndColumns = unless isUsersTable [hsx|

{mconcat suggestions}

|] where columns :: [Column] columns = map snd indexAndColumns hasColumn :: Text -> Bool hasColumn name = columns |> find (\column -> column.name == name) |> isJust isUsersTable = tableName == "users" suggestions = [createdAt, updatedAt, userId] |> catMaybes createdAt = if hasColumn "created_at" then Nothing else Just [hsx| |] updatedAt = if hasColumn "updated_at" then Nothing else Just [hsx| |] userId = if hasColumn "user_id" then Nothing else Just [hsx| |] -- TODO: this should be set to True if the Schema.sql contains any RLS related code usesRLS :: Bool usesRLS = False renderColumn :: Column -> Int -> Text -> [Statement] -> Html renderColumn Column { name, columnType, defaultValue, notNull, isUnique } id tableName statements = [hsx| contextMenuId <> "'); event.stopPropagation();"}>{name} contextMenuId <> "'); event.stopPropagation();"}>{compilePostgresType columnType}{renderAllowNull} contextMenuId <> "'); event.stopPropagation();"}>{renderDefault}{renderIsUnique} contextMenuId <> "'); event.stopPropagation();"}>{renderPrimaryKey}{renderForeignKey} |] where toggleButtonText = if isUnique then [hsx|Remove Unique|] else [hsx|Make Unique|] contextMenuId = "context-menu-column-" <> tshow id renderPrimaryKey = if inPrimaryKey then [hsx|PRIMARY KEY|] else mempty inPrimaryKey = case findPrimaryKey statements tableName of Nothing -> False Just columnNames -> name `elem` columnNames renderAllowNull = if notNull then mempty else [hsx|{" | " :: Text}NULL|] renderIsUnique = if isUnique then [hsx|IS UNIQUE|] else mempty renderDefault = case defaultValue of Just value -> [hsx|default: {compileExpression value} |] Nothing -> mempty renderForeignKey = case findForeignKey statements tableName name of Just addConstraint@AddConstraint { constraint = ForeignKeyConstraint { name = Just constraintName, referenceTable, onDelete = onDeleteConstraint } } -> [hsx|FOREIGN KEY: {referenceTable} (On Delete: {maybe "" tshow onDeleteConstraint})|] _ -> mempty foreignKeyOption = case findForeignKey statements tableName name of Just addConstraint@AddConstraint { constraint = ForeignKeyConstraint { name = Just constraintName, referenceTable } } -> [hsx|Edit Foreign Key Constraint Delete Foreign Key Constraint|] _ -> [hsx|Add Foreign Key Constraint|] addIndex :: Html addIndex = unless alreadyHasIndex [hsx| |] alreadyHasIndex :: Bool alreadyHasIndex = statements |> find \case CreateIndex { tableName = tableName', columns } -> tableName' == tableName && (VarExpression name) `elem` (map (.column) columns) otherwise -> False |> isJust renderColumnIndexes tableName statements = forEachWithIndex (findTableIndexes statements tableName) renderIndex where renderIndex :: (Int, Statement) -> Html renderIndex (id, index) = [hsx| contextMenuId <> "'); event.stopPropagation();"}> {index.indexName} contextMenuId <> "'); event.stopPropagation();"}> {unique} contextMenuId <> "'); event.stopPropagation();"}> {expressions} |] where unique = when index.unique [hsx|UNIQUE|] showColumnOrder columnOrder = columnOrder |> map (\case { Asc -> "ASC"; Desc -> "DESC"; NullsFirst -> "NULLS FIRST"; NullsLast -> "NULLS LAST" }) |> unwords expressions = index.columns |> map (\column -> (compileExpression column.column) <> " " <> (showColumnOrder column.columnOrder)) |> intercalate ", " contextMenuId = "context-menu-index-" <> tshow id renderPolicies :: Text -> [Statement] -> Html renderPolicies tableName statements = whenNonEmpty tablePolicies policiesTable where policiesTable = [hsx|

Policies

{forEach tablePolicies renderPolicy}

|] tablePolicies :: [Statement] tablePolicies = statements |> filter \case CreatePolicy { tableName = policyTable } -> policyTable == tableName otherwise -> False renderPolicy policy = [hsx| contextMenuId <> "')"}> {policy.name} {renderExpressions policy} |] where policyName = policy.name contextMenuId = "policy-" <> toSlug policyName renderExpressions policy = case (policy.using, policy.check) of (Just using, Just check) | using == check -> [hsx| read & write if {compileExpression using} |] (using, check) -> [hsx| read if {maybe "" compileExpression using} write if {maybe "" compileExpression check} |] renderEnumSelector :: Text -> [(Int, Text)] -> Html renderEnumSelector enumName values = [hsx|

Enum Values

{addIcon}

{forEach values (\value -> renderValue (snd value) (fst value) enumName)}

|] renderValue :: Text -> Int -> Text -> Html renderValue value valueId enumName = [hsx| contextMenuId <> "'); event.stopPropagation();"}> {value} |] where contextMenuId = "context-menu-value-" <> tshow valueId renderObjectSelector statements activeObjectName = [hsx|

Tables

{addIcon}

{forEach tableStatements (\statement -> renderObject (snd statement) (fst statement))} {enums}

|] where isEmptySelector :: Bool isEmptySelector = statements |> map snd |> filter shouldRenderObject |> isEmpty tableStatements :: [(Int, Statement)] tableStatements = statements |> filter \case (_, StatementCreateTable CreateTable {}) -> True otherwise -> False enumStatements :: [(Int, Statement)] enumStatements = statements |> filter \case (_, CreateEnumType {}) -> True otherwise -> False enums = whenNonEmpty enumStatements [hsx|

Enums

{forEach enumStatements (\statement -> renderObject (snd statement) (fst statement))} |] renderObject :: Statement -> Int -> Html renderObject (StatementCreateTable CreateTable { name }) id = [hsx|

contextMenuId <> "'); event.stopPropagation();"}>

{name} {when rlsEnabled rlsIcon}

|] where contextMenuId = "context-menu-" <> tshow id generateControllerLink = [hsx| "?name=" <> name}>Generate Controller|] openControllerLink = [hsx| "?name=" <> name} target="_blank">Open Controller|] controllerDoesNotExist = not $ (ucfirst name) `elem` webControllers (WebControllers webControllers) = fromFrozenContext @WebControllers rlsEnabled = statements |> map snd |> find \case EnableRowLevelSecurity { tableName = rlsTable } -> rlsTable == name otherwise -> False |> isJust rlsIcon = [hsx| {shieldIcon} |] renderObject CreateEnumType { name } id = [hsx| contextMenuId <> "'); event.stopPropagation();"}>

{name}

|] where contextMenuId = "context-menu-" <> tshow id renderObject Comment {} id = mempty renderObject AddConstraint {} id = mempty renderObject CreateExtension {} id = mempty renderObject CreateIndex {} id = mempty renderObject CreateFunction {} id = mempty renderObject UnknownStatement {} id = mempty renderObject EnableRowLevelSecurity {} id = mempty renderObject CreatePolicy {} id = mempty shouldRenderObject (StatementCreateTable CreateTable {}) = True shouldRenderObject CreateEnumType {} = True shouldRenderObject _ = False removeQuotes :: [Char] -> Text removeQuotes (x:xs) = cs $ fromMaybe [] (init xs) removeQuotes n = cs n findForeignKey :: [Statement] -> Text -> Text -> Maybe Statement findForeignKey statements tableName columnName = find (\case AddConstraint { tableName = fkTable, constraint = ForeignKeyConstraint { columnName = fkColumn } } -> tableName == fkTable && columnName == fkColumn otherwise -> False ) statements findPrimaryKey :: [Statement] -> Text -> Maybe [Text] findPrimaryKey statements tableName = do (StatementCreateTable createTable) <- find (isCreateTable tableName) statements pure . primaryKeyColumnNames $ createTable.primaryKeyConstraint where isCreateTable tableName (StatementCreateTable CreateTable { name }) = name == tableName isCreateTable _ _ = False findTableIndex :: [Statement] -> Text -> Maybe Statement findTableIndex statements tableName = find (\case CreateIndex { tableName = tableName' } -> tableName' == tableName; otherwise -> False) statements findTableIndexes :: [Statement] -> Text -> [Statement] findTableIndexes statements tableName = filter (\case CreateIndex { tableName = tableName' } -> tableName' == tableName; otherwise -> False) statements replace :: Int -> a -> [a] -> [a] replace i e xs = case List.splitAt i xs of (before, _:after) -> before ++ (e: after) (a, b) -> a ++ b -- | https://github.com/postgres/pgadmin4/blob/master/web/pgadmin/browser/server_groups/servers/databases/schemas/tables/static/img/table.svg tableIcon = preEscapedToHtml [plain||] -- | https://github.com/postgres/pgadmin4/blob/master/web/pgadmin/browser/server_groups/servers/databases/schemas/types/static/img/type.svg enumIcon = preEscapedToHtml [plain||] -- | https://github.com/postgres/pgadmin4/blob/master/web/pgadmin/browser/server_groups/servers/databases/schemas/tables/indexes/static/img/index.svg indexIcon = preEscapedToHtml [plain||] -- | https://github.com/postgres/pgadmin4/blob/master/web/pgadmin/browser/server_groups/servers/databases/schemas/tables/constraints/index_constraint/static/img/unique_constraint.svg uniqueIndexIcon = preEscapedToHtml [plain||] -- | https://github.com/postgres/pgadmin4/blob/master/web/pgadmin/browser/server_groups/servers/databases/schemas/tables/constraints/check_constraint/static/img/check-constraint.svg constraintIcon = preEscapedToHtml [plain||] -- | https://github.com/postgres/pgadmin4/blob/master/web/pgadmin/browser/server_groups/servers/databases/languages/static/img/language.svg commentIcon = preEscapedToHtml [plain||] -- | https://github.com/postgres/pgadmin4/blob/master/web/pgadmin/browser/server_groups/servers/databases/extensions/static/img/extension.svg extensionIcon = preEscapedToHtml [plain||] -- | https://github.com/postgres/pgadmin4/blob/master/web/pgadmin/browser/server_groups/servers/databases/schemas/functions/static/img/function.svg functionIcon = preEscapedToHtml [plain||] -- | https://github.com/postgres/pgadmin4/blob/master/web/pgadmin/misc/static/explain/img/ex_unknown.svg unknownIcon = preEscapedToHtml [plain||] -- | https://fonts.google.com/icons?icon.query=shield shieldIcon = preEscapedToHtml [plain||]