{-|
Module: IHP.IDE.CodeGen.MigrationGenerator
Description: Generates database migration sql files
Copyright: (c) digitally induced GmbH, 2021
-}
module IHP.IDE.CodeGen.MigrationGenerator where

import IHP.Prelude
import qualified System.Directory as Directory
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import IHP.ModelSupport hiding (withTransaction)
import qualified Data.Time.Clock.POSIX as POSIX
import qualified IHP.NameSupport as NameSupport
import qualified Data.Char as Char
import IHP.Log.Types
import IHP.SchemaMigration
import qualified System.Process as Process
import qualified IHP.IDE.SchemaDesigner.Parser as Parser
import IHP.IDE.SchemaDesigner.Types
import Text.Megaparsec
import IHP.IDE.SchemaDesigner.Compiler (compileSql)
import IHP.IDE.CodeGen.Types
import qualified IHP.LibDir as LibDir

buildPlan :: Text -> IO (Int, [GeneratorAction])
buildPlan :: Text -> IO (Int, [GeneratorAction])
buildPlan Text
description = do
    Int
revision <- POSIXTime -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (POSIXTime -> Int) -> IO POSIXTime -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO POSIXTime
POSIX.getPOSIXTime
    let slug :: Text
slug = Text -> Text
NameSupport.toSlug Text
description
    let migrationFile :: Text
migrationFile = Int -> Text
forall a. Show a => a -> Text
tshow Int
revision Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Text -> Bool
forall value. IsEmpty value => value -> Bool
isEmpty Text
slug then Text
"" else Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
slug) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".sql"

    [Statement]
appDiff <- IO [Statement]
diffAppDatabase
    let migrationSql :: Text
migrationSql = if [Statement] -> Bool
forall value. IsEmpty value => value -> Bool
isEmpty [Statement]
appDiff
        then Text
"-- Write your SQL migration code in here\n"
        else [Statement] -> Text
compileSql [Statement]
appDiff
    (Int, [GeneratorAction]) -> IO (Int, [GeneratorAction])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
revision,
            [ EnsureDirectory :: Text -> GeneratorAction
EnsureDirectory { $sel:directory:CreateFile :: Text
directory = Text
"Application/Migration" }
            , CreateFile :: Text -> Text -> GeneratorAction
CreateFile { $sel:filePath:CreateFile :: Text
filePath = Text
"Application/Migration/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
migrationFile, $sel:fileContent:CreateFile :: Text
fileContent = Text
migrationSql }
            ])

diffAppDatabase :: IO [Statement]
diffAppDatabase = do
    (Right [Statement]
schemaSql) <- IO (Either ByteString [Statement])
Parser.parseSchemaSql
    (Right [Statement]
ihpSchemaSql) <- IO (Either ByteString [Statement])
parseIHPSchema
    [Statement]
actualSchema <- IO [Statement]
getAppDBSchema

    let targetSchema :: [Statement]
targetSchema = [Statement]
ihpSchemaSql [Statement] -> [Statement] -> [Statement]
forall a. Semigroup a => a -> a -> a
<> [Statement]
schemaSql

    [Statement] -> IO [Statement]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Statement] -> [Statement] -> [Statement]
diffSchemas [Statement]
targetSchema [Statement]
actualSchema)

parseIHPSchema :: IO (Either ByteString [Statement])
parseIHPSchema :: IO (Either ByteString [Statement])
parseIHPSchema = do
    Text
libDir <- IO Text
LibDir.findLibDirectory
    FilePath -> IO (Either ByteString [Statement])
Parser.parseSqlFile (Text -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Text
libDir Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/IHPSchema.sql")

diffSchemas :: [Statement] -> [Statement] -> [Statement]
diffSchemas :: [Statement] -> [Statement] -> [Statement]
diffSchemas [Statement]
targetSchema' [Statement]
actualSchema' = ([Statement]
drop [Statement] -> [Statement] -> [Statement]
forall a. Semigroup a => a -> a -> a
<> [Statement]
create)
            [Statement] -> ([Statement] -> [Statement]) -> [Statement]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> [Statement] -> [Statement]
patchTable
            [Statement] -> ([Statement] -> [Statement]) -> [Statement]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> [Statement] -> [Statement]
patchEnumType
            [Statement] -> ([Statement] -> [Statement]) -> [Statement]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> [Statement] -> [Statement]
applyRenameTable
    where
        create :: [Statement]
        create :: [Statement]
create = [Statement]
targetSchema [Statement] -> [Statement] -> [Statement]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Statement]
actualSchema

        drop :: [Statement]
        drop :: [Statement]
drop = ([Statement]
actualSchema [Statement] -> [Statement] -> [Statement]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Statement]
targetSchema)
                [Statement] -> ([Statement] -> [Statement]) -> [Statement]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> (Statement -> Maybe Statement) -> [Statement] -> [Statement]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Statement -> Maybe Statement
toDropStatement

        targetSchema :: [Statement]
targetSchema = [Statement] -> [Statement]
removeNoise ([Statement] -> [Statement]) -> [Statement] -> [Statement]
forall a b. (a -> b) -> a -> b
$ [Statement] -> [Statement]
normalizeSchema [Statement]
targetSchema'
        actualSchema :: [Statement]
actualSchema = [Statement] -> [Statement]
removeNoise ([Statement] -> [Statement]) -> [Statement] -> [Statement]
forall a b. (a -> b) -> a -> b
$ [Statement] -> [Statement]
normalizeSchema [Statement]
actualSchema'

        -- | Replaces 'DROP TABLE x; CREATE TABLE x;' DDL sequences with a more efficient 'ALTER TABLE' sequence
        patchTable :: [Statement] -> [Statement]
        patchTable :: [Statement] -> [Statement]
patchTable ((s :: Statement
s@DropTable { Text
$sel:tableName:StatementCreateTable :: Statement -> Text
tableName :: Text
tableName }):[Statement]
statements) =
                case Maybe Statement
createTable of
                    Just Statement
createTable -> (Statement -> Statement -> [Statement]
migrateTable Statement
createTable Statement
actualTable) [Statement] -> [Statement] -> [Statement]
forall a. Semigroup a => a -> a -> a
<> [Statement] -> [Statement]
patchTable (Statement -> [Statement] -> [Statement]
forall a. Eq a => a -> [a] -> [a]
delete Statement
createTable [Statement]
statements)
                    Maybe Statement
Nothing -> Statement
sStatement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
:([Statement] -> [Statement]
patchTable [Statement]
statements)
            where
                createTable :: Maybe Statement
                createTable :: Maybe Statement
createTable = (Statement -> Bool) -> [Statement] -> Maybe Statement
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Statement -> Bool
isCreateTableStatement [Statement]
statements

                isCreateTableStatement :: Statement -> Bool
                isCreateTableStatement :: Statement -> Bool
isCreateTableStatement (StatementCreateTable { $sel:unsafeGetCreateTable:StatementCreateTable :: Statement -> CreateTable
unsafeGetCreateTable = CreateTable
table }) | Proxy "name" -> CreateTable -> Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "name" (Proxy "name")
Proxy "name"
#name CreateTable
table Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
tableName = Bool
True
                isCreateTableStatement Statement
otherwise = Bool
False

                (Just Statement
actualTable) = [Statement]
actualSchema [Statement] -> ([Statement] -> Maybe Statement) -> Maybe Statement
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> (Statement -> Bool) -> [Statement] -> Maybe Statement
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find \case
                        StatementCreateTable { $sel:unsafeGetCreateTable:StatementCreateTable :: Statement -> CreateTable
unsafeGetCreateTable = CreateTable
table } -> Proxy "name" -> CreateTable -> Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "name" (Proxy "name")
Proxy "name"
#name CreateTable
table Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
tableName
                        Statement
otherwise                                                            -> Bool
False
        patchTable (Statement
s:[Statement]
rest) = Statement
sStatement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
:([Statement] -> [Statement]
patchTable [Statement]
rest)
        patchTable [] = []

        -- | Replaces 'DROP TYPE x; CREATE TYPE x;' DDL sequences with a more efficient 'ALTER TYPE' sequence
        patchEnumType :: [Statement] -> [Statement]
        patchEnumType :: [Statement] -> [Statement]
patchEnumType ((s :: Statement
s@DropEnumType { Text
$sel:name:StatementCreateTable :: Statement -> Text
name :: Text
name }):[Statement]
statements) =
                case Maybe Statement
createEnumType of
                    Just Statement
createEnumType -> (Statement -> Statement -> [Statement]
migrateEnum Statement
createEnumType Statement
actualEnumType) [Statement] -> [Statement] -> [Statement]
forall a. Semigroup a => a -> a -> a
<> [Statement] -> [Statement]
patchEnumType (Statement -> [Statement] -> [Statement]
forall a. Eq a => a -> [a] -> [a]
delete Statement
createEnumType [Statement]
statements)
                    Maybe Statement
