module IHP.IDE.SchemaDesigner.View.Layout (schemaDesignerLayout, findStatementByName, visualNav, renderColumnSelector, renderColumn, renderEnumSelector, renderValue, renderObjectSelector, removeQuotes, replace, getDefaultValue, databaseControls, findForeignKey) where

import IHP.ViewPrelude
import IHP.IDE.SchemaDesigner.Types
import IHP.IDE.ToolServer.Types
import IHP.IDE.ToolServer.Layout
import IHP.IDE.SchemaDesigner.Compiler (compileIdentifier, compilePostgresType, compileExpression)
import qualified IHP.IDE.SchemaDesigner.Parser as Parser
import qualified Text.Megaparsec as Megaparsec
import qualified Data.List as List

schemaDesignerLayout :: Html -> Html
schemaDesignerLayout :: Html -> Html
schemaDesignerLayout Html
inner = Html -> Html
toolServerLayout Html
[hsx|
<div class="container">
    <div class="row pt-5">
        <div class="col" style="display: flex; align-self: center;">
            {visualNav}
        </div>

        <div class="col" style="display: flex; align-self: center; justify-content: center">
            Application/Schema.sql
        </div>

        {databaseControls}
    </div>

    {inner}
</div>
|]

databaseControls :: Html
databaseControls :: Html
databaseControls = [hsx|
<div class="d-flex justify-content-end col">
    <form method="POST" action={pathTo UpdateDbAction} id="update-db-form"/>
    <form method="POST" action={pathTo PushToDbAction} id="push-to-db-form"/>
    <form method="POST" action={pathTo DumpDbAction} id="db-to-fixtures-form"/>
    <div class="btn-group btn-group-sm mb-2">
        <button
            type="submit"
            form="update-db-form"
            class="btn btn-primary"
            data-toggle="tooltip"
            data-placement="bottom"
            data-html="true"
            title="Dumps DB to Fixtures.sql.<br><br>Delete the DB.<br><br>Recreate using Schema.sql and Fixtures.sql"
            >Update DB</button>

        <button type="button" class="btn btn-primary dropdown-toggle dropdown-toggle-split" data-toggle="dropdown" aria-haspopup="true" aria-expanded="false">
            <span class="sr-only">Toggle Dropdown</span>
        </button>


        <div class="dropdown-menu dropdown-menu-right" aria-labelledby="dropdownMenuLink">
            <button
                type="submit"
                class="dropdown-item"
                form="db-to-fixtures-form"
                data-toggle="tooltip"
                data-placement="left"
                data-html="true"
                title="Saves the content of all tables to Application/Fixtures.sql"
                >Save DB to Fixtures</button>
            <button
                type="submit"
                class="dropdown-item"
                form="push-to-db-form"
                data-toggle="tooltip"
                data-placement="left"
                data-html="true"
                title="Delete the DB and recreate using Application/Schema.sql and Application/Fixture.sql<br><br><strong class=text-danger>Save DB to Fixtures before using this to avoid data loss</strong>"
                >Push to DB</button>
        </div>
    </div>
</div>
|]

findStatementByName :: Text -> t Statement -> Maybe Statement
findStatementByName Text
statementName t Statement
statements = (Statement -> Bool) -> t Statement -> Maybe Statement
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Statement -> Bool
pred t Statement
statements
    where
        pred :: Statement -> Bool
pred (StatementCreateTable CreateTable { Text
$sel:name:CreateTable :: CreateTable -> Text
name :: Text
name }) | (Text -> Text
toUpper Text
name) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text -> Text
toUpper Text
statementName) = Bool
True
        pred (StatementCreateTable CreateTable { Text
name :: Text
$sel:name:CreateTable :: CreateTable -> Text
name }) | (Text -> Text
toUpper Text
name) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text -> Text
toUpper (Text -> Text
forall a. Show a => a -> Text
tshow Text
statementName)) = Bool
True
        pred CreateEnumType { Text
$sel:name:StatementCreateTable :: Statement -> Text
name :: Text
name } | (Text -> Text
toUpper Text
name) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text -> Text
toUpper Text
statementName) = Bool
True
        pred CreateEnumType { Text
name :: Text
$sel:name:StatementCreateTable :: Statement -> Text
name } | (Text -> Text
toUpper Text
name) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text -> Text
toUpper (Text -> Text
forall a. Show a => a -> Text
tshow Text
statementName)) = Bool
True
        pred Statement
