module Database.PostgreSQL.PQTypes.Internal.Monad
  ( DBT_ (..)
  , DBT
  , runDBT
  , mapDBT
  ) where

import Control.Applicative
import Control.Concurrent.MVar
import Control.Monad
import Control.Monad.Base
import Control.Monad.Catch
import Control.Monad.Error.Class
import Control.Monad.Fail qualified as MF
import Control.Monad.Reader.Class
import Control.Monad.State.Strict
import Control.Monad.Trans.Control
import Control.Monad.Trans.State.Strict qualified as S
import Control.Monad.Writer.Class
import GHC.Stack

import Database.PostgreSQL.PQTypes.Class
import Database.PostgreSQL.PQTypes.Internal.Connection
import Database.PostgreSQL.PQTypes.Internal.Error
import Database.PostgreSQL.PQTypes.Internal.Notification
import Database.PostgreSQL.PQTypes.Internal.State
import Database.PostgreSQL.PQTypes.SQL
import Database.PostgreSQL.PQTypes.SQL.Class
import Database.PostgreSQL.PQTypes.Transaction
import Database.PostgreSQL.PQTypes.Transaction.Settings
import Database.PostgreSQL.PQTypes.Utils

type InnerDBT m = StateT (DBState m)

-- | Monad transformer for adding database
-- interaction capabilities to the underlying monad.
newtype DBT_ m n a = DBT {forall (m :: * -> *) (n :: * -> *) a. DBT_ m n a -> InnerDBT m n a
unDBT :: InnerDBT m n a}
  deriving (Applicative (DBT_ m n)
Applicative (DBT_ m n) =>
(forall a. DBT_ m n a)
-> (forall a. DBT_ m n a -> DBT_ m n a -> DBT_ m n a)
-> (forall a. DBT_ m n a -> DBT_ m n [a])
-> (forall a. DBT_ m n a -> DBT_ m n [a])
-> Alternative (DBT_ m n)
forall a. DBT_ m n a
forall a. DBT_ m n a -> DBT_ m n [a]
forall a. DBT_ m n a -> DBT_ m n a -> DBT_ m n a
forall (f :: * -> *).
Applicative f =>
(forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
forall (m :: * -> *) (n :: * -> *).
MonadPlus n =>
Applicative (DBT_ m n)
forall (m :: * -> *) (n :: * -> *) a. MonadPlus n => DBT_ m n a
forall (m :: * -> *) (n :: * -> *) a.
MonadPlus n =>
DBT_ m n a -> DBT_ m n [a]
forall (m :: * -> *) (n :: * -> *) a.
MonadPlus n =>
DBT_ m n a -> DBT_ m n a -> DBT_ m n a
$cempty :: forall (m :: * -> *) (n :: * -> *) a. MonadPlus n => DBT_ m n a
empty :: forall a. DBT_ m n a
$c<|> :: forall (m :: * -> *) (n :: * -> *) a.
MonadPlus n =>
DBT_ m n a -> DBT_ m n a -> DBT_ m n a
<|> :: forall a. DBT_ m n a -> DBT_ m n a -> DBT_ m n a
$csome :: forall (m :: * -> *) (n :: * -> *) a.
MonadPlus n =>
DBT_ m n a -> DBT_ m n [a]
some :: forall a. DBT_ m n a -> DBT_ m n [a]
$cmany :: forall (m :: * -> *) (n :: * -> *) a.
MonadPlus n =>
DBT_ m n a -> DBT_ m n [a]
many :: forall a. DBT_ m n a -> DBT_ m n [a]
Alternative, Functor (DBT_ m n)
Functor (DBT_ m n) =>
(forall a. a -> DBT_ m n a)
-> (forall a b. DBT_ m n (a -> b) -> DBT_ m n a -> DBT_ m n b)
-> (forall a b c.
    (a -> b -> c) -> DBT_ m n a -> DBT_ m n b -> DBT_ m n c)
-> (forall a b. DBT_ m n a -> DBT_ m n b -> DBT_ m n b)
-> (forall a b. DBT_ m n a -> DBT_ m n b -> DBT_ m n a)
-> Applicative (DBT_ m n)
forall a. a -> DBT_ m n a
forall a b. DBT_ m n a -> DBT_ m n b -> DBT_ m n a
forall a b. DBT_ m n a -> DBT_ m n b -> DBT_ m n b
forall a b. DBT_ m n (a -> b) -> DBT_ m n a -> DBT_ m n b
forall a b c.
(a -> b -> c) -> DBT_ m n a -> DBT_ m n b -> DBT_ m n 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 :: * -> *) (n :: * -> *). Monad n => Functor (DBT_ m n)
forall (m :: * -> *) (n :: * -> *) a. Monad n => a -> DBT_ m n a
forall (m :: * -> *) (n :: * -> *) a b.
Monad n =>
DBT_ m n a -> DBT_ m n b -> DBT_ m n a
forall (m :: * -> *) (n :: * -> *) a b.
Monad n =>
DBT_ m n a -> DBT_ m n b -> DBT_ m n b
forall (m :: * -> *) (n :: * -> *) a b.
Monad n =>
DBT_ m n (a -> b) -> DBT_ m n a -> DBT_ m n b
forall (m :: * -> *) (n :: * -> *) a b c.
Monad n =>
(a -> b -> c) -> DBT_ m n a -> DBT_ m n b -> DBT_ m n c
$cpure :: forall (m :: * -> *) (n :: * -> *) a. Monad n => a -> DBT_ m n a
pure :: forall a. a -> DBT_ m n a
$c<*> :: forall (m :: * -> *) (n :: * -> *) a b.
Monad n =>
DBT_ m n (a -> b) -> DBT_ m n a -> DBT_ m n b
<*> :: forall a b. DBT_ m n (a -> b) -> DBT_ m n a -> DBT_ m n b
$cliftA2 :: forall (m :: * -> *) (n :: * -> *) a b c.
Monad n =>
(a -> b -> c) -> DBT_ m n a -> DBT_ m n b -> DBT_ m n c
liftA2 :: forall a b c.
(a -> b -> c) -> DBT_ m n a -> DBT_ m n b -> DBT_ m n c
$c*> :: forall (m :: * -> *) (n :: * -> *) a b.
Monad n =>
DBT_ m n a -> DBT_ m n b -> DBT_ m n b
*> :: forall a b. DBT_ m n a -> DBT_ m n b -> DBT_ m n b
$c<* :: forall (m :: * -> *) (n :: * -> *) a b.
Monad n =>
DBT_ m n a -> DBT_ m n b -> DBT_ m n a
<* :: forall a b. DBT_ m n a -> DBT_ m n b -> DBT_ m n a
Applicative, (forall a b. (a -> b) -> DBT_ m n a -> DBT_ m n b)
-> (forall a b. a -> DBT_ m n b -> DBT_ m n a)
-> Functor (DBT_ m n)
forall a b. a -> DBT_ m n b -> DBT_ m n a
forall a b. (a -> b) -> DBT_ m n a -> DBT_ m n b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (m :: * -> *) (n :: * -> *) a b.
Functor n =>
a -> DBT_ m n b -> DBT_ m n a
forall (m :: * -> *) (n :: * -> *) a b.
Functor n =>
(a -> b) -> DBT_ m n a -> DBT_ m n b
$cfmap :: forall (m :: * -> *) (n :: * -> *) a b.
Functor n =>
(a -> b) -> DBT_ m n a -> DBT_ m n b
fmap :: forall a b. (a -> b) -> DBT_ m n a -> DBT_ m n b
$c<$ :: forall (m :: * -> *) (n :: * -> *) a b.
Functor n =>
a -> DBT_ m n b -> DBT_ m n a
<$ :: forall a b. a -> DBT_ m n b -> DBT_ m n a
Functor, Applicative (DBT_ m n)
Applicative (DBT_ m n) =>
(forall a b. DBT_ m n a -> (a -> DBT_ m n b) -> DBT_ m n b)
-> (forall a b. DBT_ m n a -> DBT_ m n b -> DBT_ m n b)
-> (forall a. a -> DBT_ m n a)
-> Monad (DBT_ m n)
forall a. a -> DBT_ m n a
forall a b. DBT_ m n a -> DBT_ m n b -> DBT_ m n b
forall a b. DBT_ m n a -> (a -> DBT_ m n b) -> DBT_ m n 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
forall (m :: * -> *) (n :: * -> *).
Monad n =>
Applicative (DBT_ m n)
forall (m :: * -> *) (n :: * -> *) a. Monad n => a -> DBT_ m n a
forall (m :: * -> *) (n :: * -> *) a b.
Monad n =>
DBT_ m n a -> DBT_ m n b -> DBT_ m n b
forall (m :: * -> *) (n :: * -> *) a b.
Monad n =>
DBT_ m n a -> (a -> DBT_ m n b) -> DBT_ m n b
$c>>= :: forall (m :: * -> *) (n :: * -> *) a b.
Monad n =>
DBT_ m n a -> (a -> DBT_ m n b) -> DBT_ m n b
>>= :: forall a b. DBT_ m n a -> (a -> DBT_ m n b) -> DBT_ m n b
$c>> :: forall (m :: * -> *) (n :: * -> *) a b.
Monad n =>
DBT_ m n a -> DBT_ m n b -> DBT_ m n b
>> :: forall a b. DBT_ m n a -> DBT_ m n b -> DBT_ m n b
$creturn :: forall (m :: * -> *) (n :: * -> *) a. Monad n => a -> DBT_ m n a
return :: forall a. a -> DBT_ m n a
Monad, Monad (DBT_ m n)
Monad (DBT_ m n) =>
(forall a. String -> DBT_ m n a) -> MonadFail (DBT_ m n)
forall a. String -> DBT_ m n a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
forall (m :: * -> *) (n :: * -> *). MonadFail n => Monad (DBT_ m n)
forall (m :: * -> *) (n :: * -> *) a.
MonadFail n =>
String -> DBT_ m n a
$cfail :: forall (m :: * -> *) (n :: * -> *) a.
MonadFail n =>
String -> DBT_ m n a
fail :: forall a. String -> DBT_ m n a
MF.MonadFail, MonadBase b, MonadThrow (DBT_ m n)
MonadThrow (DBT_ m n) =>
(forall e a.
 (HasCallStack, Exception e) =>
 DBT_ m n a -> (e -> DBT_ m n a) -> DBT_ m n a)
-> MonadCatch (DBT_ m n)
forall e a.
(HasCallStack, Exception e) =>
DBT_ m n a -> (e -> DBT_ m n a) -> DBT_ m n a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
 (HasCallStack, Exception e) =>
 m a -> (e -> m a) -> m a)
