{-# options_ghc -Wno-partial-type-signatures #-} module Polysemy.Hasql.Test.MigrationTest where import Path (reldir) import qualified Polysemy.Test as Test import Polysemy.Test (UnitTest, assertJust, runTestAuto) import Prelude hiding (sum) import Sqel.Data.Dd (Dd, DdK (DdK), type (:>) ((:>))) import Sqel.Data.Migration (AutoMigrations, migrate) import Sqel.Data.Uid (Uid) import Sqel.Migration.Consistency (migrationConsistency) import Sqel.Migration.Table (migrateAuto) import Sqel.Names (typeAs) import Sqel.Prim (migrateDef, migrateDelete, migrateRename, prim, primNullable) import Sqel.Product (prod) import Sqel.Uid (uidAs) import Polysemy.Hasql.Test.Migration (testMigration) data PordOld = PordOld { p1 :: Int64 } deriving stock (Eq, Show, Generic) data Pord = Pord { p1 :: Int64, p2 :: Maybe Text } deriving stock (Eq, Show, Generic) data Dat0 = Dat0 { old :: Text } deriving stock (Eq, Show, Generic) data Dat1 = Dat1 { size :: Int64, pord :: PordOld } deriving stock (Eq, Show, Generic) data Dat2 = Dat2 { number :: Int64, pord :: Pord } deriving stock (Eq, Show, Generic) data Dat = Dat { name :: Text, num :: Int64, pord :: Pord } deriving stock (Eq, Show, Generic) data Q = Q { name :: Text } deriving stock (Eq, Show, Generic) t0 :: Dd ('DdK _ _ (Uid Int64 Dat0) _) t0 = uidAs @"dat" prim (prod (migrateDelete prim)) t1 :: Dd ('DdK _ _ (Uid Int64 Dat1) _) t1 = uidAs @"dat" prim (prod ( migrateDelete (migrateDef 0 prim) :> typeAs @"Pord" (prod ( migrateDef 53 prim )) )) t2 :: Dd ('DdK _ _ (Uid Int64 Dat2) _) t2 = uidAs @"dat" prim (prod ( migrateDef 15 prim :> typeAs @"Pord" (prod ( prim :> primNullable )) )) tcur :: Dd ('DdK _ _ (Uid Int64 Dat) _) tcur = uidAs @"dat" prim (prod ( migrateDef ("vunqach" :: Text) prim :> migrateRename @"number" prim :> prod ( prim :> primNullable ) )) migrations :: AutoMigrations (Sem r) [Uid Int64 Dat2, Uid Int64 Dat1, Uid Int64 Dat0] (Uid Int64 Dat) migrations = migrate ( migrateAuto t2 tcur :> migrateAuto t1 t2 :> migrateAuto t0 t1 ) migrationErrors :: NonEmpty Text migrationErrors = [ "The migration table 'dat' has mismatched columns:", " • The column 'number' with type 'bigint' was removed.", "The composite type 'sqel_type__pord' has mismatched columns:", " • The type of the column 'p1' was changed from 'text' to 'bigint'.", "The type 'sqel_type__point' was removed." ] test_migrationErrors :: UnitTest test_migrationErrors = runTestAuto do fixtures <- Test.fixturePath [reldir|migration-error|] assertJust migrationErrors =<< migrationConsistency fixtures migrations False -- TODO error message claims type change if a column constraint differs test_migrationConsistency :: UnitTest test_migrationConsistency = runTestAuto do testMigration migrations False