_ = Bool
False

visualNav :: Html
visualNav :: Html
visualNav =
    if SchemaController -> Bool
forall controller.
(?context::ControllerContext, PathString controller) =>
controller -> Bool
isActivePath SchemaController
ShowCodeAction
        then [hsx|<a class="custom-control custom-switch visual-switch" href={TablesAction}>
                <input type="checkbox" class="custom-control-input" id="visual-switch" checked="checked"/>
                <label class="custom-control-label" for="visual-switch">Code Editor</label>
            </a>|]
        else [hsx|<a class="custom-control custom-switch visual-switch" href={ShowCodeAction}>
                <input type="checkbox" class="custom-control-input" id="visual-switch"/>
                <label class="custom-control-label text-muted" for="visual-switch">Code Editor</label>
            </a>|]

renderColumnSelector :: Text -> [(Int, Column)] -> [Statement] -> Html
renderColumnSelector :: Text -> [(Int, Column)] -> [Statement] -> Html
renderColumnSelector Text
tableName [(Int, Column)]
columns [Statement]
statements = [hsx|
<div class="col-8 column-selector d-flex">
    <section class="flex-grow-1" oncontextmenu="showContextMenu('context-menu-column-root')">
        <div>
            <h5>Columns</h5>
        </div>
        <table class="table table-hover table-sm">
            <tbody>
                {forEach columns (\column -> renderColumn (snd column) (fst column) tableName statements)}
            </tbody>
        </table>
    </section>

    <section>
        {columnIndexes}
    </section>
</div>
<div class="custom-menu menu-for-column shadow backdrop-blur" id="context-menu-column-root">
    <a href={NewColumnAction tableName}>Add Column</a>
</div>
|]
    where
        columnIndexes :: Html
columnIndexes =
            case [Statement] -> Text -> Maybe Statement
findTableIndex [Statement]
statements Text
tableName of
                Just Statement
_ -> [hsx|
                    <div>
                        <h5>Indexes</h5>
                    </div>
                    <table class="table table-hover table-sm">
                        {renderColumnIndexes tableName statements}
                    </table>
                |]
                Maybe Statement
Nothing -> [hsx||]

-- <a href={NewColumnAction tableName} class="text-danger text-center d-block" id="new-column">+ New Column</a>

renderColumn :: Column -> Int -> Text -> [Statement] -> Html
renderColumn :: Column -> Int -> Text -> [Statement] -> Html
renderColumn Column { Text
$sel:name:Column :: Column -> Text
name :: Text
name, PostgresType
$sel:columnType:Column :: Column -> PostgresType
columnType :: PostgresType
columnType, Maybe Expression
$sel:defaultValue:Column :: Column -> Maybe Expression
defaultValue :: Maybe Expression
defaultValue, Bool
$sel:notNull:Column :: Column -> Bool
notNull :: Bool
notNull, Bool
$sel:isUnique:Column :: Column -> Bool
isUnique :: Bool
isUnique } Int
id Text
tableName [Statement]
statements = [hsx|
<tr class="column">
    <td class="context-column column-name" oncontextmenu={"showContextMenu('" <> contextMenuId <> "'); event.stopPropagation();"}><a href={EditColumnAction tableName id} class="d-block text-body nounderline">{name}</a></td>
    <td class="context-column" oncontextmenu={"showContextMenu('" <> contextMenuId <> "'); event.stopPropagation();"}>{compilePostgresType columnType}{renderAllowNull}</td>
    <td class="context-column" oncontextmenu={"showContextMenu('" <> contextMenuId <> "'); event.stopPropagation();"}>{renderDefault}{renderIsUnique}</td>
    <td class="context-column" oncontextmenu={"showContextMenu('" <> contextMenuId <> "'); event.stopPropagation();"}>{renderPrimaryKey}{renderForeignKey}</td>
</tr>
<div class="custom-menu menu-for-column shadow backdrop-blur" id={contextMenuId}>
    <a href={EditColumnAction tableName id}>Edit Column</a>
    <a href={DeleteColumnAction tableName id name} class="js-delete">Delete Column</a>
    <div></div>
    <form action={ToggleColumnUniqueAction tableName id}><button type="submit" class="link-button">{toggleButtonText}</button></form>
    {foreignKeyOption}
    <div></div>
    <a href={NewColumnAction tableName}>Add Column</a>
</div>
|]
    where
        toggleButtonText :: Html