Nothing -> Statement
sStatement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
:([Statement] -> [Statement]
patchEnumType [Statement]
statements)
            where
                createEnumType :: Maybe Statement
                createEnumType :: Maybe Statement
createEnumType = (Statement -> Bool) -> [Statement] -> Maybe Statement
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Statement -> Bool
isCreateEnumTypeStatement [Statement]
statements

                isCreateEnumTypeStatement :: Statement -> Bool
                isCreateEnumTypeStatement :: Statement -> Bool
isCreateEnumTypeStatement CreateEnumType { $sel:name:StatementCreateTable :: Statement -> Text
name = Text
n } = Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
n
                isCreateEnumTypeStatement Statement
otherwise                   = Bool
False

                (Just Statement
actualEnumType) = [Statement]
actualSchema [Statement] -> ([Statement] -> Maybe Statement) -> Maybe Statement
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> (Statement -> Bool) -> [Statement] -> Maybe Statement
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find \case
                        CreateEnumType { $sel:name:StatementCreateTable :: Statement -> Text
name = Text
enum } -> Text
enum Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name
                        Statement
otherwise                      -> Bool
False
        patchEnumType (Statement
s:[Statement]
rest) = Statement
sStatement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
:([Statement] -> [Statement]
patchEnumType [Statement]
rest)
        patchEnumType [] = []
        
        -- | Replaces 'DROP TABLE a; CREATE TABLE b;' DDL sequences with a more efficient 'ALTER TABLE a RENAME TO b' sequence if
        -- the tables have no differences except the name.
        applyRenameTable :: [Statement] -> [Statement]
        applyRenameTable :: [Statement] -> [Statement]
applyRenameTable ((s :: Statement
s@DropTable { Text
tableName :: Text
$sel:tableName:StatementCreateTable :: Statement -> Text
tableName }):[Statement]
statements) =
                case Maybe Statement
createTable of
                    Just createTable :: Statement
createTable@(StatementCreateTable { $sel:unsafeGetCreateTable:StatementCreateTable :: Statement -> CreateTable
unsafeGetCreateTable = CreateTable
createTable' }) -> (RenameTable :: Text -> Text -> Statement
RenameTable { $sel:from:StatementCreateTable :: Text
from = Text
tableName, $sel:to:StatementCreateTable :: Text
to = Proxy "name" -> CreateTable -> Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "name" (Proxy "name")
Proxy "name"
#name CreateTable
createTable' })Statement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
:([Statement] -> [Statement]
applyRenameTable (Statement -> [Statement] -> [Statement]
forall a. Eq a => a -> [a] -> [a]
delete Statement
createTable [Statement]
statements))
                    Maybe Statement
Nothing -> Statement
sStatement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
:([Statement] -> [Statement]
applyRenameTable [Statement]
statements)
            where
                createTable :: Maybe Statement
                createTable :: Maybe Statement
createTable = (Statement -> Bool) -> [Statement] -> Maybe Statement
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Statement -> Bool
isCreateTableStatement [Statement]
statements

                isCreateTableStatement :: Statement -> Bool
                isCreateTableStatement :: Statement -> Bool
isCreateTableStatement (StatementCreateTable { $sel:unsafeGetCreateTable:StatementCreateTable :: Statement -> CreateTable
unsafeGetCreateTable = CreateTable
table }) = (Proxy "name" -> CreateTable -> Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "name" (Proxy "name")
Proxy "name"
#name CreateTable
table Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Proxy "name" -> CreateTable -> Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "name" (Proxy "name")
Proxy "name"
#name CreateTable
actualTable') Bool -> Bool -> Bool
&& ((CreateTable
actualTable' :: CreateTable) { $sel:name:CreateTable :: Text
name = Text
"" } CreateTable -> CreateTable -> Bool
forall a. Eq a => a -> a -> Bool
== (CreateTable
table :: CreateTable) { $sel:name:CreateTable :: Text
name = Text
"" })
                isCreateTableStatement Statement
otherwise = Bool
False

                (Just Statement
actualTable) = [Statement]
actualSchema [Statement] -> ([Statement] -> Maybe Statement) -> Maybe Statement
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> (Statement -> Bool) -> [Statement] -> Maybe Statement
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find \case
                        StatementCreateTable { $sel:unsafeGetCreateTable:StatementCreateTable :: Statement -> CreateTable
unsafeGetCreateTable = CreateTable
table } -> Proxy "name" -> CreateTable -> Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "name" (Proxy "name")
Proxy "name"
#name CreateTable
table Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
tableName
                        Statement
otherwise                                                            -> Bool
False
                
                actualTable' :: CreateTable
                actualTable' :: CreateTable
actualTable' = case Statement
actualTable of
                    StatementCreateTable { $sel:unsafeGetCreateTable:StatementCreateTable :: Statement -> CreateTable
unsafeGetCreateTable = CreateTable
table } -> CreateTable
table
        applyRenameTable (Statement
s:[Statement]
rest) = Statement
sStatement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
:([Statement] -> [Statement]
applyRenameTable [Statement]
rest)
        applyRenameTable [] = []

        toDropStatement :: Statement -> Maybe Statement
        toDropStatement :: Statement -> Maybe Statement
toDropStatement StatementCreateTable { $sel:unsafeGetCreateTable:StatementCreateTable :: Statement -> CreateTable
unsafeGetCreateTable = CreateTable
table } = Statement -> Maybe Statement
forall a. a -> Maybe a
Just DropTable :: Text -> Statement
DropTable { $sel:tableName:StatementCreateTable :: Text
tableName = Proxy "name" -> CreateTable -> Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "name" (Proxy "name")
Proxy "name"
#name CreateTable
table }
        toDropStatement CreateEnumType { Text
name :: Text
$sel:name:StatementCreateTable :: Statement -> Text
name } = Statement -> Maybe Statement
forall a. a -> Maybe a
Just DropEnumType :: Text -> Statement
DropEnumType { Text
name :: Text
$sel:name:StatementCreateTable :: Text
name }
        toDropStatement CreateIndex { Text
$sel:indexName:StatementCreateTable :: Statement -> Text
indexName :: Text
indexName } = Statement -> Maybe Statement
forall a. a -> Maybe a
Just DropIndex :: Text -> Statement
DropIndex { Text
$sel:indexName:StatementCreateTable :: Text
indexName :: Text
indexName }
        toDropStatement AddConstraint { Text
tableName :: Text
$sel:tableName:StatementCreateTable :: Statement -> Text
tableName, Constraint
$sel:constraint:StatementCreateTable :: Statement -> Constraint
constraint :: Constraint
constraint } = case Proxy "name" -> Constraint -> Maybe Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "name" (Proxy "name")
Proxy "name"
#name Constraint
constraint of
                Just Text
constraintName -> Statement -> Maybe Statement
forall a. a -> Maybe a
Just DropConstraint :: Text -> Text -> Statement
DropConstraint { Text
tableName :: Text
$sel:tableName:StatementCreateTable :: Text
tableName, Text
$sel:constraintName:StatementCreateTable :: Text
constraintName :: Text
constraintName }
                Maybe Text
Nothing -> Maybe Statement
forall a. Maybe a
Nothing
        toDropStatement CreatePolicy { Text
tableName :: Text
$sel:tableName:StatementCreateTable :: Statement -> Text
tableName, Text
name :: Text
$sel:name:StatementCreateTable :: Statement -> Text
name } = Statement -> Maybe Statement
forall a. a -> Maybe a
Just DropPolicy :: Text -> Text -> Statement
DropPolicy { Text
tableName :: Text
$sel:tableName:StatementCreateTable :: Text
tableName, $sel:policyName:StatementCreateTable :: Text
policyName = Text
name }
        toDropStatement Statement
otherwise = Maybe Statement
forall a. Maybe a
Nothing

removeNoise :: [Statement] -> [Statement]
removeNoise = (Statement -> Bool) -> [Statement] -> [Statement]
forall a. (a -> Bool) -> [a] -> [a]
filter \case
        Comment {} -> Bool
False
        StatementCreateTable { $sel:unsafeGetCreateTable:StatementCreateTable :: Statement -> CreateTable
unsafeGetCreateTable = CreateTable { $sel:name:CreateTable :: CreateTable -> Text
name = Text
"schema_migrations" } } -> Bool
False
        AddConstraint { $sel:tableName:StatementCreateTable :: Statement -> Text
tableName = Text
"schema_migrations" }                                          -> Bool
False
        CreateFunction { $sel:functionName:StatementCreateTable :: Statement -> Text
functionName = Text
"ihp_user_id" }                                            -> Bool
False
        Statement
_                                                                                          -> Bool
True

migrateTable :: Statement -> Statement -> [Statement]
migrateTable :: Statement -> Statement -> [Statement]
migrateTable StatementCreateTable { $sel:unsafeGetCreateTable:StatementCreateTable :: Statement -> CreateTable
unsafeGetCreateTable = CreateTable
targetTable } StatementCreateTable { $sel:unsafeGetCreateTable:StatementCreateTable :: Statement -> CreateTable
unsafeGetCreateTable = CreateTable
actualTable } = CreateTable -> CreateTable -> [Statement]
migrateTable' CreateTable
targetTable CreateTable
actualTable
    where
        migrateTable' :: CreateTable -> CreateTable -> [Statement]
migrateTable' CreateTable { $sel:name:CreateTable :: CreateTable -> Text
name = Text
tableName, $sel:columns:CreateTable :: CreateTable -> [Column]
columns = [Column]
targetColumns } CreateTable { $sel:columns:CreateTable :: CreateTable -> [Column]
columns = [Column]
actualColumns } =
                ((Column -> Statement) -> [Column] -> [Statement]
forall a b. (a -> b) -> [a] -> [b]
map Column -> Statement
dropColumn [Column]
dropColumns [Statement] -> [Statement] -> [Statement]
forall a. Semigroup a => a -> a -> a
<> (Column -> Statement) -> [Column] -> [Statement]
forall a b. (a -> b) -> [a] -> [b]
map Column -> Statement
createColumn [Column]
createColumns)
                    [Statement] -> ([Statement] -> [Statement]) -> [Statement]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> [Statement] -> [Statement]
applyRenameColumn
                    [Statement] -> ([Statement] -> [Statement]) -> [Statement]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> [Statement] -> [Statement]
applyMakeUnique
                    [Statement] -> ([Statement] -> [Statement]) -> [Statement]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> [Statement] -> [Statement]
applySetDefault
                    [Statement] -> ([Statement] -> [Statement]) -> [Statement]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> [Statement] -> [Statement]
applyToggleNull
            where

                createColumns :: [Column]
                createColumns :: [Column]
createColumns = [Column]
targetColumns [Column] -> [Column] -> [Column]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Column]
actualColumns

                dropColumns :: [Column]
                dropColumns :: [Column]
dropColumns = [Column]
actualColumns [Column] -> [Column] -> [Column]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Column]
targetColumns

                createColumn :: Column -> Statement
                createColumn :: Column -> Statement
createColumn Column
column = AddColumn :: Text -> Column -> Statement
AddColumn { Text
tableName :: Text
$sel:tableName:StatementCreateTable :: Text
tableName, Column
$sel:column:StatementCreateTable :: Column
column :: Column
column }

                dropColumn :: Column -> Statement
                dropColumn :: Column -> Statement
dropColumn Column
column = DropColumn :: Text -> Text -> Statement
DropColumn { Text
tableName :: Text
$sel:tableName:StatementCreateTable :: Text
tableName, $sel:columnName:StatementCreateTable :: Text
columnName = Proxy "name" -> Column -> Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "name" (Proxy "name")
Proxy "name"
#name Column
column }

                applyRenameColumn :: [Statement] -> [Statement]
applyRenameColumn (s :: Statement
s@(DropColumn { Text
columnName :: Text
$sel:columnName:StatementCreateTable :: Statement -> Text
columnName }):[Statement]
statements) = case Maybe Statement
matchingCreateColumn of
                        Just Statement
matchingCreateColumn -> RenameColumn :: Text -> Text -> Text -> Statement
RenameColumn { Text
tableName :: Text
$sel:tableName:StatementCreateTable :: Text
tableName, $sel:from:StatementCreateTable :: Text
from = Text
columnName, $sel:to:StatementCreateTable :: Text
to = Proxy "name" -> Column -> Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "name" (Proxy "name")
Proxy "name"
#name (Proxy "column" -> Statement -> Column
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "column" (Proxy "column")
Proxy "column"
#column Statement
matchingCreateColumn) } Statement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
: ([Statement] -> [Statement]
applyRenameColumn ((Statement -> Bool) -> [Statement] -> [Statement]
forall a. (a -> Bool) -> [a] -> [a]
filter (Statement -> Statement -> Bool
forall a. Eq a => a -> a -> Bool
(/=) Statement
matchingCreateColumn) [Statement]
statements))
                        Maybe Statement