-> MonadCatch m
forall (m :: * -> *) (n :: * -> *).
MonadCatch n =>
MonadThrow (DBT_ m n)
forall (m :: * -> *) (n :: * -> *) e a.
(MonadCatch n, HasCallStack, Exception e) =>
DBT_ m n a -> (e -> DBT_ m n a) -> DBT_ m n a
$ccatch :: forall (m :: * -> *) (n :: * -> *) e a.
(MonadCatch n, HasCallStack, Exception e) =>
DBT_ m n a -> (e -> DBT_ m n a) -> DBT_ m n a
catch :: forall e a.
(HasCallStack, Exception e) =>
DBT_ m n a -> (e -> DBT_ m n a) -> DBT_ m n a
MonadCatch, Monad (DBT_ m n)
Monad (DBT_ m n) =>
(forall a. IO a -> DBT_ m n a) -> MonadIO (DBT_ m n)
forall a. IO a -> DBT_ m n a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *) (n :: * -> *). MonadIO n => Monad (DBT_ m n)
forall (m :: * -> *) (n :: * -> *) a.
MonadIO n =>
IO a -> DBT_ m n a
$cliftIO :: forall (m :: * -> *) (n :: * -> *) a.
MonadIO n =>
IO a -> DBT_ m n a
liftIO :: forall a. IO a -> DBT_ m n a
MonadIO, MonadCatch (DBT_ m n)
MonadCatch (DBT_ m n) =>
(forall b.
 HasCallStack =>
 ((forall a. DBT_ m n a -> DBT_ m n a) -> DBT_ m n b) -> DBT_ m n b)
-> (forall b.
    HasCallStack =>
    ((forall a. DBT_ m n a -> DBT_ m n a) -> DBT_ m n b) -> DBT_ m n b)
-> (forall a b c.
    HasCallStack =>
    DBT_ m n a
    -> (a -> ExitCase b -> DBT_ m n c)
    -> (a -> DBT_ m n b)
    -> DBT_ m n (b, c))
