{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-unused-top-binds #-} module EquivalentTypeTest (specsWith) where import UnliftIO import Database.Persist.TH import Init share [mkPersist sqlSettings, mkMigrate "migrateAll1"] [persistLowerCase| EquivalentType sql=equivalent_types field1 Int deriving Eq Show |] share [mkPersist sqlSettings, mkMigrate "migrateAll2"] [persistLowerCase| EquivalentType2 sql=equivalent_types field1 Int deriving Eq Show |] specsWith :: Runner SqlBackend 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 "doesn't migrate equivalent types" (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 "works" (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] _ <- Migration -> ReaderT SqlBackend m [Text] forall (m :: * -> *). MonadUnliftIO m => Migration -> ReaderT SqlBackend m [Text] runMigrationSilent Migration migrateAll1 [Text] xs <- Migration -> ReaderT SqlBackend m [Text] forall (m :: * -> *). (MonadIO m, HasCallStack) => Migration -> ReaderT SqlBackend m [Text] getMigration Migration migrateAll2 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] xs [Text] -> [Text] -> IO () forall a. (HasCallStack, Eq a, Show a) => a -> a -> IO () @?= []