{-|
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.Time.Clock.POSIX as POSIX
import qualified IHP.NameSupport as NameSupport
import qualified Data.Char as Char
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
import qualified IHP.FrameworkConfig as FrameworkConfig

buildPlan :: Text -> Maybe Text -> IO (Int, [GeneratorAction])
buildPlan :: Text -> Maybe Text -> IO (Int, [GeneratorAction])
buildPlan Text
description Maybe Text
sqlStatements = Bool -> Text -> Maybe Text -> IO (Int, [GeneratorAction])
buildPlan' Bool
True Text
description Maybe Text
sqlStatements

buildPlanWithoutIHPSchema :: Text -> Maybe Text -> IO (Int, [GeneratorAction])
buildPlanWithoutIHPSchema :: Text -> Maybe Text -> IO (Int, [GeneratorAction])
buildPlanWithoutIHPSchema Text
description Maybe Text
sqlStatements = Bool -> Text -> Maybe Text -> IO (Int, [GeneratorAction])
buildPlan' Bool
False Text
description Maybe Text
sqlStatements

buildPlan' :: Bool -> Text -> Maybe Text -> IO (Int, [GeneratorAction])
buildPlan' :: Bool -> Text -> Maybe Text -> IO (Int, [GeneratorAction])
buildPlan' Bool
includeIHPSchema Text
description Maybe Text
sqlStatements = do
    Int
revision <- POSIXTime -> Int
forall b. Integral b => POSIXTime -> b
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"

    Text
migrationSql <- case Maybe Text
sqlStatements of
        Just Text
sql -> Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
sql
        Maybe Text
Nothing -> do
            Text
databaseUrl <- ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ByteString
HasCallStack => IO ByteString
FrameworkConfig.defaultDatabaseUrl
            [Statement]
appDiff <- Bool -> Text -> IO [Statement]
diffAppDatabase Bool
includeIHPSchema Text
databaseUrl
            Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ 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 a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
revision,
            [ EnsureDirectory { $sel:directory:CreateFile :: Text
directory = Text
"Application/Migration" }
            , 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 :: Bool -> Text -> IO [Statement]
diffAppDatabase Bool
includeIHPSchema Text
databaseUrl = do
    (Right [Statement]
schemaSql) <- IO (Either ByteString [Statement])
Parser.parseSchemaSql
    (Right [Statement]
ihpSchemaSql) <- if Bool
includeIHPSchema
            then IO (Either ByteString [Statement])
parseIHPSchema
            else Either ByteString [Statement] -> IO (Either ByteString [Statement])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Statement] -> Either ByteString [Statement]
forall a b. b -> Either a b
Right [])
    [Statement]
actualSchema <- Text -> IO [Statement]
getAppDBSchema Text
databaseUrl

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

    [Statement] -> IO [Statement]
forall a. a -> IO a
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
    String -> IO (Either ByteString [Statement])
Parser.parseSqlFile (Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> String) -> Text -> String
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
            [Statement] -> ([Statement] -> [Statement]) -> [Statement]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> [Statement] -> [Statement] -> [Statement]
removeImplicitDeletions [Statement]
actualSchema
            [Statement] -> ([Statement] -> [Statement]) -> [Statement]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> [Statement] -> [Statement]
disableTransactionWhileAddingEnumValues
            [Statement] -> ([Statement] -> [Statement]) -> [Statement]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> [Statement] -> [Statement]
applyReplaceFunction
    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
tableName :: Text
$sel:tableName:StatementCreateTable :: Statement -> 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 }) | CreateTable
table.name 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 } -> CreateTable
table.name 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
name :: Text
$sel:name:StatementCreateTable :: Statement -> 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
$sel:tableName:StatementCreateTable :: Statement -> Text
tableName :: Text
tableName }):[Statement]
statements) =
                case Maybe Statement
createTable of
                    Just createTable :: Statement