-> MonadMask (DBT_ m n)
forall b.
HasCallStack =>
((forall a. DBT_ m n a -> DBT_ m n a) -> DBT_ m n b) -> DBT_ m n b
forall a b c.
HasCallStack =>
DBT_ m n a
-> (a -> ExitCase b -> DBT_ m n c)
-> (a -> DBT_ m n b)
-> DBT_ m n (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
forall (m :: * -> *) (n :: * -> *).
MonadMask n =>
MonadCatch (DBT_ m n)
forall (m :: * -> *) (n :: * -> *) b.
(MonadMask n, HasCallStack) =>
((forall a. DBT_ m n a -> DBT_ m n a) -> DBT_ m n b) -> DBT_ m n b
forall (m :: * -> *) (n :: * -> *) a b c.
(MonadMask n, HasCallStack) =>
DBT_ m n a
-> (a -> ExitCase b -> DBT_ m n c)
-> (a -> DBT_ m n b)
-> DBT_ m n (b, c)
$cmask :: forall (m :: * -> *) (n :: * -> *) b.
(MonadMask n, HasCallStack) =>
((forall a. DBT_ m n a -> DBT_ m n a) -> DBT_ m n b) -> DBT_ m n b
mask :: forall b.
HasCallStack =>
((forall a. DBT_ m n a -> DBT_ m n a) -> DBT_ m n b) -> DBT_ m n b
$cuninterruptibleMask :: forall (m :: * -> *) (n :: * -> *) b.
(MonadMask n, HasCallStack) =>
((forall a. DBT_ m n a -> DBT_ m n a) -> DBT_ m n b) -> DBT_ m n b
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. DBT_ m n a -> DBT_ m n a) -> DBT_ m n b) -> DBT_ m n b
$cgeneralBracket :: forall (m :: * -> *) (n :: * -> *) a b c.
(MonadMask n, HasCallStack) =>
DBT_ m n a
-> (a -> ExitCase b -> DBT_ m n c)
-> (a -> DBT_ m n b)
-> DBT_ m n (b, c)
generalBracket :: forall a b c.
HasCallStack =>
DBT_ m n a
-> (a -> ExitCase b -> DBT_ m n c)
-> (a -> DBT_ m n b)
-> DBT_ m n (b, c)
MonadMask, Monad (DBT_ m n)
Alternative (DBT_ m n)
(Alternative (DBT_ m n), Monad (DBT_ m n)) =>
(forall a. DBT_ m n a)
-> (forall a. DBT_ m n a -> DBT_ m n a -> DBT_ m n a)
-> MonadPlus (DBT_ m n)
forall a. DBT_ m n a
forall a. DBT_ m n a -> DBT_ m n a -> DBT_ m n a
forall (m :: * -> *).
(Alternative m, Monad m) =>
(forall a. m a) -> (forall a. m a -> m a -> m a) -> MonadPlus m
forall (m :: * -> *) (n :: * -> *). MonadPlus n => Monad (DBT_ m n)
forall (m :: * -> *) (n :: * -> *).
MonadPlus n =>
Alternative (DBT_ m n)
forall (m :: * -> *) (n :: * -> *) a. MonadPlus n => DBT_ m n a
forall (m :: * -> *) (n :: * -> *) a.
MonadPlus n =>
DBT_ m n a -> DBT_ m n a -> DBT_ m n a
$cmzero :: forall (m :: * -> *) (n :: * -> *) a. MonadPlus n => DBT_ m n a
mzero :: forall a. DBT_ m n a
$cmplus :: forall (m :: * -> *) (n :: * -> *) a.
MonadPlus n =>
DBT_ m n a -> DBT_ m n a -> DBT_ m n a
mplus :: forall a. DBT_ m n a -> DBT_ m n a -> DBT_ m n a
MonadPlus, Monad (DBT_ m n)
Monad (DBT_ m n) =>
(forall e a. (HasCallStack, Exception e) => e -> DBT_ m n a)
-> MonadThrow (DBT_ m n)
forall e a. (HasCallStack, Exception e) => e -> DBT_ m n a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
forall (m :: * -> *) (n :: * -> *).
MonadThrow n =>
Monad (DBT_ m n)
forall (m :: * -> *) (n :: * -> *) e a.
(MonadThrow n, HasCallStack, Exception e) =>
e -> DBT_ m n a
$cthrowM :: forall (m :: * -> *) (n :: * -> *) e a.
(MonadThrow n, HasCallStack, Exception e) =>
e -> DBT_ m n a
throwM :: forall e a. (HasCallStack, Exception e) => e -> DBT_ m n a
MonadThrow, (forall (m :: * -> *). Monad m => Monad (DBT_ m m)) =>
(forall (m :: * -> *) a. Monad m => m a -> DBT_ m m a)
-> MonadTrans (DBT_ m)
forall (m :: * -> *). Monad m => Monad (DBT_ m m)
forall (m :: * -> *) a. Monad m => m a -> DBT_ m m a
forall (m :: * -> *) (n :: * -> *). Monad n => Monad (DBT_ m n)
forall (m :: * -> *) (m :: * -> *) a. Monad m => m a -> DBT_ m 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 :: * -> *) (m :: * -> *) a. Monad m => m a -> DBT_ m m a
lift :: forall (m :: * -> *) a. Monad m => m a -> DBT_ m m a
MonadTrans)

type DBT m = DBT_ m m

-- | Evaluate monadic action with supplied
-- connection source and transaction settings.
runDBT
  :: (HasCallStack, MonadBase IO m, MonadMask m)
  => ConnectionSourceM m
  -> TransactionSettings
  -> DBT m a
  -> m a