Nothing -> Statement
sStatement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
:([Statement] -> [Statement]
applyRenameColumn [Statement]
statements)
                    where
                        matchingCreateColumn :: Maybe Statement
                        matchingCreateColumn :: Maybe Statement
matchingCreateColumn = (Statement -> Bool) -> [Statement] -> Maybe Statement
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Statement -> Bool
isMatchingCreateColumn [Statement]
statements

                        isMatchingCreateColumn :: Statement -> Bool
                        isMatchingCreateColumn :: Statement -> Bool
isMatchingCreateColumn AddColumn { $sel:column:StatementCreateTable :: Statement -> Column
column = Column
addColumn } = [Column]
actualColumns
                                [Column] -> ([Column] -> Maybe Column) -> Maybe Column
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> (Column -> Bool) -> [Column] -> Maybe Column
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find \case
                                    Column { Text
$sel:name:Column :: Column -> Text
name :: Text
name } -> Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
columnName
                                    Column
otherwise       -> Bool
False
                                Maybe Column -> (Maybe Column -> Bool) -> Bool
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Bool -> (Column -> Bool) -> Maybe Column -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\Column
c -> (Column
c :: Column) { $sel:name:Column :: Text
name = Proxy "name" -> Column -> Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "name" (Proxy "name")
Proxy "name"
#name Column
addColumn } Column -> Column -> Bool
forall a. Eq a => a -> a -> Bool
== Column
addColumn)
                        isMatchingCreateColumn Statement
otherwise                          = Bool
False
                applyRenameColumn (Statement
statement:[Statement]
rest) = Statement
statementStatement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
:([Statement] -> [Statement]
applyRenameColumn [Statement]
rest)
                applyRenameColumn [] = []

                -- | Emits 'ALTER TABLE table ADD UNIQUE (column);'
                --
                -- This function substitutes the following queries:
                --
                -- > ALTER TABLE table DROP COLUMN column;
                -- > ALTER TABLE table ADD COLUMN column UNIQUE;
                --
                -- With a more natural @ADD UNIQUE@:
                --
                -- > ALTER TABLE table ADD UNIQUE (column);
                --
                applyMakeUnique :: [Statement] -> [Statement]
applyMakeUnique (s :: Statement
s@(DropColumn { Text
columnName :: Text
$sel:columnName:StatementCreateTable :: Statement -> Text
columnName }):[Statement]
statements) = case Maybe Statement
matchingCreateColumn of
                        Just Statement
matchingCreateColumn -> Statement
updateConstraintStatement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
:([Statement] -> [Statement]
applyMakeUnique ((Statement -> Bool) -> [Statement] -> [Statement]
forall a. (a -> Bool) -> [a] -> [a]
filter (Statement -> Statement -> Bool
forall a. Eq a => a -> a -> Bool
(/=) Statement
matchingCreateColumn) [Statement]
statements))
                        Maybe Statement
Nothing -> Statement
sStatement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
:([Statement] -> [Statement]
applyMakeUnique [Statement]
statements)
                    where
                        dropColumn :: Column
                        (Just Column
dropColumn) = [Column]
actualColumns
                                [Column] -> ([Column] -> Maybe Column) -> Maybe Column
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> (Column -> Bool) -> [Column] -> Maybe Column
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find \case
                                    Column { Text
name :: Text
$sel:name:Column :: Column -> Text
name } -> Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
columnName
                                    Column
otherwise       -> Bool
False                                

                        updateConstraint :: Statement
updateConstraint = if Proxy "isUnique" -> Column -> Bool
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "isUnique" (Proxy "isUnique")
Proxy "isUnique"
#isUnique Column
dropColumn
                            then DropConstraint :: Text -> Text -> Statement
DropConstraint { Text
tableName :: Text
$sel:tableName:StatementCreateTable :: Text
tableName, $sel:constraintName:StatementCreateTable :: Text
constraintName = Text
tableName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Proxy "name" -> Column -> Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "name" (Proxy "name")
Proxy "name"
#name Column
dropColumn) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_key" }
                            else AddConstraint :: Text -> Constraint -> Statement
AddConstraint { Text
tableName :: Text
$sel:tableName:StatementCreateTable :: Text
tableName, $sel:constraint:StatementCreateTable :: Constraint
constraint = UniqueConstraint :: Maybe Text -> [Text] -> Constraint
UniqueConstraint { $sel:name:ForeignKeyConstraint :: Maybe Text
name = Maybe Text
forall a. Maybe a
Nothing, $sel:columnNames:ForeignKeyConstraint :: [Text]
columnNames = [Proxy "name" -> Column -> Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "name" (Proxy "name")
Proxy "name"
#name Column
dropColumn] } }

                        matchingCreateColumn :: Maybe Statement
                        matchingCreateColumn :: Maybe Statement
matchingCreateColumn = (Statement -> Bool) -> [Statement] -> Maybe Statement
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Statement -> Bool
isMatchingCreateColumn [Statement]
statements

                        isMatchingCreateColumn :: Statement -> Bool
                        isMatchingCreateColumn :: Statement -> Bool