createTable@(StatementCreateTable { $sel:unsafeGetCreateTable:StatementCreateTable :: Statement -> CreateTable
unsafeGetCreateTable = CreateTable
createTable' }) ->
                        let
                            from :: Text
from = Text
tableName
                            to :: Text
to = CreateTable
createTable'.name
                        in
                            (RenameTable { Text
from :: Text
$sel:from:StatementCreateTable :: Text
from, Text
to :: Text
$sel:to:StatementCreateTable :: Text
to })Statement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
:([Statement] -> [Statement]
applyRenameTable (Text -> Text -> [Statement] -> [Statement]
fixIdentifiers Text
from Text
to (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 }) = (CreateTable
table.name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= CreateTable
actualTable'.name) 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 } -> CreateTable
table.name 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

                fixIdentifiers :: Text -> Text -> [Statement] -> [Statement]
                fixIdentifiers :: Text -> Text -> [Statement] -> [Statement]
fixIdentifiers Text
tableFrom Text
tableTo [Statement]
statements = (Statement -> Statement) -> [Statement] -> [Statement]
forall a b. (a -> b) -> [a] -> [b]
map Statement -> Statement
fixIdentifier [Statement]
statements
                    where
                        fixIdentifier :: Statement -> Statement
                        fixIdentifier :: Statement -> Statement
fixIdentifier s :: Statement
s@(DropConstraint { Text
$sel:tableName:StatementCreateTable :: Statement -> Text
tableName :: Text
tableName }) | Text
tableName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
tableFrom = Statement
s { $sel:tableName:StatementCreateTable :: Text
tableName = Text
tableTo }
                        fixIdentifier s :: Statement
s@(DropPolicy { Text
$sel:tableName:StatementCreateTable :: Statement -> Text
tableName :: Text
tableName }) | Text
tableName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
tableFrom = Statement
s { $sel:tableName:StatementCreateTable :: Text
tableName = Text
tableTo }
                        fixIdentifier Statement
o = Statement
o
        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 { $sel:tableName:StatementCreateTable :: Text
tableName = CreateTable
table.name }
        toDropStatement CreateEnumType { Text
$sel:name:StatementCreateTable :: Statement -> Text
name :: Text
name } = Statement -> Maybe Statement
forall a. a -> Maybe a
Just DropEnumType { Text
$sel:name:StatementCreateTable :: Text
name :: Text
name }
        toDropStatement CreateIndex { Text
indexName :: Text
$sel:indexName:StatementCreateTable :: Statement -> Text
indexName } = Statement -> Maybe Statement
forall a. a -> Maybe a
Just DropIndex { Text
indexName :: Text
$sel:indexName:StatementCreateTable :: Text
indexName }
        toDropStatement AddConstraint { Text
$sel:tableName:StatementCreateTable :: Statement -> Text
tableName :: Text
tableName, Constraint
constraint :: Constraint
$sel:constraint:StatementCreateTable :: Statement -> Constraint
constraint } = case Constraint
constraint.name of
                Just Text
constraintName -> Statement -> Maybe Statement
forall a. a -> Maybe a
Just DropConstraint { Text
$sel:tableName:StatementCreateTable :: Text
tableName :: Text
tableName, Text
constraintName :: Text
$sel:constraintName:StatementCreateTable :: Text
constraintName }
                Maybe Text
Nothing -> Maybe Statement
forall a. Maybe a
Nothing
        toDropStatement CreatePolicy { Text
$sel:tableName:StatementCreateTable :: Statement -> Text
tableName :: Text
tableName, Text
$sel:name:StatementCreateTable :: Statement -> Text
name :: Text
name } = Statement -> Maybe Statement
forall a. a -> Maybe a
Just DropPolicy { Text
$sel:tableName:StatementCreateTable :: Text
tableName :: Text
tableName, $sel:policyName:StatementCreateTable :: Text
policyName = Text
name }
        toDropStatement CreateFunction { Text
functionName :: Text
$sel:functionName:StatementCreateTable :: Statement -> Text
functionName } = Statement -> Maybe Statement
forall a. a -> Maybe a
Just DropFunction { Text
functionName :: Text
$sel:functionName:StatementCreateTable :: Text
functionName }
        toDropStatement CreateTrigger { Text
$sel:name:StatementCreateTable :: Statement -> Text
name :: Text
name, Text
$sel:tableName:StatementCreateTable :: Statement -> Text
tableName :: Text
tableName } = Statement -> Maybe Statement
forall a. a -> Maybe a
Just DropTrigger { Text
$sel:name:StatementCreateTable :: Text
name :: Text
name, Text
$sel:tableName:StatementCreateTable :: Text
tableName :: Text
tableName }
        toDropStatement Statement
otherwise = Maybe Statement
forall a. Maybe a
Nothing


        -- | Replaces 'DROP FUNCTION a; CREATE FUNCTION a ..;' DDL sequences with a more efficient 'CREATE OR REPLACE FUNCTION a' sequence if
        -- the function have no differences except the body.
        applyReplaceFunction :: [Statement] -> [Statement]
        applyReplaceFunction :: [Statement] -> [Statement]
applyReplaceFunction (DropFunction { Text
$sel:functionName:StatementCreateTable :: Statement -> Text
functionName :: Text
functionName }:[Statement]
statements) =
            [Statement]
statements
                [Statement] -> ([Statement] -> [Statement]) -> [Statement]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Statement -> Statement) -> [Statement] -> [Statement]
forall a b. (a -> b) -> [a] -> [b]
map \case
                    s :: Statement
s@(CreateFunction { $sel:functionName:StatementCreateTable :: Statement -> Text
functionName = Text
newFunctionName }) | Text
newFunctionName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
functionName -> (Statement
s { $sel:orReplace:StatementCreateTable :: Bool
orReplace = Bool
True })
                    Statement
otherwise -> Statement
otherwise
                [Statement] -> ([Statement] -> [Statement]) -> [Statement]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> [Statement] -> [Statement]
applyReplaceFunction
        applyReplaceFunction (Statement
s:[Statement]
rest) = Statement
sStatement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
:([Statement] -> [Statement]
applyReplaceFunction [Statement]
rest)
        applyReplaceFunction [] = []

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 { Text
$sel:functionName:StatementCreateTable :: Statement -> Text
functionName :: Text
functionName } | Text
"notify_" Text -> Text -> Bool
`Text.isPrefixOf` Text
functionName                      -> Bool
False
        CreateTrigger { Text
$sel:name:StatementCreateTable :: Statement -> Text
name :: Text
name } | (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`Text.isPrefixOf` Text
name) [Text
"did_update_", Text
"did_delete_", Text
"did_insert_"] -> Bool
False
        StatementCreateTable { $sel:unsafeGetCreateTable:StatementCreateTable :: Statement -> CreateTable
unsafeGetCreateTable = CreateTable { $sel:name:CreateTable :: CreateTable -> Text
name = Text
"large_pg_notifications" } } -> Bool
False
        CreateIndex { $sel:tableName:StatementCreateTable :: Statement -> Text
tableName = Text
"large_pg_notifications" }                                            -> 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
$sel:tableName:StatementCreateTable :: Text
tableName :: Text
tableName, Column
column :: Column
$sel:column:StatementCreateTable :: Column
column }

                dropColumn :: Column -> Statement
                dropColumn :: Column -> Statement
dropColumn Column
column = DropColumn { Text
$sel:tableName:StatementCreateTable :: Text
tableName :: Text
tableName, $sel:columnName:StatementCreateTable :: Text
columnName = Column
column.name }

                applyRenameColumn :: [Statement] -> [Statement]
applyRenameColumn (s :: Statement
s@(DropColumn { Text
$sel:columnName:StatementCreateTable :: Statement -> Text
columnName :: Text
columnName }):[Statement]
statements) = case Maybe Statement
matchingCreateColumn of
                        Just Statement
matchingCreateColumn -> RenameColumn { Text
$sel:tableName:StatementCreateTable :: Text
tableName :: Text
tableName, $sel:from:StatementCreateTable :: Text
from = Text
columnName, $sel:to:StatementCreateTable :: Text
to = Statement
matchingCreateColumn.column.name } 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
name :: Text
$sel:name:Column :: Column -> Text
name } -> Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
columnName
                                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 = Column
addColumn.name } 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
$sel:columnName:StatementCreateTable :: Statement -> Text
columnName :: 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
$sel:name:Column :: Column -> Text
name :: Text
name } -> Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
columnName

                        updateConstraint :: Statement