runDBT :: forall (m :: * -> *) a.
(HasCallStack, MonadBase IO m, MonadMask m) =>
ConnectionSourceM m -> TransactionSettings -> DBT m a -> m a
runDBT ConnectionSourceM m
cs TransactionSettings
ts DBT m a
m = ConnectionSourceM m -> forall r. (Connection -> m r) -> m r
forall (m :: * -> *).
ConnectionSourceM m -> forall r. (Connection -> m r) -> m r
withConnection ConnectionSourceM m
cs ((Connection -> m a) -> m a) -> (Connection -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Connection
conn -> do
  StateT (DBState m) m a -> DBState m -> m a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT (DBState m) m a
action (DBState m -> m a) -> DBState m -> m a
forall a b. (a -> b) -> a -> b
$
    DBState
      { dbConnection :: Connection
dbConnection = Connection
conn
      , dbConnectionSource :: ConnectionSourceM m
dbConnectionSource = ConnectionSourceM m
cs
      , dbTransactionSettings :: TransactionSettings
dbTransactionSettings = TransactionSettings
ts
      , dbLastQuery :: SomeSQL
dbLastQuery = SQL -> SomeSQL
forall sql. IsSQL sql => sql -> SomeSQL
SomeSQL (SQL
forall a. Monoid a => a
mempty :: SQL)
      , dbRecordLastQuery :: Bool
dbRecordLastQuery = Bool
True
      , dbQueryResult :: forall row. FromRow row => Maybe (QueryResult row)
dbQueryResult = Maybe (QueryResult row)
forall a. Maybe a
forall row. FromRow row => Maybe (QueryResult row)
Nothing
      }
  where
    action :: StateT (DBState m) m a
action =
      DBT m a -> StateT (DBState m) m a
forall (m :: * -> *) (n :: * -> *) a. DBT_ m n a -> InnerDBT m n a
unDBT (DBT m a -> StateT (DBState m) m a)
-> DBT m a -> StateT (DBState m) m a
forall a b. (a -> b) -> a -> b
$
        if TransactionSettings -> Bool
tsAutoTransaction TransactionSettings
ts
          then TransactionSettings -> DBT m a -> DBT m a
forall (m :: * -> *) a.
(HasCallStack, MonadDB m, MonadMask m) =>
TransactionSettings -> m a -> m a
withTransaction' (TransactionSettings
ts {tsAutoTransaction = False}) DBT m a
m
          else DBT m a
m

-- | Transform the underlying monad.
mapDBT
  :: (DBState n -> DBState m)
  -> (m (a, DBState m) -> n (b, DBState n))
  -> DBT m a
  -> DBT n b
mapDBT :: forall (n :: * -> *) (m :: * -> *) a b.
(DBState n -> DBState m)
-> (m (a, DBState m) -> n (b, DBState n)) -> DBT m a -> DBT n b
mapDBT DBState n -> DBState m
f m (a, DBState m) -> n (b, DBState n)
g DBT m a
m = InnerDBT n n b -> DBT_ n n b
forall (m :: * -> *) (n :: * -> *) a. InnerDBT m n a -> DBT_ m n a
DBT (InnerDBT n n b -> DBT_ n n b)
-> ((DBState n -> n (b, DBState n)) -> InnerDBT n n b)
-> (DBState n -> n (b, DBState n))
-> DBT_ n n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DBState n -> n (b, DBState n)) -> InnerDBT n n b
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((DBState n -> n (b, DBState n)) -> DBT_ n n b)
-> (DBState n -> n (b, DBState n)) -> DBT_ n n b
forall a b. (a -> b) -> a -> b
$ m (a, DBState m) -> n (b, DBState n)
g (m (a, DBState m) -> n (b, DBState n))
-> (DBState n -> m (a, DBState m)) -> DBState n -> n (b, DBState n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT (DBState m) m a -> DBState m -> m (a, DBState m)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (DBT m a -> StateT (DBState m) m a
forall (m :: * -> *) (n :: * -> *) a. DBT_ m n a -> InnerDBT m n a
unDBT DBT m a
m) (DBState m -> m (a, DBState m))
-> (DBState n -> DBState m) -> DBState n -> m (a, DBState m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DBState n -> DBState m
f

----------------------------------------

instance (m ~ n, MonadBase IO m, MonadMask m) => MonadDB (DBT_ m n) where
  runQuery :: forall sql. (HasCallStack, IsSQL sql) => sql -> DBT_ m n Int
runQuery sql
sql = (HasCallStack => DBT_ m n Int) -> DBT_ m n Int
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => DBT_ m n Int) -> DBT_ m n Int)
-> (HasCallStack => DBT_ m n Int) -> DBT_ m n Int
forall a b. (a -> b) -> a -> b
$ do
    InnerDBT m n Int -> DBT_ m n Int
forall (m :: * -> *) (n :: * -> *) a. InnerDBT m n a -> DBT_ m n a
DBT (InnerDBT m n Int -> DBT_ m n Int)
-> ((DBState m -> n (Int, DBState m)) -> InnerDBT m n Int)
-> (DBState m -> n (Int, DBState m))
-> DBT_ m n Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DBState m -> n (Int, DBState m)) -> InnerDBT m n Int
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((DBState m -> n (Int, DBState m)) -> DBT_ m n Int)
-> (DBState m -> n (Int, DBState m)) -> DBT_ m n Int
forall a b. (a -> b) -> a -> b
$ \DBState m
st -> IO (Int, DBState m) -> n (Int, DBState m)
forall α. IO α -> n α
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (Int, DBState m) -> n (Int, DBState m))
-> IO (Int, DBState m) -> n (Int, DBState m)
forall a b. (a -> b) -> a -> b
$ do
      DBState m
-> sql -> (Int, ForeignPtr PGresult) -> IO (Int, DBState m)
forall sql (m :: * -> *) r.
IsSQL sql =>
DBState m -> sql -> (r, ForeignPtr PGresult) -> IO (r, DBState m)
updateStateWith DBState m
st sql
sql ((Int, ForeignPtr PGresult) -> IO (Int, DBState m))
-> IO (Int, ForeignPtr PGresult) -> IO (Int, DBState m)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Connection -> sql -> IO (Int, ForeignPtr PGresult)
forall sql.
(HasCallStack, IsSQL sql) =>
Connection -> sql -> IO (Int, ForeignPtr PGresult)
runQueryIO (DBState m -> Connection
forall (m :: * -> *). DBState m -> Connection
dbConnection DBState m
st) sql
sql
  runPreparedQuery :: forall sql.
(HasCallStack, IsSQL sql) =>
QueryName -> sql -> DBT_ m n Int
runPreparedQuery QueryName
name sql
sql = (HasCallStack => DBT_ m n Int) -> DBT_ m n Int
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => DBT_ m n Int) -> DBT_ m n Int)
-> (HasCallStack => DBT_ m n Int) -> DBT_ m n Int
forall a b. (a -> b) -> a -> b
$ do
    InnerDBT m n Int -> DBT_ m n Int
