module Polysemy.Hasql.Transaction where

import Hasql.Connection (Connection)
import Polysemy.Db.Effect.Store (QStore, Store)
import Sqel.Data.Uid (Uid)

import qualified Polysemy.Hasql.Effect.Database as Database
import Polysemy.Hasql.Effect.Database (ConnectionSource)
import qualified Polysemy.Hasql.Effect.Transaction as Transaction
import Polysemy.Hasql.Effect.Transaction (Transaction, Transactions)
import Polysemy.Internal.CustomErrors (FirstOrder)

type XaQStore res err f q d =
  Scoped res (QStore f q d !! err) !! err

type XaStore res err i d =
  XaQStore res err Maybe i (Uid i d)

type TransactionEffects :: EffectRow -> EffectRow -> Type -> Type -> EffectRow -> Constraint
class TransactionEffects all effs err res r where
  transactionEffects :: res -> InterpretersFor effs r

instance TransactionEffects all '[] err res r where
  transactionEffects :: res -> InterpretersFor '[] r
transactionEffects res
_ = forall a. a -> a
id

instance (
    TransactionEffects all effs err res r,
    Member (Scoped res (eff !! err) !! err) (effs ++ r),
    Member (Stop err) (effs ++ r)
  ) => TransactionEffects all (eff : effs) err res r where
  transactionEffects :: res -> InterpretersFor (eff : effs) r
transactionEffects res
res =
    forall (all :: EffectRow) (effs :: EffectRow) err res
       (r :: EffectRow).