isMatchingCreateColumn AddColumn { $sel:column:StatementCreateTable :: Statement -> Column
column = Column
addColumn } = Column
addColumn { $sel:isUnique:Column :: Bool
isUnique = Bool
False } Column -> Column -> Bool
forall a. Eq a => a -> a -> Bool
== Column
dropColumn { $sel:isUnique:Column :: Bool
isUnique = Bool
False }
                        isMatchingCreateColumn Statement
otherwise                        = Bool
False
                applyMakeUnique (Statement
statement:[Statement]
rest) = Statement
statementStatement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
:([Statement] -> [Statement]
applyMakeUnique [Statement]
rest)
                applyMakeUnique [] = []

                -- | Emits "ALTER TABLE table ALTER COLUMN column SET DEFAULT 'value'"
                --
                -- This function substitutes the following queries:
                --
                -- > ALTER TABLE table DROP COLUMN column;
                -- > ALTER TABLE table ADD COLUMN column;
                --
                -- With a more natural @SET DEFAULT@:
                --
                -- > ALTER TABLE table ALTER COLUMN column SET DEFAULT 'value'
                --
                applySetDefault :: [Statement] -> [Statement]
applySetDefault (s :: Statement
s@(DropColumn { Text
columnName :: Text
$sel:columnName:StatementCreateTable :: Statement -> Text
columnName }):[Statement]
statements) = case Maybe Statement
matchingCreateColumn of
                        Just Statement
matchingCreateColumn -> case Proxy "defaultValue" -> Column -> Maybe Expression
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "defaultValue" (Proxy "defaultValue")
Proxy "defaultValue"
#defaultValue (Proxy "column" -> Statement -> Column
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "column" (Proxy "column")
Proxy "column"
#column Statement
matchingCreateColumn) of
                            Just Expression
value -> SetDefaultValue :: Text -> Text -> Expression -> Statement
SetDefaultValue { Text
tableName :: Text
$sel:tableName:StatementCreateTable :: Text
tableName, Text
columnName :: Text
$sel:columnName:StatementCreateTable :: Text
columnName, Expression
$sel:value:StatementCreateTable :: Expression
value :: Expression
value }Statement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
:[Statement]
rest
                            Maybe Expression
Nothing -> DropDefaultValue :: Text -> Text -> Statement
DropDefaultValue { Text
tableName :: Text
$sel:tableName:StatementCreateTable :: Text
tableName, Text
columnName :: Text
$sel:columnName:StatementCreateTable :: Text
columnName }Statement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
:[Statement]
rest
                            where
                                rest :: [Statement]
rest = [Statement] -> [Statement]
applySetDefault ((Statement -> Bool) -> [Statement] -> [Statement]
forall a. (a -> Bool) -> [a] -> [a]
filter (Statement -> Statement -> Bool
forall a. Eq a => a -> a -> Bool
(/=) Statement
matchingCreateColumn) [Statement]
statements)
                        Maybe Statement
Nothing -> Statement
sStatement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
:([Statement] -> [Statement]
applySetDefault [Statement]
statements)
                    where
                        dropColumn :: Column
                        (Just Column
dropColumn) = [Column]
actualColumns
                                [Column] -> ([Column] -> Maybe Column) -> Maybe Column
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> (Column -> Bool) -> [Column] -> Maybe Column
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find \case
                                    Column { Text
name :: Text
$sel:name:Column :: Column -> Text
name } -> Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
columnName
                                    Column
otherwise       -> Bool
False                                

                        matchingCreateColumn :: Maybe Statement
                        matchingCreateColumn :: Maybe Statement
matchingCreateColumn = (Statement -> Bool) -> [Statement] -> Maybe Statement
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Statement -> Bool
isMatchingCreateColumn [Statement]
statements

                        isMatchingCreateColumn :: Statement -> Bool
                        isMatchingCreateColumn :: Statement -> Bool
isMatchingCreateColumn AddColumn { $sel:column:StatementCreateTable :: Statement -> Column
column = Column
addColumn } = (Column
addColumn { $sel:defaultValue:Column :: Maybe Expression
defaultValue = Maybe Expression
forall a. Maybe a
Nothing } :: Column) Column -> Column -> Bool
forall a. Eq a => a -> a -> Bool
== (Column
dropColumn { $sel:defaultValue:Column :: Maybe Expression
defaultValue = Maybe Expression
forall a. Maybe a
Nothing } :: Column)
                        isMatchingCreateColumn Statement
otherwise                        = Bool
False
                applySetDefault (Statement
statement:[Statement]
rest) = Statement
statementStatement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
:([Statement] -> [Statement]
applySetDefault [Statement]
rest)
                applySetDefault [] = []

                -- | Emits 'ALTER TABLE table ALTER COLUMN column DROP NOT NULL'
                --
                -- This function substitutes the following queries:
                --
                -- > ALTER TABLE table DROP COLUMN column;
                -- > ALTER TABLE table ADD COLUMN column;
                --
                -- With a more natural @DROP NOT NULL@:
                --
                -- > ALTER TABLE table ALTER COLUMN column DROP NOT NULL
                --
                applyToggleNull :: [Statement] -> [Statement]
applyToggleNull (s :: Statement
s@(DropColumn { Text
columnName :: Text
$sel:columnName:StatementCreateTable :: Statement -> Text
columnName }):[Statement]
statements) = case Maybe Statement
matchingCreateColumn of
                        Just Statement
matchingCreateColumn -> Statement
updateConstraintStatement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
:([Statement] -> [Statement]
applyToggleNull ((Statement -> Bool) -> [Statement] -> [Statement]
forall a. (a -> Bool) -> [a] -> [a]
filter (Statement -> Statement -> Bool
forall a. Eq a => a -> a -> Bool
(/=) Statement
matchingCreateColumn) [Statement]
statements))
                        Maybe Statement
Nothing -> Statement
sStatement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
:([Statement] -> [Statement]
applyToggleNull [Statement]
statements)
                    where
                        dropColumn :: Column
                        (Just Column
dropColumn) = [Column]
actualColumns
                                [Column] -> ([Column] -> Maybe Column) -> Maybe Column
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> (Column -> Bool) -> [Column] -> Maybe Column
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find \case
                                    Column { Text
name :: Text
$sel:name:Column :: Column -> Text
name } -> Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
columnName
                                    Column
otherwise       -> Bool
False                                

                        updateConstraint :: Statement
updateConstraint = if Proxy "notNull" -> Column -> Bool
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "notNull" (Proxy "notNull")
Proxy "notNull"
#notNull Column
dropColumn
                            then DropNotNull :: Text -> Text -> Statement
DropNotNull { Text
tableName :: Text
$sel:tableName:StatementCreateTable :: Text
tableName, $sel:columnName:StatementCreateTable :: Text
columnName = Proxy "name" -> Column -> Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "name" (Proxy "name")
Proxy "name"
#name Column
dropColumn }
                            else SetNotNull :: Text -> Text -> Statement
SetNotNull { Text
tableName :: Text
$sel:tableName:StatementCreateTable :: Text
tableName, $sel:columnName:StatementCreateTable :: Text
columnName = Proxy "name" -> Column -> Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "name" (Proxy "name")
Proxy "name"
#name Column
dropColumn }

                        matchingCreateColumn :: Maybe Statement
                        matchingCreateColumn :: Maybe Statement
matchingCreateColumn = (Statement -> Bool) -> [Statement] -> Maybe Statement
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Statement -> Bool
isMatchingCreateColumn [Statement]
statements

                        isMatchingCreateColumn :: Statement -> Bool
                        isMatchingCreateColumn :: Statement -> Bool
isMatchingCreateColumn AddColumn { $sel:column:StatementCreateTable :: Statement -> Column
column = Column
addColumn } = Column
addColumn Column -> Column -> Bool
`eqColumnExceptNull` Column
dropColumn
                        isMatchingCreateColumn Statement
otherwise                        = Bool
False

                        eqColumnExceptNull :: Column -> Column -> Bool
                        eqColumnExceptNull :: Column -> Column -> Bool
eqColumnExceptNull Column
colA Column
colB = (Column -> Column
normalizeCol Column
colA) Column -> Column -> Bool
forall a. Eq a => a -> a -> Bool
== (Column -> Column
normalizeCol Column
colB)
                            where
                                normalizeCol :: Column -> Column
normalizeCol Column
col = Column
col { $sel:notNull:Column :: Bool
notNull = Bool
False, $sel:defaultValue:Column :: Maybe Expression
defaultValue = Expression -> Maybe Expression
forall a. a -> Maybe a
Just (Text -> Expression
VarExpression Text
"null") }
                applyToggleNull (Statement
statement:[Statement]
rest) = Statement
statementStatement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
:([Statement] -> [Statement]
applyToggleNull [Statement]
rest)
                applyToggleNull [] = []