forall (m :: * -> *) (n :: * -> *) a. InnerDBT m n a -> DBT_ m n a
DBT (InnerDBT m n Int -> DBT_ m n Int)
-> ((DBState m -> n (Int, DBState m)) -> InnerDBT m n Int)
-> (DBState m -> n (Int, DBState m))
-> DBT_ m n Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DBState m -> n (Int, DBState m)) -> InnerDBT m n Int
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((DBState m -> n (Int, DBState m)) -> DBT_ m n Int)
-> (DBState m -> n (Int, DBState m)) -> DBT_ m n Int
forall a b. (a -> b) -> a -> b
$ \DBState m
st -> IO (Int, DBState m) -> n (Int, DBState m)
forall α. IO α -> n α
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (Int, DBState m) -> n (Int, DBState m))
-> IO (Int, DBState m) -> n (Int, DBState m)
forall a b. (a -> b) -> a -> b
$ do
      DBState m
-> sql -> (Int, ForeignPtr PGresult) -> IO (Int, DBState m)
forall sql (m :: * -> *) r.
IsSQL sql =>
DBState m -> sql -> (r, ForeignPtr PGresult) -> IO (r, DBState m)
updateStateWith DBState m
st sql
sql ((Int, ForeignPtr PGresult) -> IO (Int, DBState m))
-> IO (Int, ForeignPtr PGresult) -> IO (Int, DBState m)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Connection -> QueryName -> sql -> IO (Int, ForeignPtr PGresult)
forall sql.
(HasCallStack, IsSQL sql) =>
Connection -> QueryName -> sql -> IO (Int, ForeignPtr PGresult)
runPreparedQueryIO (DBState m -> Connection
forall (m :: * -> *). DBState m -> Connection
dbConnection DBState m
st) QueryName
name sql
sql

  getLastQuery :: DBT_ m n SomeSQL
getLastQuery = InnerDBT m n SomeSQL -> DBT_ m n SomeSQL
forall (m :: * -> *) (n :: * -> *) a. InnerDBT m n a -> DBT_ m n a
DBT (InnerDBT m n SomeSQL -> DBT_ m n SomeSQL)
-> ((DBState n -> SomeSQL) -> InnerDBT m n SomeSQL)
-> (DBState n -> SomeSQL)
-> DBT_ m n SomeSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DBState n -> SomeSQL) -> InnerDBT m n SomeSQL
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((DBState n -> SomeSQL) -> DBT_ m n SomeSQL)
-> (DBState n -> SomeSQL) -> DBT_ m n SomeSQL
forall a b. (a -> b) -> a -> b
$ DBState n -> SomeSQL
forall (m :: * -> *). DBState m -> SomeSQL
dbLastQuery

  withFrozenLastQuery :: forall a. DBT_ m n a -> DBT_ m n a
withFrozenLastQuery DBT_ m n a
callback = InnerDBT m n a -> DBT_ m n a
forall (m :: * -> *) (n :: * -> *) a. InnerDBT m n a -> DBT_ m n a
DBT (InnerDBT m n a -> DBT_ m n a)
-> ((DBState m -> n (a, DBState m)) -> InnerDBT m n a)
-> (DBState m -> n (a, DBState m))
-> DBT_ m n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DBState m -> n (a, DBState m)) -> InnerDBT m n a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((DBState m -> n (a, DBState m)) -> DBT_ m n a)
-> (DBState m -> n (a, DBState m)) -> DBT_ m n a
forall a b. (a -> b) -> a -> b
$ \DBState m
st -> do
    let st' :: DBState m
st' = DBState m
st {dbRecordLastQuery = False}
    (a
x, DBState m
st'') <- InnerDBT m n a -> DBState m -> n (a, DBState m)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (DBT_ m n a -> InnerDBT m n a
forall (m :: * -> *) (n :: * -> *) a. DBT_ m n a -> InnerDBT m n a
unDBT DBT_ m n a
callback) DBState m
st'
    (a, DBState m) -> n (a, DBState m)
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
x, DBState m
st'' {dbRecordLastQuery = dbRecordLastQuery st})

  getBackendPid :: DBT_ m n BackendPid
getBackendPid = InnerDBT m n BackendPid -> DBT_ m n BackendPid
forall (m :: * -> *) (n :: * -> *) a. InnerDBT m n a -> DBT_ m n a
DBT (InnerDBT m n BackendPid -> DBT_ m n BackendPid)
-> ((DBState m -> n (BackendPid, DBState m))
    -> InnerDBT m n BackendPid)
-> (DBState m -> n (BackendPid, DBState m))
-> DBT_ m n BackendPid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DBState m -> n (BackendPid, DBState m)) -> InnerDBT m n BackendPid
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((DBState m -> n (BackendPid, DBState m)) -> DBT_ m n BackendPid)
-> (DBState m -> n (BackendPid, DBState m)) -> DBT_ m n BackendPid
forall a b. (a -> b) -> a -> b
$ \DBState m
st -> do
    (,DBState m
st) (BackendPid -> (BackendPid, DBState m))
-> n BackendPid -> n (BackendPid, DBState m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO BackendPid -> n BackendPid
forall α. IO α -> n α
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (Connection -> IO BackendPid
getBackendPidIO (Connection -> IO BackendPid) -> Connection -> IO BackendPid
forall a b. (a -> b) -> a -> b
$ DBState m -> Connection
forall (m :: * -> *). DBState m -> Connection
dbConnection DBState m
st)

  getConnectionStats :: HasCallStack => DBT_ m n ConnectionStats
getConnectionStats = (HasCallStack => DBT_ m n ConnectionStats)
-> DBT_ m n ConnectionStats
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => DBT_ m n ConnectionStats)
 -> DBT_ m n ConnectionStats)
-> (HasCallStack => DBT_ m n ConnectionStats)
-> DBT_ m n ConnectionStats
forall a b. (a -> b) -> a -> b
$ do
    Maybe ConnectionData
mconn <- InnerDBT m n (Maybe ConnectionData)
-> DBT_ m n (Maybe ConnectionData)
forall (m :: * -> *) (n :: * -> *) a. InnerDBT m n a -> DBT_ m n a
DBT (InnerDBT m n (Maybe ConnectionData)
 -> DBT_ m n (Maybe ConnectionData))
