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)