module Polysemy.Hasql.Migration where import Generics.SOP (All) import qualified Log import qualified Polysemy.Db.Data.DbError as DbError import Polysemy.Db.Data.DbError (DbError) import Sqel.Class.MigrationEffect (MigrationEffect (error, log, runMigrationStatements, runStatement, runStatement_)) import Sqel.Data.Migration ( CustomMigration, HoistMigration (hoistMigration), HoistMigrations (hoistMigrations), Migrations, ) import Sqel.Migration.Statement (migrationSession) import qualified Sqel.Migration.Transform as Transform import Sqel.Migration.Transform (MigrateTransform (MigrateTransform)) import qualified Polysemy.Hasql.Effect.Database as Database import Polysemy.Hasql.Effect.Database (Database) newtype MigrateSem r a = MigrateSem { forall (r :: [(* -> *) -> * -> *]) a. MigrateSem r a -> Sem (Database : Stop DbError : r) a unMigrateSem :: Sem (Database : Stop DbError : r) a } deriving stock (forall (r :: [(* -> *) -> * -> *]) a x. Rep (MigrateSem r a) x -> MigrateSem r a forall (r :: [(* -> *) -> * -> *]) a x. MigrateSem r a -> Rep (MigrateSem r a) x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall (r :: [(* -> *) -> * -> *]) a x. Rep (MigrateSem r a) x -> MigrateSem r a $cfrom :: forall (r :: [(* -> *) -> * -> *]) a x. MigrateSem r a -> Rep (MigrateSem r a) x Generic, forall (r :: [(* -> *) -> * -> *]) a b. a -> MigrateSem r b -> MigrateSem r a forall (r :: [(* -> *) -> * -> *]) a b. (a -> b) -> MigrateSem r a -> MigrateSem r b forall a b. a -> MigrateSem r b -> MigrateSem r a forall a b. (a -> b) -> MigrateSem r a -> MigrateSem r b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f <$ :: forall a b. a -> MigrateSem r b -> MigrateSem r a $c<$ :: forall (r :: [(* -> *) -> * -> *]) a b. a -> MigrateSem r b -> MigrateSem r a fmap :: forall a b. (a -> b) -> MigrateSem r a -> MigrateSem r b $cfmap :: forall (r :: [(* -> *) -> * -> *]) a b. (a -> b) -> MigrateSem r a -> MigrateSem r b Functor) deriving newtype (forall (r :: [(* -> *) -> * -> *]). Functor (MigrateSem r) forall (r :: [(* -> *) -> * -> *]) a. a -> MigrateSem r a forall (r :: [(* -> *) -> * -> *]) a b. MigrateSem r a -> MigrateSem r b -> MigrateSem r a forall (r :: [(* -> *) -> * -> *]) a b. MigrateSem r a -> MigrateSem r b -> MigrateSem r b forall (r :: [(* -> *) -> * -> *]) a b. MigrateSem r (a -> b) -> MigrateSem r a -> MigrateSem r b forall (r :: [(* -> *) -> * -> *]) a b c. (a -> b -> c) -> MigrateSem r a -> MigrateSem r b -> MigrateSem r c forall a. a -> MigrateSem r a forall a b. MigrateSem r a -> MigrateSem r b -> MigrateSem r a forall a b. MigrateSem r a -> MigrateSem r b -> MigrateSem r b forall a b. MigrateSem r (a -> b) -> MigrateSem r a -> MigrateSem r b forall a b c. (a -> b -> c) -> MigrateSem r a -> MigrateSem r b -> MigrateSem r c forall (f :: * -> *). Functor f -> (forall a. a -> f a) -> (forall a b. f (a -> b) -> f a -> f b) -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c) -> (forall a b. f a -> f b -> f b) -> (forall a b. f a -> f b -> f a) -> Applicative f <* :: forall a b. MigrateSem r a -> MigrateSem r b -> MigrateSem r a $c<* :: forall (r :: [(* -> *) -> * -> *]) a b. MigrateSem r a -> MigrateSem r b -> MigrateSem r a *> :: forall a b. MigrateSem r a -> MigrateSem r b -> MigrateSem r b $c*> :: forall (r :: [(* -> *) -> * -> *]) a b. MigrateSem r a -> MigrateSem r b -> MigrateSem r b liftA2 :: forall a b c. (a -> b -> c) -> MigrateSem r a -> MigrateSem r b -> MigrateSem r c $cliftA2 :: forall (r :: [(* -> *) -> * -> *]) a b c. (a -> b -> c) -> MigrateSem r a -> MigrateSem r b -> MigrateSem r c <*> :: forall a b. MigrateSem r (a -> b) -> MigrateSem r a -> MigrateSem r b $c<*> :: forall (r :: [(* -> *) -> * -> *]) a b. MigrateSem r (a -> b) -> MigrateSem r a -> MigrateSem r b pure :: forall a. a -> MigrateSem r a $cpure :: forall (r :: [(* -> *) -> * -> *]) a. a -> MigrateSem r a Applicative, forall (r :: [(* -> *) -> * -> *]). Applicative (MigrateSem r) forall (r :: [(* -> *) -> * -> *]) a. a -> MigrateSem r a forall (r :: [(* -> *) -> * -> *]) a b. MigrateSem r a -> MigrateSem r b -> MigrateSem r b forall (r :: [(* -> *) -> * -> *]) a b. MigrateSem r a -> (a -> MigrateSem r b) -> MigrateSem r b forall a. a -> MigrateSem r a forall a b. MigrateSem r a -> MigrateSem r b -> MigrateSem r b forall a b. MigrateSem r a -> (a -> MigrateSem r b) -> MigrateSem r b forall (m :: * -> *). Applicative m -> (forall a b. m a -> (a -> m b) -> m b) -> (forall a b. m a -> m b -> m b) -> (forall a. a -> m a) -> Monad m return :: forall a. a -> MigrateSem r a $creturn :: forall (r :: [(* -> *) -> * -> *]) a. a -> MigrateSem r a >> :: forall a b. MigrateSem r a -> MigrateSem r b -> MigrateSem r b $c>> :: forall (r :: [(* -> *) -> * -> *]) a b. MigrateSem r a -> MigrateSem r b -> MigrateSem r b >>= :: forall a b. MigrateSem r a -> (a -> MigrateSem r b) -> MigrateSem r b $c>>= :: forall (r :: [(* -> *) -> * -> *]) a b. MigrateSem r a -> (a -> MigrateSem r b) -> MigrateSem r b Monad) type SemMigrations r migs = Migrations (MigrateSem r) migs type HoistSemMigrations extra r migs migs' = HoistMigrations (MigrateSem r) (MigrateSem (extra ++ r)) migs migs' type CustomSemMigrations r migs = All (CustomMigration (MigrateSem r)) migs instance HoistMigration (MigrateSem r) (MigrateSem r') (MigrateTransform (MigrateSem r) old new) (MigrateTransform (MigrateSem r') old new) where hoistMigration :: (forall x. MigrateSem r x -> MigrateSem r' x) -> MigrateTransform (MigrateSem r) old new -> MigrateTransform (MigrateSem r') old new hoistMigration forall x. MigrateSem r x -> MigrateSem r' x f MigrateTransform {Map PgCompName CompAction TableSchema old TableSchema new [old] -> MigrateSem r [new] $sel:trans:MigrateTransform :: forall (m :: * -> *) old new. MigrateTransform m old new -> [old] -> m [new] $sel:types:MigrateTransform :: forall (m :: * -> *) old new. MigrateTransform m old new -> Map PgCompName CompAction $sel:schemaOld:MigrateTransform :: forall (m :: * -> *) old new. MigrateTransform m old new -> TableSchema old $sel:schemaNew:MigrateTransform :: forall (m :: * -> *) old new. MigrateTransform m old new -> TableSchema new schemaNew :: TableSchema new schemaOld :: TableSchema old types :: Map PgCompName CompAction trans :: [old] -> MigrateSem r [new] ..} = MigrateTransform {$sel:trans:MigrateTransform :: [old] -> MigrateSem r' [new] trans = forall x. MigrateSem r x -> MigrateSem r' x f forall b c a. (b -> c) -> (a -> b) -> a -> c . [old] -> MigrateSem r [new] trans, Map PgCompName CompAction TableSchema old TableSchema new $sel:types:MigrateTransform :: Map PgCompName CompAction $sel:schemaOld:MigrateTransform :: TableSchema old $sel:schemaNew:MigrateTransform :: TableSchema new schemaNew :: TableSchema new schemaOld :: TableSchema old types :: Map PgCompName CompAction ..} hoistSemMigrations :: ∀ extra r migs migs' . HoistSemMigrations extra r migs migs' => (∀ x . Sem (Database : Stop DbError : r) x -> Sem (Database : Stop DbError : extra ++ r) x) -> SemMigrations r migs -> SemMigrations (extra ++ r) migs' hoistSemMigrations :: forall (extra :: [(* -> *) -> * -> *]) (r :: [(* -> *) -> * -> *]) (migs :: [Mig]) (migs' :: [Mig]). HoistSemMigrations extra r migs migs' => (forall x. Sem (Database : Stop DbError : r) x -> Sem (Database : Stop DbError : (extra ++ r)) x) -> SemMigrations r migs -> SemMigrations (extra ++ r) migs' hoistSemMigrations forall x. Sem (Database : Stop DbError : r) x -> Sem (Database : Stop DbError : (extra ++ r)) x f SemMigrations r migs m = forall (m :: * -> *) (n :: * -> *) (migs :: [Mig]) (migs' :: [Mig]). HoistMigrations m n migs migs' => (forall x. m x -> n x) -> Migrations m migs -> Migrations n migs' hoistMigrations (forall (r :: [(* -> *) -> * -> *]) a. Sem (Database : Stop DbError : r) a -> MigrateSem r a MigrateSem forall b c a. (b -> c) -> (a -> b) -> a -> c . forall x. Sem (Database : Stop DbError : r) x -> Sem (Database : Stop DbError : (extra ++ r)) x f forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (r :: [(* -> *) -> * -> *]) a. MigrateSem r a -> Sem (Database : Stop DbError : r) a unMigrateSem) SemMigrations r migs m instance ( Member Log r ) => MigrationEffect (MigrateSem r) where runMigrationStatements :: [MigrationStatement] -> MigrateSem r () runMigrationStatements [MigrationStatement] actions = forall (r :: [(* -> *) -> * -> *]) a. Sem (Database : Stop DbError : r) a -> MigrateSem r a MigrateSem (forall (r :: [(* -> *) -> * -> *]) a. Member Database r => Session a -> Sem r a Database.session ([MigrationStatement] -> Session () migrationSession [MigrationStatement] actions)) runStatement_ :: forall q. q -> Statement q () -> MigrateSem r () runStatement_ q q Statement q () s = forall (r :: [(* -> *) -> * -> *]) a. Sem (Database : Stop DbError : r) a -> MigrateSem r a MigrateSem (forall (r :: [(* -> *) -> * -> *]) p o. Member Database r => p -> Statement p o -> Sem r o Database.statement q q Statement q () s) runStatement :: forall q a. q -> Statement q [a] -> MigrateSem r [a] runStatement q q Statement q [a] s = forall (r :: [(* -> *) -> * -> *]) a. Sem (Database : Stop DbError : r) a -> MigrateSem r a MigrateSem (forall (r :: [(* -> *) -> * -> *]) p o. Member Database r => p -> Statement p o -> Sem r o Database.statement q q Statement q [a] s) log :: Text -> MigrateSem r () log = forall (r :: [(* -> *) -> * -> *]) a. Sem (Database : Stop DbError : r) a -> MigrateSem r a MigrateSem forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (r :: [(* -> *) -> * -> *]). (HasCallStack, Member Log r) => Text -> Sem r () Log.debug error :: Text -> MigrateSem r () error Text msg = forall (r :: [(* -> *) -> * -> *]) a. Sem (Database : Stop DbError : r) a -> MigrateSem r a MigrateSem do forall (r :: [(* -> *) -> * -> *]). (HasCallStack, Member Log r) => Text -> Sem r () Log.error Text msg forall e (r :: [(* -> *) -> * -> *]) a. Member (Stop e) r => e -> Sem r a stop (Text -> DbError DbError.Table Text msg)