module IHP.IDE.SchemaDesigner.Controller.Migrations where

import IHP.ControllerPrelude
import IHP.IDE.ToolServer.Types

import IHP.IDE.SchemaDesigner.View.Migrations.Index
import IHP.IDE.SchemaDesigner.View.Migrations.New
import IHP.IDE.SchemaDesigner.View.Migrations.Edit

import IHP.IDE.SchemaDesigner.Types
import IHP.IDE.SchemaDesigner.View.Layout (schemaDesignerLayout, findStatementByName, replace, findForeignKey, findTableIndex)
import IHP.IDE.SchemaDesigner.Controller.Helper
import IHP.IDE.SchemaDesigner.Controller.Validation

import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import qualified Data.Maybe as Maybe
import qualified Data.List as List

import qualified IHP.IDE.SchemaDesigner.SchemaOperations as SchemaOperations
import qualified IHP.SchemaMigration as SchemaMigration
import qualified IHP.IDE.CodeGen.MigrationGenerator as MigrationGenerator
import IHP.IDE.CodeGen.Controller
import IHP.IDE.ToolServer.Helper.Controller (openEditor, clearDatabaseNeedsMigration)
import IHP.Log.Types
import qualified Control.Exception as Exception
import qualified System.Directory as Directory
import qualified Database.PostgreSQL.Simple as PG
import qualified Database.PostgreSQL.Simple.Types as PG

instance Controller MigrationsController where
    beforeAction :: IO ()
beforeAction = (?context::ControllerContext) =>
((?context::ControllerContext) => Layout) -> IO ()
((?context::ControllerContext) => Layout) -> IO ()
setLayout (?context::ControllerContext) => Layout
Html -> Html
schemaDesignerLayout

    action :: MigrationsController -> IO ()
action MigrationsController
MigrationsAction = do
        [Migration]
migrations <- IO [Migration]
findRecentMigrations
        [Int]
migratedRevisions <- IO [Int]
findMigratedRevisions

        [(Migration, Text)]
migrationsWithSql <- [Migration]
-> (Migration -> IO (Migration, Text)) -> IO [(Migration, Text)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Migration]
migrations ((Migration -> IO (Migration, Text)) -> IO [(Migration, Text)])
-> (Migration -> IO (Migration, Text)) -> IO [(Migration, Text)]
forall a b. (a -> b) -> a -> b
$ \Migration
migration -> do
                Text
sql <- Migration -> IO Text
readSqlStatements Migration
migration
                (Migration, Text) -> IO (Migration, Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Migration
migration, Text
sql)

        Maybe Text
lastError <- ByteString -> IO (Maybe Text)
forall value.
(?context::ControllerContext, Serialize value) =>
ByteString -> IO (Maybe value)
getSessionAndClear ByteString
"last_migraton_error"
        IndexView -> IO ()
forall view.
(View view, ?context::ControllerContext) =>
view -> IO ()
render IndexView :: [(Migration, Text)] -> [Int] -> Maybe Text -> IndexView
IndexView { [Int]
[(Migration, Text)]
Maybe Text
$sel:lastError:IndexView :: Maybe Text
$sel:migratedRevisions:IndexView :: [Int]
$sel:migrationsWithSql:IndexView :: [(Migration, Text)]
lastError :: Maybe Text
migrationsWithSql :: [(Migration, Text)]
migratedRevisions :: [Int]
.. }


    action MigrationsController
NewMigrationAction = do
        let description :: Text
description = Text -> ByteString -> Text
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Text
"" ByteString
"description"
        (Int
_, [GeneratorAction]
plan) <- Text -> Maybe Text -> IO (Int, [GeneratorAction])
MigrationGenerator.buildPlan Text
description Maybe Text
forall a. Maybe a
Nothing
        let runMigration :: Bool
runMigration = Bool -> ByteString -> Bool
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Bool
True ByteString
"runMigration"
        NewView -> IO ()
forall view.
(View view, ?context::ControllerContext) =>
view -> IO ()
render NewView :: [GeneratorAction] -> NewView
NewView { [GeneratorAction]
$sel:plan:NewView :: [GeneratorAction]
plan :: [GeneratorAction]
.. }

    action MigrationsController