-> InnerDBT m n (Maybe ConnectionData)
-> DBT_ m n (Maybe ConnectionData)
forall a b. (a -> b) -> a -> b
$ IO (Maybe ConnectionData) -> InnerDBT m n (Maybe ConnectionData)
forall α. IO α -> StateT (DBState m) n α
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (Maybe ConnectionData) -> InnerDBT m n (Maybe ConnectionData))
-> (MVar (Maybe ConnectionData) -> IO (Maybe ConnectionData))
-> MVar (Maybe ConnectionData)
-> InnerDBT m n (Maybe ConnectionData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar (Maybe ConnectionData) -> IO (Maybe ConnectionData)
forall a. MVar a -> IO a
readMVar (MVar (Maybe ConnectionData)
 -> InnerDBT m n (Maybe ConnectionData))
-> StateT (DBState m) n (MVar (Maybe ConnectionData))
-> InnerDBT m n (Maybe ConnectionData)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (DBState n -> MVar (Maybe ConnectionData))
-> StateT (DBState m) n (MVar (Maybe ConnectionData))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Connection -> MVar (Maybe ConnectionData)
unConnection (Connection -> MVar (Maybe ConnectionData))
-> (DBState n -> Connection)
-> DBState n
-> MVar (Maybe ConnectionData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DBState n -> Connection
forall (m :: * -> *). DBState m -> Connection
dbConnection)
    case Maybe ConnectionData
mconn of
      Maybe ConnectionData
Nothing -> HPQTypesError -> DBT_ m n ConnectionStats
forall e (m :: * -> *) a.
(HasCallStack, Exception e, MonadDB m, MonadThrow m) =>
e -> m a
throwDB (HPQTypesError -> DBT_ m n ConnectionStats)
-> HPQTypesError -> DBT_ m n ConnectionStats
forall a b. (a -> b) -> a -> b
$ String -> HPQTypesError
HPQTypesError String
"getConnectionStats: no connection"
      Just ConnectionData
cd -> ConnectionStats -> DBT_ m n ConnectionStats
forall a. a -> DBT_ m n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectionStats -> DBT_ m n ConnectionStats)
-> ConnectionStats -> DBT_ m n ConnectionStats
forall a b. (a -> b) -> a -> b
$ ConnectionData -> ConnectionStats
cdStats ConnectionData
cd

  getQueryResult :: forall row. FromRow row => DBT_ m n (Maybe (QueryResult row))
getQueryResult = InnerDBT m n (Maybe (QueryResult row))
-> DBT_ m n (Maybe (QueryResult row))
forall (m :: * -> *) (n :: * -> *) a. InnerDBT m n a -> DBT_ m n a
DBT (InnerDBT m n (Maybe (QueryResult row))
 -> DBT_ m n (Maybe (QueryResult row)))
-> ((DBState n -> Maybe (QueryResult row))
    -> InnerDBT m n (Maybe (QueryResult row)))
-> (DBState n -> Maybe (QueryResult row))
-> DBT_ m n (Maybe (QueryResult row))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DBState n -> Maybe (QueryResult row))
-> InnerDBT m n (Maybe (QueryResult row))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((DBState n -> Maybe (QueryResult row))
 -> DBT_ m n (Maybe (QueryResult row)))
-> (DBState n -> Maybe (QueryResult row))
-> DBT_ m n (Maybe (QueryResult row))
forall a b. (a -> b) -> a -> b
$ \DBState n
st -> DBState n -> forall row. FromRow row => Maybe (QueryResult row)
forall (m :: * -> *).
DBState m -> forall row. FromRow row => Maybe (QueryResult row)
dbQueryResult DBState n
st
  clearQueryResult :: DBT_ m n ()
clearQueryResult = InnerDBT m n () -> DBT_ m n ()
forall (m :: * -> *) (n :: * -> *) a. InnerDBT m n a -> DBT_ m n a
DBT (InnerDBT m n () -> DBT_ m n ())
-> ((DBState n -> DBState n) -> InnerDBT m n ())
-> (DBState n -> DBState n)
-> DBT_ m n ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DBState n -> DBState n) -> InnerDBT m n ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DBState n -> DBState n) -> DBT_ m n ())
-> (DBState n -> DBState n) -> DBT_ m n ()
forall a b. (a -> b) -> a -> b
$ \DBState n
st -> DBState n
st {dbQueryResult = Nothing}

  getTransactionSettings :: DBT_ m n TransactionSettings
getTransactionSettings = InnerDBT m n TransactionSettings -> DBT_ m n TransactionSettings
forall (m :: * -> *) (n :: * -> *) a. InnerDBT m n a -> DBT_ m n a
DBT (InnerDBT m n TransactionSettings -> DBT_ m n TransactionSettings)
-> ((DBState n -> TransactionSettings)
    -> InnerDBT m n TransactionSettings)
-> (DBState n -> TransactionSettings)
-> DBT_ m n TransactionSettings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DBState n -> TransactionSettings)
-> InnerDBT m n TransactionSettings
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((DBState n -> TransactionSettings)
 -> DBT_ m n TransactionSettings)
-> (DBState n -> TransactionSettings)
-> DBT_ m n TransactionSettings
forall a b. (a -> b) -> a -> b
$ DBState n -> TransactionSettings
forall (m :: * -> *). DBState m -> TransactionSettings
dbTransactionSettings
  setTransactionSettings :: TransactionSettings -> DBT_ m n ()
setTransactionSettings TransactionSettings
ts = InnerDBT m n () -> DBT_ m n ()
forall (m :: * -> *) (n :: * -> *) a. InnerDBT m n a -> DBT_ m n a
DBT (InnerDBT m n () -> DBT_ m n ())
-> ((DBState n -> DBState n) -> InnerDBT m n ())
-> (DBState n -> DBState n)
-> DBT_ m n ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DBState n -> DBState n) -> InnerDBT m n ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DBState n -> DBState n) -> DBT_ m n ())
-> (DBState n -> DBState n) -> DBT_ m n ()
forall a b. (a -> b) -> a -> b
$ \DBState n
st -> DBState n
st {dbTransactionSettings = ts}

  getNotification :: Int -> DBT_ m n (Maybe Notification)
getNotification Int
time = InnerDBT m n (Maybe Notification) -> DBT_ m n (Maybe Notification)
forall (m :: * -> *) (n :: * -> *) a. InnerDBT m n a -> DBT_ m n a
DBT (InnerDBT m n (Maybe Notification)
 -> DBT_ m n (Maybe Notification))