updateConstraint = if Column
dropColumn.isUnique
                            then DropConstraint { Text
$sel:tableName:StatementCreateTable :: Text
tableName :: 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
<> (Column
dropColumn.name) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_key" }
                            else AddConstraint { Text
$sel:tableName:StatementCreateTable :: Text
tableName :: Text
tableName, $sel:constraint:StatementCreateTable :: Constraint
constraint = UniqueConstraint { $sel:name:ForeignKeyConstraint :: Maybe Text
name = Maybe Text
forall a. Maybe a
Nothing, $sel:columnNames:ForeignKeyConstraint :: [Text]
columnNames = [Column
dropColumn.name] }, $sel:deferrable:StatementCreateTable :: Maybe Bool
deferrable = Maybe Bool
forall a. Maybe a
Nothing, $sel:deferrableType:StatementCreateTable :: Maybe DeferrableType
deferrableType = Maybe DeferrableType
forall a. Maybe a
Nothing }

                        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
$sel:columnName:StatementCreateTable :: Statement -> Text
columnName :: Text
columnName }):[Statement]
statements) = case Maybe Statement
matchingCreateColumn of
                        Just Statement
matchingCreateColumn -> case Statement
matchingCreateColumn.column.defaultValue of
                            Just Expression
value -> SetDefaultValue { Text
$sel:tableName:StatementCreateTable :: Text
tableName :: Text
tableName, Text
$sel:columnName:StatementCreateTable :: Text
columnName :: Text
columnName, Expression
value :: Expression
$sel:value:StatementCreateTable :: Expression
value }Statement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
:[Statement]
rest
                            Maybe Expression
Nothing -> DropDefaultValue { Text
$sel:tableName:StatementCreateTable :: Text
tableName :: Text
tableName, Text
$sel:columnName:StatementCreateTable :: Text
columnName :: 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
$sel:name:Column :: Column -> Text
name :: Text
name } -> Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
columnName

                        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
$sel:columnName:StatementCreateTable :: Statement -> Text
columnName :: 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
$sel:name:Column :: Column -> Text
name :: Text
name } -> Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
columnName

                        updateConstraint :: Statement
updateConstraint = if Column
dropColumn.notNull
                            then DropNotNull { Text
$sel:tableName:StatementCreateTable :: Text
tableName :: Text
tableName, $sel:columnName:StatementCreateTable :: Text
columnName = Column
dropColumn.name }
                            else SetNotNull { Text
$sel:tableName:StatementCreateTable :: Text
tableName :: Text
tableName, $sel:columnName:StatementCreateTable :: Text
columnName = Column
dropColumn.name }

                        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
$sel:name:StatementCreateTable :: Statement -> Text
name :: 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 { $sel:enumName:StatementCreateTable :: Text
enumName = Text
name, $sel:newValue:StatementCreateTable :: Text
newValue = Text
value, $sel:ifNotExists:StatementCreateTable :: Bool
ifNotExists = Bool
True }

getAppDBSchema :: Text -> IO [Statement]
getAppDBSchema :: Text -> IO [Statement]
getAppDBSchema Text
databaseUrl = do
    Text
sql <- Text -> IO Text
dumpAppDatabaseSchema Text
databaseUrl
    case Text -> Either ByteString [Statement]
parseDumpedSql Text
sql of
        Left ByteString
error -> String -> IO [Statement]
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (ByteString -> String
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
error)
        Right [Statement]
result -> [Statement] -> IO [Statement]
forall a. a -> IO a
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 :: Text -> IO Text
dumpAppDatabaseSchema :: Text -> IO Text
dumpAppDatabaseSchema Text
databaseUrl = do
    String
projectDir <- IO String
Directory.getCurrentDirectory
    String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text) -> IO String -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> String -> IO String
Process.readProcess String
"pg_dump" [String
"-s", String
"--no-owner", String
"--no-acl", Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs Text
databaseUrl] []

parseDumpedSql :: Text -> (Either ByteString [Statement])
parseDumpedSql :: Text -> Either ByteString [Statement]
parseDumpedSql Text
sql =
    case Parsec Void Text [Statement]
-> String
-> Text
-> Either (ParseErrorBundle Text Void) [Statement]
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser Parsec Void Text [Statement]
Parser.parseDDL String
"pg_dump" Text
sql of
        Left ParseErrorBundle Text Void
