module Polysemy.Hasql.Interpreter.DbTable where

import Polysemy.Db.Data.DbError (DbError)
import Sqel.Data.Dd (Dd, DdType)
import Sqel.Data.Migration (noMigrations)
import qualified Sqel.Data.PgType as PgType
import Sqel.Data.PgType (PgTable (PgTable))
import Sqel.Data.PgTypeName (pattern PgTypeName)
import Sqel.Data.ProjectionWitness (ProjectionWitness)
import Sqel.Data.TableSchema (TableSchema (TableSchema))
import Sqel.Migration.Run (runMigrations)
import Sqel.PgType (CheckedProjection, projectionWitness)

import Polysemy.Hasql.Data.InitDb (ClientTag (ClientTag), InitDb (InitDb))
import qualified Polysemy.Hasql.Effect.Database as Database
import Polysemy.Hasql.Effect.Database (Database)
import qualified Polysemy.Hasql.Effect.DbTable as DbTable
import Polysemy.Hasql.Effect.DbTable (DbTable)
import Polysemy.Hasql.Migration (CustomSemMigrations, MigrateSem (unMigrateSem), SemMigrations)

handleDbTable ::
  ∀ d migs m r' r a .
  CustomSemMigrations r' migs =>
  Members [Log, Embed IO] r =>
  Member Log r' =>
  (∀ x . Sem (Database : Stop DbError : r') x -> Sem (Database : Stop DbError : r) x) ->
  TableSchema d ->
  SemMigrations r' migs ->
  DbTable d m a ->
  Sem (Stop DbError : Database !! DbError : r) a
handleDbTable :: forall d (migs :: [Mig]) (m :: * -> *) (r' :: [(* -> *) -> * -> *])
       (r :: [(* -> *) -> * -> *]) a.
(CustomSemMigrations r' migs, Members '[Log, Embed IO] r,
 Member Log r') =>
(forall x.
 Sem (Database : Stop DbError : r') x
 -> Sem (Database : Stop DbError : r) x)
-> TableSchema d
-> SemMigrations r' migs
-> DbTable d m a
-> Sem (Stop DbError : (Database !! DbError) : r) a
handleDbTable forall x.
Sem (Database : Stop DbError : r') x
-> Sem (Database : Stop DbError : r) x
raiser (TableSchema table :: PgTable d
table@PgTable {$sel:name:PgTable :: forall {k} (a :: k). PgTable a -> PgTableName
name = PgTypeName Text
name} Row d
_ Params d
_) SemMigrations r' migs
migrations = \case
  DbTable.Statement p
q Statement p a
stmt ->
    forall err (eff :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]).
Members '[Resumable err eff, Stop err] r =>
InterpreterFor eff r
restop (forall (r :: [(* -> *) -> * -> *]) a.
Member Database r =>
InitDb (Sem r) -> Sem r a -> Sem r a
Database.withInit InitDb (Sem (Database : Stop DbError : (Database !! DbError) : r))
initDb (forall (r :: [(* -> *) -> * -> *]) p o.
Member Database r =>
p -> Statement p o -> Sem r o
Database.statement p
q Statement p a
stmt))
  where
    initDb :: InitDb (Sem (Database : Stop DbError : Database !! DbError : r))
    initDb :: InitDb (Sem (Database : Stop DbError : (Database !! DbError) : r))
initDb = forall (m :: * -> *).
ClientTag -> Bool -> (Connection -> m ()) -> InitDb m
InitDb (Text -> ClientTag
ClientTag Text
name) Bool
True \ Connection
_ -> forall (e3 :: (* -> *) -> * -> *) (e1 :: (* -> *) -> * -> *)
       (e2 :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Sem (e1 : e2 : r) a -> Sem (e1 : e2 : e3 : r) a
raise2Under (forall x.
Sem (Database : Stop DbError : r') x
-> Sem (Database : Stop DbError : r) x
raiser (forall (r :: [(* -> *) -> * -> *]) a.
MigrateSem r a -> Sem (Database : Stop DbError : r) a
unMigrateSem (forall {k} (m :: * -> *) (migs :: [Mig]) (a :: k).
(Monad m, MigrationEffect m, All (CustomMigration m) migs) =>
PgTable a -> Migrations m migs -> m ()
runMigrations PgTable d
table SemMigrations r' migs
migrations)))

interpretTable ::
  ∀ d r .
  Members [Database !! DbError, Log, Embed IO] r =>
  TableSchema d ->
  InterpreterFor (DbTable d !! DbError) r
interpretTable :: forall d (r :: [(* -> *) -> * -> *]).
Members '[Database !! DbError, Log, Embed IO] r =>
TableSchema d -> InterpreterFor (DbTable d !! DbError) r
interpretTable TableSchema d
schema =
  forall err (eff :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]).
FirstOrder eff "interpretResumable" =>
(forall x (r0 :: [(* -> *) -> * -> *]).
 eff (Sem r0) x -> Sem (Stop err : r) x)
-> InterpreterFor (Resumable err eff) r
interpretResumable (forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Member e r =>
Sem (e : r) a -> Sem r a
subsume forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Member e r =>
Sem (e : r) a -> Sem r a
subsume forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (e3 :: (* -> *) -> * -> *) (e1 :: (* -> *) -> * -> *)
       (e2 :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Sem (e1 : e2 : r) a -> Sem (e1 : e2 : e3 : r) a
raise2Under forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall d (migs :: [Mig]) (m :: * -> *) (r' :: [(* -> *) -> * -> *])
       (r :: [(* -> *) -> * -> *]) a.
(CustomSemMigrations r' migs, Members '[Log, Embed IO] r,
 Member Log r') =>
(forall x.
 Sem (Database : Stop DbError : r') x
 -> Sem (Database : Stop DbError : r) x)
-> TableSchema d
-> SemMigrations r' migs
-> DbTable d m a
-> Sem (Stop DbError : (Database !! DbError) : r) a
handleDbTable forall a. a -> a
id TableSchema d
schema forall (m :: * -> *). Migrations m '[]
noMigrations)

tablesScope ::
  Member (Scoped p (Database !! DbError)) r =>
  p ->
  (() -> Sem (Database !! DbError : r) a) ->
  Sem r a
tablesScope :: forall p (r :: [(* -> *) -> * -> *]) a.
Member (Scoped p (Database !! DbError)) r =>
p -> (() -> Sem ((Database !! DbError) : r) a) -> Sem r a
tablesScope p
conn () -> Sem ((Database !! DbError) : r) a
use =
  forall param (effect :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]).
Member (Scoped param effect) r =>
param -> InterpreterFor effect r
scoped p
conn (() -> Sem ((Database !! DbError) : r) a
use ())

interpretTableMigrations ::
  ∀ d migs r .
  CustomSemMigrations r migs =>
  Members [Database !! DbError, Log, Embed IO] r =>
  TableSchema d ->
  SemMigrations r migs ->
  InterpreterFor (DbTable d !! DbError) r
interpretTableMigrations :: forall d (migs :: [Mig]) (r :: [(* -> *) -> * -> *]).
(CustomSemMigrations r migs,
 Members '[Database !! DbError, Log, Embed IO] r) =>
TableSchema d
-> SemMigrations r migs -> InterpreterFor (DbTable d !! DbError) r
interpretTableMigrations TableSchema d
schema SemMigrations r migs
migrations =
  forall err (eff :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]).
FirstOrder eff "interpretResumable" =>
(forall x (r0 :: [(* -> *) -> * -> *]).
 eff (Sem r0) x -> Sem (Stop err : r) x)
-> InterpreterFor (Resumable err eff) r
interpretResumable \ DbTable d (Sem r0) x
ma ->
    forall (r :: [(* -> *) -> * -> *]) (r' :: [(* -> *) -> * -> *]) a.
Subsume r r' =>
Sem r a -> Sem r' a
subsume_ (forall d (migs :: [Mig]) (m :: * -> *) (r' :: [(* -> *) -> * -> *])
       (r :: [(* -> *) -> * -> *]) a.
(CustomSemMigrations r' migs, Members '[Log, Embed IO] r,
 Member Log r') =>
(forall x.
 Sem (Database : Stop DbError : r') x
 -> Sem (Database : Stop DbError : r) x)
-> TableSchema d
-> SemMigrations r' migs
-> DbTable d m a
-> Sem (Stop DbError : (Database !! DbError) : r) a
handleDbTable forall a. a -> a
id TableSchema d
schema SemMigrations r migs
migrations DbTable d (Sem r0) x
ma)

interpretTableMigrationsScoped ::
  CustomSemMigrations r migs =>
  Members [Scoped p (Database !! DbError), Log, Embed IO] r =>
  TableSchema d ->
  SemMigrations r migs ->
  InterpreterFor (Scoped p (DbTable d !! DbError)) r
interpretTableMigrationsScoped :: forall (r :: [(* -> *) -> * -> *]) (migs :: [Mig]) p d.
(CustomSemMigrations r migs,
 Members '[Scoped p (Database !! DbError), Log, Embed IO] r) =>
TableSchema d
-> SemMigrations r migs
-> InterpreterFor (Scoped p (DbTable d !! DbError)) r
interpretTableMigrationsScoped TableSchema d
schema SemMigrations r migs
migrations =
  forall (extra :: [(* -> *) -> * -> *]) param resource
       (effect :: (* -> *) -> * -> *) err (r :: [(* -> *) -> * -> *]).
KnownList extra =>
(forall (q :: (* -> *) -> * -> *) x.
 param
 -> (resource -> Sem (extra ++ (Opaque q : r)) x)
 -> Sem (Opaque q : r) x)
-> (forall (r0 :: [(* -> *) -> * -> *]) x.
    resource -> effect (Sem r0) x -> Sem (Stop err : (extra ++ r)) x)
-> InterpreterFor (Scoped param (effect !! err)) r
interpretResumableScopedWith @'[Database !! DbError] forall p (r :: [(* -> *) -> * -> *]) a.
Member (Scoped p (Database !! DbError)) r =>
p -> (() -> Sem ((Database !! DbError) : r) a) -> Sem r a
tablesScope \ () -> forall d (migs :: [Mig]) (m :: * -> *) (r' :: [(* -> *) -> * -> *])
       (r :: [(* -> *) -> * -> *]) a.
(CustomSemMigrations r' migs, Members '[Log, Embed IO] r,
 Member Log r') =>
(forall x.
 Sem (Database : Stop DbError : r') x
 -> Sem (Database : Stop DbError : r) x)
-> TableSchema d
-> SemMigrations r' migs
-> DbTable d m a
-> Sem (Stop DbError : (Database !! DbError) : r) a
handleDbTable forall a. a -> a
id TableSchema d
schema SemMigrations r migs
migrations

interpretTableMigrationsScoped' ::
  CustomSemMigrations r' migs =>
  Member Log r' =>
  Members [Scoped p (Database !! DbError), Log, Embed IO] r =>
  (∀ x . Sem (Database : Stop DbError : r') x -> Sem (Database : Stop DbError : r) x) ->
  TableSchema d ->
  SemMigrations r' migs ->
  InterpreterFor (Scoped p (DbTable d !! DbError)) r
interpretTableMigrationsScoped' :: forall (r' :: [(* -> *) -> * -> *]) (migs :: [Mig]) p
       (r :: [(* -> *) -> * -> *]) d.
(CustomSemMigrations r' migs, Member Log r',
 Members '[Scoped p (Database !! DbError), Log, Embed IO] r) =>
(forall x.
 Sem (Database : Stop DbError : r') x
 -> Sem (Database : Stop DbError : r) x)
-> TableSchema d
-> SemMigrations r' migs
-> InterpreterFor (Scoped p (DbTable d !! DbError)) r
interpretTableMigrationsScoped' forall x.
Sem (Database : Stop DbError : r') x
-> Sem (Database : Stop DbError : r) x
raiser TableSchema d
schema SemMigrations r' migs
migrations =
  forall (extra :: [(* -> *) -> * -> *]) param resource
       (effect :: (* -> *) -> * -> *) err (r :: [(* -> *) -> * -> *]).
KnownList extra =>
(forall (q :: (* -> *) -> * -> *) x.
 param
 -> (resource -> Sem (extra ++ (Opaque q : r)) x)
 -> Sem (Opaque q : r) x)
-> (forall (r0 :: [(* -> *) -> * -> *]) x.
    resource -> effect (Sem r0) x -> Sem (Stop err : (extra ++ r)) x)
-> InterpreterFor (Scoped param (effect !! err)) r
interpretResumableScopedWith @'[Database !! DbError] forall p (r :: [(* -> *) -> * -> *]) a.
Member (Scoped p (Database !! DbError)) r =>
p -> (() -> Sem ((Database !! DbError) : r) a) -> Sem r a
tablesScope \ () -> forall d (migs :: [Mig]) (m :: * -> *) (r' :: [(* -> *) -> * -> *])
       (r :: [(* -> *) -> * -> *]) a.
(CustomSemMigrations r' migs, Members '[Log, Embed IO] r,
 Member Log r') =>
(forall x.
 Sem (Database : Stop DbError : r') x
 -> Sem (Database : Stop DbError : r) x)
-> TableSchema d
-> SemMigrations r' migs
-> DbTable d m a
-> Sem (Stop DbError : (Database !! DbError) : r) a
handleDbTable forall x.
Sem (Database : Stop DbError : r') x
-> Sem (Database : Stop DbError : r) x
raiser TableSchema d
schema SemMigrations r' migs
migrations

interpretTablesMigrations ::
  ∀ d migs p r .
  CustomSemMigrations r migs =>
  Members [Scoped p (Database !! DbError), Database !! DbError, Log, Embed IO] r =>
  TableSchema d ->
  SemMigrations r migs ->
  InterpretersFor [Scoped p (DbTable d !! DbError), DbTable d !! DbError] r
interpretTablesMigrations :: forall d (migs :: [Mig]) p (r :: [(* -> *) -> * -> *]).
(CustomSemMigrations r migs,
 Members
   '[Scoped p (Database !! DbError), Database !! DbError, Log,
     Embed IO]
   r) =>
TableSchema d
-> SemMigrations r migs
-> InterpretersFor
     '[Scoped p (DbTable d !! DbError), DbTable d !! DbError] r
interpretTablesMigrations TableSchema d
schema SemMigrations r migs
migrations =
  forall d (migs :: [Mig]) (r :: [(* -> *) -> * -> *]).
(CustomSemMigrations r migs,
 Members '[Database !! DbError, Log, Embed IO] r) =>
TableSchema d
-> SemMigrations r migs -> InterpreterFor (DbTable d !! DbError) r
interpretTableMigrations TableSchema d
schema SemMigrations r migs
migrations forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall (r' :: [(* -> *) -> * -> *]) (migs :: [Mig]) p
       (r :: [(* -> *) -> * -> *]) d.
(CustomSemMigrations r' migs, Member Log r',
 Members '[Scoped p (Database !! DbError), Log, Embed IO] r) =>
(forall x.
 Sem (Database : Stop DbError : r') x
 -> Sem (Database : Stop DbError : r) x)
-> TableSchema d
-> SemMigrations r' migs
-> InterpreterFor (Scoped p (DbTable d !! DbError)) r
interpretTableMigrationsScoped' forall (e3 :: (* -> *) -> * -> *) (e1 :: (* -> *) -> * -> *)
       (e2 :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Sem (e1 : e2 : r) a -> Sem (e1 : e2 : e3 : r) a
raise2Under TableSchema d
schema SemMigrations r migs
migrations

interpretTables ::
  Members [Scoped p (Database !! DbError), Database !! DbError, Log, Embed IO] r =>
  TableSchema d ->
  InterpretersFor [Scoped p (DbTable d !! DbError), DbTable d !! DbError] r
interpretTables :: forall p (r :: [(* -> *) -> * -> *]) d.
Members
  '[Scoped p (Database !! DbError), Database !! DbError, Log,
    Embed IO]
  r =>
TableSchema d
-> InterpretersFor
     '[Scoped p (DbTable d !! DbError), DbTable d !! DbError] r
interpretTables TableSchema d
schema =
  forall d (migs :: [Mig]) p (r :: [(* -> *) -> * -> *]).
(CustomSemMigrations r migs,
 Members
   '[Scoped p (Database !! DbError), Database !! DbError, Log,
     Embed IO]
   r) =>
TableSchema d
-> SemMigrations r migs
-> InterpretersFor
     '[Scoped p (DbTable d !! DbError), DbTable d !! DbError] r
interpretTablesMigrations TableSchema d
schema forall (m :: * -> *). Migrations m '[]
noMigrations

interpretTableView ::
  Member (DbTable table !! DbError) r =>
  ProjectionWitness view table ->
  InterpreterFor (DbTable view !! DbError) r
interpretTableView :: forall table (r :: [(* -> *) -> * -> *]) view.
Member (DbTable table !! DbError) r =>
ProjectionWitness view table
-> InterpreterFor (DbTable view !! DbError) r
interpretTableView ProjectionWitness view table
_ =
  forall err (eff :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]).
FirstOrder eff "interpretResumable" =>
(forall x (r0 :: [(* -> *) -> * -> *]).
 eff (Sem r0) x -> Sem (Stop err : r) x)
-> InterpreterFor (Resumable err eff) r
interpretResumable \case
    DbTable.Statement p
q Statement p x
stmt ->
      forall err (eff :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]).
Members '[Resumable err eff, Stop err] r =>
InterpreterFor eff r
restop (forall a (r :: [(* -> *) -> * -> *]) p o.
Member (DbTable a) r =>
p -> Statement p o -> Sem r o
DbTable.statement p
q Statement p x
stmt)

interpretTableViewDd ::
  CheckedProjection view table =>
  Member (DbTable (DdType table) !! DbError) r =>
  Dd table ->
  Dd view ->
  InterpreterFor (DbTable (DdType view) !! DbError) r
interpretTableViewDd :: forall (view :: DdK) (table :: DdK) (r :: [(* -> *) -> * -> *]).
(CheckedProjection view table,
 Member (DbTable (DdType table) !! DbError) r) =>
Dd table
-> Dd view -> InterpreterFor (DbTable (DdType view) !! DbError) r
interpretTableViewDd Dd table
table Dd view
view =
  forall table (r :: [(* -> *) -> * -> *]) view.
Member (DbTable table !! DbError) r =>
ProjectionWitness view table
-> InterpreterFor (DbTable view !! DbError) r
interpretTableView (forall (proj :: DdK) (table :: DdK).
CheckedProjection proj table =>
Dd proj
-> Dd table -> ProjectionWitness (DdType proj) (DdType table)
projectionWitness Dd view
view Dd table
table)