migrateEnum :: Statement -> Statement -> [Statement]
migrateEnum :: Statement -> Statement -> [Statement]
migrateEnum CreateEnumType { Text
name :: Text
$sel:name:StatementCreateTable :: Statement -> Text
name, $sel:values:StatementCreateTable :: Statement -> [Text]
values = [Text]
targetValues } CreateEnumType { $sel:values:StatementCreateTable :: Statement -> [Text]
values = [Text]
actualValues } = (Text -> Statement) -> [Text] -> [Statement]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Statement
addValue [Text]
newValues
    where
        newValues :: [Text]
        newValues :: [Text]
newValues = [Text]
targetValues [Text] -> [Text] -> [Text]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Text]
actualValues
        
        addValue :: Text -> Statement
        addValue :: Text -> Statement
addValue Text
value = AddValueToEnumType :: Text -> Text -> Statement
AddValueToEnumType { $sel:enumName:StatementCreateTable :: Text
enumName = Text
name, $sel:newValue:StatementCreateTable :: Text
newValue = Text
value }

getAppDBSchema :: IO [Statement]
getAppDBSchema :: IO [Statement]
getAppDBSchema = do
    Text
sql <- IO Text
dumpAppDatabaseSchema
    case Text -> Either ByteString [Statement]
parseDumpedSql Text
sql of
        Left ByteString
error -> FilePath -> IO [Statement]
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (ByteString -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
error)
        Right [Statement]
result -> [Statement] -> IO [Statement]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Statement]
result

-- | Returns the DDL statements of the locally running dev db
--
-- Basically does the same as @make dumpdb@ but returns the output as a string
dumpAppDatabaseSchema :: IO Text
dumpAppDatabaseSchema :: IO Text
dumpAppDatabaseSchema = do
    FilePath
projectDir <- IO FilePath
Directory.getCurrentDirectory
    FilePath -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (FilePath -> Text) -> IO FilePath -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> [FilePath] -> FilePath -> IO FilePath
Process.readProcess FilePath
"pg_dump" [FilePath
"-s", FilePath
"--no-owner", FilePath
"--no-acl", FilePath
"-h", FilePath
projectDir FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"/build/db", FilePath
"app"] []

parseDumpedSql :: Text -> (Either ByteString [Statement])
parseDumpedSql :: Text -> Either ByteString [Statement]
parseDumpedSql Text
sql =
    case Parsec Void Text [Statement]
-> FilePath
-> Text
-> Either (ParseErrorBundle Text Void) [Statement]
forall e s a.
Parsec e s a -> FilePath -> s -> Either (ParseErrorBundle s e) a
runParser Parsec Void Text [Statement]
Parser.parseDDL FilePath
"pg_dump" Text
sql of
        Left ParseErrorBundle Text Void
error -> ByteString -> Either ByteString [Statement]
forall a b. a -> Either a b
Left (FilePath -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text Void -> FilePath
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> FilePath
errorBundlePretty ParseErrorBundle Text Void
error)
        Right [Statement]
r -> [Statement] -> Either ByteString [Statement]
forall a b. b -> Either a b
Right [Statement]
r

normalizeSchema :: [Statement] -> [Statement]
normalizeSchema :: [Statement] -> [Statement]
normalizeSchema [Statement]
statements = (Statement -> [Statement]) -> [Statement] -> [[Statement]]
forall a b. (a -> b) -> [a] -> [b]
map Statement -> [Statement]
normalizeStatement [Statement]
statements
        [[Statement]] -> ([[Statement]] -> [Statement]) -> [Statement]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> [[Statement]] -> [Statement]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [Statement] -> ([Statement] -> [Statement]) -> [Statement]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> [Statement] -> [Statement]
normalizePrimaryKeys

normalizeStatement :: Statement -> [Statement]
normalizeStatement :: Statement -> [Statement]
normalizeStatement StatementCreateTable { $sel:unsafeGetCreateTable:StatementCreateTable :: Statement -> CreateTable
unsafeGetCreateTable = CreateTable
table } = StatementCreateTable :: CreateTable -> Statement
StatementCreateTable { $sel:unsafeGetCreateTable:StatementCreateTable :: CreateTable
unsafeGetCreateTable = CreateTable
normalizedTable } Statement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
: [Statement]
normalizeTableRest
    where 
        (CreateTable
normalizedTable, [Statement]
normalizeTableRest) = CreateTable -> (CreateTable, [Statement])
normalizeTable CreateTable
table
normalizeStatement AddConstraint { Text
tableName :: Text
$sel:tableName:StatementCreateTable :: Statement -> Text
tableName, Constraint
constraint :: Constraint
$sel:constraint:StatementCreateTable :: Statement -> Constraint
constraint } = [ AddConstraint :: Text -> Constraint -> Statement
AddConstraint { Text
tableName :: Text
$sel:tableName:StatementCreateTable :: Text
tableName, $sel:constraint:StatementCreateTable :: Constraint
constraint = Constraint -> Constraint
normalizeConstraint Constraint
constraint } ]
normalizeStatement CreateEnumType { Text
name :: Text
$sel:name:StatementCreateTable :: Statement -> Text
name, [Text]
values :: [Text]
$sel:values:StatementCreateTable :: Statement -> [Text]
values } = [ CreateEnumType :: Text -> [Text] -> Statement
CreateEnumType { $sel:name:StatementCreateTable :: Text
name = Text -> Text
Text.toLower Text
name, $sel:values:StatementCreateTable :: [Text]
values = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
Text.toLower [Text]
values } ]
normalizeStatement CreatePolicy { Text
name :: Text
$sel:name:StatementCreateTable :: Statement -> Text
name, Text
tableName :: Text
$sel:tableName:StatementCreateTable :: Statement -> Text
tableName, Maybe Expression
$sel:using:StatementCreateTable :: Statement -> Maybe Expression
using :: Maybe Expression
using, Maybe Expression
$sel:check:StatementCreateTable :: Statement -> Maybe Expression
check :: Maybe Expression
check } = [ CreatePolicy :: Text -> Text -> Maybe Expression -> Maybe Expression -> Statement
CreatePolicy { Text
name :: Text
$sel:name:StatementCreateTable :: Text
name, Text
tableName :: Text
$sel:tableName:StatementCreateTable :: Text
tableName, $sel:using:StatementCreateTable :: Maybe Expression
using = Expression -> Expression
normalizeExpression (Expression -> Expression) -> Maybe Expression -> Maybe Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Expression
using, $sel:check:StatementCreateTable :: Maybe Expression
check = Expression -> Expression
normalizeExpression (Expression -> Expression) -> Maybe Expression -> Maybe Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Expression
check } ]
normalizeStatement CreateIndex { [Expression]
$sel:expressions:StatementCreateTable :: Statement -> [Expression]
expressions :: [Expression]
expressions, Bool
Maybe Expression
Text
$sel:whereClause:StatementCreateTable :: Statement -> Maybe Expression
$sel:unique:StatementCreateTable :: Statement -> Bool
whereClause :: Maybe Expression
tableName :: Text
unique :: Bool
indexName :: Text
$sel:indexName:StatementCreateTable :: Statement -> Text
$sel:tableName:StatementCreateTable :: Statement -> Text
.. } = [ CreateIndex :: Text
-> Bool -> Text -> [Expression] -> Maybe Expression -> Statement
CreateIndex { $sel:expressions:StatementCreateTable :: [Expression]
expressions = (Expression -> Expression) -> [Expression] -> [Expression]
forall a b. (a -> b) -> [a] -> [b]
map Expression -> Expression
normalizeExpression [Expression]
expressions, Bool
Maybe Expression
Text
$sel:whereClause:StatementCreateTable :: Maybe Expression
$sel:unique:StatementCreateTable :: Bool
whereClause :: Maybe Expression
tableName :: Text
unique :: Bool
indexName :: Text
$sel:indexName:StatementCreateTable :: Text
$sel:tableName:StatementCreateTable :: Text
.. } ]
normalizeStatement CreateFunction { Bool
Text
PostgresType
$sel:language:StatementCreateTable :: Statement -> Text
$sel:returns:StatementCreateTable :: Statement -> PostgresType
$sel:orReplace:StatementCreateTable :: Statement -> Bool
$sel:functionBody:StatementCreateTable :: Statement -> Text
language :: Text
returns :: PostgresType
orReplace :: Bool
functionBody :: Text
functionName :: Text
$sel:functionName:StatementCreateTable :: Statement -> Text
.. } = [ CreateFunction :: Text -> Text -> Bool -> PostgresType -> Text -> Statement
CreateFunction { $sel:orReplace:StatementCreateTable :: Bool
orReplace = Bool
False, Text
PostgresType
$sel:language:StatementCreateTable :: Text
$sel:returns:StatementCreateTable :: PostgresType
$sel:functionBody:StatementCreateTable :: Text
language :: Text
returns :: PostgresType
functionBody :: Text
functionName :: Text
$sel:functionName:StatementCreateTable :: Text
.. } ]
normalizeStatement Statement
otherwise = [Statement
otherwise]

