{-# LANGUAGE UndecidableInstances #-}
-- TODO: Fix with new GHC version, that doesn't complain.
{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}

module Mensam.Server.Application.SeldaPool.Class where

import Control.Monad.Catch
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Monad.Trans.Compose
import Control.Monad.Trans.Control.Identity
import Control.Monad.Trans.Elevator
import Control.Monad.Trans.Reader
import Data.Kind
import Database.Selda.Backend
import Database.Selda.Backend.Internal
import Database.Selda.SQLite

type MonadSeldaPool :: (Type -> Type) -> Constraint
class (Monad m, MonadMask (SeldaTransactionT m), MonadSelda (SeldaTransactionT m)) => MonadSeldaPool m where
  runSeldaTransactionT :: SeldaTransactionT m a -> m (SeldaResult a)

instance
  ( Monad (t m)
  , MonadTransControlIdentity t
  , MonadSeldaPool m
  , MonadIO m
  , MonadMask m
  ) =>
  MonadSeldaPool (Elevator t m)
  where
  runSeldaTransactionT :: forall a.
SeldaTransactionT (Elevator t m) a -> Elevator t m (SeldaResult a)
runSeldaTransactionT SeldaTransactionT (Elevator t m) a
transaction =
    ((forall x. Elevator t m x -> m x) -> m (SeldaResult a))
-> Elevator t m (SeldaResult a)
forall (m :: * -> *) a.
Monad m =>
((forall x. Elevator t m x -> m x) -> m a) -> Elevator t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControlIdentity t, Monad m) =>
((forall x. t m x -> m x) -> m a) -> t m a
liftWithIdentity (((forall x. Elevator t m x -> m x) -> m (SeldaResult a))
 -> Elevator t m (SeldaResult a))
-> ((forall x. Elevator t m x -> m x) -> m (SeldaResult a))
-> Elevator t m (SeldaResult a)
forall a b. (a -> b) -> a -> b
$ \forall x. Elevator t m x -> m x
runT ->
      SeldaTransactionT m a -> m (SeldaResult a)
forall a. SeldaTransactionT m a -> m (SeldaResult a)
forall (m :: * -> *) a.
MonadSeldaPool m =>
SeldaTransactionT m a -> m (SeldaResult a)
runSeldaTransactionT (SeldaTransactionT m a -> m (SeldaResult a))
-> SeldaTransactionT m a -> m (SeldaResult a)
forall a b. (a -> b) -> a -> b
$
        (Elevator t m a -> m a)
-> SeldaTransactionT (Elevator t m) a -> SeldaTransactionT m a
forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> SeldaTransactionT m a -> SeldaTransactionT n b
mapSeldaTransactionT Elevator t m a -> m a
forall x. Elevator t m x -> m x
runT SeldaTransactionT (Elevator t m) a
transaction