-> ((DBState m -> n (Maybe Notification, DBState m))
    -> InnerDBT m n (Maybe Notification))
-> (DBState m -> n (Maybe Notification, DBState m))
-> DBT_ m n (Maybe Notification)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DBState m -> n (Maybe Notification, DBState m))
-> InnerDBT m n (Maybe Notification)
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((DBState m -> n (Maybe Notification, DBState m))
 -> DBT_ m n (Maybe Notification))
-> (DBState m -> n (Maybe Notification, DBState m))
-> DBT_ m n (Maybe Notification)
forall a b. (a -> b) -> a -> b
$ \DBState m
st -> do
    (,DBState m
st) (Maybe Notification -> (Maybe Notification, DBState m))
-> n (Maybe Notification) -> n (Maybe Notification, DBState m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe Notification) -> n (Maybe Notification)
forall α. IO α -> n α
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (DBState m -> Int -> IO (Maybe Notification)
forall (m :: * -> *). DBState m -> Int -> IO (Maybe Notification)
getNotificationIO DBState m
st Int
time)

  withNewConnection :: forall a. DBT_ m n a -> DBT_ m n a
withNewConnection DBT_ m n a
m = InnerDBT m n a -> DBT_ m n a
forall (m :: * -> *) (n :: * -> *) a. InnerDBT m n a -> DBT_ m n a
DBT (InnerDBT m n a -> DBT_ m n a)
-> ((DBState m -> n (a, DBState m)) -> InnerDBT m n a)
-> (DBState m -> n (a, DBState m))
-> DBT_ m n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DBState m -> n (a, DBState m)) -> InnerDBT m n a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((DBState m -> n (a, DBState m)) -> DBT_ m n a)
-> (DBState m -> n (a, DBState m)) -> DBT_ m n a
forall a b. (a -> b) -> a -> b
$ \DBState m
st -> do
    let cs :: ConnectionSourceM m
cs = DBState m -> ConnectionSourceM m
forall (m :: * -> *). DBState m -> ConnectionSourceM m
dbConnectionSource DBState m
st
        ts :: TransactionSettings
ts = DBState m -> TransactionSettings
forall (m :: * -> *). DBState m -> TransactionSettings
dbTransactionSettings DBState m
st
    a
res <- ConnectionSourceM n -> TransactionSettings -> DBT n a -> n a
forall (m :: * -> *) a.
(HasCallStack, MonadBase IO m, MonadMask m) =>
ConnectionSourceM m -> TransactionSettings -> DBT m a -> m a
runDBT ConnectionSourceM m
ConnectionSourceM n
cs TransactionSettings
ts DBT_ m n a
DBT n a
m
    (a, DBState m) -> n (a, DBState m)
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
res, DBState m
st)

----------------------------------------

instance MonadTransControl (DBT_ m) where
  type StT (DBT_ m) a = StT (InnerDBT m) a
  liftWith :: forall (m :: * -> *) a.
Monad m =>
(Run (DBT_ m) -> m a) -> DBT_ m m a
liftWith = (forall b. StateT (DBState m) m b -> DBT_ m m b)
-> (forall (o :: * -> *) b. DBT_ m o b -> StateT (DBState m) o b)
-> (RunDefault (DBT_ m) (StateT (DBState m)) -> m a)
-> DBT_ m m a
forall (m :: * -> *) (n :: (* -> *) -> * -> *)
       (t :: (* -> *) -> * -> *) a.
(Monad m, MonadTransControl n) =>
(forall b. n m b -> t m b)
-> (forall (o :: * -> *) b. t o b -> n o b)
-> (RunDefault t n -> m a)
-> t m a
defaultLiftWith InnerDBT m m b -> DBT_ m m b
forall b. StateT (DBState m) m b -> DBT_ m m b
forall (m :: * -> *) (n :: * -> *) a. InnerDBT m n a -> DBT_ m n a
DBT DBT_ m o b -> StateT (DBState m) o b
forall (o :: * -> *) b. DBT_ m o b -> StateT (DBState m) o b
forall (m :: * -> *) (n :: * -> *) a. DBT_ m n a -> InnerDBT m n a
unDBT
  restoreT :: forall (m :: * -> *) a. Monad m => m (StT (DBT_ m) a) -> DBT_ m m a
restoreT = (StateT (DBState m) m a -> DBT_ m m a)
-> m (StT (StateT (DBState m)) a) -> DBT_ m m a
forall (m :: * -> *) (n :: (* -> *) -> * -> *) a
       (t :: (* -> *) -> * -> *).
(Monad m, MonadTransControl n) =>
(n m a -> t m a) -> m (StT n a) -> t m a
defaultRestoreT StateT (DBState m) m a -> DBT_ m m a
forall (m :: * -> *) (n :: * -> *) a. InnerDBT m n a -> DBT_ m n a
DBT

instance (m ~ n, MonadBaseControl b m) => MonadBaseControl b (DBT_ m n) where
  type StM (DBT_ m n) a = ComposeSt (DBT_ m) m a
  liftBaseWith :: forall a. (RunInBase (DBT_ m n) b -> b a) -> DBT_ m n a
liftBaseWith = (RunInBaseDefault (DBT_ m) n b -> b a) -> DBT_ m n a
(RunInBase (DBT_ m n) b -> b a) -> DBT_ m n a
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
(RunInBaseDefault t m b -> b a) -> t m a
defaultLiftBaseWith
  restoreM :: forall a. StM (DBT_ m n) a -> DBT_ m n a
restoreM = ComposeSt (DBT_ m) n a -> DBT_ m n a
StM (DBT_ m n) a -> DBT_ m n a
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
ComposeSt t m a -> t m a
defaultRestoreM

instance (m ~ n, MonadError e m) => MonadError e (DBT_ m n) where
  throwError :: forall a. e -> DBT_ m n a
throwError = n a -> DBT_ m n a
forall (m :: * -> *) a. Monad m => m a -> DBT_ m m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (n a -> DBT_ m n a) -> (e -> n a) -> e -> DBT_ m n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> n a
forall a. e -> n a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
  catchError :: forall a. DBT_ m n a -> (e -> DBT_ m n a) -> DBT_ m n a