normalizeTable :: CreateTable -> (CreateTable, [Statement])
normalizeTable :: CreateTable -> (CreateTable, [Statement])
normalizeTable table :: CreateTable
table@(CreateTable { [Constraint]
[Column]
Text
PrimaryKeyConstraint
$sel:constraints:CreateTable :: CreateTable -> [Constraint]
$sel:primaryKeyConstraint:CreateTable :: CreateTable -> PrimaryKeyConstraint
constraints :: [Constraint]
primaryKeyConstraint :: PrimaryKeyConstraint
columns :: [Column]
name :: Text
$sel:columns:CreateTable :: CreateTable -> [Column]
$sel:name:CreateTable :: CreateTable -> Text
.. }) = ( CreateTable :: Text
-> [Column] -> PrimaryKeyConstraint -> [Constraint] -> CreateTable
CreateTable { $sel:columns:CreateTable :: [Column]
columns = ([Column], [[Statement]]) -> [Column]
forall a b. (a, b) -> a
fst ([Column], [[Statement]])
normalizedColumns, $sel:constraints:CreateTable :: [Constraint]
constraints = [Constraint]
normalizedTableConstraints, Text
PrimaryKeyConstraint
$sel:primaryKeyConstraint:CreateTable :: PrimaryKeyConstraint
primaryKeyConstraint :: PrimaryKeyConstraint
name :: Text
$sel:name:CreateTable :: Text
.. }, ([[Statement]] -> [Statement]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Statement]] -> [Statement]) -> [[Statement]] -> [Statement]
forall a b. (a -> b) -> a -> b
$ (([Column], [[Statement]]) -> [[Statement]]
forall a b. (a, b) -> b
snd ([Column], [[Statement]])
normalizedColumns)) [Statement] -> [Statement] -> [Statement]
forall a. Semigroup a => a -> a -> a
<> [Statement]
normalizedConstraintsStatements )
    where
        normalizedColumns :: ([Column], [[Statement]])
normalizedColumns = [Column]
columns
                [Column]
-> ([Column] -> [(Column, [Statement])]) -> [(Column, [Statement])]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> (Column -> (Column, [Statement]))
-> [Column] -> [(Column, [Statement])]
forall a b. (a -> b) -> [a] -> [b]
map (CreateTable -> Column -> (Column, [Statement])
normalizeColumn CreateTable
table)
                [(Column, [Statement])]
-> ([(Column, [Statement])] -> ([Column], [[Statement]]))
-> ([Column], [[Statement]])
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> [(Column, [Statement])] -> ([Column], [[Statement]])
forall a b. [(a, b)] -> ([a], [b])
unzip

        -- pg_dump typically inlines the table constraints into the CREATE TABLE statement like this:
        --
        -- > CREATE TABLE public.a (
        -- >     id uuid DEFAULT public.uuid_generate_v4() NOT NULL,
        -- >     CONSTRAINT c CHECK 1=1
        -- > );
        --
        -- In IHP we typically split this into a 'CREATE TABLE' statement and into a 'ALTER TABLE .. ADD CONSTRAINT ..' statement.
        --
        -- We normalize the above statement to this:
        --
        -- > CREATE TABLE public.a (
        -- >     id uuid DEFAULT public.uuid_generate_v4() NOT NULL
        -- > );
        -- > ALTER TABLE a ADD CONSTRAINT c CHECK 1=1;
        normalizedCheckConstraints :: [Either Statement Constraint]
        normalizedCheckConstraints :: [Either Statement Constraint]
normalizedCheckConstraints = [Constraint]
constraints
                [Constraint]
-> ([Constraint] -> [Either Statement Constraint])
-> [Either Statement Constraint]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> (Constraint -> Either Statement Constraint)
-> [Constraint] -> [Either Statement Constraint]
forall a b. (a -> b) -> [a] -> [b]
map \case
                    checkConstraint :: Constraint
checkConstraint@(CheckConstraint {}) -> Statement -> Either Statement Constraint
forall a b. a -> Either a b
Left AddConstraint :: Text -> Constraint -> Statement
AddConstraint { $sel:tableName:StatementCreateTable :: Text
tableName = Text
name, $sel:constraint:StatementCreateTable :: Constraint
constraint = Constraint
checkConstraint }
                    Constraint
otherConstraint -> Constraint -> Either Statement Constraint
forall a b. b -> Either a b
Right Constraint
otherConstraint

        normalizedTableConstraints :: [Constraint]
        normalizedTableConstraints :: [Constraint]
normalizedTableConstraints = 
            [Either Statement Constraint]
normalizedCheckConstraints
            [Either Statement Constraint]
-> ([Either Statement Constraint] -> [Constraint]) -> [Constraint]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> (Either Statement Constraint -> Maybe Constraint)
-> [Either Statement Constraint] -> [Constraint]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe \case
                Left Statement
_ -> Maybe Constraint
forall a. Maybe a
Nothing
                Right Constraint
c -> Constraint -> Maybe Constraint
forall a. a -> Maybe a
Just Constraint
c

        normalizedConstraintsStatements :: [Statement]
        normalizedConstraintsStatements :: [Statement]
normalizedConstraintsStatements = 
            [Either Statement Constraint]
normalizedCheckConstraints
            [Either Statement Constraint]
-> ([Either Statement Constraint] -> [Statement]) -> [Statement]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> (Either Statement Constraint -> Maybe Statement)
-> [Either Statement Constraint] -> [Statement]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe \case
                Right Constraint
_ -> Maybe Statement
forall a. Maybe a
Nothing
                Left Statement
c -> Statement -> Maybe Statement
forall a. a -> Maybe a
Just Statement
c