CreateMigrationAction = do
        let description :: Text
description = Text -> ByteString -> Text
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Text
"" ByteString
"description"
        let sqlStatements :: Maybe Text
sqlStatements = ByteString -> Maybe Text
forall paramType.
(?context::ControllerContext, ParamReader (Maybe paramType)) =>
ByteString -> Maybe paramType
paramOrNothing ByteString
"sqlStatements"
        (Int
revision, [GeneratorAction]
plan) <- Text -> Maybe Text -> IO (Int, [GeneratorAction])
MigrationGenerator.buildPlan Text
description Maybe Text
sqlStatements
        let path :: Text
path = [GeneratorAction] -> Text
MigrationGenerator.migrationPathFromPlan [GeneratorAction]
plan

        [GeneratorAction] -> IO ()
executePlan [GeneratorAction]
plan

        let createOnly :: Bool
createOnly = Bool -> ByteString -> Bool
forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault Bool
False ByteString
"createOnly"
        if Bool
createOnly
            then do
                (?context::ControllerContext) => Text -> IO ()
Text -> IO ()
setSuccessMessage (Text
"Migration generated: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
path)
                Text -> Int -> Int -> IO ()
openEditor Text
path Int
0 Int
0
            else do
                Int -> IO ()
migrateAppDB Int
revision

        IO ()
(?context::ControllerContext) => IO ()
clearDatabaseNeedsMigration

        MigrationsController -> IO ()
forall action.
(?context::ControllerContext, HasPath action) =>
action -> IO ()
redirectTo MigrationsController
MigrationsAction

    action EditMigrationAction { Int
$sel:migrationId:MigrationsAction :: MigrationsController -> Int
migrationId :: Int
migrationId } = do
        Migration
migration <- Int -> IO Migration
findMigrationByRevision Int
migrationId
        Text
sqlStatements <- Migration -> IO Text
readSqlStatements Migration
migration

        EditView -> IO ()
forall view.
(View view, ?context::ControllerContext) =>
view -> IO ()
render EditView :: Migration -> Text -> EditView
EditView { Text
Migration
$sel:sqlStatements:EditView :: Text
$sel:migration:EditView :: Migration
sqlStatements :: Text
migration :: Migration
.. }

    action UpdateMigrationAction { Int
migrationId :: Int
$sel:migrationId:MigrationsAction :: MigrationsController -> Int
migrationId } = do
        Migration
migration <- Int -> IO Migration
findMigrationByRevision Int
migrationId
        let sqlStatements :: Text
sqlStatements = ByteString -> Text
forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"sqlStatements"

        FilePath -> Text -> IO ()
Text.writeFile (Text -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Migration -> Text
SchemaMigration.migrationPath Migration
migration) Text
sqlStatements

        MigrationsController -> IO ()
forall action.
(?context::ControllerContext, HasPath action) =>
action -> IO ()
redirectTo MigrationsController
MigrationsAction

    action DeleteMigrationAction { Int
migrationId :: Int
$sel:migrationId:MigrationsAction :: MigrationsController -> Int
migrationId } = do
        Migration
migration <- Int -> IO Migration
findMigrationByRevision Int
migrationId
        let path :: FilePath
path = Text -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Migration -> Text
SchemaMigration.migrationPath Migration
migration

        FilePath -> IO ()
Directory.removeFile FilePath
path

        MigrationsController -> IO ()
forall action.
(?context::ControllerContext, HasPath action) =>
action -> IO ()
redirectTo MigrationsController
MigrationsAction

    action RunMigrationAction { Int
migrationId :: Int
$sel:migrationId:MigrationsAction :: MigrationsController -> Int
migrationId } = do
        Migration
migration <- Int -> IO Migration
findMigrationByRevision Int
migrationId

        Either SomeException ()
result <- IO () -> IO (Either SomeException ())
forall e a. Exception e => IO a -> IO (Either e a)
Exception.try (Int -> IO ()
migrateAppDB Int
migrationId)
        case Either SomeException ()
