{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
module MigrationTest where

import Database.Persist.TH
import qualified Data.Text as T

import Init

share [mkPersist sqlSettings, mkMigrate "migrationMigrate", mkDeleteCascade sqlSettings] [persistLowerCase|
Target
    field1 Int
    field2 T.Text
    UniqueTarget field1 field2
    deriving Eq Show

Source
    field3 Int
    field4 TargetId

CustomSqlId
    pk      Int   sql=id
    Primary pk
|]

share [mkPersist sqlSettings, mkMigrate "migrationAddCol", mkDeleteCascade sqlSettings] [persistLowerCase|
Target1 sql=target
    field1 Int
    field2 T.Text
    UniqueTarget1 field1 field2
    deriving Eq Show

Source1 sql=source
    field3 Int
    extra  Int
    field4 Target1Id
|]

specsWith :: (MonadUnliftIO m) => RunDb SqlBackend m -> Spec
specsWith :: RunDb SqlBackend m -> Spec
specsWith RunDb SqlBackend m
runDb = String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Migration" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"is idempotent" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ RunDb SqlBackend m
runDb RunDb SqlBackend m -> RunDb SqlBackend m
forall a b. (a -> b) -> a -> b
$ do
      [Text]
again <- Migration -> ReaderT SqlBackend m [Text]
forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Migration -> ReaderT SqlBackend m [Text]
getMigration Migration
migrationMigrate
      IO () -> ReaderT SqlBackend m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT SqlBackend m ())
-> IO () -> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$ [Text]
again [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Eq a, Show a) => a -> a -> IO ()
@?= []
    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"really is idempotent" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ RunDb SqlBackend m
runDb RunDb SqlBackend m -> RunDb SqlBackend m
forall a b. (a -> b) -> a -> b
$ do
      ReaderT SqlBackend m [Text] -> ReaderT SqlBackend m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT SqlBackend m [Text] -> ReaderT SqlBackend m ())
-> ReaderT SqlBackend m [Text] -> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$ Migration -> ReaderT SqlBackend m [Text]
forall (m :: * -> *).
MonadUnliftIO m =>
Migration -> ReaderT SqlBackend m [Text]
runMigrationSilent Migration
migrationMigrate
      ReaderT SqlBackend m [Text] -> ReaderT SqlBackend m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT SqlBackend m [Text] -> ReaderT SqlBackend m ())
-> ReaderT SqlBackend m [Text] -> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$ Migration -> ReaderT SqlBackend m [Text]
forall (m :: * -> *).
MonadUnliftIO m =>
Migration -> ReaderT SqlBackend m [Text]
runMigrationSilent Migration
migrationMigrate
      [Text]
again <- Migration -> ReaderT SqlBackend m [Text]
forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Migration -> ReaderT SqlBackend m [Text]
getMigration Migration
migrationMigrate
      IO () -> ReaderT SqlBackend m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT SqlBackend m ())
-> IO () -> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$ [Text]
again [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Eq a, Show a) => a -> a -> IO ()
@?= []
    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"can add an extra column" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ RunDb SqlBackend m
runDb RunDb SqlBackend m -> RunDb SqlBackend m
forall a b. (a -> b) -> a -> b
$ do
      -- Failing test case for #735.  Foreign-key checking, switched on in
      -- version 2.6.1, caused persistent-sqlite to generate a `references`
      -- constraint in a *temporary* table during migration, which fails.
      ReaderT SqlBackend m [Text] -> ReaderT SqlBackend m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT SqlBackend m [Text] -> ReaderT SqlBackend m ())
-> ReaderT SqlBackend m [Text] -> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$ Migration -> ReaderT SqlBackend m [Text]
forall (m :: * -> *).
MonadUnliftIO m =>
Migration -> ReaderT SqlBackend m [Text]
runMigrationSilent Migration
migrationAddCol
      [Text]
again <- Migration -> ReaderT SqlBackend m [Text]
forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Migration -> ReaderT SqlBackend m [Text]
getMigration Migration
migrationAddCol
      IO () -> ReaderT SqlBackend m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT SqlBackend m ())
-> IO () -> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$ [Text]
again [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Eq a, Show a) => a -> a -> IO ()
@?= []