normalizeConstraint :: Constraint -> Constraint
normalizeConstraint :: Constraint -> Constraint
normalizeConstraint ForeignKeyConstraint { Maybe Text
name :: Maybe Text
$sel:name:ForeignKeyConstraint :: Constraint -> Maybe Text
name, Text
$sel:columnName:ForeignKeyConstraint :: Constraint -> Text
columnName :: Text
columnName, Text
$sel:referenceTable:ForeignKeyConstraint :: Constraint -> Text
referenceTable :: Text
referenceTable, Maybe Text
$sel:referenceColumn:ForeignKeyConstraint :: Constraint -> Maybe Text
referenceColumn :: Maybe Text
referenceColumn, Maybe OnDelete
$sel:onDelete:ForeignKeyConstraint :: Constraint -> Maybe OnDelete
onDelete :: Maybe OnDelete
onDelete } = ForeignKeyConstraint :: Maybe Text
-> Text -> Text -> Maybe Text -> Maybe OnDelete -> Constraint
ForeignKeyConstraint { Maybe Text
name :: Maybe Text
$sel:name:ForeignKeyConstraint :: Maybe Text
name, $sel:columnName:ForeignKeyConstraint :: Text
columnName = Text -> Text
Text.toLower Text
columnName, $sel:referenceTable:ForeignKeyConstraint :: Text
referenceTable = Text -> Text
Text.toLower Text
referenceTable, $sel:referenceColumn:ForeignKeyConstraint :: Maybe Text
referenceColumn = (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
Text.toLower Maybe Text
referenceColumn, $sel:onDelete:ForeignKeyConstraint :: Maybe OnDelete
onDelete = OnDelete -> Maybe OnDelete
forall a. a -> Maybe a
Just (OnDelete -> Maybe OnDelete -> OnDelete
forall a. a -> Maybe a -> a
fromMaybe OnDelete
NoAction Maybe OnDelete
onDelete) }
normalizeConstraint Constraint
otherwise = Constraint
otherwise

normalizeColumn :: CreateTable -> Column -> (Column, [Statement])
normalizeColumn :: CreateTable -> Column -> (Column, [Statement])
normalizeColumn CreateTable
table Column { Text
name :: Text
$sel:name:Column :: Column -> Text
name, PostgresType
$sel:columnType:Column :: Column -> PostgresType
columnType :: PostgresType
columnType, Maybe Expression
defaultValue :: Maybe Expression
$sel:defaultValue:Column :: Column -> Maybe Expression
defaultValue, Bool
notNull :: Bool
$sel:notNull:Column :: Column -> Bool
notNull, Bool
isUnique :: Bool
$sel:isUnique:Column :: Column -> Bool
isUnique } = (Column :: Text -> PostgresType -> Maybe Expression -> Bool -> Bool -> Column
Column { $sel:name:Column :: Text
name = Text -> Text
normalizeName Text
name, $sel:columnType:Column :: PostgresType
columnType = PostgresType -> PostgresType
normalizeSqlType PostgresType
columnType, $sel:defaultValue:Column :: Maybe Expression
defaultValue = Maybe Expression
normalizedDefaultValue, Bool
notNull :: Bool
$sel:notNull:Column :: Bool
notNull, $sel:isUnique:Column :: Bool
isUnique = Bool
False }, [Statement]
uniqueConstraint)
    where
        uniqueConstraint :: [Statement]
uniqueConstraint =
            if Bool
isUnique
                then [ AddConstraint :: Text -> Constraint -> Statement
AddConstraint { $sel:tableName:StatementCreateTable :: Text
tableName = Proxy "name" -> CreateTable -> Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "name" (Proxy "name")
Proxy "name"
#name CreateTable
table, $sel:constraint:StatementCreateTable :: Constraint
constraint = Maybe Text -> [Text] -> Constraint
UniqueConstraint (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ (Proxy "name" -> CreateTable -> Text
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "name" (Proxy "name")
Proxy "name"
#name CreateTable
table) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_key") [Text
name] } ]
                else []

        normalizeName :: Text -> Text
        normalizeName :: Text -> Text
normalizeName Text
nane = Text -> Text
Text.toLower Text
name

        normalizedDefaultValue :: Maybe Expression
normalizedDefaultValue = case Maybe Expression
defaultValue of
            Just Expression
defaultValue -> Expression -> Maybe Expression
forall a. a -> Maybe a
Just (Expression -> Expression
normalizeExpression Expression
defaultValue)
            Maybe Expression
Nothing -> if Bool
notNull
                then Maybe Expression
forall a. Maybe a
Nothing
                else Expression -> Maybe Expression
forall a. a -> Maybe a
Just (Text -> Expression
VarExpression Text
"null") -- pg_dump columns don't have an explicit default null value

normalizeExpression :: Expression -> Expression
normalizeExpression :: Expression -> Expression
normalizeExpression e :: Expression
e@(TextExpression {}) = Expression
e
normalizeExpression (VarExpression Text
var) = Text -> Expression
VarExpression (Text -> Text
Text.toLower Text
var)
normalizeExpression (CallExpression Text
function [Expression]
args) = Text -> [Expression] -> Expression
CallExpression (Text -> Text
Text.toLower Text
function) ((Expression -> Expression) -> [Expression] -> [Expression]
forall a b. (a -> b) -> [a] -> [b]
map Expression -> Expression
normalizeExpression [Expression]
args)
normalizeExpression (NotEqExpression Expression
a Expression
b) = Expression -> Expression -> Expression
NotEqExpression (Expression -> Expression
normalizeExpression Expression
a) (Expression -> Expression
normalizeExpression Expression
b)
normalizeExpression (EqExpression Expression
a Expression
b) = Expression -> Expression -> Expression
EqExpression (Expression -> Expression
normalizeExpression Expression
a) (Expression -> Expression
normalizeExpression Expression
b)
normalizeExpression (AndExpression Expression
a Expression
b) = Expression -> Expression -> Expression
AndExpression (Expression -> Expression
normalizeExpression Expression
a) (Expression -> Expression
normalizeExpression Expression
b)
normalizeExpression (IsExpression Expression
a Expression
b) = Expression -> Expression -> Expression
IsExpression (Expression -> Expression
normalizeExpression Expression
a) (Expression -> Expression
normalizeExpression Expression
b)
normalizeExpression (NotExpression Expression
a) = Expression -> Expression
NotExpression (Expression -> Expression
normalizeExpression Expression
a)
normalizeExpression (OrExpression Expression
a Expression
b) = Expression -> Expression -> Expression
OrExpression (Expression -> Expression
normalizeExpression Expression
a) (Expression -> Expression
normalizeExpression Expression
b)
normalizeExpression (LessThanExpression Expression
a Expression
b) = Expression -> Expression -> Expression
LessThanExpression (Expression -> Expression
normalizeExpression Expression
a) (Expression -> Expression
normalizeExpression Expression
b)
normalizeExpression (LessThanOrEqualToExpression Expression
a Expression
b) = Expression -> Expression -> Expression
LessThanOrEqualToExpression (Expression -> Expression
normalizeExpression Expression
a) (Expression -> Expression
normalizeExpression Expression
b)
normalizeExpression (GreaterThanExpression Expression
a Expression
b) = Expression -> Expression -> Expression
GreaterThanExpression (Expression -> Expression
normalizeExpression Expression
a) (Expression -> Expression
normalizeExpression Expression
b)
normalizeExpression (GreaterThanOrEqualToExpression Expression
a Expression
b) = Expression -> Expression -> Expression
GreaterThanOrEqualToExpression (Expression -> Expression
normalizeExpression Expression
a) (Expression -> Expression
normalizeExpression Expression
b)
normalizeExpression e :: Expression
e@(DoubleExpression {}) = Expression
e
normalizeExpression e :: Expression
e@(IntExpression {}) = Expression
e
-- Enum default values from pg_dump always have an explicit type cast. Inside the Schema.sql they typically don't have those.
-- Therefore we remove these typecasts here
--
-- 'job_status_not_started'::public.job_status => 'job_status_not_started'
--
normalizeExpression (TypeCastExpression Expression
a PostgresType
b) = Expression -> Expression
normalizeExpression Expression
a
normalizeExpression (SelectExpression Select { [Expression]
$sel:columns:Select :: Select -> [Expression]
columns :: [Expression]
columns, Expression
$sel:from:Select :: Select -> Expression
from :: Expression
from, Expression
$sel:whereClause:Select :: Select -> Expression
whereClause :: Expression
whereClause, Maybe Text
$sel:alias:Select :: Select -> Maybe Text
alias :: Maybe Text
alias }) = Select -> Expression
SelectExpression Select :: [Expression] -> Expression -> Maybe Text -> Expression -> Select
Select { $sel:columns:Select :: [Expression]
columns = Expression -> Expression
resolveAlias' (Expression -> Expression) -> [Expression] -> [Expression]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expression -> Expression
normalizeExpression (Expression -> Expression) -> [Expression] -> [Expression]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expression]
columns), $sel:from:Select :: Expression
from = Expression -> Expression
normalizeFrom Expression
from, $sel:whereClause:Select :: Expression
whereClause = Expression -> Expression
resolveAlias' (Expression -> Expression
normalizeExpression Expression
whereClause), $sel:alias:Select :: Maybe Text
alias = Maybe Text
forall a. Maybe a
Nothing }
    where
        -- Turns a `SELECT 1 FROM a` into `SELECT 1 FROM public.a`
        normalizeFrom :: Expression -> Expression
normalizeFrom (VarExpression Text
a) = Expression -> Text -> Expression
DotExpression (Text -> Expression
VarExpression Text
"public") Text
a
        normalizeFrom Expression
otherwise = Expression -> Expression
normalizeExpression Expression
otherwise

        resolveAlias' :: Expression -> Expression
resolveAlias' = Maybe Text -> Expression -> Expression -> Expression
resolveAlias Maybe Text
alias (Expression -> Expression
unqualifiedName Expression
from)

        unqualifiedName :: Expression -> Expression
        unqualifiedName :: Expression -> Expression
unqualifiedName (DotExpression (VarExpression Text
"public") Text
name) = Text -> Expression
VarExpression Text
name
        unqualifiedName Expression
name = Expression
name
normalizeExpression (DotExpression Expression
a Text
b) = Expression -> Text -> Expression
DotExpression (Expression -> Expression
normalizeExpression Expression
a) Text
b
normalizeExpression (ExistsExpression Expression
a) = Expression -> Expression
ExistsExpression (Expression -> Expression
normalizeExpression Expression
a)


resolveAlias :: Maybe Text -> Expression -> Expression -> Expression
resolveAlias :: Maybe Text -> Expression -> Expression -> Expression
resolveAlias (Just Text
alias) Expression
fromExpression Expression
expression =
    let
        rec :: Expression -> Expression
rec = Maybe Text -> Expression -> Expression -> Expression
resolveAlias (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
alias) Expression
fromExpression
    in case Expression
expression of
        e :: Expression
e@(TextExpression {}) -> Expression
e
        e :: Expression
e@(VarExpression Text
var) -> if Text
var Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
alias
                    then Expression
fromExpression
                    else Expression
e
        e :: Expression
e@(CallExpression Text
function [Expression]
args) -> Text -> [Expression] -> Expression
CallExpression Text
function ((Expression -> Expression) -> [Expression] -> [Expression]
forall a b. (a -> b) -> [a] -> [b]
map Expression -> Expression
rec [Expression]
args)
        e :: Expression
e@(NotEqExpression Expression
a Expression
b) -> Expression -> Expression -> Expression
NotEqExpression (Expression -> Expression
rec Expression
a) (Expression -> Expression
rec Expression
b)
        e :: Expression
e@(EqExpression Expression
a Expression
b) -> Expression -> Expression -> Expression
EqExpression (Expression -> Expression
rec Expression
a) (Expression -> Expression
rec Expression
b)
        e :: Expression
e@(AndExpression Expression
a Expression
b) -> Expression -> Expression -> Expression
AndExpression (Expression -> Expression
rec Expression
a) (Expression -> Expression
rec Expression
b)
        e :: Expression
e@(IsExpression Expression
a Expression
b) -> Expression -> Expression -> Expression
IsExpression (Expression -> Expression
rec Expression
a) (Expression -> Expression
rec Expression
b)
        e :: Expression
e@(NotExpression Expression
a) -> Expression -> Expression
NotExpression (Expression -> Expression
rec Expression
a)
        e :: Expression
