{-# options_ghc -Wno-partial-type-signatures #-} module Polysemy.Hasql.Test.MigrationTest where import Lens.Micro.Extras (view) import Polysemy.Db.Data.DbError (DbError) import qualified Polysemy.Db.Effect.Query as Query import Polysemy.Db.Effect.Query (Query) import qualified Polysemy.Db.Effect.Store as Store import Polysemy.Db.Effect.Store (Store) import Polysemy.Test (UnitTest, assertEq) import Prelude hiding (sum) import Sqel.Data.Dd (Dd, DdK (DdK), type (:>) ((:>))) import Sqel.Data.Migration (AutoMigrations, migrate) import Sqel.Data.TableSchema (TableSchema) import Sqel.Data.Uid (Uid (Uid)) import Sqel.Migration.Table (migrateAuto) import Sqel.PgType (tableSchema) import Sqel.Prim (array, migrateDef, migrateDelete, migrateRename, migrateRenameType, prim, primAs, primNullable) import Sqel.Product (Product (prod)) import Sqel.Query (checkQuery) import Sqel.Uid (uidAs) import qualified Polysemy.Hasql.Effect.Database as Database import Polysemy.Hasql.Interpreter.DbTable (interpretTableMigrations, interpretTables) import Polysemy.Hasql.Interpreter.Query (interpretQueryDd) import Polysemy.Hasql.Interpreter.Store (interpretStoreDb) import Polysemy.Hasql.Migration (MigrateSem) import Polysemy.Hasql.Test.RunIntegration (integrationTest) 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, names :: [Text] } deriving stock (Eq, Show, Generic) data Dat1 = Dat1 { size :: Int64, names :: [Text], pordOld :: PordOld } deriving stock (Eq, Show, Generic) data Dat2 = Dat2 { number :: Int64, names :: [Text], pord :: Pord } deriving stock (Eq, Show, Generic) data Dat = Dat { name :: Text, names :: [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 :> array prim)) t1 :: Dd ('DdK _ _ (Uid Int64 Dat1) _) t1 = uidAs @"dat" prim (prod ( migrateDelete (migrateDef 0 prim) :> array prim :> prod ( migrateDef 53 prim ) )) t2 :: Dd ('DdK _ _ (Uid Int64 Dat2) _) t2 = uidAs @"dat" prim (prod ( migrateDef 15 prim :> array prim :> migrateRename @"pordOld" (migrateRenameType @"sqel_type__PordOld" (prod ( prim :> primNullable ))) )) tcur :: Dd ('DdK _ _ (Uid Int64 Dat) _) tcur = uidAs @"dat" prim (prod ( migrateDef ("vunqach" :: Text) prim :> array prim :> migrateRename @"number" prim :> prod ( prim :> primNullable ) )) q :: Dd ('DdK _ _ Q _) q = prod (primAs @"name") schemaOld :: TableSchema (Uid Int64 Dat1) schemaOld = tableSchema t1 schemaCur :: TableSchema (Uid Int64 Dat) schemaCur = tableSchema tcur migrations :: AutoMigrations (MigrateSem r) [Uid Int64 Dat2, Uid Int64 Dat1, Uid Int64 Dat0] (Uid Int64 Dat) migrations = migrate ( migrateAuto t2 tcur :> migrateAuto t1 t2 :> migrateAuto t0 t1 ) test_migration :: UnitTest test_migration = integrationTest do interpretTables schemaOld $ interpretStoreDb schemaOld (checkQuery (primAs @"id") t1) $ restop @DbError do Store.insert (Uid 3 (Dat1 11 ["0"] (PordOld 93))) Store.insert (Uid 4 (Dat1 55 ["0", "1"] (PordOld 78))) restop @DbError Database.release restop @DbError Database.resetInit interpretTableMigrations schemaCur migrations $ interpretStoreDb schemaCur (checkQuery (primAs @"id") tcur) $ interpretQueryDd @[_] tcur tcur q $ restop @DbError @(Query _ _) $ restop @DbError @(Store _ _) do Store.insert (Uid 1 (Dat "1" ["11"] 5 (Pord 10 (Just "new 1")))) Store.insert (Uid 2 (Dat "2" ["22", "33"] 5 (Pord 10 (Just "new 2")))) assertEq [3, 4] =<< fmap (view #id) <$> Query.query (Q "vunqach") assertEq [2] =<< fmap (view #id) <$> Query.query (Q "2")