{-# 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 ()
@?= []