content: 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.View.Layout (schemaDesignerLayout)
  
  import qualified Data.Text.IO as Text
  
  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.Safe as Exception
  import qualified System.Directory as Directory
  import qualified Database.PostgreSQL.Simple as PG
  
  instance Controller MigrationsController where
      beforeAction = setLayout schemaDesignerLayout
  
      action MigrationsAction = do
          migrations <- findRecentMigrations
          migratedRevisions <- findMigratedRevisions
  
          migrationsWithSql <- forM migrations $ \migration -> do
                  sql <- readSqlStatements migration
                  pure (migration, sql)
  
          lastError <- getSessionAndClear "last_migraton_error"
          render IndexView { .. }
  
  
      action NewMigrationAction = do
          let description = paramOrDefault "" "description"
          (_, plan) <- MigrationGenerator.buildPlan description Nothing
          let runMigration = paramOrDefault True "runMigration"
          render NewView { .. }
  
      action CreateMigrationAction = do
          let description = paramOrDefault "" "description"
          let sqlStatements = paramOrNothing "sqlStatements"
          (revision, plan) <- MigrationGenerator.buildPlan description sqlStatements
          let path = MigrationGenerator.migrationPathFromPlan plan
  
          executePlan plan
  
          let createOnly = paramOrDefault False "createOnly"
          if createOnly
              then do
                  setSuccessMessage ("Migration generated: " <> path)
                  openEditor path 0 0
              else do
                  result <- Exception.try (migrateAppDB revision)
                  case result of
                      Left (exception :: SomeException) -> do
                          let errorMessage = case fromException exception of
                                  Just (exception :: EnhancedSqlError) -> cs exception.sqlError.sqlErrorMsg
                                  Nothing -> tshow exception
  
                          setErrorMessage errorMessage
                          redirectTo MigrationsAction
                      Right _ -> do
                          clearDatabaseNeedsMigration
                          redirectTo MigrationsAction
  
          redirectTo MigrationsAction
  
      action EditMigrationAction { migrationId } = do
          migration <- findMigrationByRevision migrationId
          sqlStatements <- readSqlStatements migration
  
          render EditView { .. }
  
      action UpdateMigrationAction { migrationId } = do
          migration <- findMigrationByRevision migrationId
          let sqlStatements = param "sqlStatements"
          migrationFilePath <- SchemaMigration.migrationPath migration
          Text.writeFile (cs migrationFilePath) sqlStatements
  
          redirectTo MigrationsAction
  
      action DeleteMigrationAction { migrationId } = do
          migration <- findMigrationByRevision migrationId
          path <- cs <$> SchemaMigration.migrationPath migration
  
          Directory.removeFile path
  
          redirectTo MigrationsAction
  
      action RunMigrationAction { migrationId } = do
          migration <- findMigrationByRevision migrationId
  
          result <- Exception.try (migrateAppDB migrationId)
          case result of
              Left (exception :: SomeException) -> do
                  let errorMessage = case fromException exception of
                          Just (exception :: EnhancedSqlError) -> cs exception.sqlError.sqlErrorMsg
                          Nothing -> tshow exception
  
                  setErrorMessage errorMessage
                  redirectTo MigrationsAction
              Right _ -> do
                  clearDatabaseNeedsMigration
                  redirectTo MigrationsAction
  
  readSqlStatements :: SchemaMigration.Migration -> IO Text
  readSqlStatements migration = do
      migrationFilePath <- (SchemaMigration.migrationPath migration)
      Text.readFile (cs migrationFilePath)
  
  findRecentMigrations :: IO [SchemaMigration.Migration]
  findRecentMigrations = take 20 . reverse <$> SchemaMigration.findAllMigrations
  
  findMigrationByRevision :: Int -> IO SchemaMigration.Migration
  findMigrationByRevision migrationRevision = do
      migrations <- findRecentMigrations
      let (Just migration) = migrations |> find (\SchemaMigration.Migration { revision } -> revision == migrationRevision)
      pure migration
  
  migrateAppDB :: Int -> IO ()
  migrateAppDB revision = withAppModelContext do
      let minimumRevision = Just (revision - 1)
      SchemaMigration.migrate SchemaMigration.MigrateOptions { minimumRevision }
  
  findMigratedRevisions :: IO [Int]
  findMigratedRevisions = emptyListIfTablesDoesntExists (withAppModelContext 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 operation = do
              result <- Exception.try operation
              case result of
                  Left (EnhancedSqlError { sqlError }) | sqlError.sqlErrorMsg == "relation \"schema_migrations\" does not exist" -> pure []
                  Right result -> pure result
  
  withAppModelContext :: ((?modelContext :: ModelContext) => IO result) -> IO result
  withAppModelContext inner =
          Exception.bracket initModelContext cleanupModelContext callback
      where
          callback (frameworkConfig, logger, modelContext) = let ?modelContext = modelContext in inner
          initModelContext = do
              frameworkConfig <- buildFrameworkConfig (pure ())
              logger <- defaultLogger
  
              modelContext <- createModelContext
                  (frameworkConfig.dbPoolIdleTime)
                  (frameworkConfig.dbPoolMaxConnections)
                  (frameworkConfig.databaseUrl)
                  logger
  
              pure (frameworkConfig, logger, modelContext)
  
          cleanupModelContext (frameworkConfig, logger, modelContext) = do
              logger |> cleanup
  