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 as Exception
import qualified System.Directory as Directory
import qualified Database.PostgreSQL.Simple as PG
instance Controller MigrationsController where
beforeAction :: (?context::ControllerContext, ?modelContext::ModelContext,
?theAction::MigrationsController) =>
IO ()
beforeAction = (?context::ControllerContext) =>
((?context::ControllerContext) => Layout) -> IO ()
((?context::ControllerContext) => Layout) -> IO ()
setLayout (?context::ControllerContext) => Layout
Layout
Html -> Html
schemaDesignerLayout
action :: (?context::ControllerContext, ?modelContext::ModelContext,
?theAction::MigrationsController) =>
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 a. a -> IO a
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 { [Int]
[(Migration, Text)]
Maybe Text
migratedRevisions :: [Int]
migrationsWithSql :: [(Migration, Text)]
lastError :: Maybe Text
$sel:migrationsWithSql:IndexView :: [(Migration, Text)]
$sel:migratedRevisions:IndexView :: [Int]
$sel:lastError:IndexView :: Maybe Text
.. }
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]
plan :: [GeneratorAction]
$sel:plan:NewView :: [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
Either SomeException ()
result <- IO () -> IO (Either SomeException ())
forall e a. Exception e => IO a -> IO (Either e a)
Exception.try (Int -> IO ()
migrateAppDB Int
revision)
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 EnhancedSqlError
exception.sqlError.sqlErrorMsg
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
MigrationsController -> IO ()
forall action.
(?context::ControllerContext, HasPath action) =>
action -> IO ()
redirectTo MigrationsController
MigrationsAction
action EditMigrationAction { Int
migrationId :: Int
$sel:migrationId:MigrationsAction :: MigrationsController -> 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 { Text
Migration
migration :: Migration
sqlStatements :: Text
$sel:migration:EditView :: Migration
$sel:sqlStatements:EditView :: Text
.. }
action UpdateMigrationAction { Int
$sel:migrationId:MigrationsAction :: MigrationsController -> Int
migrationId :: 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
$sel:migrationId:MigrationsAction :: MigrationsController -> Int
migrationId :: 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
$sel:migrationId:MigrationsAction :: MigrationsController -> Int
migrationId :: 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 EnhancedSqlError
exception.sqlError.sqlErrorMsg
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 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
. [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
revision :: Int
$sel:revision:Migration :: Migration -> Int
revision } -> Int
revision Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
migrationRevision)
Migration -> IO Migration
forall a. a -> IO a
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 SchemaMigration.MigrateOptions { Maybe Int
minimumRevision :: Maybe Int
$sel:minimumRevision:MigrateOptions :: 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 IO [Int]
(?modelContext::ModelContext) => IO [Int]
SchemaMigration.findMigratedRevisions)
where
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
sqlError :: SqlError
$sel:sqlError:EnhancedSqlError :: EnhancedSqlError -> SqlError
sqlError }) | SqlError
sqlError.sqlErrorMsg ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"relation \"schema_migrations\" does not exist" -> [a] -> IO [a]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
Right [a]
result -> [a] -> IO [a]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a]
result
withAppModelContext :: ((?modelContext :: ModelContext) => IO result) -> IO result
withAppModelContext :: forall result.
((?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::ModelContext
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 a. a -> StateT TMap IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
Logger
logger <- IO Logger
defaultLogger
ModelContext
modelContext <- NominalDiffTime -> Int -> ByteString -> Logger -> IO ModelContext
createModelContext
(FrameworkConfig
frameworkConfig.dbPoolIdleTime)
(FrameworkConfig
frameworkConfig.dbPoolMaxConnections)
(FrameworkConfig
frameworkConfig.databaseUrl)
Logger
logger
(FrameworkConfig, Logger, ModelContext)
-> IO (FrameworkConfig, Logger, ModelContext)
forall a. a -> IO a
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