error -> ByteString -> Either ByteString [Statement]
forall a b. a -> Either a b
Left (String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
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 { $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
$sel:tableName:StatementCreateTable :: Statement -> Text
tableName :: Text
tableName, Constraint
$sel:constraint:StatementCreateTable :: Statement -> Constraint
constraint :: Constraint
constraint, Maybe Bool
$sel:deferrable:StatementCreateTable :: Statement -> Maybe Bool
deferrable :: Maybe Bool
deferrable, Maybe DeferrableType
$sel:deferrableType:StatementCreateTable :: Statement -> Maybe DeferrableType
deferrableType :: Maybe DeferrableType
deferrableType } = [ AddConstraint { Text
$sel:tableName:StatementCreateTable :: Text
tableName :: Text
tableName, $sel:constraint:StatementCreateTable :: Constraint
constraint = Text -> Constraint -> Constraint
normalizeConstraint Text
tableName Constraint
constraint, Maybe Bool
$sel:deferrable:StatementCreateTable :: Maybe Bool
deferrable :: Maybe Bool
deferrable, Maybe DeferrableType
$sel:deferrableType:StatementCreateTable :: Maybe DeferrableType
deferrableType :: Maybe DeferrableType
deferrableType } ]
normalizeStatement CreateEnumType { Text
$sel:name:StatementCreateTable :: Statement -> Text
name :: Text
name, [Text]
$sel:values:StatementCreateTable :: Statement -> [Text]
values :: [Text]
values } = [ 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
$sel:name:StatementCreateTable :: Statement -> Text
name :: Text
name, Maybe PolicyAction
action :: Maybe PolicyAction
$sel:action:StatementCreateTable :: Statement -> Maybe PolicyAction
action, Text
$sel:tableName:StatementCreateTable :: Statement -> Text
tableName :: Text
tableName, Maybe Expression
using :: Maybe Expression
$sel:using:StatementCreateTable :: Statement -> Maybe Expression
using, Maybe Expression
check :: Maybe Expression
$sel:check:StatementCreateTable :: Statement -> Maybe Expression
check } = [ CreatePolicy { $sel:name:StatementCreateTable :: Text
name = Text -> Text
truncateIdentifier Text
name, Text
$sel:tableName:StatementCreateTable :: Text
tableName :: Text
tableName, $sel:using:StatementCreateTable :: Maybe Expression
using = (Text -> Expression -> Expression
unqualifyExpression Text
tableName (Expression -> Expression)
-> (Expression -> Expression) -> Expression -> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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 = (Text -> Expression -> Expression
unqualifyExpression Text
tableName (Expression -> Expression)
-> (Expression -> Expression) -> Expression -> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Expression -> Expression
normalizeExpression) (Expression -> Expression) -> Maybe Expression -> Maybe Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Expression
check, $sel:action:StatementCreateTable :: Maybe PolicyAction
action = Maybe PolicyAction -> Maybe PolicyAction
normalizePolicyAction Maybe PolicyAction
action } ]
normalizeStatement CreateIndex { [IndexColumn]
columns :: [IndexColumn]
$sel:columns:StatementCreateTable :: Statement -> [IndexColumn]
columns, Maybe IndexType
indexType :: Maybe IndexType
$sel:indexType:StatementCreateTable :: Statement -> Maybe IndexType
indexType, Text
$sel:indexName:StatementCreateTable :: Statement -> Text
indexName :: Text
indexName, Bool
Maybe Expression
Text
$sel:tableName:StatementCreateTable :: Statement -> Text
unique :: Bool
tableName :: Text
whereClause :: Maybe Expression
$sel:unique:StatementCreateTable :: Statement -> Bool
$sel:whereClause:StatementCreateTable :: Statement -> Maybe Expression
.. } = [ CreateIndex { $sel:columns:StatementCreateTable :: [IndexColumn]
columns = (IndexColumn -> IndexColumn) -> [IndexColumn] -> [IndexColumn]
forall a b. (a -> b) -> [a] -> [b]
map IndexColumn -> IndexColumn
normalizeIndexColumn [IndexColumn]
columns, $sel:indexType:StatementCreateTable :: Maybe IndexType
indexType = Maybe IndexType -> Maybe IndexType
normalizeIndexType Maybe IndexType
indexType, $sel:indexName:StatementCreateTable :: Text
indexName = Text -> Text
truncateIdentifier Text
indexName, Bool
Maybe Expression
Text
$sel:tableName:StatementCreateTable :: Text
unique :: Bool
tableName :: Text
whereClause :: Maybe Expression
$sel:unique:StatementCreateTable :: Bool
$sel:whereClause:StatementCreateTable :: Maybe Expression
.. } ]
normalizeStatement CreateFunction { Bool
[(Text, PostgresType)]
Text
PostgresType
$sel:functionName:StatementCreateTable :: Statement -> Text
$sel:orReplace:StatementCreateTable :: Statement -> Bool
functionName :: Text
functionArguments :: [(Text, PostgresType)]
functionBody :: Text
orReplace :: Bool
returns :: PostgresType
language :: Text
$sel:functionArguments:StatementCreateTable :: Statement -> [(Text, PostgresType)]
$sel:functionBody:StatementCreateTable :: Statement -> Text
$sel:returns:StatementCreateTable :: Statement -> PostgresType
$sel:language:StatementCreateTable :: Statement -> Text
.. } = [ CreateFunction { $sel:orReplace:StatementCreateTable :: Bool
orReplace = Bool
False, $sel:language:StatementCreateTable :: Text
language = Text -> Text
Text.toUpper Text
language, $sel:functionBody:StatementCreateTable :: Text
functionBody = Text -> Text
removeIndentation (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
normalizeNewLines Text
functionBody, [(Text, PostgresType)]
Text
PostgresType
$sel:functionName:StatementCreateTable :: Text
functionName :: Text
functionArguments :: [(Text, PostgresType)]
returns :: PostgresType
$sel:functionArguments:StatementCreateTable :: [(Text, PostgresType)]
$sel:returns:StatementCreateTable :: PostgresType
.. } ]
normalizeStatement Statement
otherwise = [Statement
otherwise]

normalizePolicyAction :: Maybe PolicyAction -> Maybe PolicyAction
normalizePolicyAction (Just PolicyAction
PolicyForAll) = Maybe PolicyAction
forall a. Maybe a
Nothing
normalizePolicyAction Maybe PolicyAction
otherwise = Maybe PolicyAction
otherwise

normalizeTable :: CreateTable -> (CreateTable, [Statement])
normalizeTable :: CreateTable -> (CreateTable, [Statement])
normalizeTable table :: CreateTable
table@(CreateTable { Bool
[Constraint]
[Column]
Text
PrimaryKeyConstraint
$sel:name:CreateTable :: CreateTable -> Text
$sel:columns:CreateTable :: CreateTable -> [Column]
name :: Text
columns :: [Column]
primaryKeyConstraint :: PrimaryKeyConstraint
constraints :: [Constraint]
unlogged :: Bool
$sel:primaryKeyConstraint:CreateTable :: CreateTable -> PrimaryKeyConstraint
$sel:constraints:CreateTable :: CreateTable -> [Constraint]
$sel:unlogged:CreateTable :: CreateTable -> Bool
.. }) = ( 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, Bool
Text
PrimaryKeyConstraint
$sel:name:CreateTable :: Text
name :: Text
primaryKeyConstraint :: PrimaryKeyConstraint
unlogged :: Bool
$sel:primaryKeyConstraint:CreateTable :: PrimaryKeyConstraint
$sel:unlogged:CreateTable :: Bool
.. }, ([[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 { $sel:tableName:StatementCreateTable :: Text
tableName = Text
name, $sel:constraint:StatementCreateTable :: Constraint
constraint = Constraint
checkConstraint, $sel:deferrable:StatementCreateTable :: Maybe Bool
deferrable = Maybe Bool
forall a. Maybe a
Nothing, $sel:deferrableType:StatementCreateTable :: Maybe DeferrableType
deferrableType = Maybe DeferrableType
forall a. Maybe a
Nothing }
                    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 :: Text -> Constraint -> Constraint
normalizeConstraint :: Text -> Constraint -> Constraint
normalizeConstraint Text
_ ForeignKeyConstraint { Maybe Text
$sel:name:ForeignKeyConstraint :: Constraint -> Maybe Text
name :: Maybe Text
name, Text
columnName :: Text
$sel:columnName:ForeignKeyConstraint :: Constraint -> Text
columnName, Text
referenceTable :: Text
$sel:referenceTable:ForeignKeyConstraint :: Constraint -> Text
referenceTable, Maybe Text
referenceColumn :: Maybe Text
$sel:referenceColumn:ForeignKeyConstraint :: Constraint -> Maybe Text
referenceColumn, Maybe OnDelete
onDelete :: Maybe OnDelete
$sel:onDelete:ForeignKeyConstraint :: Constraint -> Maybe OnDelete
onDelete } = ForeignKeyConstraint { Maybe Text
$sel:name:ForeignKeyConstraint :: Maybe Text
name :: 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 a b. (a -> b) -> Maybe a -> Maybe b
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 Text
tableName constraint :: Constraint
constraint@(UniqueConstraint { $sel:name:ForeignKeyConstraint :: Constraint -> Maybe Text
name = Just Text
uniqueName, [Text]
$sel:columnNames:ForeignKeyConstraint :: Constraint -> [Text]
columnNames :: [Text]
columnNames }) | [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
columnNames Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 =
        -- Single column UNIQUE constraints like:
        --
        -- > ALTER TABLE ONLY public.users ADD CONSTRAINT users_github_user_id_key UNIQUE (github_user_id);
        --
        -- are packed into the CREATE TABLE definition:
        --
        -- > CREATE TABLE users (
        -- >     id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
        -- >     github_user_id INT DEFAULT NULL UNIQUE
        -- > );
        --
        -- For multi columns we need to normalize the name, e.g.:
        --
        -- > ALTER TABLE days ADD UNIQUE (category_id, date);
        --
        -- Is the same as:
        --
        -- > ALTER TABLE ONLY public.days ADD CONSTRAINT days_category_id_date_key UNIQUE (category_id, date);
        --
        let
            defaultName :: Text
defaultName = ([Text
tableName] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
columnNames [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
"key"])
                    [Text] -> ([Text] -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> [Text] -> Text
Text.intercalate Text
"_" 
        in
            if Text
uniqueName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
defaultName
                then Constraint
constraint { $sel:name:ForeignKeyConstraint :: Maybe Text
name = Maybe Text
forall a. Maybe a
Nothing }
                else Constraint
constraint
normalizeConstraint Text
_ Constraint
otherwise = Constraint
otherwise

normalizeColumn :: CreateTable -> Column -> (Column, [Statement])
normalizeColumn :: CreateTable -> Column -> (Column, [Statement])
normalizeColumn CreateTable
table Column { Text
$sel:name:Column :: Column -> Text
name :: Text
name, PostgresType
columnType :: PostgresType
$sel:columnType:Column :: Column -> 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, Maybe ColumnGenerator
generator :: Maybe ColumnGenerator
$sel:generator:Column :: Column -> Maybe ColumnGenerator
generator } = (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
$sel:notNull:Column :: Bool
notNull :: Bool
notNull, $sel:isUnique:Column :: Bool
isUnique = Bool
False, $sel:generator:Column :: Maybe ColumnGenerator
generator = ColumnGenerator -> ColumnGenerator
normalizeColumnGenerator (ColumnGenerator -> ColumnGenerator)
-> Maybe ColumnGenerator -> Maybe ColumnGenerator
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ColumnGenerator
generator }, [Statement]
uniqueConstraint)
    where
        uniqueConstraint :: [Statement]
uniqueConstraint =
            if Bool
isUnique
                then [ AddConstraint { $sel:tableName:StatementCreateTable :: Text
tableName = CreateTable
table.name, $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
$ (CreateTable
table.name) 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], $sel:deferrable:StatementCreateTable :: Maybe Bool
deferrable = Maybe Bool
forall a. Maybe a
Nothing, $sel:deferrableType:StatementCreateTable :: Maybe DeferrableType
deferrableType = Maybe DeferrableType
forall a. Maybe a
Nothing } ]
                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 Bool -> Bool -> Bool
|| Maybe ColumnGenerator -> Bool
forall a. Maybe a -> Bool
isJust Maybe ColumnGenerator
generator
                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

normalizeColumnGenerator :: ColumnGenerator -> ColumnGenerator
normalizeColumnGenerator :: ColumnGenerator -> ColumnGenerator
normalizeColumnGenerator generator :: ColumnGenerator
generator@(ColumnGenerator { Expression
generate :: Expression
$sel:generate:ColumnGenerator :: ColumnGenerator -> Expression
generate }) = ColumnGenerator
generator { $sel:generate:ColumnGenerator :: Expression
generate = Expression -> Expression
normalizeExpression Expression
generate }

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 (InExpression Expression
a Expression
b) = Expression -> Expression -> Expression
InExpression (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
normalizeExpression (ConcatenationExpression Expression
a Expression
b) = Expression -> Expression -> Expression
ConcatenationExpression (Expression -> Expression
normalizeExpression Expression
a) (Expression -> Expression
normalizeExpression Expression
b)
-- 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]
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 { $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
_) 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)

-- | Replaces @table.field@ with just @field@
--
-- >>> unqualifyExpression "servers" (sql "SELECT * FROM servers WHERE servers.is_public")
-- sql "SELECT * FROM servers WHERE is_public"
--
unqualifyExpression :: Text -> Expression -> Expression
unqualifyExpression :: Text -> Expression -> Expression
unqualifyExpression Text
scope Expression
expression = Expression -> Expression
doUnqualify Expression
expression
    where
        doUnqualify :: Expression -> Expression
doUnqualify e :: Expression
e@(TextExpression {}) = Expression
e
        doUnqualify e :: Expression
e@(VarExpression {}) = Expression
e
        doUnqualify (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
doUnqualify [Expression]
args)
        doUnqualify (NotEqExpression Expression
a Expression
b) = Expression -> Expression -> Expression
NotEqExpression (Expression -> Expression
doUnqualify Expression
a) (Expression -> Expression
doUnqualify Expression
b)
        doUnqualify (EqExpression Expression
a Expression
b) = Expression -> Expression -> Expression
EqExpression (Expression -> Expression
doUnqualify Expression
a) (Expression -> Expression
doUnqualify Expression
b)
        doUnqualify (AndExpression Expression
a Expression
b) = Expression -> Expression -> Expression
AndExpression (Expression -> Expression
doUnqualify Expression
a) (Expression -> Expression
doUnqualify Expression
b)
        doUnqualify (IsExpression Expression
a Expression
b) = Expression -> Expression -> Expression
IsExpression (Expression -> Expression
doUnqualify Expression
a) (Expression -> Expression
doUnqualify Expression
b)
        doUnqualify (InExpression Expression
a Expression
b) = Expression -> Expression -> Expression
InExpression (Expression -> Expression
doUnqualify Expression
a) (Expression -> Expression
doUnqualify Expression
b)
        doUnqualify (NotExpression Expression
a) = Expression -> Expression
NotExpression (Expression -> Expression
doUnqualify Expression
a)
        doUnqualify (OrExpression Expression
a Expression
b) = Expression -> Expression -> Expression
OrExpression (Expression -> Expression
doUnqualify Expression
a) (Expression -> Expression
doUnqualify Expression
b)
        doUnqualify (LessThanExpression Expression
a Expression
b) = Expression -> Expression -> Expression
LessThanExpression (Expression -> Expression
doUnqualify Expression
a) (Expression -> Expression
doUnqualify Expression
b)
        doUnqualify (LessThanOrEqualToExpression Expression
a Expression
b) = Expression -> Expression -> Expression
LessThanOrEqualToExpression (Expression -> Expression
doUnqualify Expression
a) (Expression -> Expression
doUnqualify Expression
b)
        doUnqualify (GreaterThanExpression Expression
a Expression
b) = Expression -> Expression -> Expression
GreaterThanExpression (Expression -> Expression
doUnqualify Expression
a) (Expression -> Expression
doUnqualify Expression
b)
        doUnqualify (GreaterThanOrEqualToExpression Expression
a Expression
b) = Expression -> Expression -> Expression
GreaterThanOrEqualToExpression (Expression -> Expression
doUnqualify Expression
a) (Expression -> Expression
doUnqualify Expression
b)
        doUnqualify e :: Expression
e@(DoubleExpression {}) = Expression
e
        doUnqualify e :: Expression
e@(IntExpression {}) = Expression
e
        doUnqualify (ConcatenationExpression Expression
a Expression
b) = Expression -> Expression -> Expression
ConcatenationExpression (Expression -> Expression
doUnqualify Expression
a) (Expression -> Expression
doUnqualify Expression
b)
        doUnqualify (TypeCastExpression Expression
a PostgresType
b) = Expression -> PostgresType -> Expression
TypeCastExpression (Expression -> Expression
doUnqualify Expression
a) PostgresType
b
        doUnqualify e :: Expression
e@(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 }) =
            let recurse :: Expression -> Expression
recurse = case Expression
from of
                    VarExpression Text
fromName -> Expression -> Expression
doUnqualify (Expression -> Expression)
-> (Expression -> Expression) -> Expression -> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Expression -> Expression
unqualifyExpression Text
fromName
                    DotExpression (VarExpression Text
"public") Text
fromName -> Expression -> Expression
doUnqualify (Expression -> Expression)
-> (Expression -> Expression) -> Expression -> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Expression -> Expression
unqualifyExpression Text
fromName
                    Expression
_ -> Expression -> Expression
doUnqualify
            in
                Select -> Expression
SelectExpression Select { $sel:columns:Select :: [Expression]
columns = (Expression -> Expression
recurse (Expression -> Expression) -> [Expression] -> [Expression]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expression]
columns), $sel:from:Select :: Expression
from = Expression
from, $sel:whereClause:Select :: Expression
whereClause = Expression -> Expression
recurse Expression
whereClause, Maybe Text
$sel:alias:Select :: Maybe Text
alias :: Maybe Text
alias }
        doUnqualify (ExistsExpression Expression
a) = Expression -> Expression
ExistsExpression (Expression -> Expression
doUnqualify Expression
a)
        doUnqualify (DotExpression (VarExpression Text
scope') Text
b) | Text
scope Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
scope' = Text -> Expression
VarExpression Text
b
        doUnqualify (DotExpression Expression
a Text
b) = Expression -> Text -> Expression
DotExpression (Expression -> Expression
doUnqualify Expression
a) Text
b


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@(InExpression Expression
a Expression
b) -> Expression -> Expression -> Expression
InExpression (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]
$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 { $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
$sel:filePath:CreateFile :: GeneratorAction -> Text
filePath :: 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
$sel:tableName:StatementCreateTable :: Statement -> Text
tableName :: Text
tableName, $sel:constraint:StatementCreateTable :: Statement -> Constraint
constraint = AlterTableAddPrimaryKey { PrimaryKeyConstraint
primaryKeyConstraint :: 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
$sel:name:CreateTable :: CreateTable -> Text
name :: Text
name }) } | Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
tableName -> 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]
primaryKeyColumnNames :: [Text]
$sel:primaryKeyColumnNames:PrimaryKeyConstraint :: PrimaryKeyConstraint -> [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 { $sel:primaryKeyColumnNames:PrimaryKeyConstraint :: [Text]
primaryKeyColumnNames = [Text]
existingPKs [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
primaryKeyColumnNames } }


-- | Removes @DROP INDEX ..@ statements and other that appear after a @DROP TABLE@ statement. The @DROP TABLE ..@ statement
-- itself already removes indexes and foreigns keys on that table. So an @DROP INDEX ..@ would then fail.
--
-- Shrinks a sequence like this:
--
-- > DROP TABLE a;
-- > DROP INDEX some_index_on_table_a;
-- > ALTER TABLE a DROP CONSTRAINT some_constraint_on_table_a;
--
-- Into this:
--
-- > DROP TABLE a;
--
removeImplicitDeletions :: [Statement] -> [Statement] -> [Statement]
removeImplicitDeletions :: [Statement] -> [Statement] -> [Statement]
removeImplicitDeletions [Statement]
actualSchema (statement :: Statement
statement@Statement
dropStatement:[Statement]
rest) | Statement -> Bool
isDropStatement Statement
dropStatement = Statement
statementStatement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
:((Statement -> Bool) -> [Statement] -> [Statement]
forall a. (a -> Bool) -> [a] -> [a]
filter Statement -> Bool
isImplicitlyDeleted [Statement]
rest)
    where
        isImplicitlyDeleted :: Statement -> Bool
isImplicitlyDeleted (DropIndex { Text
$sel:indexName:StatementCreateTable :: Statement -> Text
indexName :: Text
indexName }) = case Text -> Maybe Statement
findIndexByName Text
indexName of
                Just CreateIndex { $sel:tableName:StatementCreateTable :: Statement -> Text
tableName = Text
indexTableName, $sel:columns:StatementCreateTable :: Statement -> [IndexColumn]
columns = [IndexColumn]
indexColumns } -> Text
indexTableName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
dropTableName Bool -> Bool -> Bool
&& (
                        case Maybe Text
dropColumnName of
                            Just Text
dropColumnName -> [IndexColumn]
indexColumns
                                    [IndexColumn]
-> ([IndexColumn] -> Maybe IndexColumn) -> Maybe IndexColumn
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (IndexColumn -> Bool) -> [IndexColumn] -> Maybe IndexColumn
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\IndexColumn { Expression
column :: Expression
$sel:column:IndexColumn :: IndexColumn -> Expression
column } -> Expression
column Expression -> Expression -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Expression
VarExpression Text
dropColumnName)
                                    Maybe IndexColumn -> (Maybe IndexColumn -> Bool) -> Bool
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Maybe IndexColumn -> Bool
forall a. Maybe a -> Bool
isNothing
                            Maybe Text
Nothing -> Bool
True
                    )
                Maybe Statement
Nothing -> Bool
True
        isImplicitlyDeleted (DropConstraint { $sel:tableName:StatementCreateTable :: Statement -> Text
tableName = Text
constraintTableName }) = Text
constraintTableName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
dropTableName
        isImplicitlyDeleted (DropPolicy { $sel:tableName:StatementCreateTable :: Statement -> Text
tableName = Text
policyTableName }) = Bool -> Bool
not (Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Text
dropColumnName Bool -> Bool -> Bool
&& Text
policyTableName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
dropTableName)
        isImplicitlyDeleted Statement
otherwise = Bool
True

        findIndexByName :: Text -> Maybe Statement
        findIndexByName :: Text -> Maybe Statement
findIndexByName Text
name = (Statement -> Bool) -> [Statement] -> Maybe Statement
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Text -> Statement -> Bool
isIndex Text
name) [Statement]
actualSchema

        isIndex :: Text -> Statement -> Bool
        isIndex :: Text -> Statement -> Bool
isIndex Text
name CreateIndex { Text
$sel:indexName:StatementCreateTable :: Statement -> Text
indexName :: Text
indexName } = Text
indexName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name
        isIndex Text
_    Statement
_                         = Bool
False

        isDropStatement :: Statement -> Bool
isDropStatement DropTable {} = Bool
True
        isDropStatement DropColumn {} = Bool
True
        isDropStatement Statement
_ = Bool
False

        (Text
dropTableName, Maybe Text
dropColumnName) = case Statement
dropStatement of
            DropTable { Text
$sel:tableName:StatementCreateTable :: Statement -> Text
tableName :: Text
tableName } -> (Text
tableName, Maybe Text
forall a. Maybe a
Nothing)
            DropColumn { Text
$sel:tableName:StatementCreateTable :: Statement -> Text
tableName :: Text
tableName, Text
$sel:columnName:StatementCreateTable :: Statement -> Text
columnName :: Text
columnName } -> (Text
tableName, Text -> Maybe Text
forall a. a -> Maybe a
Just Text
columnName)
removeImplicitDeletions [Statement]
actualSchema (Statement
statement:[Statement]
rest) = Statement
statementStatement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
:([Statement] -> [Statement] -> [Statement]
removeImplicitDeletions [Statement]
actualSchema [Statement]
rest)
removeImplicitDeletions [Statement]
actualSchema [] = []

-- | Moves statements that add enum values outside the database transaction
--
-- When IHP generates a migration that contains a statement like this:
--
-- > ALTER TYPE my_enum ADD VALUE 'some_value';
--
-- the migration will fail with this error:
--
-- > Query (89.238182ms): "BEGIN" ()
-- > migrate: SqlError {sqlState = "25001", sqlExecStatus = FatalError, sqlErrorMsg = "ALTER TYPE ... ADD cannot run inside a transaction block", sqlErrorDetail = "", sqlErrorHint = ""}
--
-- This function moves the @ADD VALUE@ statement outside the main database transaction:
--
-- > COMMIT; -- Commit the transaction previously started by IHP
-- > ALTER TYPE my_enum ADD VALUE 'some_value';
-- > BEGIN; -- Restart the connection as IHP will also try to run it's own COMMIT
--
disableTransactionWhileAddingEnumValues :: [Statement] -> [Statement]
disableTransactionWhileAddingEnumValues :: [Statement] -> [Statement]
disableTransactionWhileAddingEnumValues [Statement]
statements =
        if [Statement] -> Bool
forall value. IsEmpty value => value -> Bool
isEmpty [Statement]
addEnumValueStatements
            then [Statement]
otherStatements
            else [Text -> Statement
Comment Text
" Commit the transaction previously started by IHP", Statement
Commit] [Statement] -> [Statement] -> [Statement]
forall a. Semigroup a => a -> a -> a
<> ((Statement -> Statement) -> [Statement] -> [Statement]
forall a b. (a -> b) -> [a] -> [b]
map Statement -> Statement
enableIfNotExists [Statement]
addEnumValueStatements) [Statement] -> [Statement] -> [Statement]
forall a. Semigroup a => a -> a -> a
<> [Text -> Statement
Comment Text
" Restart the connection as IHP will also try to run it's own COMMIT", Statement
Begin] [Statement] -> [Statement] -> [Statement]
forall a. Semigroup a => a -> a -> a
<> [Statement]
otherStatements
    where
        ([Statement]
addEnumValueStatements, [Statement]
otherStatements) = (Statement -> Bool) -> [Statement] -> ([Statement], [Statement])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Statement -> Bool
isAddEnumValueStatement [Statement]
statements

        isAddEnumValueStatement :: Statement -> Bool
isAddEnumValueStatement AddValueToEnumType {} = Bool
True
        isAddEnumValueStatement Statement
otherwise = Bool
False

        enableIfNotExists :: Statement -> Statement
enableIfNotExists statement :: Statement
statement@(AddValueToEnumType { Bool
Text
$sel:enumName:StatementCreateTable :: Statement -> Text
$sel:newValue:StatementCreateTable :: Statement -> Text
$sel:ifNotExists:StatementCreateTable :: Statement -> Bool
enumName :: Text
newValue :: Text
ifNotExists :: Bool
.. }) = Statement
statement { $sel:ifNotExists:StatementCreateTable :: Bool
ifNotExists = Bool
True }
        enableIfNotExists Statement
otherwise = Statement
otherwise

normalizeIndexType :: Maybe IndexType -> Maybe IndexType
normalizeIndexType :: Maybe IndexType -> Maybe IndexType
normalizeIndexType (Just IndexType
Btree) = Maybe IndexType
forall a. Maybe a
Nothing
normalizeIndexType Maybe IndexType
indexType = Maybe IndexType
indexType

normalizeIndexColumn :: IndexColumn -> IndexColumn
normalizeIndexColumn :: IndexColumn -> IndexColumn
normalizeIndexColumn IndexColumn { Expression
$sel:column:IndexColumn :: IndexColumn -> Expression
column :: Expression
column, [IndexColumnOrder]
columnOrder :: [IndexColumnOrder]
$sel:columnOrder:IndexColumn :: IndexColumn -> [IndexColumnOrder]
columnOrder } =
    IndexColumn
        { $sel:column:IndexColumn :: Expression
column = Expression -> Expression
normalizeExpression Expression
column
        , $sel:columnOrder:IndexColumn :: [IndexColumnOrder]
columnOrder = [IndexColumnOrder] -> [IndexColumnOrder]
normalizeIndexColumnOrder [IndexColumnOrder]
columnOrder
        }

normalizeIndexColumnOrder :: [IndexColumnOrder] -> [IndexColumnOrder]
normalizeIndexColumnOrder :: [IndexColumnOrder] -> [IndexColumnOrder]
normalizeIndexColumnOrder [IndexColumnOrder]
columnOrder = [IndexColumnOrder]
columnOrder [IndexColumnOrder]
-> ([IndexColumnOrder] -> [IndexColumnOrder]) -> [IndexColumnOrder]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (IndexColumnOrder -> Bool)
-> [IndexColumnOrder] -> [IndexColumnOrder]
forall a. (a -> Bool) -> [a] -> [a]
filter (IndexColumnOrder -> IndexColumnOrder -> Bool
forall a. Eq a => a -> a -> Bool
/=IndexColumnOrder
Asc)

normalizeNewLines :: Text -> Text
normalizeNewLines :: Text -> Text
normalizeNewLines Text
text =
    Text
text
    Text -> (Text -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"\r\n" Text
"\n"
    Text -> (Text -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"\r" Text
"\n"


removeIndentation :: Text -> Text
removeIndentation :: Text -> Text
removeIndentation Text
text =
        [Text]
lines
        [Text] -> ([Text] -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
line -> if Text
line Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"BEGIN"
                then Int -> Text -> Text
Text.drop Int
spacesToDrop Text
line
                else Text
line)
        [Text] -> ([Text] -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> [Text] -> Text
Text.unlines
        Text -> (Text -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Char -> Bool) -> Text -> Text
Text.dropAround (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n')
    where
        lines :: [Text]
        lines :: [Text]
lines = Text
text
                Text -> (Text -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> [Text]
Text.lines
        spaces :: [Int]
        spaces :: [Int]
spaces = [Text]
lines
                [Text] -> ([Text] -> [Text]) -> [Text]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Text
line -> Text
line Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"" Bool -> Bool -> Bool
&& Text
line Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"BEGIN")
                [Text] -> ([Text] -> [Int]) -> [Int]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Text -> Int) -> [Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
line -> Text -> Int
Text.length ((Char -> Bool) -> Text -> Text
Text.takeWhile Char -> Bool
Char.isSpace Text
line))
        spacesToDrop :: Int
spacesToDrop = [Int]
spaces [Int] -> ([Int] -> Int) -> Int
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum

-- | Postgres truncates identifiers longer than 63 characters.
--
-- This function truncates a Text to 63 chars max. This way we avoid unnecssary changes in the generated migrations.
truncateIdentifier :: Text -> Text
truncateIdentifier :: Text -> Text
truncateIdentifier Text
identifier =
    if Text -> Int
Text.length Text
identifier Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
63
        then Int -> Text -> Text
Text.take Int
63 Text
identifier
        else Text
identifier