result of
            Left (SomeException
exception :: SomeException) -> do
                let errorMessage :: Text
errorMessage = case SomeException -> Maybe EnhancedSqlError
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
exception of
                        Just (EnhancedSqlError
exception :: EnhancedSqlError) -> ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Proxy "sqlErrorMsg" -> SqlError -> ByteString
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "sqlErrorMsg" (Proxy "sqlErrorMsg")
Proxy "sqlErrorMsg"
#sqlErrorMsg (Proxy "sqlError" -> EnhancedSqlError -> SqlError
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "sqlError" (Proxy "sqlError")
Proxy "sqlError"
#sqlError EnhancedSqlError
exception)
                        Maybe EnhancedSqlError
Nothing -> SomeException -> Text
forall a. Show a => a -> Text
tshow SomeException
exception
                
                (?context::ControllerContext) => Text -> IO ()
Text -> IO ()
setErrorMessage Text
errorMessage
                MigrationsController -> IO ()
forall action.
(?context::ControllerContext, HasPath action) =>
action -> IO ()
redirectTo MigrationsController
MigrationsAction
            Right ()
_ -> do
                IO ()
(?context::ControllerContext) => IO ()
clearDatabaseNeedsMigration
                MigrationsController -> IO ()
forall action.
(?context::ControllerContext, HasPath action) =>
action -> IO ()
redirectTo MigrationsController
MigrationsAction

readSqlStatements :: SchemaMigration.Migration -> IO Text
readSqlStatements :: Migration -> IO Text
readSqlStatements Migration
migration = FilePath -> IO Text
Text.readFile (Text -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Migration -> Text
SchemaMigration.migrationPath Migration
migration)

findRecentMigrations :: IO [SchemaMigration.Migration]
findRecentMigrations :: IO [Migration]
findRecentMigrations = Int -> [Migration] -> [Migration]
forall a. Int -> [a] -> [a]
take Int
20 ([Migration] -> [Migration])
-> ([Migration] -> [Migration]) -> [Migration] -> [Migration]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Migration] -> [Migration]
forall a. [a] -> [a]
reverse ([Migration] -> [Migration]) -> IO [Migration] -> IO [Migration]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Migration]
SchemaMigration.findAllMigrations

findMigrationByRevision :: Int -> IO SchemaMigration.Migration
findMigrationByRevision :: Int -> IO Migration
findMigrationByRevision Int
migrationRevision = do
    [Migration]
migrations <- IO [Migration]
findRecentMigrations
    let (Just Migration
migration) = [Migration]
migrations [Migration] -> ([Migration] -> Maybe Migration) -> Maybe Migration
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> (Migration -> Bool) -> [Migration] -> Maybe Migration
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\SchemaMigration.Migration { Int
$sel:revision:Migration :: Migration -> Int
revision :: Int
revision } -> Int
revision Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
migrationRevision)
    Migration -> IO Migration
forall (f :: * -> *) a. Applicative f => a -> f a
pure Migration
migration

migrateAppDB :: Int -> IO ()
migrateAppDB :: Int -> IO ()
migrateAppDB Int
revision = ((?modelContext::ModelContext) => IO ()) -> IO ()
forall result.
((?modelContext::ModelContext) => IO result) -> IO result
withAppModelContext do
    let minimumRevision :: Maybe Int
minimumRevision = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
revision Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    (?modelContext::ModelContext) => MigrateOptions -> IO ()
MigrateOptions -> IO ()
SchemaMigration.migrate MigrateOptions :: Maybe Int -> MigrateOptions
SchemaMigration.MigrateOptions { Maybe Int
$sel:minimumRevision:MigrateOptions :: Maybe Int
minimumRevision :: Maybe Int
minimumRevision }