deriving via
  Elevator t1 ((t2 :: (Type -> Type) -> Type -> Type) m)
  instance
  {-# OVERLAPPABLE #-}
    ( Monad (t1 (t2 m))
    , MonadTransControlIdentity t1
    , MonadSeldaPool (t2 m)
    , MonadIO (t2 m)
    , MonadMask (t2 m)
    , MonadIO m
    , MonadTrans (ComposeT t1 t2)
    ) =>
    MonadSeldaPool (ComposeT t1 t2 m)

type SeldaTransactionT :: (Type -> Type) -> Type -> Type
newtype SeldaTransactionT m a = MkSeldaTransactionT {forall (m :: * -> *) a. SeldaTransactionT m a -> SeldaT SQLite m a
unSeldaTransactionT :: SeldaT SQLite m a}
  deriving newtype ((forall a b.
 (a -> b) -> SeldaTransactionT m a -> SeldaTransactionT m b)
-> (forall a b.
    a -> SeldaTransactionT m b -> SeldaTransactionT m a)
-> Functor (SeldaTransactionT m)
forall a b. a -> SeldaTransactionT m b -> SeldaTransactionT m a
forall a b.
(a -> b) -> SeldaTransactionT m a -> SeldaTransactionT m b
forall (m :: * -> *) a b.
Functor m =>
a -> SeldaTransactionT m b -> SeldaTransactionT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> SeldaTransactionT m a -> SeldaTransactionT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> SeldaTransactionT m a -> SeldaTransactionT m b
fmap :: forall a b.
(a -> b) -> SeldaTransactionT m a -> SeldaTransactionT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> SeldaTransactionT m b -> SeldaTransactionT m a
<$ :: forall a b. a -> SeldaTransactionT m b -> SeldaTransactionT m a
Functor, Functor (SeldaTransactionT m)
Functor (SeldaTransactionT m) =>
(forall a. a -> SeldaTransactionT m a)
-> (forall a b.
    SeldaTransactionT m (a -> b)
    -> SeldaTransactionT m a -> SeldaTransactionT m b)
-> (forall a b c.
    (a -> b -> c)
    -> SeldaTransactionT m a
    -> SeldaTransactionT m b
    -> SeldaTransactionT m c)
-> (forall a b.
    SeldaTransactionT m a
    -> SeldaTransactionT m b -> SeldaTransactionT m b)
-> (forall a b.
    SeldaTransactionT m a
    -> SeldaTransactionT m b -> SeldaTransactionT m a)
-> Applicative (SeldaTransactionT m)
forall a. a -> SeldaTransactionT m a
forall a b.
SeldaTransactionT m a
-> SeldaTransactionT m b -> SeldaTransactionT m a
forall a b.
SeldaTransactionT m a
-> SeldaTransactionT m b -> SeldaTransactionT m b
forall a b.
SeldaTransactionT m (a -> b)
-> SeldaTransactionT m a -> SeldaTransactionT m b
forall a b c.
(a -> b -> c)
-> SeldaTransactionT m a
-> SeldaTransactionT m b
-> SeldaTransactionT m 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 (m :: * -> *).
Applicative m =>
Functor (SeldaTransactionT m)
forall (m :: * -> *) a. Applicative m => a -> SeldaTransactionT m a
forall (m :: * -> *) a b.
Applicative m =>
SeldaTransactionT m a
-> SeldaTransactionT m b -> SeldaTransactionT m a
forall (m :: * -> *) a b.
Applicative m =>
SeldaTransactionT m a
-> SeldaTransactionT m b -> SeldaTransactionT m b
forall (m :: * -> *) a b.
Applicative m =>
SeldaTransactionT m (a -> b)
-> SeldaTransactionT m a -> SeldaTransactionT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> SeldaTransactionT m a
-> SeldaTransactionT m b
-> SeldaTransactionT m c
$cpure :: forall (m :: * -> *) a. Applicative m => a -> SeldaTransactionT m a
pure :: forall a. a -> SeldaTransactionT m a
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
SeldaTransactionT m (a -> b)
-> SeldaTransactionT m a -> SeldaTransactionT m b
<*> :: forall a b.
SeldaTransactionT m (a -> b)
-> SeldaTransactionT m a -> SeldaTransactionT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> SeldaTransactionT m a
-> SeldaTransactionT m b
-> SeldaTransactionT m c
liftA2 :: forall a b c.
(a -> b -> c)
-> SeldaTransactionT m a
-> SeldaTransactionT m b
-> SeldaTransactionT m c
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
SeldaTransactionT m a
-> SeldaTransactionT m b -> SeldaTransactionT m b
*> :: forall a b.
SeldaTransactionT m a
-> SeldaTransactionT m b -> SeldaTransactionT m b
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
SeldaTransactionT m a
-> SeldaTransactionT m b -> SeldaTransactionT m a
<* :: forall a b.
SeldaTransactionT m a
-> SeldaTransactionT m b -> SeldaTransactionT m a
Applicative, Applicative (SeldaTransactionT m)
Applicative (SeldaTransactionT m) =>
(forall a b.
 SeldaTransactionT m a
 -> (a -> SeldaTransactionT m b) -> SeldaTransactionT m b)
-> (forall a b.
    SeldaTransactionT m a
    -> SeldaTransactionT m b -> SeldaTransactionT m b)
-> (forall a. a -> SeldaTransactionT m a)
-> Monad (SeldaTransactionT m)
forall a. a -> SeldaTransactionT m a
forall a b.
SeldaTransactionT m a
-> SeldaTransactionT m b -> SeldaTransactionT m b
forall a b.
SeldaTransactionT m a
-> (a -> SeldaTransactionT m b) -> SeldaTransactionT m b
forall (m :: * -> *). Monad m => Applicative (SeldaTransactionT m)
forall (m :: * -> *) a. Monad m => a -> SeldaTransactionT m a
forall (m :: * -> *) a b.
Monad m =>
SeldaTransactionT m a
-> SeldaTransactionT m b -> SeldaTransactionT m b
forall (m :: * -> *) a b.
Monad m =>
SeldaTransactionT m a
-> (a -> SeldaTransactionT m b) -> SeldaTransactionT m 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
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
SeldaTransactionT m a
-> (a -> SeldaTransactionT m b) -> SeldaTransactionT m b
>>= :: forall a b.
SeldaTransactionT m a
-> (a -> SeldaTransactionT m b) -> SeldaTransactionT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
SeldaTransactionT m a
-> SeldaTransactionT m b -> SeldaTransactionT m b
>> :: forall a b.
SeldaTransactionT m a
-> SeldaTransactionT m b -> SeldaTransactionT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> SeldaTransactionT m a
return :: forall a. a -> SeldaTransactionT m a
Monad)
  deriving newtype ((forall (m :: * -> *). Monad m => Monad (SeldaTransactionT m)) =>
(forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a)
-> MonadTrans SeldaTransactionT
forall (m :: * -> *). Monad m => Monad (SeldaTransactionT m)
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *). Monad m => Monad (t m)) =>
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
$clift :: forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
lift :: forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
MonadTrans)
  deriving newtype (Monad (SeldaTransactionT m)
Monad (SeldaTransactionT m) =>
(forall a. IO a -> SeldaTransactionT m a)
-> MonadIO (SeldaTransactionT m)
forall a. IO a -> SeldaTransactionT m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (SeldaTransactionT m)
forall (m :: * -> *) a. MonadIO m => IO a -> SeldaTransactionT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> SeldaTransactionT m a
liftIO :: forall a. IO a -> SeldaTransactionT m a
MonadIO)
  deriving newtype (Monad (SeldaTransactionT m)
Monad (SeldaTransactionT m) =>
(forall e a.
 (HasCallStack, Exception e) =>
 e -> SeldaTransactionT m a)
-> MonadThrow (SeldaTransactionT m)
forall e a.
(HasCallStack, Exception e) =>
e -> SeldaTransactionT m a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
forall (m :: * -> *). MonadThrow m => Monad (SeldaTransactionT m)
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> SeldaTransactionT m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> SeldaTransactionT m a
throwM :: forall e a.
(HasCallStack, Exception e) =>
e -> SeldaTransactionT m a
MonadThrow, MonadThrow (SeldaTransactionT m)
MonadThrow (SeldaTransactionT m) =>
(forall e a.
 (HasCallStack, Exception e) =>
 SeldaTransactionT m a
 -> (e -> SeldaTransactionT m a) -> SeldaTransactionT m a)
-> MonadCatch (SeldaTransactionT m)
forall e a.
(HasCallStack, Exception e) =>
SeldaTransactionT m a
-> (e -> SeldaTransactionT m a) -> SeldaTransactionT m a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
 (HasCallStack, Exception e) =>
 m a -> (e -> m a) -> m a)
