{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE UndecidableInstances #-} module MigrationIdempotencyTest where import qualified Data.Text as T import Database.Persist.TH import Init share [mkPersist sqlSettings, mkMigrate "migration"] [persistLowerCase| Idempotency field1 Int field2 T.Text sqltype=varchar(5) field3 T.Text sqltype=mediumtext field4 T.Text sqltype=longtext field5 T.Text sqltype=mediumblob field6 T.Text sqltype=longblob field7 Double sqltype=double(6,5) |] specsWith :: (MonadIO 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 "MySQL migration with backend-specific sqltypes" (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 migration 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 () @?= []