findMigratedRevisions :: IO [Int]
findMigratedRevisions :: IO [Int]
findMigratedRevisions = IO [Int] -> IO [Int]
forall a. IO [a] -> IO [a]
emptyListIfTablesDoesntExists (((?modelContext::ModelContext) => IO [Int]) -> IO [Int]
forall result.
((?modelContext::ModelContext) => IO result) -> IO result
withAppModelContext (?modelContext::ModelContext) => IO [Int]
SchemaMigration.findMigratedRevisions)
    where
        -- The schema_migrations table might not have been created yet
        -- In that case there cannot be any migrations that have been run yet
        emptyListIfTablesDoesntExists :: IO [a] -> IO [a]
emptyListIfTablesDoesntExists IO [a]
operation = do
            Either EnhancedSqlError [a]
result <- IO [a] -> IO (Either EnhancedSqlError [a])
forall e a. Exception e => IO a -> IO (Either e a)
Exception.try IO [a]
operation
            case Either EnhancedSqlError [a]
result of
                Left (EnhancedSqlError { SqlError
$sel:sqlError:EnhancedSqlError :: EnhancedSqlError -> SqlError
sqlError :: SqlError
sqlError }) | Proxy "sqlErrorMsg" -> SqlError -> ByteString
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "sqlErrorMsg" (Proxy "sqlErrorMsg")
Proxy "sqlErrorMsg"
#sqlErrorMsg SqlError
sqlError ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"relation \"schema_migrations\" does not exist" -> [a] -> IO [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
                Right [a]
result -> [a] -> IO [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a]
result

withAppModelContext :: ((?modelContext :: ModelContext) => IO result) -> IO result
withAppModelContext :: ((?modelContext::ModelContext) => IO result) -> IO result
withAppModelContext (?modelContext::ModelContext) => IO result
inner =
        IO (FrameworkConfig, Logger, ModelContext)
-> ((FrameworkConfig, Logger, ModelContext) -> IO ())
-> ((FrameworkConfig, Logger, ModelContext) -> IO result)
-> IO result
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Exception.bracket IO (FrameworkConfig, Logger, ModelContext)
initModelContext (FrameworkConfig, Logger, ModelContext) -> IO ()
forall a c. (a, Logger, c) -> IO ()
cleanupModelContext (FrameworkConfig, Logger, ModelContext) -> IO result
callback
    where
        callback :: (FrameworkConfig, Logger, ModelContext) -> IO result
callback (FrameworkConfig
frameworkConfig, Logger
logger, ModelContext
modelContext) = let ?modelContext = modelContext in IO result
(?modelContext::ModelContext) => IO result
inner
        initModelContext :: IO (FrameworkConfig, Logger, ModelContext)
initModelContext = do
            FrameworkConfig
frameworkConfig <- ConfigBuilder -> IO FrameworkConfig
buildFrameworkConfig (() -> ConfigBuilder
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
            Logger
logger <- IO Logger
defaultLogger

            ModelContext
modelContext <- NominalDiffTime -> Int -> ByteString -> Logger -> IO ModelContext
createModelContext
                (Proxy "dbPoolIdleTime" -> FrameworkConfig -> NominalDiffTime
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "dbPoolIdleTime" (Proxy "dbPoolIdleTime")
Proxy "dbPoolIdleTime"
#dbPoolIdleTime FrameworkConfig
frameworkConfig)
                (Proxy "dbPoolMaxConnections" -> FrameworkConfig -> Int
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "dbPoolMaxConnections" (Proxy "dbPoolMaxConnections")
Proxy "dbPoolMaxConnections"
#dbPoolMaxConnections FrameworkConfig
frameworkConfig)
                (Proxy "databaseUrl" -> FrameworkConfig -> ByteString
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "databaseUrl" (Proxy "databaseUrl")
Proxy "databaseUrl"
#databaseUrl FrameworkConfig
frameworkConfig)
                Logger
logger

            (FrameworkConfig, Logger, ModelContext)
-> IO (FrameworkConfig, Logger, ModelContext)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FrameworkConfig
frameworkConfig, Logger
logger, ModelContext
modelContext)

        cleanupModelContext :: (a, Logger, c) -> IO ()
cleanupModelContext (a
frameworkConfig, Logger
logger, c
modelContext) = do
            Logger
logger Logger -> (Logger -> IO ()) -> IO ()
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Logger -> IO ()
cleanup