toggleButtonText = if Bool
isUnique then [hsx|Remove Unique|] else [hsx|Make Unique|]
        contextMenuId :: Text
contextMenuId = Text
"context-menu-column-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
id
        renderPrimaryKey :: Html
renderPrimaryKey = if Bool
inPrimaryKey then [hsx|PRIMARY KEY|] else Html
forall a. Monoid a => a
mempty
        inPrimaryKey :: Bool
inPrimaryKey = case [Statement] -> Text -> Maybe [Text]
findPrimaryKey [Statement]
statements Text
tableName of
          Maybe [Text]
Nothing -> Bool
False
          Just [Text]
columnNames -> Text
name Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
columnNames
        renderAllowNull :: Html
renderAllowNull = if Bool
notNull then Html
forall a. Monoid a => a
mempty else [hsx|{" | " :: Text}NULL|]
        renderIsUnique :: Html
renderIsUnique = if Bool
isUnique then [hsx|IS UNIQUE|] else Html
forall a. Monoid a => a
mempty
        renderDefault :: Html
renderDefault =
            case Maybe Expression
defaultValue of
                Just Expression
value -> [hsx|default: {compileExpression value} |]
                Maybe Expression
Nothing -> Html
forall a. Monoid a => a
mempty
        renderForeignKey :: Html
renderForeignKey = case [Statement] -> Text -> Text -> Maybe Statement
findForeignKey [Statement]
statements Text
tableName Text
name of
            Just addConstraint :: Statement