TransactionEffects all effs err res r =>
res -> InterpretersFor effs r
transactionEffects @all @effs @err res
res forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    forall err (eff :: Effect) (r :: EffectRow).
Members '[Resumable err eff, Stop err] r =>
InterpreterFor eff r
restop @err @(Scoped res (eff !! err)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    forall param (effect :: Effect) (r :: EffectRow).
Member (Scoped param effect) r =>
param -> InterpreterFor effect r
scoped res
res forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    forall err (eff :: Effect) (r :: EffectRow).
Members '[Resumable err eff, Stop err] r =>
InterpreterFor eff r
restop @err @eff forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    forall (e2 :: Effect) (e3 :: Effect) (e1 :: Effect)
       (r :: EffectRow) a.
Sem (e1 : r) a -> Sem (e1 : e2 : e3 : r) a
raiseUnder2

-- TODO add scope parameter of type TransactionConfig
transact ::
  ∀ effs res err r .
  effs ++ '[Transaction res] ++ r ~ (effs ++ '[Transaction res]) ++ r =>
  Member (Transactions res) r =>
  TransactionEffects effs effs err res (Transaction res : r) =>
  InterpretersFor (effs ++ '[Transaction res]) r
transact :: forall (effs :: EffectRow) res err (r :: EffectRow).
((effs ++ ('[Transaction res] ++ r))
 ~ ((effs ++ '[Transaction res]) ++ r),
 Member (Transactions res) r,
 TransactionEffects effs effs err res (Transaction res : r)) =>
InterpretersFor (effs ++ '[Transaction res]) r
transact Sem ((effs ++ '[Transaction res]) ++ r) a
ma =
  forall (effect :: Effect) (r :: EffectRow).
Member (Scoped_ effect) r =>
InterpreterFor effect r
scoped_ do
    res
conn <- forall res (r :: EffectRow).
Member (Transaction res) r =>
Sem r res
Transaction.resource
    forall (all :: EffectRow) (effs :: EffectRow) err res
       (r :: EffectRow).
TransactionEffects all effs err res r =>
res -> InterpretersFor effs r
transactionEffects @effs @effs @err res
conn do
      Sem ((effs ++ '[Transaction res]) ++ r) a
ma

type family XaStores (ds :: [(Type, Type)]) :: [Effect] where
  XaStores '[] = '[]
  XaStores ('(i, d) : ds) = Store i d : XaStores ds

transactStores ::
  ∀ ds res err r xas .
  xas ~ XaStores ds =>
  XaStores ds ++ (Transaction res : r) ~ (xas ++ '[Transaction res]) ++ r =>
  Member (Transactions res) r =>
  TransactionEffects xas xas err res (Transaction res : r) =>
  InterpretersFor (xas ++ '[Transaction res]) r
transactStores :: forall (ds :: [(*, *)]) res err (r :: EffectRow)
       (xas :: EffectRow).
(xas ~ XaStores ds,
 (XaStores ds ++ (Transaction res : r))
 ~ ((xas ++ '[Transaction res]) ++ r),
 Member (Transactions res) r,
 TransactionEffects xas xas err res (Transaction res : r)) =>
InterpretersFor (xas ++ '[Transaction res]) r
transactStores Sem ((xas ++ '[Transaction res]) ++ r) a
ma =
  forall (effect :: Effect) (r :: EffectRow).
Member (Scoped_ effect) r =>
InterpreterFor effect r
scoped_ do
    res
conn <- forall res (r :: EffectRow).
Member (Transaction res) r =>
Sem r res
Transaction.resource
    forall (all :: EffectRow) (effs :: EffectRow) err res
       (r :: EffectRow).
TransactionEffects all effs err res r =>
res -> InterpretersFor effs r
transactionEffects @xas @xas @err res
conn do
      Sem ((xas ++ '[Transaction res]) ++ r) a
ma

connectionScope ::
  ∀ eff err r a .
  Member (Scoped ConnectionSource (eff !! err)) r =>
  Connection ->
  (() -> Sem (eff !! err : r) a) ->
  Sem r a
connectionScope :: forall (eff :: Effect) err (r :: EffectRow) a.
Member (Scoped ConnectionSource (eff !! err)) r =>
Connection -> (() -> Sem ((eff !! err) : r) a) -> Sem r a
connectionScope Connection
conn () -> Sem ((eff !! err) : r) a
use =
  forall param (effect :: Effect) (r :: EffectRow).
Member (Scoped param effect) r =>
param -> InterpreterFor effect r
scoped (ConnectionTag -> Connection -> ConnectionSource
Database.Supplied ConnectionTag
"transaction" Connection
conn) (() -> Sem ((eff !! err) : r) a
use ())

interpretForXa ::
  ∀ dep eff err r .
  Member (Scoped ConnectionSource (dep !! err)) r =>
  (∀ x r0 . eff (Sem r0) x -> Sem (Stop err : dep !! err : r) x) ->
  InterpreterFor (Scoped Connection (eff !! err) !! err) r
interpretForXa :: forall (dep :: Effect) (eff :: Effect) err (r :: EffectRow).
Member (Scoped ConnectionSource (dep !! err)) r =>
(forall x (r0 :: EffectRow).
 eff (Sem r0) x -> Sem (Stop err : (dep !! err) : r) x)
-> InterpreterFor (Scoped Connection (eff !! err) !! err) r
interpretForXa forall x (r0 :: EffectRow).
eff (Sem r0) x -> Sem (Stop err : (dep !! err) : r) x
handler =
  forall (extra :: EffectRow) param resource (effect :: Effect) eo ei
       (r :: EffectRow).
KnownList extra =>
(forall (q :: Effect) x.
 param
 -> (resource -> Sem (extra ++ (Stop eo : Opaque q : r)) x)
 -> Sem (Stop eo : Opaque q : r) x)
-> (forall (q :: Effect) (r0 :: EffectRow) x.
    resource
    -> effect (Sem r0) x
    -> Sem (Stop ei : (extra ++ (Stop eo : Opaque q : r))) x)
-> InterpreterFor (Scoped param (effect !! ei) !! eo) r
interpretScopedRWith @'[dep !! err] forall (eff :: Effect) err (r :: EffectRow) a.
Member (Scoped ConnectionSource (eff !! err)) r =>
Connection -> (() -> Sem ((eff !! err) : r) a) -> Sem r a
connectionScope \ () -> forall (index :: Nat) (inserted :: EffectRow) (head :: EffectRow)
       (oldTail :: EffectRow) (tail :: EffectRow) (old :: EffectRow)
       (full :: EffectRow) a.
(ListOfLength index head, WhenStuck index InsertAtUnprovidedIndex,
 old ~ Append head oldTail, tail ~ Append inserted oldTail,
 full ~ Append head tail,
 InsertAtIndex index head tail oldTail full inserted) =>
Sem old a -> Sem full a
insertAt @2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x (r0 :: EffectRow).
eff (Sem r0) x -> Sem (Stop err : (dep !! err) : r) x
handler

interpretWithXa ::
  ∀ dep eff err r .
  FirstOrder eff "interpretResumable" =>
  Members [Scoped ConnectionSource (dep !! err), dep !! err] r =>
  (∀ x r0 . eff (Sem r0) x -> Sem (Stop err : dep !! err : r) x) ->
  InterpretersFor [Scoped Connection (eff !! err) !! err, eff !! err] r
interpretWithXa :: forall (dep :: Effect) (eff :: Effect) err (r :: EffectRow).
(FirstOrder eff "interpretResumable",
 Members '[Scoped ConnectionSource (dep !! err), dep !! err] r) =>
(forall x (r0 :: EffectRow).
 eff (Sem r0) x -> Sem (Stop err : (dep !! err) : r) x)
-> InterpretersFor
     '[Scoped Connection (eff !! err) !! err, eff !! err] r
interpretWithXa forall x (r0 :: EffectRow).
eff (Sem r0) x -> Sem (Stop err : (dep !! err) : r) x
handler =
  forall err (eff :: Effect) (r :: EffectRow).
FirstOrder eff "interpretResumable" =>
(forall x (r0 :: EffectRow).
 eff (Sem r0) x -> Sem (Stop err : r) x)
-> InterpreterFor (Resumable err eff) r
interpretResumable (forall (r :: EffectRow) (r' :: EffectRow) a.
Subsume r r' =>
Sem r a -> Sem r' a
subsume_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (e3 :: Effect) (e1 :: Effect) (e2 :: Effect)
       (r :: EffectRow) a.
Sem (e1 : e2 : r) a -> Sem (e1 : e2 : e3 : r) a
raise2Under forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x (r0 :: EffectRow).
eff (Sem r0) x -> Sem (Stop err : (dep !! err) : r) x
handler) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall (dep :: Effect) (eff :: Effect) err (r :: EffectRow).
Member (Scoped ConnectionSource (dep !! err)) r =>
(forall x (r0 :: EffectRow).
 eff (Sem r0) x -> Sem (Stop err : (dep !! err) : r) x)
-> InterpreterFor (Scoped Connection (eff !! err) !! err) r
interpretForXa (forall (e3 :: Effect) (e1 :: Effect) (e2 :: Effect)
       (r :: EffectRow) a.
Sem (e1 : e2 : r) a -> Sem (e1 : e2 : e3 : r) a
raise2Under forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x (r0 :: EffectRow).
eff (Sem r0) x -> Sem (Stop err : (dep !! err) : r) x
handler)