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.Reader.Class
import Control.Monad.State.Strict
import Control.Monad.Trans.Control
import Control.Monad.Writer.Class
import Data.Bifunctor
import qualified Control.Monad.Trans.State.Strict as S
import qualified Control.Monad.Fail as MF

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 (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
many :: 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]
some :: forall a. DBT_ m n a -> DBT_ m n [a]
$csome :: forall (m :: * -> *) (n :: * -> *) a.
MonadPlus n =>
DBT_ m n a -> DBT_ m n [a]
<|> :: forall a. DBT_ m n a -> DBT_ m n a -> DBT_ m n a
$c<|> :: forall (m :: * -> *) (n :: * -> *) a.
MonadPlus n =>
DBT_ m n a -> DBT_ m n a -> DBT_ m n a
empty :: forall a. DBT_ m n a
$cempty :: forall (m :: * -> *) (n :: * -> *) a. MonadPlus n => DBT_ m n a
Alternative, 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
<* :: forall a b. DBT_ m n a -> DBT_ m n b -> DBT_ m n a
$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 b
$c*> :: forall (m :: * -> *) (n :: * -> *) a b.
Monad n =>
DBT_ m n a -> DBT_ m n b -> DBT_ m n b
liftA2 :: forall a b c.
(a -> b -> c) -> DBT_ m n a -> DBT_ m n b -> DBT_ m n c
$cliftA2 :: forall (m :: * -> *) (n :: * -> *) a b c.
Monad n =>
(a -> b -> c) -> DBT_ m n a -> DBT_ m n b -> DBT_ m n c
<*> :: forall a b. DBT_ m n (a -> b) -> DBT_ m n a -> DBT_ m n b
$c<*> :: forall (m :: * -> *) (n :: * -> *) a b.
Monad n =>
DBT_ m n (a -> b) -> DBT_ m n a -> DBT_ m n b
pure :: forall a. a -> DBT_ m n a
$cpure :: forall (m :: * -> *) (n :: * -> *) a. Monad n => a -> DBT_ m n a
Applicative, 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
<$ :: forall a b. a -> DBT_ m n b -> DBT_ m n a
$c<$ :: forall (m :: * -> *) (n :: * -> *) a b.
Functor n =>
a -> DBT_ m n b -> DBT_ m n a
fmap :: forall a b. (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
Functor, 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
return :: forall a. a -> DBT_ m n a
$creturn :: forall (m :: * -> *) (n :: * -> *) a. Monad n => a -> DBT_ m n a
>> :: 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 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 -> (a -> DBT_ m n b) -> DBT_ m n b
Monad, 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
fail :: forall a. String -> DBT_ m n a
$cfail :: forall (m :: * -> *) (n :: * -> *) a.
MonadFail n =>
String -> DBT_ m n a
MF.MonadFail, MonadBase b, forall e a.
Exception e =>
DBT_ m n a -> (e -> DBT_ m n a) -> DBT_ m n a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. 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, Exception e) =>
DBT_ m n a -> (e -> DBT_ m n a) -> DBT_ m n a
catch :: forall e a.
Exception e =>
DBT_ m n a -> (e -> DBT_ m n a) -> DBT_ m n a
$ccatch :: forall (m :: * -> *) (n :: * -> *) e a.
(MonadCatch n, Exception e) =>
DBT_ m n a -> (e -> DBT_ m n a) -> DBT_ m n a
MonadCatch, 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
liftIO :: forall a. IO a -> DBT_ m n a
$cliftIO :: forall (m :: * -> *) (n :: * -> *) a.
MonadIO n =>
IO a -> DBT_ m n a
MonadIO, forall b.
((forall a. DBT_ m n a -> DBT_ m n a) -> DBT_ m n b) -> DBT_ m n b
forall a b c.
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. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    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 =>
((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 =>
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.
DBT_ m n a
-> (a -> ExitCase b -> DBT_ m n c)
-> (a -> DBT_ m n b)
-> DBT_ m n (b, c)
$cgeneralBracket :: forall (m :: * -> *) (n :: * -> *) a b c.
MonadMask n =>
DBT_ m n a
-> (a -> ExitCase b -> DBT_ m n c)
-> (a -> DBT_ m n b)
-> DBT_ m n (b, c)
uninterruptibleMask :: forall b.
((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 =>
((forall a. DBT_ m n a -> DBT_ m n a) -> DBT_ m n b) -> DBT_ m n b
mask :: forall b.
((forall a. DBT_ m n a -> DBT_ m n a) -> DBT_ m n b) -> DBT_ m n b
$cmask :: forall (m :: * -> *) (n :: * -> *) b.
MonadMask n =>
((forall a. DBT_ m n a -> DBT_ m n a) -> DBT_ m n b) -> DBT_ m n b
MonadMask, 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
mplus :: forall a. DBT_ m n a -> DBT_ m n a -> DBT_ m n a
$cmplus :: forall (m :: * -> *) (n :: * -> *) a.
MonadPlus n =>
DBT_ m n a -> DBT_ m n a -> DBT_ m n a
mzero :: forall a. DBT_ m n a
$cmzero :: forall (m :: * -> *) (n :: * -> *) a. MonadPlus n => DBT_ m n a
MonadPlus, forall e a. Exception e => e -> DBT_ m n a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
forall {m :: * -> *} {n :: * -> *}.
MonadThrow n =>
Monad (DBT_ m n)
forall (m :: * -> *) (n :: * -> *) e a.
(MonadThrow n, Exception e) =>
e -> DBT_ m n a
throwM :: forall e a. Exception e => e -> DBT_ m n a
$cthrowM :: forall (m :: * -> *) (n :: * -> *) e a.
(MonadThrow n, Exception e) =>
e -> DBT_ m n a
MonadThrow, forall (m :: * -> *) a. Monad m => m a -> DBT_ m m a
forall (m :: * -> *) (m :: * -> *) a. Monad m => m a -> DBT_ m m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: forall (m :: * -> *) a. Monad m => m a -> DBT_ m m a
$clift :: forall (m :: * -> *) (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
  :: (MonadBase IO m, MonadMask m)
  => ConnectionSourceM m
  -> TransactionSettings
  -> DBT m a
  -> m a
runDBT :: forall (m :: * -> *) a.
(MonadBase IO m, MonadMask m) =>
ConnectionSourceM m -> TransactionSettings -> DBT m a -> m a
runDBT ConnectionSourceM m
cs TransactionSettings
ts DBT m a
m = forall (m :: * -> *).
ConnectionSourceM m -> forall r. (Connection -> m r) -> m r
withConnection ConnectionSourceM m
cs forall a b. (a -> b) -> a -> b
$ \Connection
conn -> do
  forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT InnerDBT m m a
action 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 = forall sql. IsSQL sql => sql -> SomeSQL
SomeSQL (forall a. Monoid a => a
mempty::SQL)
  , dbRecordLastQuery :: Bool
dbRecordLastQuery = Bool
True
  , dbQueryResult :: forall row. FromRow row => Maybe (QueryResult row)
dbQueryResult = forall a. Maybe a
Nothing
  }
  where
    action :: InnerDBT m m a
action = forall (m :: * -> *) (n :: * -> *) a. DBT_ m n a -> InnerDBT m n a
unDBT forall a b. (a -> b) -> a -> b
$ if TransactionSettings -> Bool
tsAutoTransaction TransactionSettings
ts
      then forall (m :: * -> *) a.
(MonadDB m, MonadMask m) =>
TransactionSettings -> m a -> m a
withTransaction' (TransactionSettings
ts { tsAutoTransaction :: Bool
tsAutoTransaction = Bool
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 = forall (m :: * -> *) (n :: * -> *) a. InnerDBT m n a -> DBT_ m n a
DBT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ m (a, DBState m) -> n (b, DBState n)
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (forall (m :: * -> *) (n :: * -> *) a. DBT_ m n a -> InnerDBT m n a
unDBT DBT m a
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. IsSQL sql => sql -> DBT_ m n Int
runQuery sql
sql = forall (m :: * -> *) (n :: * -> *) a. InnerDBT m n a -> DBT_ m n a
DBT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ \DBState m
st -> forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall a b. (a -> b) -> a -> b
$ do
    forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall sql (m :: * -> *).
IsSQL sql =>
DBState m -> sql -> ForeignPtr PGresult -> DBState m
updateStateWith DBState m
st sql
sql) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall sql.
IsSQL sql =>
Connection -> sql -> IO (Int, ForeignPtr PGresult)
runQueryIO (forall (m :: * -> *). DBState m -> Connection
dbConnection DBState m
st) sql
sql
  runPreparedQuery :: forall sql. IsSQL sql => QueryName -> sql -> DBT_ m n Int
runPreparedQuery QueryName
name sql
sql = forall (m :: * -> *) (n :: * -> *) a. InnerDBT m n a -> DBT_ m n a
DBT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ \DBState m
st -> forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall a b. (a -> b) -> a -> b
$ do
    forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall sql (m :: * -> *).
IsSQL sql =>
DBState m -> sql -> ForeignPtr PGresult -> DBState m
updateStateWith DBState m
st sql
sql) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall sql.
IsSQL sql =>
Connection -> QueryName -> sql -> IO (Int, ForeignPtr PGresult)
runPreparedQueryIO (forall (m :: * -> *). DBState m -> Connection
dbConnection DBState m
st) QueryName
name sql
sql

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

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

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

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

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

  getNotification :: Int -> DBT_ m n (Maybe Notification)
getNotification Int
time = forall (m :: * -> *) (n :: * -> *) a. InnerDBT m n a -> DBT_ m n a
DBT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ \DBState m
st -> (, DBState m
st)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (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 = forall (m :: * -> *) (n :: * -> *) a. InnerDBT m n a -> DBT_ m n a
DBT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ \DBState m
st -> do
    let cs :: ConnectionSourceM m
cs = forall (m :: * -> *). DBState m -> ConnectionSourceM m
dbConnectionSource DBState m
st
        ts :: TransactionSettings
ts = forall (m :: * -> *). DBState m -> TransactionSettings
dbTransactionSettings DBState m
st
    a
res <- forall (m :: * -> *) a.
(MonadBase IO m, MonadMask m) =>
ConnectionSourceM m -> TransactionSettings -> DBT m a -> m a
runDBT ConnectionSourceM m
cs TransactionSettings
ts DBT_ m n a
m
    forall (m :: * -> *) a. Monad m => a -> m a
return (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 (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 forall (m :: * -> *) (n :: * -> *) a. InnerDBT m n a -> DBT_ m n a
DBT 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 = forall (m :: * -> *) (n :: (* -> *) -> * -> *) a
       (t :: (* -> *) -> * -> *).
(Monad m, MonadTransControl n) =>
(n m a -> t m a) -> m (StT n a) -> t m a
defaultRestoreT 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 = 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     = 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 = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) (n :: * -> *) a. InnerDBT m n a -> DBT_ m n a
DBT forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a s.
Catch e m (a, s) -> Catch e (StateT s m) a
S.liftCatch forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (forall (m :: * -> *) (n :: * -> *) a. DBT_ m n a -> InnerDBT m n a
unDBT DBT_ m n a
m) (forall (m :: * -> *) (n :: * -> *) a. DBT_ m n a -> InnerDBT m n a
unDBT 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 = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift 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 = forall (n :: * -> *) (m :: * -> *) a b.
(DBState n -> DBState m)
-> (m (a, DBState m) -> n (b, DBState n)) -> DBT m a -> DBT n b
mapDBT forall a. a -> a
id (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 = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *). MonadState s m => m s
get
  put :: s -> DBT_ m n ()
put = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *). MonadState s m => s -> m ()
put
  state :: forall a. (s -> (a, s)) -> DBT_ m n a
state = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) a. MonadWriter w m => (a, w) -> m a
writer
  tell :: w -> DBT_ m n ()
tell = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
  listen :: forall a. DBT_ m n a -> DBT_ m n (a, w)
listen = forall (m :: * -> *) (n :: * -> *) a. InnerDBT m n a -> DBT_ m n a
DBT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) w a s.
Monad m =>
Listen w m (a, s) -> Listen w (StateT s m) a
S.liftListen forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) (n :: * -> *) a. InnerDBT m n a -> DBT_ m n a
DBT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) w a s.
Monad m =>
Pass w m (a, s) -> Pass w (StateT s m) a
S.liftPass forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (n :: * -> *) a. DBT_ m n a -> InnerDBT m n a
unDBT