{-# LANGUAGE TypeFamilies #-}

-- | A 'MonadArbiter' transformer over the application's Orville monad:
--
-- @
-- import Arbiter.Core qualified as Arb
-- import Arbiter.Orville qualified as ArbO
-- import Orville.PostgreSQL qualified as O
--
-- O.withTransaction $ do
--   O.insertEntity ordersTable order
--   ArbO.runOrvilleDb \@MyRegistry ArbO.OrvilleEnv {ArbO.schema = "arbiter", ArbO.listener = Nothing} $
--     Arb.insertJob (Arb.defaultJob (ProcessOrder orderId))
-- @
--
-- Queries run on the base monad's connection and join its open transaction.
module Arbiter.Orville.OrvilleDb
  ( -- * Database monad
    OrvilleDb (..)
  , OrvilleEnv (..)
  , runOrvilleDb

    -- * Connection options
  , toOrvilleConnectionOptions
  ) where

import Arbiter.Core.Job.Schema (SchemaName)
import Arbiter.Core.Listen (Listener)
import Arbiter.Core.MonadArbiter (MonadArbiter (..))
import Arbiter.Core.PoolConfig (PoolConfig (..))
import Arbiter.Core.QueueRegistry (JobPayloadRegistry)
import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Trans.Class (MonadTrans (..))
import Control.Monad.Trans.Reader (ReaderT (..), asks)
import Data.ByteString (ByteString)
import Data.ByteString.Char8 qualified as BS8
import Orville.PostgreSQL qualified as O
import UnliftIO (MonadUnliftIO)

import Arbiter.Orville.MonadArbiter
  ( orvilleExecuteQuery
  , orvilleExecuteStatement
  , orvilleWithDbTransaction
  )

-- | The schema of the arbiter tables and an optional LISTEN\/NOTIFY listener.
data OrvilleEnv (registry :: JobPayloadRegistry) = OrvilleEnv
  { forall (registry :: JobPayloadRegistry).
OrvilleEnv registry -> SchemaName
schema :: SchemaName
  , forall (registry :: JobPayloadRegistry).
OrvilleEnv registry -> Maybe Listener
listener :: Maybe Listener
  -- ^ A listener such as @Arbiter.LibPQ.newLibPQListener@ from arbiter-libpq. 'Nothing' for poll-only.
  }

-- | The Orville database monad. Handlers run in the base monad.
newtype OrvilleDb (registry :: JobPayloadRegistry) m a = OrvilleDb
  { forall (registry :: JobPayloadRegistry) (m :: * -> *) a.
OrvilleDb registry m a -> ReaderT (OrvilleEnv registry) m a
unOrvilleDb :: ReaderT (OrvilleEnv registry) m a
  }
  deriving newtype
    ( Functor (OrvilleDb registry m)
Functor (OrvilleDb registry m) =>
(forall a. a -> OrvilleDb registry m a)
-> (forall a b.
    OrvilleDb registry m (a -> b)
    -> OrvilleDb registry m a -> OrvilleDb registry m b)
-> (forall a b c.
    (a -> b -> c)
    -> OrvilleDb registry m a
    -> OrvilleDb registry m b
    -> OrvilleDb registry m c)
-> (forall a b.
    OrvilleDb registry m a
    -> OrvilleDb registry m b -> OrvilleDb registry m b)
-> (forall a b.
    OrvilleDb registry m a
    -> OrvilleDb registry m b -> OrvilleDb registry m a)
-> Applicative (OrvilleDb registry m)
forall (registry :: JobPayloadRegistry) (m :: * -> *).
Applicative m =>
Functor (OrvilleDb registry m)
forall (registry :: JobPayloadRegistry) (m :: * -> *) a.
Applicative m =>
a -> OrvilleDb registry m a
forall (registry :: JobPayloadRegistry) (m :: * -> *) a b.
Applicative m =>
OrvilleDb registry m a
-> OrvilleDb registry m b -> OrvilleDb registry m a
forall (registry :: JobPayloadRegistry) (m :: * -> *) a b.
Applicative m =>
OrvilleDb registry m a
-> OrvilleDb registry m b -> OrvilleDb registry m b
forall (registry :: JobPayloadRegistry) (m :: * -> *) a b.
Applicative m =>
OrvilleDb registry m (a -> b)
-> OrvilleDb registry m a -> OrvilleDb registry m b
forall (registry :: JobPayloadRegistry) (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> OrvilleDb registry m a
-> OrvilleDb registry m b
-> OrvilleDb registry m c
forall a. a -> OrvilleDb registry m a
forall a b.
OrvilleDb registry m a
-> OrvilleDb registry m b -> OrvilleDb registry m a
forall a b.
OrvilleDb registry m a
-> OrvilleDb registry m b -> OrvilleDb registry m b
forall a b.
OrvilleDb registry m (a -> b)
-> OrvilleDb registry m a -> OrvilleDb registry m b
forall a b c.
(a -> b -> c)
-> OrvilleDb registry m a
-> OrvilleDb registry m b
-> OrvilleDb registry 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
$cpure :: forall (registry :: JobPayloadRegistry) (m :: * -> *) a.
Applicative m =>
a -> OrvilleDb registry m a
pure :: forall a. a -> OrvilleDb registry m a
$c<*> :: forall (registry :: JobPayloadRegistry) (m :: * -> *) a b.
Applicative m =>
OrvilleDb registry m (a -> b)
-> OrvilleDb registry m a -> OrvilleDb registry m b
<*> :: forall a b.
OrvilleDb registry m (a -> b)
-> OrvilleDb registry m a -> OrvilleDb registry m b
$cliftA2 :: forall (registry :: JobPayloadRegistry) (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> OrvilleDb registry m a
-> OrvilleDb registry m b
-> OrvilleDb registry m c
liftA2 :: forall a b c.
(a -> b -> c)
-> OrvilleDb registry m a
-> OrvilleDb registry m b
-> OrvilleDb registry m c
$c*> :: forall (registry :: JobPayloadRegistry) (m :: * -> *) a b.
Applicative m =>
OrvilleDb registry m a
-> OrvilleDb registry m b -> OrvilleDb registry m b
*> :: forall a b.
OrvilleDb registry m a
-> OrvilleDb registry m b -> OrvilleDb registry m b
$c<* :: forall (registry :: JobPayloadRegistry) (m :: * -> *) a b.
Applicative m =>
OrvilleDb registry m a
-> OrvilleDb registry m b -> OrvilleDb registry m a
<* :: forall a b.
OrvilleDb registry m a
-> OrvilleDb registry m b -> OrvilleDb registry m a
Applicative
    , (forall a b.
 (a -> b) -> OrvilleDb registry m a -> OrvilleDb registry m b)
-> (forall a b.
    a -> OrvilleDb registry m b -> OrvilleDb registry m a)
-> Functor (OrvilleDb registry m)
forall (registry :: JobPayloadRegistry) (m :: * -> *) a b.
Functor m =>
a -> OrvilleDb registry m b -> OrvilleDb registry m a
forall (registry :: JobPayloadRegistry) (m :: * -> *) a b.
Functor m =>
(a -> b) -> OrvilleDb registry m a -> OrvilleDb registry m b
forall a b. a -> OrvilleDb registry m b -> OrvilleDb registry m a
forall a b.
(a -> b) -> OrvilleDb registry m a -> OrvilleDb registry 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 (registry :: JobPayloadRegistry) (m :: * -> *) a b.
Functor m =>
(a -> b) -> OrvilleDb registry m a -> OrvilleDb registry m b
fmap :: forall a b.
(a -> b) -> OrvilleDb registry m a -> OrvilleDb registry m b
$c<$ :: forall (registry :: JobPayloadRegistry) (m :: * -> *) a b.
Functor m =>
a -> OrvilleDb registry m b -> OrvilleDb registry m a
<$ :: forall a b. a -> OrvilleDb registry m b -> OrvilleDb registry m a
Functor
    , Applicative (OrvilleDb registry m)
Applicative (OrvilleDb registry m) =>
(forall a b.
 OrvilleDb registry m a
 -> (a -> OrvilleDb registry m b) -> OrvilleDb registry m b)
-> (forall a b.
    OrvilleDb registry m a
    -> OrvilleDb registry m b -> OrvilleDb registry m b)
-> (forall a. a -> OrvilleDb registry m a)
-> Monad (OrvilleDb registry m)
forall (registry :: JobPayloadRegistry) (m :: * -> *).
Monad m =>
Applicative (OrvilleDb registry m)
forall (registry :: JobPayloadRegistry) (m :: * -> *) a.
Monad m =>
a -> OrvilleDb registry m a
forall (registry :: JobPayloadRegistry) (m :: * -> *) a b.
Monad m =>
OrvilleDb registry m a
-> OrvilleDb registry m b -> OrvilleDb registry m b
forall (registry :: JobPayloadRegistry) (m :: * -> *) a b.
Monad m =>
OrvilleDb registry m a
-> (a -> OrvilleDb registry m b) -> OrvilleDb registry m b
forall a. a -> OrvilleDb registry m a
forall a b.
OrvilleDb registry m a
-> OrvilleDb registry m b -> OrvilleDb registry m b
forall a b.
OrvilleDb registry m a
-> (a -> OrvilleDb registry m b) -> OrvilleDb registry 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 (registry :: JobPayloadRegistry) (m :: * -> *) a b.
Monad m =>
OrvilleDb registry m a
-> (a -> OrvilleDb registry m b) -> OrvilleDb registry m b
>>= :: forall a b.
OrvilleDb registry m a
-> (a -> OrvilleDb registry m b) -> OrvilleDb registry m b
$c>> :: forall (registry :: JobPayloadRegistry) (m :: * -> *) a b.
Monad m =>
OrvilleDb registry m a
-> OrvilleDb registry m b -> OrvilleDb registry m b
>> :: forall a b.
OrvilleDb registry m a
-> OrvilleDb registry m b -> OrvilleDb registry m b
$creturn :: forall (registry :: JobPayloadRegistry) (m :: * -> *) a.
Monad m =>
a -> OrvilleDb registry m a
return :: forall a. a -> OrvilleDb registry m a
Monad
    , MonadThrow (OrvilleDb registry m)
MonadThrow (OrvilleDb registry m) =>
(forall e a.
 (HasCallStack, Exception e) =>
 OrvilleDb registry m a
 -> (e -> OrvilleDb registry m a) -> OrvilleDb registry m a)
-> (forall e a.
    Exception e =>
    OrvilleDb registry m a
    -> (ExceptionWithContext e -> OrvilleDb registry m a)
    -> OrvilleDb registry m a)
-> MonadCatch (OrvilleDb registry m)
forall (registry :: JobPayloadRegistry) (m :: * -> *).
MonadCatch m =>
MonadThrow (OrvilleDb registry m)
forall (registry :: JobPayloadRegistry) (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
OrvilleDb registry m a
-> (e -> OrvilleDb registry m a) -> OrvilleDb registry m a
forall (registry :: JobPayloadRegistry) (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
OrvilleDb registry m a
-> (ExceptionWithContext e -> OrvilleDb registry m a)
-> OrvilleDb registry m a
forall e a.
(HasCallStack, Exception e) =>
OrvilleDb registry m a
-> (e -> OrvilleDb registry m a) -> OrvilleDb registry m a
forall e a.
Exception e =>
OrvilleDb registry m a
-> (ExceptionWithContext e -> OrvilleDb registry m a)
-> OrvilleDb registry m a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
 (HasCallStack, Exception e) =>
 m a -> (e -> m a) -> m a)
-> (forall e a.
    Exception e =>
    m a -> (ExceptionWithContext e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall (registry :: JobPayloadRegistry) (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
OrvilleDb registry m a
-> (e -> OrvilleDb registry m a) -> OrvilleDb registry m a
catch :: forall e a.
(HasCallStack, Exception e) =>
OrvilleDb registry m a
-> (e -> OrvilleDb registry m a) -> OrvilleDb registry m a
$ccatchNoPropagate :: forall (registry :: JobPayloadRegistry) (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
OrvilleDb registry m a
-> (ExceptionWithContext e -> OrvilleDb registry m a)
-> OrvilleDb registry m a
catchNoPropagate :: forall e a.
Exception e =>
OrvilleDb registry m a
-> (ExceptionWithContext e -> OrvilleDb registry m a)
-> OrvilleDb registry m a
MonadCatch
    , Monad (OrvilleDb registry m)
Monad (OrvilleDb registry m) =>
(forall a. HasCallStack => String -> OrvilleDb registry m a)
-> MonadFail (OrvilleDb registry m)
forall (registry :: JobPayloadRegistry) (m :: * -> *).
MonadFail m =>
Monad (OrvilleDb registry m)
forall (registry :: JobPayloadRegistry) (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
String -> OrvilleDb registry m a
forall a. HasCallStack => String -> OrvilleDb registry m a
forall (m :: * -> *).
Monad m =>
(forall a. HasCallStack => String -> m a) -> MonadFail m
$cfail :: forall (registry :: JobPayloadRegistry) (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
String -> OrvilleDb registry m a
fail :: forall a. HasCallStack => String -> OrvilleDb registry m a
MonadFail
    , Monad (OrvilleDb registry m)
Monad (OrvilleDb registry m) =>
(forall a. IO a -> OrvilleDb registry m a)
-> MonadIO (OrvilleDb registry m)
forall (registry :: JobPayloadRegistry) (m :: * -> *).
MonadIO m =>
Monad (OrvilleDb registry m)
forall (registry :: JobPayloadRegistry) (m :: * -> *) a.
MonadIO m =>
IO a -> OrvilleDb registry m a
forall a. IO a -> OrvilleDb registry m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall (registry :: JobPayloadRegistry) (m :: * -> *) a.
MonadIO m =>
IO a -> OrvilleDb registry m a
liftIO :: forall a. IO a -> OrvilleDb registry m a
MonadIO
    , MonadCatch (OrvilleDb registry m)
MonadCatch (OrvilleDb registry m) =>
(forall b.
 HasCallStack =>
 ((forall a. OrvilleDb registry m a -> OrvilleDb registry m a)
  -> OrvilleDb registry m b)
 -> OrvilleDb registry m b)
-> (forall b.
    HasCallStack =>
    ((forall a. OrvilleDb registry m a -> OrvilleDb registry m a)
     -> OrvilleDb registry m b)
    -> OrvilleDb registry m b)
-> (forall a b c.
    HasCallStack =>
    OrvilleDb registry m a
    -> (a -> ExitCase b -> OrvilleDb registry m c)
    -> (a -> OrvilleDb registry m b)
    -> OrvilleDb registry m (b, c))
-> MonadMask (OrvilleDb registry m)
forall (registry :: JobPayloadRegistry) (m :: * -> *).
MonadMask m =>
MonadCatch (OrvilleDb registry m)
forall (registry :: JobPayloadRegistry) (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. OrvilleDb registry m a -> OrvilleDb registry m a)
 -> OrvilleDb registry m b)
-> OrvilleDb registry m b
forall (registry :: JobPayloadRegistry) (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
OrvilleDb registry m a
-> (a -> ExitCase b -> OrvilleDb registry m c)
-> (a -> OrvilleDb registry m b)
-> OrvilleDb registry m (b, c)
forall b.
HasCallStack =>
((forall a. OrvilleDb registry m a -> OrvilleDb registry m a)
 -> OrvilleDb registry m b)
-> OrvilleDb registry m b
forall a b c.
HasCallStack =>
OrvilleDb registry m a
-> (a -> ExitCase b -> OrvilleDb registry m c)
-> (a -> OrvilleDb registry m b)
-> OrvilleDb registry 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 (registry :: JobPayloadRegistry) (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. OrvilleDb registry m a -> OrvilleDb registry m a)
 -> OrvilleDb registry m b)
-> OrvilleDb registry m b
mask :: forall b.
HasCallStack =>
((forall a. OrvilleDb registry m a -> OrvilleDb registry m a)
 -> OrvilleDb registry m b)
-> OrvilleDb registry m b
$cuninterruptibleMask :: forall (registry :: JobPayloadRegistry) (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. OrvilleDb registry m a -> OrvilleDb registry m a)
 -> OrvilleDb registry m b)
-> OrvilleDb registry m b
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. OrvilleDb registry m a -> OrvilleDb registry m a)
 -> OrvilleDb registry m b)
-> OrvilleDb registry m b
$cgeneralBracket :: forall (registry :: JobPayloadRegistry) (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
OrvilleDb registry m a
-> (a -> ExitCase b -> OrvilleDb registry m c)
-> (a -> OrvilleDb registry m b)
-> OrvilleDb registry m (b, c)
generalBracket :: forall a b c.
HasCallStack =>
OrvilleDb registry m a
-> (a -> ExitCase b -> OrvilleDb registry m c)
-> (a -> OrvilleDb registry m b)
-> OrvilleDb registry m (b, c)
MonadMask
    , Monad (OrvilleDb registry m)
Monad (OrvilleDb registry m) =>
(forall e a.
 (HasCallStack, Exception e) =>
 e -> OrvilleDb registry m a)
-> (forall e a.
    Exception e =>
    ExceptionWithContext e -> OrvilleDb registry m a)
-> MonadThrow (OrvilleDb registry m)
forall (registry :: JobPayloadRegistry) (m :: * -> *).
MonadThrow m =>
Monad (OrvilleDb registry m)
forall (registry :: JobPayloadRegistry) (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> OrvilleDb registry m a
forall (registry :: JobPayloadRegistry) (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
ExceptionWithContext e -> OrvilleDb registry m a
forall e a.
(HasCallStack, Exception e) =>
e -> OrvilleDb registry m a
forall e a.
Exception e =>
ExceptionWithContext e -> OrvilleDb registry m a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> (forall e a. Exception e => ExceptionWithContext e -> m a)
-> MonadThrow m
$cthrowM :: forall (registry :: JobPayloadRegistry) (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> OrvilleDb registry m a
throwM :: forall e a.
(HasCallStack, Exception e) =>
e -> OrvilleDb registry m a
$crethrowM :: forall (registry :: JobPayloadRegistry) (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
ExceptionWithContext e -> OrvilleDb registry m a
rethrowM :: forall e a.
Exception e =>
ExceptionWithContext e -> OrvilleDb registry m a
MonadThrow
    , MonadIO (OrvilleDb registry m)
MonadIO (OrvilleDb registry m) =>
(forall b.
 ((forall a. OrvilleDb registry m a -> IO a) -> IO b)
 -> OrvilleDb registry m b)
-> MonadUnliftIO (OrvilleDb registry m)
forall (registry :: JobPayloadRegistry) (m :: * -> *).
MonadUnliftIO m =>
MonadIO (OrvilleDb registry m)
forall (registry :: JobPayloadRegistry) (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. OrvilleDb registry m a -> IO a) -> IO b)
-> OrvilleDb registry m b
forall b.
((forall a. OrvilleDb registry m a -> IO a) -> IO b)
-> OrvilleDb registry m b
forall (m :: * -> *).
MonadIO m =>
(forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
$cwithRunInIO :: forall (registry :: JobPayloadRegistry) (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. OrvilleDb registry m a -> IO a) -> IO b)
-> OrvilleDb registry m b
withRunInIO :: forall b.
((forall a. OrvilleDb registry m a -> IO a) -> IO b)
-> OrvilleDb registry m b
MonadUnliftIO
    , OrvilleDb registry m OrvilleState
OrvilleDb registry m OrvilleState
-> (forall a.
    (OrvilleState -> OrvilleState)
    -> OrvilleDb registry m a -> OrvilleDb registry m a)
-> HasOrvilleState (OrvilleDb registry m)
forall (registry :: JobPayloadRegistry) (m :: * -> *).
(Monad m, HasOrvilleState m) =>
OrvilleDb registry m OrvilleState
forall (registry :: JobPayloadRegistry) (m :: * -> *) a.
(Monad m, HasOrvilleState m) =>
(OrvilleState -> OrvilleState)
-> OrvilleDb registry m a -> OrvilleDb registry m a
forall a.
(OrvilleState -> OrvilleState)
-> OrvilleDb registry m a -> OrvilleDb registry m a
forall (m :: * -> *).
m OrvilleState
-> (forall a. (OrvilleState -> OrvilleState) -> m a -> m a)
-> HasOrvilleState m
$caskOrvilleState :: forall (registry :: JobPayloadRegistry) (m :: * -> *).
(Monad m, HasOrvilleState m) =>
OrvilleDb registry m OrvilleState
askOrvilleState :: OrvilleDb registry m OrvilleState
$clocalOrvilleState :: forall (registry :: JobPayloadRegistry) (m :: * -> *) a.
(Monad m, HasOrvilleState m) =>
(OrvilleState -> OrvilleState)
-> OrvilleDb registry m a -> OrvilleDb registry m a
localOrvilleState :: forall a.
(OrvilleState -> OrvilleState)
-> OrvilleDb registry m a -> OrvilleDb registry m a
O.HasOrvilleState
    , (forall b.
 (forall a. (Connection -> IO a) -> IO a)
 -> (Connection -> OrvilleDb registry m b)
 -> OrvilleDb registry m b)
-> (forall e b.
    Exception e =>
    (forall a. IO a -> (e -> IO a) -> IO a)
    -> OrvilleDb registry m b
    -> (e -> OrvilleDb registry m b)
    -> OrvilleDb registry m b)
-> (forall c.
    (forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b)
    -> ((forall a. OrvilleDb registry m a -> OrvilleDb registry m a)
        -> OrvilleDb registry m c)
    -> OrvilleDb registry m c)
-> MonadOrvilleControl (OrvilleDb registry m)
forall (registry :: JobPayloadRegistry) (m :: * -> *) b.
MonadOrvilleControl m =>
(forall a. (Connection -> IO a) -> IO a)
-> (Connection -> OrvilleDb registry m b) -> OrvilleDb registry m b
forall (registry :: JobPayloadRegistry) (m :: * -> *) c.
MonadOrvilleControl m =>
(forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b)
-> ((forall a. OrvilleDb registry m a -> OrvilleDb registry m a)
    -> OrvilleDb registry m c)
-> OrvilleDb registry m c
forall (registry :: JobPayloadRegistry) (m :: * -> *) e b.
(MonadOrvilleControl m, Exception e) =>
(forall a. IO a -> (e -> IO a) -> IO a)
-> OrvilleDb registry m b
-> (e -> OrvilleDb registry m b)
-> OrvilleDb registry m b
forall b.
(forall a. (Connection -> IO a) -> IO a)
-> (Connection -> OrvilleDb registry m b) -> OrvilleDb registry m b
forall c.
(forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b)
-> ((forall a. OrvilleDb registry m a -> OrvilleDb registry m a)
    -> OrvilleDb registry m c)
-> OrvilleDb registry m c
forall e b.
Exception e =>
(forall a. IO a -> (e -> IO a) -> IO a)
-> OrvilleDb registry m b
-> (e -> OrvilleDb registry m b)
-> OrvilleDb registry m b
forall (m :: * -> *).
(forall b.
 (forall a. (Connection -> IO a) -> IO a)
 -> (Connection -> m b) -> m b)
-> (forall e b.
    Exception e =>
    (forall a. IO a -> (e -> IO a) -> IO a)
    -> m b -> (e -> m b) -> m b)
-> (forall c.
    (forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b)
    -> ((forall a. m a -> m a) -> m c) -> m c)
-> MonadOrvilleControl m
$cliftWithConnection :: forall (registry :: JobPayloadRegistry) (m :: * -> *) b.
MonadOrvilleControl m =>
(forall a. (Connection -> IO a) -> IO a)
-> (Connection -> OrvilleDb registry m b) -> OrvilleDb registry m b
liftWithConnection :: forall b.
(forall a. (Connection -> IO a) -> IO a)
-> (Connection -> OrvilleDb registry m b) -> OrvilleDb registry m b
$cliftCatch :: forall (registry :: JobPayloadRegistry) (m :: * -> *) e b.
(MonadOrvilleControl m, Exception e) =>
(forall a. IO a -> (e -> IO a) -> IO a)
-> OrvilleDb registry m b
-> (e -> OrvilleDb registry m b)
-> OrvilleDb registry m b
liftCatch :: forall e b.
Exception e =>
(forall a. IO a -> (e -> IO a) -> IO a)
-> OrvilleDb registry m b
-> (e -> OrvilleDb registry m b)
-> OrvilleDb registry m b
$cliftMask :: forall (registry :: JobPayloadRegistry) (m :: * -> *) c.
MonadOrvilleControl m =>
(forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b)
-> ((forall a. OrvilleDb registry m a -> OrvilleDb registry m a)
    -> OrvilleDb registry m c)
-> OrvilleDb registry m c
liftMask :: forall c.
(forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b)
-> ((forall a. OrvilleDb registry m a -> OrvilleDb registry m a)
    -> OrvilleDb registry m c)
-> OrvilleDb registry m c
O.MonadOrvilleControl
    )

instance MonadTrans (OrvilleDb registry) where
  lift :: forall (m :: * -> *) a. Monad m => m a -> OrvilleDb registry m a
lift = ReaderT (OrvilleEnv registry) m a -> OrvilleDb registry m a
forall (registry :: JobPayloadRegistry) (m :: * -> *) a.
ReaderT (OrvilleEnv registry) m a -> OrvilleDb registry m a
OrvilleDb (ReaderT (OrvilleEnv registry) m a -> OrvilleDb registry m a)
-> (m a -> ReaderT (OrvilleEnv registry) m a)
-> m a
-> OrvilleDb registry m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ReaderT (OrvilleEnv registry) m a
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (OrvilleEnv registry) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance (O.MonadOrville m) => O.MonadOrville (OrvilleDb registry m)

instance (MonadUnliftIO m, O.MonadOrville m) => MonadArbiter (OrvilleDb registry m) where
  type RegistryOf (OrvilleDb registry m) = registry
  type Handler (OrvilleDb registry m) job result = job -> m result
  getSchema :: OrvilleDb registry m SchemaName
getSchema = ReaderT (OrvilleEnv registry) m SchemaName
-> OrvilleDb registry m SchemaName
forall (registry :: JobPayloadRegistry) (m :: * -> *) a.
ReaderT (OrvilleEnv registry) m a -> OrvilleDb registry m a
OrvilleDb (ReaderT (OrvilleEnv registry) m SchemaName
 -> OrvilleDb registry m SchemaName)
-> ReaderT (OrvilleEnv registry) m SchemaName
-> OrvilleDb registry m SchemaName
forall a b. (a -> b) -> a -> b
$ (OrvilleEnv registry -> SchemaName)
-> ReaderT (OrvilleEnv registry) m SchemaName
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks OrvilleEnv registry -> SchemaName
forall (registry :: JobPayloadRegistry).
OrvilleEnv registry -> SchemaName
schema
  executeQuery :: forall a. Query a -> OrvilleDb registry m [a]
executeQuery = Query a -> OrvilleDb registry m [a]
forall (m :: * -> *) a. MonadOrville m => Query a -> m [a]
orvilleExecuteQuery
  executeStatement :: forall a. Query a -> OrvilleDb registry m Int64
executeStatement = Query a -> OrvilleDb registry m Int64
forall (m :: * -> *) a. MonadOrville m => Query a -> m Int64
orvilleExecuteStatement
  withDbTransaction :: forall a. OrvilleDb registry m a -> OrvilleDb registry m a
withDbTransaction = OrvilleDb registry m a -> OrvilleDb registry m a
forall (m :: * -> *) a. MonadOrville m => m a -> m a
orvilleWithDbTransaction
  runHandlerWithConnection :: forall payload.
JobHandler
  (OrvilleDb registry m)
  payload
  (ResultOf (OrvilleDb registry m) payload)
-> JobRead payload
-> OrvilleDb registry m (ResultOf (OrvilleDb registry m) payload)
runHandlerWithConnection JobHandler
  (OrvilleDb registry m)
  payload
  (ResultOf (OrvilleDb registry m) payload)
handler = m (SpecResult (MatchIn payload '[] registry))
-> OrvilleDb registry m (SpecResult (MatchIn payload '[] registry))
forall (m :: * -> *) a. Monad m => m a -> OrvilleDb registry m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (SpecResult (MatchIn payload '[] registry))
 -> OrvilleDb
      registry m (SpecResult (MatchIn payload '[] registry)))
-> (JobRead payload
    -> m (SpecResult (MatchIn payload '[] registry)))
-> JobRead payload
-> OrvilleDb registry m (SpecResult (MatchIn payload '[] registry))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JobHandler
  (OrvilleDb registry m)
  payload
  (ResultOf (OrvilleDb registry m) payload)
JobRead payload -> m (SpecResult (MatchIn payload '[] registry))
handler
  getListener :: OrvilleDb registry m (Maybe Listener)
getListener = ReaderT (OrvilleEnv registry) m (Maybe Listener)
-> OrvilleDb registry m (Maybe Listener)
forall (registry :: JobPayloadRegistry) (m :: * -> *) a.
ReaderT (OrvilleEnv registry) m a -> OrvilleDb registry m a
OrvilleDb (ReaderT (OrvilleEnv registry) m (Maybe Listener)
 -> OrvilleDb registry m (Maybe Listener))
-> ReaderT (OrvilleEnv registry) m (Maybe Listener)
-> OrvilleDb registry m (Maybe Listener)
forall a b. (a -> b) -> a -> b
$ (OrvilleEnv registry -> Maybe Listener)
-> ReaderT (OrvilleEnv registry) m (Maybe Listener)
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks OrvilleEnv registry -> Maybe Listener
forall (registry :: JobPayloadRegistry).
OrvilleEnv registry -> Maybe Listener
listener

-- | Run an 'OrvilleDb' action in the base monad.
runOrvilleDb :: OrvilleEnv registry -> OrvilleDb registry m a -> m a
runOrvilleDb :: forall (registry :: JobPayloadRegistry) (m :: * -> *) a.
OrvilleEnv registry -> OrvilleDb registry m a -> m a
runOrvilleDb OrvilleEnv registry
env = (ReaderT (OrvilleEnv registry) m a -> OrvilleEnv registry -> m a)
-> OrvilleEnv registry -> ReaderT (OrvilleEnv registry) m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT (OrvilleEnv registry) m a -> OrvilleEnv registry -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT OrvilleEnv registry
env (ReaderT (OrvilleEnv registry) m a -> m a)
-> (OrvilleDb registry m a -> ReaderT (OrvilleEnv registry) m a)
-> OrvilleDb registry m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrvilleDb registry m a -> ReaderT (OrvilleEnv registry) m a
forall (registry :: JobPayloadRegistry) (m :: * -> *) a.
OrvilleDb registry m a -> ReaderT (OrvilleEnv registry) m a
unOrvilleDb

-- | Orville @ConnectionOptions@ from an arbiter 'Arbiter.Core.PoolConfig.PoolConfig'.
-- Notice reporting is off.
toOrvilleConnectionOptions
  :: ByteString
  -- ^ PostgreSQL connection string
  -> PoolConfig
  -- ^ Arbiter pool configuration
  -> O.ConnectionOptions
toOrvilleConnectionOptions :: ByteString -> PoolConfig -> ConnectionOptions
toOrvilleConnectionOptions ByteString
connStr PoolConfig
config =
  let stripes :: StripeOption
stripes = StripeOption -> (Int -> StripeOption) -> Maybe Int -> StripeOption
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StripeOption
O.OneStripePerCapability Int -> StripeOption
O.StripeCount (PoolConfig -> Maybe Int
poolStripes PoolConfig
config)
   in O.ConnectionOptions
        { connectionString :: String
O.connectionString = ByteString -> String
BS8.unpack ByteString
connStr
        , connectionNoticeReporting :: NoticeReporting
O.connectionNoticeReporting = NoticeReporting
O.DisableNoticeReporting
        , connectionPoolStripes :: StripeOption
O.connectionPoolStripes = StripeOption
stripes
        , connectionPoolLingerTime :: NominalDiffTime
O.connectionPoolLingerTime = Int -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PoolConfig -> Int
poolIdleTimeout PoolConfig
config)
        , connectionPoolMaxConnections :: MaxConnections
O.connectionPoolMaxConnections = Int -> MaxConnections
O.MaxConnectionsTotal (PoolConfig -> Int
poolSize PoolConfig
config)
        }