{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
module Database.PostgreSQL.Tx.Query.Internal
  ( -- * Disclaimer
    -- $disclaimer

    -- ** Internals
    module Database.PostgreSQL.Tx.Query.Internal
  ) where

import Control.Monad.Base (MonadBase)
import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Logger (MonadLogger(monadLoggerLog), MonadLoggerIO(askLoggerIO), toLogStr)
import Control.Monad.Reader (ReaderT(ReaderT))
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Kind (Constraint)
import Database.PostgreSQL.Tx (TxEnvs, TxM, askTxEnv, mapExceptionTx)
import Database.PostgreSQL.Tx.Query.Internal.Reexport
import Database.PostgreSQL.Tx.Unsafe (unsafeMkTxM, unsafeRunIOInTxM, unsafeRunTxM, unsafeUnTxM)
import GHC.Stack (HasCallStack)
import qualified Database.PostgreSQL.Simple as Simple
import qualified Database.PostgreSQL.Tx.MonadLogger
import qualified Database.PostgreSQL.Tx.Simple.Internal as Tx.Simple.Internal

-- | Runtime environment needed to run @postgresql-query@ via @postgresql-tx@.
--
-- @since 0.2.0.0
type PgQueryEnv r = (TxEnvs '[Simple.Connection, Logger] r) :: Constraint

-- | Monad type alias for running @postgresql-query@ via @postgresql-tx@.
--
-- @since 0.2.0.0
type PgQueryM a = forall r. (PgQueryEnv r) => TxM r a

-- | Re-export of 'Database.PostgreSQL.Tx.MonadLogger.Logger'.
--
-- @since 0.1.0.0
type Logger = Database.PostgreSQL.Tx.MonadLogger.Logger

-- | Analogous to 'TxM' but allows for 'IO'. Useful so we can have
-- instances which are required to run @postgresql-query@ functions.
-- See 'unsafeToPgQueryIO' and 'unsafeFromPgQueryIO' for converting to/from
-- 'TxM'.
newtype UnsafePgQueryIO r a = UnsafePgQueryIO (ReaderT r IO a)
  deriving newtype
    ( a -> UnsafePgQueryIO r b -> UnsafePgQueryIO r a
(a -> b) -> UnsafePgQueryIO r a -> UnsafePgQueryIO r b
(forall a b.
 (a -> b) -> UnsafePgQueryIO r a -> UnsafePgQueryIO r b)
-> (forall a b. a -> UnsafePgQueryIO r b -> UnsafePgQueryIO r a)
-> Functor (UnsafePgQueryIO r)
forall a b. a -> UnsafePgQueryIO r b -> UnsafePgQueryIO r a
forall a b. (a -> b) -> UnsafePgQueryIO r a -> UnsafePgQueryIO r b
forall r a b. a -> UnsafePgQueryIO r b -> UnsafePgQueryIO r a
forall r a b.
(a -> b) -> UnsafePgQueryIO r a -> UnsafePgQueryIO r b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> UnsafePgQueryIO r b -> UnsafePgQueryIO r a
$c<$ :: forall r a b. a -> UnsafePgQueryIO r b -> UnsafePgQueryIO r a
fmap :: (a -> b) -> UnsafePgQueryIO r a -> UnsafePgQueryIO r b
$cfmap :: forall r a b.
(a -> b) -> UnsafePgQueryIO r a -> UnsafePgQueryIO r b
Functor, Functor (UnsafePgQueryIO r)
a -> UnsafePgQueryIO r a
Functor (UnsafePgQueryIO r) =>
(forall a. a -> UnsafePgQueryIO r a)
-> (forall a b.
    UnsafePgQueryIO r (a -> b)
    -> UnsafePgQueryIO r a -> UnsafePgQueryIO r b)
-> (forall a b c.
    (a -> b -> c)
    -> UnsafePgQueryIO r a
    -> UnsafePgQueryIO r b
    -> UnsafePgQueryIO r c)
-> (forall a b.
    UnsafePgQueryIO r a -> UnsafePgQueryIO r b -> UnsafePgQueryIO r b)
-> (forall a b.
    UnsafePgQueryIO r a -> UnsafePgQueryIO r b -> UnsafePgQueryIO r a)
-> Applicative (UnsafePgQueryIO r)
UnsafePgQueryIO r a -> UnsafePgQueryIO r b -> UnsafePgQueryIO r b
UnsafePgQueryIO r a -> UnsafePgQueryIO r b -> UnsafePgQueryIO r a
UnsafePgQueryIO r (a -> b)
-> UnsafePgQueryIO r a -> UnsafePgQueryIO r b
(a -> b -> c)
-> UnsafePgQueryIO r a
-> UnsafePgQueryIO r b
-> UnsafePgQueryIO r c
forall r. Functor (UnsafePgQueryIO r)
forall a. a -> UnsafePgQueryIO r a
forall r a. a -> UnsafePgQueryIO r a
forall a b.
UnsafePgQueryIO r a -> UnsafePgQueryIO r b -> UnsafePgQueryIO r a
forall a b.
UnsafePgQueryIO r a -> UnsafePgQueryIO r b -> UnsafePgQueryIO r b
forall a b.
UnsafePgQueryIO r (a -> b)
-> UnsafePgQueryIO r a -> UnsafePgQueryIO r b
forall r a b.
UnsafePgQueryIO r a -> UnsafePgQueryIO r b -> UnsafePgQueryIO r a
forall r a b.
UnsafePgQueryIO r a -> UnsafePgQueryIO r b -> UnsafePgQueryIO r b
forall r a b.
UnsafePgQueryIO r (a -> b)
-> UnsafePgQueryIO r a -> UnsafePgQueryIO r b
forall a b c.
(a -> b -> c)
-> UnsafePgQueryIO r a
-> UnsafePgQueryIO r b
-> UnsafePgQueryIO r c
forall r a b c.
(a -> b -> c)
-> UnsafePgQueryIO r a
-> UnsafePgQueryIO r b
-> UnsafePgQueryIO r 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
<* :: UnsafePgQueryIO r a -> UnsafePgQueryIO r b -> UnsafePgQueryIO r a
$c<* :: forall r a b.
UnsafePgQueryIO r a -> UnsafePgQueryIO r b -> UnsafePgQueryIO r a
*> :: UnsafePgQueryIO r a -> UnsafePgQueryIO r b -> UnsafePgQueryIO r b
$c*> :: forall r a b.
UnsafePgQueryIO r a -> UnsafePgQueryIO r b -> UnsafePgQueryIO r b
liftA2 :: (a -> b -> c)
-> UnsafePgQueryIO r a
-> UnsafePgQueryIO r b
-> UnsafePgQueryIO r c
$cliftA2 :: forall r a b c.
(a -> b -> c)
-> UnsafePgQueryIO r a
-> UnsafePgQueryIO r b
-> UnsafePgQueryIO r c
<*> :: UnsafePgQueryIO r (a -> b)
-> UnsafePgQueryIO r a -> UnsafePgQueryIO r b
$c<*> :: forall r a b.
UnsafePgQueryIO r (a -> b)
-> UnsafePgQueryIO r a -> UnsafePgQueryIO r b
pure :: a -> UnsafePgQueryIO r a
$cpure :: forall r a. a -> UnsafePgQueryIO r a
$cp1Applicative :: forall r. Functor (UnsafePgQueryIO r)
Applicative, Applicative (UnsafePgQueryIO r)
a -> UnsafePgQueryIO r a
Applicative (UnsafePgQueryIO r) =>
(forall a b.
 UnsafePgQueryIO r a
 -> (a -> UnsafePgQueryIO r b) -> UnsafePgQueryIO r b)
-> (forall a b.
    UnsafePgQueryIO r a -> UnsafePgQueryIO r b -> UnsafePgQueryIO r b)
-> (forall a. a -> UnsafePgQueryIO r a)
-> Monad (UnsafePgQueryIO r)
UnsafePgQueryIO r a
-> (a -> UnsafePgQueryIO r b) -> UnsafePgQueryIO r b
UnsafePgQueryIO r a -> UnsafePgQueryIO r b -> UnsafePgQueryIO r b
forall r. Applicative (UnsafePgQueryIO r)
forall a. a -> UnsafePgQueryIO r a
forall r a. a -> UnsafePgQueryIO r a
forall a b.
UnsafePgQueryIO r a -> UnsafePgQueryIO r b -> UnsafePgQueryIO r b
forall a b.
UnsafePgQueryIO r a
-> (a -> UnsafePgQueryIO r b) -> UnsafePgQueryIO r b
forall r a b.
UnsafePgQueryIO r a -> UnsafePgQueryIO r b -> UnsafePgQueryIO r b
forall r a b.
UnsafePgQueryIO r a
-> (a -> UnsafePgQueryIO r b) -> UnsafePgQueryIO r 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
return :: a -> UnsafePgQueryIO r a
$creturn :: forall r a. a -> UnsafePgQueryIO r a
>> :: UnsafePgQueryIO r a -> UnsafePgQueryIO r b -> UnsafePgQueryIO r b
$c>> :: forall r a b.
UnsafePgQueryIO r a -> UnsafePgQueryIO r b -> UnsafePgQueryIO r b
>>= :: UnsafePgQueryIO r a
-> (a -> UnsafePgQueryIO r b) -> UnsafePgQueryIO r b
$c>>= :: forall r a b.
UnsafePgQueryIO r a
-> (a -> UnsafePgQueryIO r b) -> UnsafePgQueryIO r b
$cp1Monad :: forall r. Applicative (UnsafePgQueryIO r)
Monad, Monad (UnsafePgQueryIO r)
Monad (UnsafePgQueryIO r) =>
(forall a. IO a -> UnsafePgQueryIO r a)
-> MonadIO (UnsafePgQueryIO r)
IO a -> UnsafePgQueryIO r a
forall r. Monad (UnsafePgQueryIO r)
forall a. IO a -> UnsafePgQueryIO r a
forall r a. IO a -> UnsafePgQueryIO r a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> UnsafePgQueryIO r a
$cliftIO :: forall r a. IO a -> UnsafePgQueryIO r a
$cp1MonadIO :: forall r. Monad (UnsafePgQueryIO r)
MonadIO
    , MonadBase IO, MonadBaseControl IO, TransactionSafe (UnsafePgQueryIO r)
forall (m :: * -> *). TransactionSafe m
TransactionSafe
    , MonadThrow (UnsafePgQueryIO r)
MonadThrow (UnsafePgQueryIO r) =>
(forall e a.
 Exception e =>
 UnsafePgQueryIO r a
 -> (e -> UnsafePgQueryIO r a) -> UnsafePgQueryIO r a)
-> MonadCatch (UnsafePgQueryIO r)
UnsafePgQueryIO r a
-> (e -> UnsafePgQueryIO r a) -> UnsafePgQueryIO r a
forall r. MonadThrow (UnsafePgQueryIO r)
forall e a.
Exception e =>
UnsafePgQueryIO r a
-> (e -> UnsafePgQueryIO r a) -> UnsafePgQueryIO r a
forall r e a.
Exception e =>
UnsafePgQueryIO r a
-> (e -> UnsafePgQueryIO r a) -> UnsafePgQueryIO r a
forall (m :: * -> *).
MonadThrow m =>
(forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: UnsafePgQueryIO r a
-> (e -> UnsafePgQueryIO r a) -> UnsafePgQueryIO r a
$ccatch :: forall r e a.
Exception e =>
UnsafePgQueryIO r a
-> (e -> UnsafePgQueryIO r a) -> UnsafePgQueryIO r a
$cp1MonadCatch :: forall r. MonadThrow (UnsafePgQueryIO r)
MonadCatch, MonadCatch (UnsafePgQueryIO r)
MonadCatch (UnsafePgQueryIO r) =>
(forall b.
 ((forall a. UnsafePgQueryIO r a -> UnsafePgQueryIO r a)
  -> UnsafePgQueryIO r b)
 -> UnsafePgQueryIO r b)
-> (forall b.
    ((forall a. UnsafePgQueryIO r a -> UnsafePgQueryIO r a)
     -> UnsafePgQueryIO r b)
    -> UnsafePgQueryIO r b)
-> (forall a b c.
    UnsafePgQueryIO r a
    -> (a -> ExitCase b -> UnsafePgQueryIO r c)
    -> (a -> UnsafePgQueryIO r b)
    -> UnsafePgQueryIO r (b, c))
-> MonadMask (UnsafePgQueryIO r)
UnsafePgQueryIO r a
-> (a -> ExitCase b -> UnsafePgQueryIO r c)
-> (a -> UnsafePgQueryIO r b)
-> UnsafePgQueryIO r (b, c)
((forall a. UnsafePgQueryIO r a -> UnsafePgQueryIO r a)
 -> UnsafePgQueryIO r b)
-> UnsafePgQueryIO r b
((forall a. UnsafePgQueryIO r a -> UnsafePgQueryIO r a)
 -> UnsafePgQueryIO r b)
-> UnsafePgQueryIO r b
forall r. MonadCatch (UnsafePgQueryIO r)
forall b.
((forall a. UnsafePgQueryIO r a -> UnsafePgQueryIO r a)
 -> UnsafePgQueryIO r b)
-> UnsafePgQueryIO r b
forall r b.
((forall a. UnsafePgQueryIO r a -> UnsafePgQueryIO r a)
 -> UnsafePgQueryIO r b)
-> UnsafePgQueryIO r b
forall a b c.
UnsafePgQueryIO r a
-> (a -> ExitCase b -> UnsafePgQueryIO r c)
-> (a -> UnsafePgQueryIO r b)
-> UnsafePgQueryIO r (b, c)
forall r a b c.
UnsafePgQueryIO r a
-> (a -> ExitCase b -> UnsafePgQueryIO r c)
-> (a -> UnsafePgQueryIO r b)
-> UnsafePgQueryIO r (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
generalBracket :: UnsafePgQueryIO r a
-> (a -> ExitCase b -> UnsafePgQueryIO r c)
-> (a -> UnsafePgQueryIO r b)
-> UnsafePgQueryIO r (b, c)
$cgeneralBracket :: forall r a b c.
UnsafePgQueryIO r a
-> (a -> ExitCase b -> UnsafePgQueryIO r c)
-> (a -> UnsafePgQueryIO r b)
-> UnsafePgQueryIO r (b, c)
uninterruptibleMask :: ((forall a. UnsafePgQueryIO r a -> UnsafePgQueryIO r a)
 -> UnsafePgQueryIO r b)
-> UnsafePgQueryIO r b
$cuninterruptibleMask :: forall r b.
((forall a. UnsafePgQueryIO r a -> UnsafePgQueryIO r a)
 -> UnsafePgQueryIO r b)
-> UnsafePgQueryIO r b
mask :: ((forall a. UnsafePgQueryIO r a -> UnsafePgQueryIO r a)
 -> UnsafePgQueryIO r b)
-> UnsafePgQueryIO r b
$cmask :: forall r b.
((forall a. UnsafePgQueryIO r a -> UnsafePgQueryIO r a)
 -> UnsafePgQueryIO r b)
-> UnsafePgQueryIO r b
$cp1MonadMask :: forall r. MonadCatch (UnsafePgQueryIO r)
MonadMask, Monad (UnsafePgQueryIO r)
e -> UnsafePgQueryIO r a
Monad (UnsafePgQueryIO r) =>
(forall e a. Exception e => e -> UnsafePgQueryIO r a)
-> MonadThrow (UnsafePgQueryIO r)
forall r. Monad (UnsafePgQueryIO r)
forall e a. Exception e => e -> UnsafePgQueryIO r a
forall r e a. Exception e => e -> UnsafePgQueryIO r a
forall (m :: * -> *).
Monad m =>
(forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> UnsafePgQueryIO r a
$cthrowM :: forall r e a. Exception e => e -> UnsafePgQueryIO r a
$cp1MonadThrow :: forall r. Monad (UnsafePgQueryIO r)
MonadThrow
    )

instance (PgQueryEnv r) => HasPostgres (UnsafePgQueryIO r) where
  withPGConnection :: (Connection -> UnsafePgQueryIO r a) -> UnsafePgQueryIO r a
withPGConnection f :: Connection -> UnsafePgQueryIO r a
f = do
    TxM r a -> UnsafePgQueryIO r a
forall r a. HasCallStack => TxM r a -> UnsafePgQueryIO r a
unsafeToPgQueryIO do
      Connection
conn <- TxM r Connection
forall a r. TxEnv a r => TxM r a
askTxEnv
      UnsafePgQueryIO r a -> TxM r a
forall r a. HasCallStack => UnsafePgQueryIO r a -> TxM r a
unsafeFromPgQueryIO (UnsafePgQueryIO r a -> TxM r a) -> UnsafePgQueryIO r a -> TxM r a
forall a b. (a -> b) -> a -> b
$ Connection -> UnsafePgQueryIO r a
f Connection
conn

instance (PgQueryEnv r) => MonadLogger (UnsafePgQueryIO r) where
  monadLoggerLog :: Loc -> LogSource -> LogLevel -> msg -> UnsafePgQueryIO r ()
monadLoggerLog loc :: Loc
loc src :: LogSource
src lvl :: LogLevel
lvl msg :: msg
msg = do
    TxM r () -> UnsafePgQueryIO r ()
forall r a. HasCallStack => TxM r a -> UnsafePgQueryIO r a
unsafeToPgQueryIO do
      Loc -> LogSource -> LogLevel -> LogStr -> IO ()
logger <- TxM r (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
forall a r. TxEnv a r => TxM r a
askTxEnv
      IO () -> TxM r ()
forall a r. IO a -> TxM r a
unsafeRunIOInTxM (IO () -> TxM r ()) -> IO () -> TxM r ()
forall a b. (a -> b) -> a -> b
$ Loc -> LogSource -> LogLevel -> LogStr -> IO ()
logger Loc
loc LogSource
src LogLevel
lvl (msg -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr msg
msg)

instance (PgQueryEnv r) => MonadLoggerIO (UnsafePgQueryIO r) where
  askLoggerIO :: UnsafePgQueryIO r (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
askLoggerIO = TxM r (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
-> UnsafePgQueryIO
     r (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
forall r a. HasCallStack => TxM r a -> UnsafePgQueryIO r a
unsafeToPgQueryIO TxM r (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
forall a r. TxEnv a r => TxM r a
askTxEnv

unsafeToPgQueryIO :: (HasCallStack) => TxM r a -> UnsafePgQueryIO r a
unsafeToPgQueryIO :: TxM r a -> UnsafePgQueryIO r a
unsafeToPgQueryIO x :: TxM r a
x = ReaderT r IO a -> UnsafePgQueryIO r a
forall r a. ReaderT r IO a -> UnsafePgQueryIO r a
UnsafePgQueryIO (ReaderT r IO a -> UnsafePgQueryIO r a)
-> ReaderT r IO a -> UnsafePgQueryIO r a
forall a b. (a -> b) -> a -> b
$ TxM r a -> ReaderT r IO a
forall r a. TxM r a -> ReaderT r IO a
unsafeUnTxM TxM r a
x

unsafeFromPgQueryIO :: (HasCallStack) => UnsafePgQueryIO r a -> TxM r a
unsafeFromPgQueryIO :: UnsafePgQueryIO r a -> TxM r a
unsafeFromPgQueryIO (UnsafePgQueryIO (ReaderT f :: r -> IO a
f)) =
  (SqlError -> Maybe TxException) -> TxM r a -> TxM r a
forall e e' r a.
(Exception e, Exception e') =>
(e -> Maybe e') -> TxM r a -> TxM r a
mapExceptionTx (TxException -> Maybe TxException
forall a. a -> Maybe a
Just (TxException -> Maybe TxException)
-> (SqlError -> TxException) -> SqlError -> Maybe TxException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlError -> TxException
Tx.Simple.Internal.fromSqlError) do
    (r -> IO a) -> TxM r a
forall r a. (r -> IO a) -> TxM r a
unsafeMkTxM r -> IO a
f

unsafeRunPgQueryTransaction
  :: (PgQueryEnv r, HasCallStack)
  => (HasCallStack => UnsafePgQueryIO r a -> UnsafePgQueryIO r a)
  -> r
  -> TxM r a
  -> IO a
unsafeRunPgQueryTransaction :: (HasCallStack => UnsafePgQueryIO r a -> UnsafePgQueryIO r a)
-> r -> TxM r a -> IO a
unsafeRunPgQueryTransaction f :: HasCallStack => UnsafePgQueryIO r a -> UnsafePgQueryIO r a
f r :: r
r x :: TxM r a
x =
  r -> TxM r a -> IO a
forall r a. r -> TxM r a -> IO a
unsafeRunTxM r
r
    (TxM r a -> IO a) -> TxM r a -> IO a
forall a b. (a -> b) -> a -> b
$ UnsafePgQueryIO r a -> TxM r a
forall r a. HasCallStack => UnsafePgQueryIO r a -> TxM r a
unsafeFromPgQueryIO
    (UnsafePgQueryIO r a -> TxM r a) -> UnsafePgQueryIO r a -> TxM r a
forall a b. (a -> b) -> a -> b
$ HasCallStack => UnsafePgQueryIO r a -> UnsafePgQueryIO r a
UnsafePgQueryIO r a -> UnsafePgQueryIO r a
f
    (UnsafePgQueryIO r a -> UnsafePgQueryIO r a)
-> UnsafePgQueryIO r a -> UnsafePgQueryIO r a
forall a b. (a -> b) -> a -> b
$ TxM r a -> UnsafePgQueryIO r a
forall r a. HasCallStack => TxM r a -> UnsafePgQueryIO r a
unsafeToPgQueryIO TxM r a
x

-- $disclaimer
--
-- Changes to this module will not be reflected in the library's version
-- updates.