catchError DBT_ m n a
m e -> DBT_ m n a
h = InnerDBT m n a -> DBT_ m n a
forall (m :: * -> *) (n :: * -> *) a. InnerDBT m n a -> DBT_ m n a
DBT (InnerDBT m n a -> DBT_ m n a) -> InnerDBT m n a -> DBT_ m n a
forall a b. (a -> b) -> a -> b
$ Catch e n (a, DBState m) -> Catch e (StateT (DBState m) n) a
forall e (m :: * -> *) a s.
Catch e m (a, s) -> Catch e (StateT s m) a
S.liftCatch Catch e n (a, DBState m)
forall a. n a -> (e -> n a) -> n a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (DBT_ m n a -> InnerDBT m n a
forall (m :: * -> *) (n :: * -> *) a. DBT_ m n a -> InnerDBT m n a
unDBT DBT_ m n a
m) (DBT_ m n a -> InnerDBT m n a
forall (m :: * -> *) (n :: * -> *) a. DBT_ m n a -> InnerDBT m n a
unDBT (DBT_ m n a -> InnerDBT m n a)
-> (e -> DBT_ m n a) -> e -> InnerDBT m n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> DBT_ m n a
h)

instance (m ~ n, MonadReader r m) => MonadReader r (DBT_ m n) where
  ask :: DBT_ m n r
ask = n r -> DBT_ m n r
forall (m :: * -> *) a. Monad m => m a -> DBT_ m m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift n r
forall r (m :: * -> *). MonadReader r m => m r
ask
  local :: forall a. (r -> r) -> DBT_ m n a -> DBT_ m n a
local r -> r
f = (DBState m -> DBState m)
-> (m (a, DBState m) -> m (a, DBState m)) -> DBT m a -> DBT m a
forall (n :: * -> *) (m :: * -> *) a b.
(DBState n -> DBState m)
-> (m (a, DBState m) -> n (b, DBState n)) -> DBT m a -> DBT n b
mapDBT DBState m -> DBState m
forall a. a -> a
id ((r -> r) -> m (a, DBState m) -> m (a, DBState m)
forall a. (r -> r) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f)
  reader :: forall a. (r -> a) -> DBT_ m n a
reader = n a -> DBT_ m n a
forall (m :: * -> *) a. Monad m => m a -> DBT_ m m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (n a -> DBT_ m n a) -> ((r -> a) -> n a) -> (r -> a) -> DBT_ m n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> a) -> n a
forall a. (r -> a) -> n a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
reader

instance (m ~ n, MonadState s m) => MonadState s (DBT_ m n) where
  get :: DBT_ m n s
get = n s -> DBT_ m n s
forall (m :: * -> *) a. Monad m => m a -> DBT_ m m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift n s
forall s (m :: * -> *). MonadState s m => m s
get
  put :: s -> DBT_ m n ()
put = n () -> DBT_ m n ()
forall (m :: * -> *) a. Monad m => m a -> DBT_ m m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (n () -> DBT_ m n ()) -> (s -> n ()) -> s -> DBT_ m n ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> n ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
  state :: forall a. (s -> (a, s)) -> DBT_ m n a
state = n a -> DBT_ m n a
forall (m :: * -> *) a. Monad m => m a -> DBT_ m m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (n a -> DBT_ m n a)
-> ((s -> (a, s)) -> n a) -> (s -> (a, s)) -> DBT_ m n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> (a, s)) -> n a
forall a. (s -> (a, s)) -> n a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state

instance (m ~ n, MonadWriter w m) => MonadWriter w (DBT_ m n) where
  writer :: forall a. (a, w) -> DBT_ m n a
writer = n a -> DBT_ m n a
forall (m :: * -> *) a. Monad m => m a -> DBT_ m m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (n a -> DBT_ m n a) -> ((a, w) -> n a) -> (a, w) -> DBT_ m n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, w) -> n a
forall a. (a, w) -> n a
forall w (m :: * -> *) a. MonadWriter w m => (a, w) -> m a
writer
  tell :: w -> DBT_ m n ()
tell = n () -> DBT_ m n ()
forall (m :: * -> *) a. Monad m => m a -> DBT_ m m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (n () -> DBT_ m n ()) -> (w -> n ()) -> w -> DBT_ m n ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> n ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
  listen :: forall a. DBT_ m n a -> DBT_ m n (a, w)
listen = InnerDBT m n (a, w) -> DBT_ m n (a, w)
forall (m :: * -> *) (n :: * -> *) a. InnerDBT m n a -> DBT_ m n a
DBT (InnerDBT m n (a, w) -> DBT_ m n (a, w))
-> (DBT_ m n a -> InnerDBT m n (a, w))
-> DBT_ m n a
-> DBT_ m n (a, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Listen w n (a, DBState m) -> Listen w (StateT (DBState m) n) a
forall (m :: * -> *) w a s.
Monad m =>
Listen w m (a, s) -> Listen w (StateT s m) a
S.liftListen Listen w n (a, DBState m)
forall a. n a -> n (a, w)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen Listen w (StateT (DBState m) n) a
-> (DBT_ m n a -> StateT (DBState m) n a)
-> DBT_ m n a
-> InnerDBT m n (a, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DBT_ m n a -> StateT (DBState m) n a
forall (m :: * -> *) (n :: * -> *) a. DBT_ m n a -> InnerDBT m n a
unDBT
  pass :: forall a. DBT_ m n (a, w -> w) -> DBT_ m n a
pass = InnerDBT m n a -> DBT_ m n a
forall (m :: * -> *) (n :: * -> *) a. InnerDBT m n a -> DBT_ m n a
DBT (InnerDBT m n a -> DBT_ m n a)
-> (DBT_ m n (a, w -> w) -> InnerDBT m n a)
-> DBT_ m n (a, w -> w)
-> DBT_ m n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pass w n (a, DBState m) -> Pass w (StateT (DBState m) n) a
forall (m :: * -> *) w a s.
Monad m =>
Pass w m (a, s) -> Pass w (StateT s m) a
S.liftPass Pass w n (a, DBState m)
forall a. n (a, w -> w) -> n a
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass Pass w (StateT (DBState m) n) a
-> (DBT_ m n (a, w -> w) -> StateT (DBState m) n (a, w -> w))
-> DBT_ m n (a, w -> w)
-> InnerDBT m n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DBT_ m n (a, w -> w) -> StateT (DBState m) n (a, w -> w)
forall (m :: * -> *) (n :: * -> *) a. DBT_ m n a -> InnerDBT m n a
unDBT