e@(OrExpression Expression
a Expression
b) -> Expression -> Expression -> Expression
OrExpression (Expression -> Expression
rec Expression
a) (Expression -> Expression
rec Expression
b)
        e :: Expression
e@(LessThanExpression Expression
a Expression
b) -> Expression -> Expression -> Expression
LessThanExpression (Expression -> Expression
rec Expression
a) (Expression -> Expression
rec Expression
b)
        e :: Expression
e@(LessThanOrEqualToExpression Expression
a Expression
b) -> Expression -> Expression -> Expression
LessThanOrEqualToExpression (Expression -> Expression
rec Expression
a) (Expression -> Expression
rec Expression
b)
        e :: Expression
e@(GreaterThanExpression Expression
a Expression
b) -> Expression -> Expression -> Expression
GreaterThanExpression (Expression -> Expression
rec Expression
a) (Expression -> Expression
rec Expression
b)
        e :: Expression
e@(GreaterThanOrEqualToExpression Expression
a Expression
b) -> Expression -> Expression -> Expression
GreaterThanOrEqualToExpression (Expression -> Expression
rec Expression
a) (Expression -> Expression
rec Expression
b)
        e :: Expression
e@(DoubleExpression {}) -> Expression
e
        e :: Expression
e@(IntExpression {}) -> Expression
e
        e :: Expression
e@(TypeCastExpression Expression
a PostgresType
b) -> (Expression -> PostgresType -> Expression
TypeCastExpression (Expression -> Expression
rec Expression
a) PostgresType
b)
        e :: Expression
e@(SelectExpression Select { [Expression]
columns :: [Expression]
$sel:columns:Select :: Select -> [Expression]
columns, Expression
from :: Expression
$sel:from:Select :: Select -> Expression
from, Expression
whereClause :: Expression
$sel:whereClause:Select :: Select -> Expression
whereClause, Maybe Text
alias :: Maybe Text
$sel:alias:Select :: Select -> Maybe Text
alias }) -> Select -> Expression
SelectExpression Select :: [Expression] -> Expression -> Maybe Text -> Expression -> Select
Select { $sel:columns:Select :: [Expression]
columns = Expression -> Expression
rec (Expression -> Expression) -> [Expression] -> [Expression]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expression]
columns, $sel:from:Select :: Expression
from = Expression -> Expression
rec Expression
from, $sel:whereClause:Select :: Expression
whereClause = Expression -> Expression
rec Expression
whereClause, $sel:alias:Select :: Maybe Text
alias = Maybe Text
alias }
        e :: Expression
e@(DotExpression Expression
a Text
b) -> Expression -> Text -> Expression
DotExpression (Expression -> Expression
rec Expression
a) Text
b
        e :: Expression
e@(ExistsExpression Expression
a) -> Expression -> Expression
ExistsExpression (Expression -> Expression
rec Expression
a)
resolveAlias Maybe Text
Nothing Expression
fromExpression Expression
expression = Expression
expression

normalizeSqlType :: PostgresType -> PostgresType
normalizeSqlType :: PostgresType -> PostgresType
normalizeSqlType (PCustomType Text
customType) = Text -> PostgresType
PCustomType (Text -> Text
Text.toLower Text
customType)
normalizeSqlType PostgresType
PBigserial = PostgresType
PBigInt
normalizeSqlType PostgresType
PSerial = PostgresType
PInt
normalizeSqlType PostgresType
otherwise = PostgresType
otherwise

migrationPathFromPlan :: [GeneratorAction] -> Text
migrationPathFromPlan :: [GeneratorAction] -> Text
migrationPathFromPlan [GeneratorAction]
plan =
        let (Just Text
path) = [GeneratorAction]
plan
                [GeneratorAction]
-> ([GeneratorAction] -> Maybe GeneratorAction)
-> Maybe GeneratorAction
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> (GeneratorAction -> Bool)
-> [GeneratorAction] -> Maybe GeneratorAction
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find \case
                    CreateFile {} -> Bool
True
                    GeneratorAction
otherwise     -> Bool
False
                Maybe GeneratorAction
-> (Maybe GeneratorAction -> Maybe Text) -> Maybe Text
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> \case
                    Just CreateFile { Text
filePath :: Text
$sel:filePath:CreateFile :: GeneratorAction -> Text
filePath } -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
filePath
                    Maybe GeneratorAction
otherwise                    -> Maybe Text
forall a. Maybe a
Nothing
        in
            Text
path

-- | Removes @ALTER TABLE .. ADD CONSTRAINT .._pkey PRIMARY KEY (id);@ and moves it into the 'primaryKeyConstraint' field of the 'CreateTable'  statement
--
-- pg_dump dumps a table like this:
--
-- > CREATE TABLE a (
-- >     id uuid DEFAULT uuid_generate_v4() NOT NULL
-- > );
-- > 
-- > ALTER TABLE a ADD CONSTRAINT users_pkey PRIMARY KEY (id);
--
-- This function basically removes the @ALTER TABLE@ statements and moves the primary key directly into the @CREATE TABLE@ statement:
--
-- > CREATE TABLE a (
-- >     id uuid DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
-- > );
--
normalizePrimaryKeys :: [Statement] -> [Statement]
normalizePrimaryKeys :: [Statement] -> [Statement]
normalizePrimaryKeys [Statement]
statements = [Statement] -> [Statement]
forall a. [a] -> [a]
reverse ([Statement] -> [Statement]) -> [Statement] -> [Statement]
forall a b. (a -> b) -> a -> b
$ [Statement] -> [Statement] -> [Statement]
normalizePrimaryKeys' [] [Statement]
statements
    where
        normalizePrimaryKeys' :: [Statement] -> [Statement] -> [Statement]
normalizePrimaryKeys' [Statement]
normalizedStatements ((AddConstraint { Text
tableName :: Text
$sel:tableName:StatementCreateTable :: Statement -> Text
tableName, $sel:constraint:StatementCreateTable :: Statement -> Constraint
constraint = AlterTableAddPrimaryKey { PrimaryKeyConstraint
$sel:primaryKeyConstraint:ForeignKeyConstraint :: Constraint -> PrimaryKeyConstraint
primaryKeyConstraint :: PrimaryKeyConstraint
primaryKeyConstraint } }):[Statement]
rest) =
            [Statement] -> [Statement] -> [Statement]
normalizePrimaryKeys'
                ([Statement]
normalizedStatements
                    [Statement] -> ([Statement] -> [Statement]) -> [Statement]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> (Statement -> Statement) -> [Statement] -> [Statement]
forall a b. (a -> b) -> [a] -> [b]
map \case
                        StatementCreateTable { $sel:unsafeGetCreateTable:StatementCreateTable :: Statement -> CreateTable
unsafeGetCreateTable = table :: CreateTable
table@(CreateTable { Text
name :: Text
$sel:name:CreateTable :: CreateTable -> Text
name }) } | Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
tableName -> StatementCreateTable :: CreateTable -> Statement
StatementCreateTable { $sel:unsafeGetCreateTable:StatementCreateTable :: CreateTable
unsafeGetCreateTable = PrimaryKeyConstraint -> CreateTable -> CreateTable
addPK PrimaryKeyConstraint
primaryKeyConstraint CreateTable
table }
                        Statement
otherwise -> Statement
otherwise
                )
                ([Statement]
rest)
        normalizePrimaryKeys' [Statement]
normalizedStatements (Statement
statement:[Statement]
rest) = [Statement] -> [Statement] -> [Statement]
normalizePrimaryKeys' (Statement
statementStatement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
:[Statement]
normalizedStatements) [Statement]
rest
        normalizePrimaryKeys' [Statement]
normalizedStatements [] = [Statement]
normalizedStatements

        addPK :: PrimaryKeyConstraint -> CreateTable -> CreateTable
        addPK :: PrimaryKeyConstraint -> CreateTable -> CreateTable
addPK PrimaryKeyConstraint { [Text]
$sel:primaryKeyColumnNames:PrimaryKeyConstraint :: PrimaryKeyConstraint -> [Text]
primaryKeyColumnNames :: [Text]
primaryKeyColumnNames } table :: CreateTable
table@(CreateTable { $sel:primaryKeyConstraint:CreateTable :: CreateTable -> PrimaryKeyConstraint
primaryKeyConstraint = PrimaryKeyConstraint { $sel:primaryKeyColumnNames:PrimaryKeyConstraint :: PrimaryKeyConstraint -> [Text]
primaryKeyColumnNames = [Text]
existingPKs } }) = CreateTable
table { $sel:primaryKeyConstraint:CreateTable :: PrimaryKeyConstraint
primaryKeyConstraint = PrimaryKeyConstraint :: [Text] -> PrimaryKeyConstraint
PrimaryKeyConstraint { $sel:primaryKeyColumnNames:PrimaryKeyConstraint :: [Text]
primaryKeyColumnNames = [Text]
existingPKs [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
primaryKeyColumnNames } }