-> MonadCatch m
forall (m :: * -> *).
MonadCatch m =>
MonadThrow (SeldaTransactionT m)
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
SeldaTransactionT m a
-> (e -> SeldaTransactionT m a) -> SeldaTransactionT m a
$ccatch :: forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
SeldaTransactionT m a
-> (e -> SeldaTransactionT m a) -> SeldaTransactionT m a
catch :: forall e a.
(HasCallStack, Exception e) =>
SeldaTransactionT m a
-> (e -> SeldaTransactionT m a) -> SeldaTransactionT m a
MonadCatch, MonadCatch (SeldaTransactionT m)
MonadCatch (SeldaTransactionT m) =>
(forall b.
 HasCallStack =>
 ((forall a. SeldaTransactionT m a -> SeldaTransactionT m a)
  -> SeldaTransactionT m b)
 -> SeldaTransactionT m b)
-> (forall b.
    HasCallStack =>
    ((forall a. SeldaTransactionT m a -> SeldaTransactionT m a)
     -> SeldaTransactionT m b)
    -> SeldaTransactionT m b)
-> (forall a b c.
    HasCallStack =>
    SeldaTransactionT m a
    -> (a -> ExitCase b -> SeldaTransactionT m c)
    -> (a -> SeldaTransactionT m b)
    -> SeldaTransactionT m (b, c))
-> MonadMask (SeldaTransactionT m)
forall b.
HasCallStack =>
((forall a. SeldaTransactionT m a -> SeldaTransactionT m a)
 -> SeldaTransactionT m b)
-> SeldaTransactionT m b
forall a b c.
HasCallStack =>
SeldaTransactionT m a
-> (a -> ExitCase b -> SeldaTransactionT m c)
-> (a -> SeldaTransactionT m b)
-> SeldaTransactionT m (b, c)
forall (m :: * -> *).
MonadMask m =>
MonadCatch (SeldaTransactionT m)
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. SeldaTransactionT m a -> SeldaTransactionT m a)
 -> SeldaTransactionT m b)
-> SeldaTransactionT m b
forall (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
SeldaTransactionT m a
-> (a -> ExitCase b -> SeldaTransactionT m c)
-> (a -> SeldaTransactionT m b)
-> SeldaTransactionT m (b, c)
forall (m :: * -> *).
MonadCatch m =>
(forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b.
    HasCallStack =>
    ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    HasCallStack =>
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
$cmask :: forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. SeldaTransactionT m a -> SeldaTransactionT m a)
 -> SeldaTransactionT m b)
-> SeldaTransactionT m b
mask :: forall b.
HasCallStack =>
((forall a. SeldaTransactionT m a -> SeldaTransactionT m a)
 -> SeldaTransactionT m b)