addConstraint@AddConstraint { Constraint
$sel:constraint:StatementCreateTable :: Statement -> Constraint
constraint :: Constraint
constraint } -> [hsx|<a href={EditForeignKeyAction tableName name (get #constraintName addConstraint) (get #referenceTable constraint)} class="d-block nounderline" style="color: #808080;">FOREIGN KEY: {get #referenceTable constraint}</a>|]
            Maybe Statement
_ -> Html
forall a. Monoid a => a
mempty
        foreignKeyOption :: Html
foreignKeyOption = case [Statement] -> Text -> Text -> Maybe Statement
findForeignKey [Statement]
statements Text
tableName Text
name of
            Just addConstraint :: Statement
addConstraint@AddConstraint { Constraint
constraint :: Constraint
$sel:constraint:StatementCreateTable :: Statement -> Constraint
constraint } ->
                [hsx|<a href={EditForeignKeyAction tableName name (get #constraintName addConstraint) (get #referenceTable constraint)}>Edit Foreign Key Constraint</a>
                <a href={DeleteForeignKeyAction (get #constraintName addConstraint) tableName} class="js-delete">Delete Foreign Key Constraint</a>|]
            Maybe Statement
_ -> [hsx|<a href={NewForeignKeyAction tableName name}>Add Foreign Key Constraint</a>|]

renderColumnIndexes :: Text -> [Statement] -> Html
renderColumnIndexes Text
tableName [Statement]
statements = [hsx|
<tr>
    {index}
</tr>
|]
    where
        index :: Html
index = case [Statement] -> Text -> Maybe Statement
findTableIndex [Statement]
statements Text
tableName of
            Just Statement
statement -> [hsx|
                    <td>{get #indexName statement}</td>
                    <td>{columns}</td>
                |] where columns :: Text
columns = Proxy "columnNames" -> Statement -> [Text]
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "columnNames" (Proxy "columnNames")
Proxy "columnNames"
#columnNames Statement
statement [Text] -> ([Text] -> Text) -> Text
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Text -> [Text] -> Text
intercalate Text
", "
            Maybe Statement
Nothing -> [hsx||]

renderEnumSelector :: Text -> [(Int, Text)] -> Html
renderEnumSelector :: Text -> [(Int, Text)] -> Html
renderEnumSelector Text
enumName [(Int, Text)]
values = [hsx|
<div class="col-8 column-selector" oncontextmenu="showContextMenu('context-menu-value-root')">
    <div class="d-flex">
        <h5>Enum Values</h5>
        <div class="toolbox">
            <a href={NewEnumValueAction enumName} class="btn btn-sm btn-outline-primary m-1">New</a>
        </div>
    </div>
    <table class="table table-hover table-sm">
        <tbody>
            {forEach values (\value -> renderValue (snd value) (fst value) enumName)}
        </tbody>
    </table>
</div>
<div class="custom-menu menu-for-column shadow backdrop-blur" id="context-menu-value-root">
    <a href={NewEnumValueAction enumName}>Add Value</a>
</div>|]

renderValue :: Text -> Int -> Text -> Html
renderValue :: Text -> Int -> Text -> Html
renderValue Text
value Int
valueId Text
enumName = [hsx|
<tr class="column">
    <td class="context-column column-name" oncontextmenu={"showContextMenu('" <> contextMenuId <> "'); event.stopPropagation();"}>
        {value}
    </td>
</tr>
<div class="custom-menu menu-for-column shadow backdrop-blur" id={contextMenuId}>
    <a href={EditEnumValueAction enumName valueId}>Edit Value</a>
    <a href={DeleteEnumValueAction enumName valueId} class="js-delete">Delete Value</a>
    <div></div>
    <a href={NewEnumValueAction enumName}>Add Value</a>
</div>
|]
    where
        contextMenuId :: Text
contextMenuId = Text
"context-menu-value-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
valueId

renderObjectSelector :: [(Int, Statement)] -> Maybe Text -> Html
renderObjectSelector [(Int, Statement)]
statements Maybe Text
activeObjectName = [hsx|
    <div class={classes ["col", "object-selector", ("empty", isEmptySelector)]} oncontextmenu="showContextMenu('context-menu-object-root')">
        <div class="d-flex">
            <h5>Objects</h5>
        </div>
        {forEach statements (\statement -> renderObject (snd statement) (fst statement))}
        <div class="text-muted context-menu-notice">Right click to open context menu</div>
    </div>
    <div class="custom-menu menu-for-table shadow backdrop-blur" id="context-menu-object-root">
        <a href={NewTableAction}>Add Table</a>
        <a href={NewEnumAction}>Add Enum</a>
    </div>
|]
    where
        isEmptySelector :: Bool
        isEmptySelector :: Bool
isEmptySelector = [(Int, Statement)]
statements [(Int, Statement)]
-> ([(Int, Statement)] -> [Statement]) -> [Statement]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> ((Int, Statement) -> Statement)
-> [(Int, Statement)] -> [Statement]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Statement) -> Statement
forall a b. (a, b) -> b
snd [Statement] -> ([Statement] -> [Statement]) -> [Statement]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> (Statement -> Bool) -> [Statement] -> [Statement]
forall a. (a -> Bool) -> [a] -> [a]
filter Statement -> Bool
shouldRenderObject [Statement] -> ([Statement] -> Bool) -> Bool
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> [Statement] -> Bool
forall value. IsEmpty value => value -> Bool
isEmpty

        renderObject :: Statement -> Int -> Html
        renderObject :: Statement -> Int -> Html
renderObject (StatementCreateTable CreateTable { Text
name :: Text
$sel:name:CreateTable :: CreateTable -> Text
name }) Int
id = [hsx|
        <a href={ShowTableAction name} class={classes [("object object-table w-100 context-table", True), ("active", Just name == activeObjectName)]} oncontextmenu={"showContextMenu('" <> contextMenuId <> "'); event.stopPropagation();"}>
            <div class="d-flex">
                {name}
            </div>
        </a>
        <div class="custom-menu menu-for-table shadow backdrop-blur" id={contextMenuId}>
            <a href={EditTableAction name id}>Rename Table</a>
            <a href={DeleteTableAction id name} class="js-delete">Delete Table</a>
            <div></div>
            <a href={ShowGeneratedCodeAction name}>Show Generated Haskell Code</a>
            {when controllerDoesNotExist generateControllerLink}
            {unless controllerDoesNotExist openControllerLink}
            <div></div>
            <a href={NewColumnAction name}>Add Column to Table</a>
            <div></div>
            <a href={NewTableAction}>Add Table</a>
            <a href={NewEnumAction}>Add Enum</a>
        </div>
        |]
            where
                contextMenuId :: Text
contextMenuId = Text
"context-menu-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
id
                generateControllerLink :: Html
generateControllerLink = [hsx|<a href={pathTo NewControllerAction <> "?name=" <> name}>Generate Controller</a>|]
                openControllerLink :: Html
openControllerLink = [hsx|<a href={pathTo OpenControllerAction <> "?name=" <> name} target="_blank">Open Controller</a>|]
                controllerDoesNotExist :: Bool
controllerDoesNotExist = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Text -> Text
ucfirst Text
name) Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
webControllers
                (WebControllers [Text]
webControllers) = (?context::ControllerContext, Typeable WebControllers) =>
WebControllers
forall value.
(?context::ControllerContext, Typeable value) =>
value
fromFrozenContext @WebControllers

        renderObject CreateEnumType { Text
name :: Text
$sel:name:StatementCreateTable :: Statement -> Text
name } Int
id = [hsx|
        <a href={ShowEnumAction name} class={classes [("object object-table w-100 context-enum", True), ("active", Just name == activeObjectName)]} oncontextmenu={"showContextMenu('" <> contextMenuId <> "'); event.stopPropagation();"}>
            <div class="d-flex">
                {name}
            </div>
        </a>
        <div class="custom-menu menu-for-enum shadow backdrop-blur" id={contextMenuId}>
            <a href={EditEnumAction name id}>Rename Enum</a>
            <a href={DeleteEnumAction id} class="js-delete">Delete Enum</a>
            <div></div>
            <a href={ShowGeneratedCodeAction name}>Show Generated Haskell Code</a>
            <a href={NewEnumValueAction name}>Add Column to Table</a>
            <div></div>
            <a href={NewTableAction}>Add Table</a>
            <a href={NewEnumAction}>Add Enum</a>
        </div>
        |]
            where
                contextMenuId :: Text
contextMenuId = Text
"context-menu-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
id
        renderObject Comment {} Int
id = Html
forall a. Monoid a => a
mempty
        renderObject AddConstraint {} Int
id = Html
forall a. Monoid a => a
mempty
        renderObject CreateExtension {} Int
id = Html
forall a. Monoid a => a
mempty
        renderObject CreateIndex {} Int
id = Html
forall a. Monoid a => a
mempty
        renderObject Statement
statement Int
id = [hsx|<div>{statement}</div>|]

        shouldRenderObject :: Statement -> Bool
shouldRenderObject (StatementCreateTable CreateTable {}) = Bool
True
        shouldRenderObject CreateEnumType {} = Bool
True
        shouldRenderObject Statement
_ = Bool
False

removeQuotes :: [Char] -> Text
removeQuotes :: String -> Text
removeQuotes (Char
x:String
xs) = String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe [] (String -> Maybe String
forall a. [a] -> Maybe [a]
init String
xs)
removeQuotes String
n = String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
n

findForeignKey :: [Statement] -> Text -> Text -> Maybe Statement
findForeignKey :: [Statement] -> Text -> Text -> Maybe Statement
findForeignKey [Statement]
statements Text
tableName Text
columnName =
    (Statement -> Bool) -> [Statement] -> Maybe Statement
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Statement
statement -> Statement
statement Statement -> Statement -> Bool
forall a. Eq a => a -> a -> Bool
== AddConstraint :: Text -> Text -> Constraint -> Statement
AddConstraint
        { $sel:tableName:StatementCreateTable :: Text
tableName = Text
tableName
        , $sel:constraintName:StatementCreateTable :: Text
constraintName = (Proxy "constraintName" -> Statement -> Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "constraintName" (Proxy "constraintName")
Proxy "constraintName"
#constraintName Statement
statement)
        , $sel:constraint:StatementCreateTable :: Constraint
constraint = ForeignKeyConstraint :: Text -> Text -> Maybe Text -> Maybe OnDelete -> Constraint
ForeignKeyConstraint
            { $sel:columnName:ForeignKeyConstraint :: Text
columnName = Text
columnName
            , $sel:referenceTable:ForeignKeyConstraint :: Text
referenceTable = (Proxy "referenceTable" -> Constraint -> Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "referenceTable" (Proxy "referenceTable")
Proxy "referenceTable"
#referenceTable (Proxy "constraint" -> Statement -> Constraint
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "constraint" (Proxy "constraint")
Proxy "constraint"
#constraint Statement
statement))
            , $sel:referenceColumn:ForeignKeyConstraint :: Maybe Text
referenceColumn = (Proxy "referenceColumn" -> Constraint -> Maybe Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "referenceColumn" (Proxy "referenceColumn")
Proxy "referenceColumn"
#referenceColumn (Proxy "constraint" -> Statement -> Constraint
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "constraint" (Proxy "constraint")
Proxy "constraint"
#constraint Statement
statement))
            , $sel:onDelete:ForeignKeyConstraint :: Maybe OnDelete
onDelete = (Proxy "onDelete" -> Constraint -> Maybe OnDelete
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "onDelete" (Proxy "onDelete")
Proxy "onDelete"
#onDelete (Proxy "constraint" -> Statement -> Constraint
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "constraint" (Proxy "constraint")
Proxy "constraint"
#constraint Statement
statement))  }
            } ) [Statement]
statements

findPrimaryKey :: [Statement] -> Text -> Maybe [Text]
findPrimaryKey :: [Statement] -> Text -> Maybe [Text]
findPrimaryKey [Statement]
statements Text
tableName = do
    (StatementCreateTable CreateTable
createTable) <- (Statement -> Bool) -> [Statement] -> Maybe Statement
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Text -> Statement -> Bool
isCreateTable Text
tableName) [Statement]
statements
    [Text] -> Maybe [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> Maybe [Text])
-> (PrimaryKeyConstraint -> [Text])
-> PrimaryKeyConstraint
-> Maybe [Text]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. PrimaryKeyConstraint -> [Text]
primaryKeyColumnNames (PrimaryKeyConstraint -> Maybe [Text])
-> PrimaryKeyConstraint -> Maybe [Text]
forall a b. (a -> b) -> a -> b
$ CreateTable -> PrimaryKeyConstraint
primaryKeyConstraint CreateTable
createTable
    where
      isCreateTable :: Text -> Statement -> Bool
isCreateTable Text
tableName (StatementCreateTable CreateTable { Text
name :: Text
$sel:name:CreateTable :: CreateTable -> Text
name }) = Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
tableName
      isCreateTable Text
_ Statement
_ = Bool
False

findTableIndex :: [Statement] -> Text -> Maybe Statement
findTableIndex :: [Statement] -> Text -> Maybe Statement
findTableIndex [Statement]
statements Text
tableName =
    (Statement -> Bool) -> [Statement] -> Maybe Statement
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\case CreateIndex { $sel:tableName:StatementCreateTable :: Statement -> Text
tableName = Text
tableName' } -> Text
tableName' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
tableName; Statement
otherwise -> Bool
False) [Statement]
statements

replace :: Int -> a -> [a] -> [a]
replace :: Int -> a -> [a] -> [a]
replace Int
i a
e [a]
xs = case Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
List.splitAt Int
i [a]
xs of
   ([a]
before, a
_:[a]
after) -> [a]
before [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
++ (a
ea -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
after)
   ([a]
a, [a]
b) -> [a]
a [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
++ [a]
b

getDefaultValue :: Text -> Text -> Maybe Expression
getDefaultValue :: Text -> Text -> Maybe Expression
getDefaultValue Text
columnType Text
value = case Parsec Void Text Expression
-> String -> Text -> Either (ParseErrorBundle Text Void) Expression
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
Megaparsec.runParser Parsec Void Text Expression
Parser.expression String
"" Text
value of
        Left ParseErrorBundle Text Void
_ -> Maybe Expression
forall a. Maybe a
Nothing
        Right Expression
expression -> Expression -> Maybe Expression
forall a. a -> Maybe a
Just Expression
expression