-> SeldaTransactionT m b
$cuninterruptibleMask :: forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. SeldaTransactionT m a -> SeldaTransactionT m a)
 -> SeldaTransactionT m b)
-> SeldaTransactionT m b
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. SeldaTransactionT m a -> SeldaTransactionT m a)
 -> SeldaTransactionT m b)
-> SeldaTransactionT m b
$cgeneralBracket :: forall (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
SeldaTransactionT m a
-> (a -> ExitCase b -> SeldaTransactionT m c)
-> (a -> SeldaTransactionT m b)
-> SeldaTransactionT m (b, c)
generalBracket :: forall a b c.
HasCallStack =>
SeldaTransactionT m a
-> (a -> ExitCase b -> SeldaTransactionT m c)
-> (a -> SeldaTransactionT m b)
-> SeldaTransactionT m (b, c)
MonadMask)
  deriving newtype (MonadIO (SeldaTransactionT m)
MonadIO (SeldaTransactionT m) =>
(forall a.
 (SeldaConnection (Backend (SeldaTransactionT m))
  -> SeldaTransactionT m a)
 -> SeldaTransactionT m a)
-> (forall a. SeldaTransactionT m a -> SeldaTransactionT m a)
-> MonadSelda (SeldaTransactionT m)
forall a. SeldaTransactionT m a -> SeldaTransactionT m a
forall a.
(SeldaConnection (Backend (SeldaTransactionT m))
 -> SeldaTransactionT m a)
-> SeldaTransactionT m a
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
MonadIO (SeldaTransactionT m)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
SeldaTransactionT m a -> SeldaTransactionT m a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
(SeldaConnection (Backend (SeldaTransactionT m))
 -> SeldaTransactionT m a)
-> SeldaTransactionT m a
forall (m :: * -> *).
MonadIO m =>
(forall a. (SeldaConnection (Backend m) -> m a) -> m a)
-> (forall a. m a -> m a) -> MonadSelda m
$cwithConnection :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
(SeldaConnection (Backend (SeldaTransactionT m))
 -> SeldaTransactionT m a)
-> SeldaTransactionT m a
withConnection :: forall a.
(SeldaConnection (Backend (SeldaTransactionT m))
 -> SeldaTransactionT m a)
-> SeldaTransactionT m a
$ctransact :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
SeldaTransactionT m a -> SeldaTransactionT m a
transact :: forall a. SeldaTransactionT m a -> SeldaTransactionT m a
MonadSelda)

mapSeldaTransactionT :: (m a -> n b) -> SeldaTransactionT m a -> SeldaTransactionT n b
mapSeldaTransactionT :: forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> SeldaTransactionT m a -> SeldaTransactionT n b
mapSeldaTransactionT m a -> n b
f = SeldaT SQLite n b -> SeldaTransactionT n b
forall (m :: * -> *) a. SeldaT SQLite m a -> SeldaTransactionT m a
MkSeldaTransactionT (SeldaT SQLite n b -> SeldaTransactionT n b)
-> (SeldaTransactionT m a -> SeldaT SQLite n b)
-> SeldaTransactionT m a
-> SeldaTransactionT n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT (SeldaConnection SQLite) n b -> SeldaT SQLite n b
forall b (m :: * -> *) a.
ReaderT (SeldaConnection b) m a -> SeldaT b m a
S (ReaderT (SeldaConnection SQLite) n b -> SeldaT SQLite n b)
-> (SeldaTransactionT m a -> ReaderT (SeldaConnection SQLite) n b)
-> SeldaTransactionT m a
-> SeldaT SQLite n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m a -> n b)
-> ReaderT (SeldaConnection SQLite) m a
-> ReaderT (SeldaConnection SQLite) n b
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT m a -> n b
f (ReaderT (SeldaConnection SQLite) m a
 -> ReaderT (SeldaConnection SQLite) n b)
-> (SeldaTransactionT m a -> ReaderT (SeldaConnection SQLite) m a)
-> SeldaTransactionT m a
-> ReaderT (SeldaConnection SQLite) n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SeldaT SQLite m a -> ReaderT (SeldaConnection SQLite) m a
forall b (m :: * -> *) a.
SeldaT b m a -> ReaderT (SeldaConnection b) m a
unS (SeldaT SQLite m a -> ReaderT (SeldaConnection SQLite) m a)
-> (SeldaTransactionT m a -> SeldaT SQLite m a)
-> SeldaTransactionT m a
-> ReaderT (SeldaConnection SQLite) m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SeldaTransactionT m a -> SeldaT SQLite m a
forall (m :: * -> *) a. SeldaTransactionT m a -> SeldaT SQLite m a
unSeldaTransactionT

type SeldaResult :: Type -> Type
data SeldaResult a
  = SeldaSuccess a
  | SeldaFailure SomeException