{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- | In here one will find the things to execute database queries.
module PostgreSQL.Query
  ( -- * Query execution
    Class.execute
  , execute_
  , query
  , queryWith

    -- * Class
  , Class.Query (..)

    -- * Interpreter
  , QueryT
  , runQueryT
  , runQueryTThrow
  )
where

import           Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow (throwM), bracket)
import qualified Control.Monad.Except as Except
import           Control.Monad.IO.Class (MonadIO (liftIO))
import qualified Control.Monad.Reader as Reader
import           Control.Monad.State.Class (MonadState)
import           Control.Monad.Trans (MonadTrans (lift))
import           Control.Monad.Writer.Class (MonadWriter)
import           Data.Coerce (coerce)
import           Data.Functor (void)
import           Data.Functor.Alt (Alt (..))
import           Data.Functor.Apply (Apply)
import           Data.Functor.Bind (Bind (..))
import qualified Data.List.NonEmpty as NonEmpty
import           Data.Text.Encoding (decodeUtf8)
import qualified Data.Vector as Vector
import qualified Database.PostgreSQL.LibPQ as PQ
import qualified PostgreSQL.Param as Param
import qualified PostgreSQL.Query.Class as Class
import qualified PostgreSQL.Result as Result
import qualified PostgreSQL.Result.Row as Row
import qualified PostgreSQL.Statement as Statement
import           PostgreSQL.Types (Connection, Error (..), Errors, Format (Text))

---

-- | Like 'Class.execute' but does not concern itself with the result handle.
--
-- @since 0.0.0
execute_
  :: (Class.Executable statement, Class.Query query)
  => statement param
  -- ^ Statement
  -> param
  -- ^ Statement input
  -> query ()
execute_ :: statement param -> param -> query ()
execute_ statement param
statement param
param =
  query (NativeResult query) -> query ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (statement param -> param -> query (NativeResult query)
forall (statement :: * -> *) (query :: * -> *) param.
(Executable statement, Query query) =>
statement param -> param -> query (NativeResult query)
Class.execute statement param
statement param
param)

{-# INLINE execute_ #-}

-- | Perform a parameterized query.
--
-- @since 0.0.0
query
  :: (Class.Executable statement, Class.Query query, Row.AutoRow row)
  => statement param
  -- ^ Query statement
  -> param
  -- ^ Query parameter
  -> query (Vector.Vector row)
query :: statement param -> param -> query (Vector row)
query statement param
statement param
input =
  statement param
-> param -> Result (Vector row) -> query (Vector row)
forall (statement :: * -> *) (query :: * -> *) param row.
(Executable statement, Query query) =>
statement param -> param -> Result row -> query row
queryWith statement param
statement param
input (Row row -> Result (Vector row)
forall a. Row a -> Result (Vector a)
Result.many Row row
forall a. AutoRow a => Row a
Row.autoRow)

{-# INLINE query #-}

-- | Perform a parameterized query. This also lets you specify the result processor explicitly.
--
-- @since 0.0.0
queryWith
  :: (Class.Executable statement, Class.Query query)
  => statement param
  -- ^ Query statement
  -> param
  -- ^ Query parameter
  -> Result.Result row
  -- ^ Result row processor
  -> query row
queryWith :: statement param -> param -> Result row -> query row
queryWith statement param
statement param
input Result row
resultProcessor = do
  NativeResult query
result <- statement param -> param -> query (NativeResult query)
forall (statement :: * -> *) (query :: * -> *) param.
(Executable statement, Query query) =>
statement param -> param -> query (NativeResult query)
Class.execute statement param
statement param
input
  NativeResult query -> Result row -> query row
forall (query :: * -> *) a.
Query query =>
NativeResult query -> Result a -> query a
Class.processResult NativeResult query
result Result row
resultProcessor

{-# INLINE queryWith #-}

---

-- | Interpreter for 'Class.Query'
--
-- @since 0.0.0
newtype QueryT m a = QueryT
  { QueryT m a -> ReaderT Connection (ExceptT Errors m) a
unQueryT :: Reader.ReaderT Connection (Except.ExceptT Errors m) a }
  deriving newtype
    ( Functor -- ^ @since 0.0.0
    , Apply -- ^ @since 0.0.0
    , Applicative -- ^ @since 0.0.0
    , Monad -- ^ @since 0.0.0
    , MonadIO -- ^ @since 0.0.0
    , MonadState s -- ^ @since 0.0.0
    , MonadWriter s -- ^ @since 0.0.0
    , Except.MonadError Errors -- ^ @since 0.0.0
    , MonadThrow -- ^ @since 0.0.0
    , MonadCatch -- ^ @since 0.0.0
    , MonadMask -- ^ @since 0.0.0
    )

-- | @since 0.0.0
instance Monad m => Alt (QueryT m) where
  QueryT ReaderT Connection (ExceptT Errors m) a
lhs <!> :: QueryT m a -> QueryT m a -> QueryT m a
<!> QueryT ReaderT Connection (ExceptT Errors m) a
rhs = ReaderT Connection (ExceptT Errors m) a -> QueryT m a
forall (m :: * -> *) a.
ReaderT Connection (ExceptT Errors m) a -> QueryT m a
QueryT (ReaderT Connection (ExceptT Errors m) a -> QueryT m a)
-> ReaderT Connection (ExceptT Errors m) a -> QueryT m a
forall a b. (a -> b) -> a -> b
$ ReaderT Connection (ExceptT Errors m) a
lhs ReaderT Connection (ExceptT Errors m) a
-> ReaderT Connection (ExceptT Errors m) a
-> ReaderT Connection (ExceptT Errors m) a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> ReaderT Connection (ExceptT Errors m) a
rhs

  {-# INLINE (<!>) #-}

-- | @since 0.0.0
instance Monad m => Bind (QueryT m) where
  QueryT ReaderT Connection (ExceptT Errors m) a
x >>- :: QueryT m a -> (a -> QueryT m b) -> QueryT m b
>>- a -> QueryT m b
f = ReaderT Connection (ExceptT Errors m) b -> QueryT m b
forall (m :: * -> *) a.
ReaderT Connection (ExceptT Errors m) a -> QueryT m a
QueryT (ReaderT Connection (ExceptT Errors m) a
x ReaderT Connection (ExceptT Errors m) a
-> (a -> ReaderT Connection (ExceptT Errors m) b)
-> ReaderT Connection (ExceptT Errors m) b
forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- QueryT m b -> ReaderT Connection (ExceptT Errors m) b
forall (m :: * -> *) a.
QueryT m a -> ReaderT Connection (ExceptT Errors m) a
unQueryT (QueryT m b -> ReaderT Connection (ExceptT Errors m) b)
-> (a -> QueryT m b)
-> a
-> ReaderT Connection (ExceptT Errors m) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> QueryT m b
f)

  {-# INLINE (>>-) #-}

-- | @since 0.0.0
instance MonadTrans QueryT where
  lift :: m a -> QueryT m a
lift = ReaderT Connection (ExceptT Errors m) a -> QueryT m a
forall (m :: * -> *) a.
ReaderT Connection (ExceptT Errors m) a -> QueryT m a
QueryT (ReaderT Connection (ExceptT Errors m) a -> QueryT m a)
-> (m a -> ReaderT Connection (ExceptT Errors m) a)
-> m a
-> QueryT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT Errors m a -> ReaderT Connection (ExceptT Errors m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT Errors m a -> ReaderT Connection (ExceptT Errors m) a)
-> (m a -> ExceptT Errors m a)
-> m a
-> ReaderT Connection (ExceptT Errors m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ExceptT Errors m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

  {-# INLINE lift #-}

-- | @since 0.0.0
instance Reader.MonadReader r m => Reader.MonadReader r (QueryT m) where
  ask :: QueryT m r
ask = ReaderT Connection (ExceptT Errors m) r -> QueryT m r
forall (m :: * -> *) a.
ReaderT Connection (ExceptT Errors m) a -> QueryT m a
QueryT (ReaderT Connection (ExceptT Errors m) r -> QueryT m r)
-> ReaderT Connection (ExceptT Errors m) r -> QueryT m r
forall a b. (a -> b) -> a -> b
$ ExceptT Errors m r -> ReaderT Connection (ExceptT Errors m) r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT Errors m r -> ReaderT Connection (ExceptT Errors m) r)
-> ExceptT Errors m r -> ReaderT Connection (ExceptT Errors m) r
forall a b. (a -> b) -> a -> b
$ m r -> ExceptT Errors m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
Reader.ask

  {-# INLINE ask #-}

  local :: (r -> r) -> QueryT m a -> QueryT m a
local r -> r
f (QueryT ReaderT Connection (ExceptT Errors m) a
inner) = ReaderT Connection (ExceptT Errors m) a -> QueryT m a
forall (m :: * -> *) a.
ReaderT Connection (ExceptT Errors m) a -> QueryT m a
QueryT (ReaderT Connection (ExceptT Errors m) a -> QueryT m a)
-> ReaderT Connection (ExceptT Errors m) a -> QueryT m a
forall a b. (a -> b) -> a -> b
$
    (ExceptT Errors m a -> ExceptT Errors m a)
-> ReaderT Connection (ExceptT Errors m) a
-> ReaderT Connection (ExceptT Errors m) a
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
Reader.mapReaderT ((m (Either Errors a) -> m (Either Errors a))
-> ExceptT Errors m a -> ExceptT Errors m a
forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ExceptT e m a -> ExceptT e' n b
Except.mapExceptT ((r -> r) -> m (Either Errors a) -> m (Either Errors a)
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
Reader.local r -> r
f)) ReaderT Connection (ExceptT Errors m) a
inner

  {-# INLINE local #-}

prepareStatement
  :: MonadIO m
  => Statement.Statement a
  -> QueryT m (Statement.PreparedStatement a)
prepareStatement :: Statement a -> QueryT m (PreparedStatement a)
prepareStatement Statement a
statement = ReaderT Connection (ExceptT Errors m) (PreparedStatement a)
-> QueryT m (PreparedStatement a)
forall (m :: * -> *) a.
ReaderT Connection (ExceptT Errors m) a -> QueryT m a
QueryT (ReaderT Connection (ExceptT Errors m) (PreparedStatement a)
 -> QueryT m (PreparedStatement a))
-> ReaderT Connection (ExceptT Errors m) (PreparedStatement a)
-> QueryT m (PreparedStatement a)
forall a b. (a -> b) -> a -> b
$ (Connection -> ExceptT Errors m (PreparedStatement a))
-> ReaderT Connection (ExceptT Errors m) (PreparedStatement a)
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
Reader.ReaderT ((Connection -> ExceptT Errors m (PreparedStatement a))
 -> ReaderT Connection (ExceptT Errors m) (PreparedStatement a))
-> (Connection -> ExceptT Errors m (PreparedStatement a))
-> ReaderT Connection (ExceptT Errors m) (PreparedStatement a)
forall a b. (a -> b) -> a -> b
$ \Connection
conn -> do
  let name :: ByteString
name = Statement a -> ByteString
forall a. Statement a -> ByteString
Statement.statement_name Statement a
statement

  Maybe Result
mbResult <- IO (Maybe Result) -> ExceptT Errors m (Maybe Result)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Result) -> ExceptT Errors m (Maybe Result))
-> IO (Maybe Result) -> ExceptT Errors m (Maybe Result)
forall a b. (a -> b) -> a -> b
$
    Connection
-> ByteString -> ByteString -> Maybe [Oid] -> IO (Maybe Result)
PQ.prepare
      Connection
conn
      ByteString
name
      (Statement a -> ByteString
forall a. Statement a -> ByteString
Statement.statement_code Statement a
statement)
      ([Oid] -> Maybe [Oid]
forall a. a -> Maybe a
Just (Statement a -> [Oid]
forall a. Statement a -> [Oid]
Statement.statement_types Statement a
statement))

  Result
_result <- (NonEmpty ResultError -> Errors)
-> ExceptT (NonEmpty ResultError) m Result
-> ExceptT Errors m Result
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
Except.withExceptT ((ResultError -> Error) -> NonEmpty ResultError -> Errors
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultError -> Error
ErrorDuringValidation) (ExceptT (NonEmpty ResultError) m Result
 -> ExceptT Errors m Result)
-> ExceptT (NonEmpty ResultError) m Result
-> ExceptT Errors m Result
forall a b. (a -> b) -> a -> b
$
    Connection
-> Maybe Result -> ExceptT (NonEmpty ResultError) m Result
forall (m :: * -> *).
(MonadIO m, MonadError (NonEmpty ResultError) m) =>
Connection -> Maybe Result -> m Result
Result.checkForError Connection
conn Maybe Result
mbResult

  PreparedStatement a -> ExceptT Errors m (PreparedStatement a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure PreparedStatement :: forall a.
ByteString -> (a -> [PackedParamPrepared]) -> PreparedStatement a
Statement.PreparedStatement
    { preparedStatement_name :: ByteString
Statement.preparedStatement_name = ByteString
name
    , preparedStatement_mkParams :: a -> [PackedParamPrepared]
Statement.preparedStatement_mkParams =
      (PackedParam -> PackedParamPrepared)
-> [PackedParam] -> [PackedParamPrepared]
forall a b. (a -> b) -> [a] -> [b]
map PackedParam -> PackedParamPrepared
Param.toPrepared ([PackedParam] -> [PackedParamPrepared])
-> (a -> [PackedParam]) -> a -> [PackedParamPrepared]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Statement a -> a -> [PackedParam]
forall a. Statement a -> a -> [PackedParam]
Statement.statement_mkParams Statement a
statement
    }

{-# INLINE prepareStatement #-}

deallocatePreparedStatement
  :: (MonadIO m, MonadMask m)
  => Statement.PreparedStatement a
  -> QueryT m ()
deallocatePreparedStatement :: PreparedStatement a -> QueryT m ()
deallocatePreparedStatement PreparedStatement a
statement =
  Statement () -> () -> QueryT m ()
forall (statement :: * -> *) (query :: * -> *) param.
(Executable statement, Query query) =>
statement param -> param -> query ()
execute_ [Statement.stmt| DEALLOCATE $(quotedName) |] ()
  where
    quotedName :: Template ()
quotedName = Text -> Template ()
forall a. Text -> Template a
Statement.identifier (Text -> Template ()) -> Text -> Template ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ PreparedStatement a -> ByteString
forall a. PreparedStatement a -> ByteString
Statement.preparedStatement_name PreparedStatement a
statement

instance (MonadIO m, MonadMask m) => Class.Query (QueryT m) where
  type NativeResult (QueryT m) = PQ.Result

  executeStatement :: Statement a -> a -> QueryT m (NativeResult (QueryT m))
executeStatement Statement a
statement a
input = ReaderT Connection (ExceptT Errors m) Result -> QueryT m Result
forall (m :: * -> *) a.
ReaderT Connection (ExceptT Errors m) a -> QueryT m a
QueryT (ReaderT Connection (ExceptT Errors m) Result -> QueryT m Result)
-> ReaderT Connection (ExceptT Errors m) Result -> QueryT m Result
forall a b. (a -> b) -> a -> b
$ (Connection -> ExceptT Errors m Result)
-> ReaderT Connection (ExceptT Errors m) Result
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
Reader.ReaderT ((Connection -> ExceptT Errors m Result)
 -> ReaderT Connection (ExceptT Errors m) Result)
-> (Connection -> ExceptT Errors m Result)
-> ReaderT Connection (ExceptT Errors m) Result
forall a b. (a -> b) -> a -> b
$ \Connection
conn -> do
    Maybe Result
mbResult <- IO (Maybe Result) -> ExceptT Errors m (Maybe Result)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Result) -> ExceptT Errors m (Maybe Result))
-> IO (Maybe Result) -> ExceptT Errors m (Maybe Result)
forall a b. (a -> b) -> a -> b
$ do
      let code :: ByteString
code = Statement a -> ByteString
forall a. Statement a -> ByteString
Statement.statement_code Statement a
statement
      case Statement a -> a -> [PackedParam]
forall a. Statement a -> a -> [PackedParam]
Statement.statement_mkParams Statement a
statement a
input of
        []     -> Connection -> ByteString -> IO (Maybe Result)
PQ.exec Connection
conn ByteString
code
        [PackedParam]
params -> Connection
-> ByteString
-> [Maybe (Oid, ByteString, Format)]
-> Format
-> IO (Maybe Result)
PQ.execParams Connection
conn ByteString
code ([PackedParam] -> [Maybe (Oid, ByteString, Format)]
coerce [PackedParam]
params) Format
Text

    (NonEmpty ResultError -> Errors)
-> ExceptT (NonEmpty ResultError) m Result
-> ExceptT Errors m Result
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
Except.withExceptT ((ResultError -> Error) -> NonEmpty ResultError -> Errors
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultError -> Error
ErrorDuringValidation) (ExceptT (NonEmpty ResultError) m Result
 -> ExceptT Errors m Result)
-> ExceptT (NonEmpty ResultError) m Result
-> ExceptT Errors m Result
forall a b. (a -> b) -> a -> b
$ Connection
-> Maybe Result -> ExceptT (NonEmpty ResultError) m Result
forall (m :: * -> *).
(MonadIO m, MonadError (NonEmpty ResultError) m) =>
Connection -> Maybe Result -> m Result
Result.checkForError Connection
conn Maybe Result
mbResult

  {-# INLINE executeStatement #-}

  withPreparedStatement :: Statement a -> (PreparedStatement a -> QueryT m r) -> QueryT m r
withPreparedStatement Statement a
statement =
    QueryT m (PreparedStatement a)
-> (PreparedStatement a -> QueryT m ())
-> (PreparedStatement a -> QueryT m r)
-> QueryT m r
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (Statement a -> QueryT m (PreparedStatement a)
forall (m :: * -> *) a.
MonadIO m =>
Statement a -> QueryT m (PreparedStatement a)
prepareStatement Statement a
statement) PreparedStatement a -> QueryT m ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
PreparedStatement a -> QueryT m ()
deallocatePreparedStatement

  {-# INLINE withPreparedStatement #-}

  executePreparedStatement :: PreparedStatement a -> a -> QueryT m (NativeResult (QueryT m))
executePreparedStatement PreparedStatement a
statement a
input = ReaderT Connection (ExceptT Errors m) Result -> QueryT m Result
forall (m :: * -> *) a.
ReaderT Connection (ExceptT Errors m) a -> QueryT m a
QueryT (ReaderT Connection (ExceptT Errors m) Result -> QueryT m Result)
-> ReaderT Connection (ExceptT Errors m) Result -> QueryT m Result
forall a b. (a -> b) -> a -> b
$ (Connection -> ExceptT Errors m Result)
-> ReaderT Connection (ExceptT Errors m) Result
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
Reader.ReaderT ((Connection -> ExceptT Errors m Result)
 -> ReaderT Connection (ExceptT Errors m) Result)
-> (Connection -> ExceptT Errors m Result)
-> ReaderT Connection (ExceptT Errors m) Result
forall a b. (a -> b) -> a -> b
$ \Connection
conn -> do
    Maybe Result
mbResult <- IO (Maybe Result) -> ExceptT Errors m (Maybe Result)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Result) -> ExceptT Errors m (Maybe Result))
-> IO (Maybe Result) -> ExceptT Errors m (Maybe Result)
forall a b. (a -> b) -> a -> b
$
      Connection
-> ByteString
-> [Maybe (ByteString, Format)]
-> Format
-> IO (Maybe Result)
PQ.execPrepared
        Connection
conn
        (PreparedStatement a -> ByteString
forall a. PreparedStatement a -> ByteString
Statement.preparedStatement_name PreparedStatement a
statement)
        ([PackedParamPrepared] -> [Maybe (ByteString, Format)]
coerce (PreparedStatement a -> a -> [PackedParamPrepared]
forall a. PreparedStatement a -> a -> [PackedParamPrepared]
Statement.preparedStatement_mkParams PreparedStatement a
statement a
input))
        Format
Text

    (NonEmpty ResultError -> Errors)
-> ExceptT (NonEmpty ResultError) m Result
-> ExceptT Errors m Result
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
Except.withExceptT ((ResultError -> Error) -> NonEmpty ResultError -> Errors
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultError -> Error
ErrorDuringValidation) (ExceptT (NonEmpty ResultError) m Result
 -> ExceptT Errors m Result)
-> ExceptT (NonEmpty ResultError) m Result
-> ExceptT Errors m Result
forall a b. (a -> b) -> a -> b
$ Connection
-> Maybe Result -> ExceptT (NonEmpty ResultError) m Result
forall (m :: * -> *).
(MonadIO m, MonadError (NonEmpty ResultError) m) =>
Connection -> Maybe Result -> m Result
Result.checkForError Connection
conn Maybe Result
mbResult

  {-# INLINE executePreparedStatement #-}

  processResult :: NativeResult (QueryT m) -> Result a -> QueryT m a
processResult NativeResult (QueryT m)
result Result a
processor = ReaderT Connection (ExceptT Errors m) a -> QueryT m a
forall (m :: * -> *) a.
ReaderT Connection (ExceptT Errors m) a -> QueryT m a
QueryT
    (ReaderT Connection (ExceptT Errors m) a -> QueryT m a)
-> ReaderT Connection (ExceptT Errors m) a -> QueryT m a
forall a b. (a -> b) -> a -> b
$ ExceptT Errors m a -> ReaderT Connection (ExceptT Errors m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Reader.lift
    (ExceptT Errors m a -> ReaderT Connection (ExceptT Errors m) a)
-> ExceptT Errors m a -> ReaderT Connection (ExceptT Errors m) a
forall a b. (a -> b) -> a -> b
$ m (Either Errors a) -> ExceptT Errors m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
Except.ExceptT
    (m (Either Errors a) -> ExceptT Errors m a)
-> m (Either Errors a) -> ExceptT Errors m a
forall a b. (a -> b) -> a -> b
$ Result -> Result a -> m (Either Errors a)
forall (m :: * -> *) a.
MonadIO m =>
Result -> Result a -> m (Either Errors a)
Result.runResultPq Result
NativeResult (QueryT m)
result Result a
processor

  {-# INLINE processResult #-}

-- | Run an interaction with a PostgreSQL database.
--
-- @since 0.0.0
runQueryT
  :: Connection
  -> QueryT m a
  -> m (Either Errors a)
runQueryT :: Connection -> QueryT m a -> m (Either Errors a)
runQueryT Connection
conn (QueryT ReaderT Connection (ExceptT Errors m) a
action) =
  ExceptT Errors m a -> m (Either Errors a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
Except.runExceptT (ExceptT Errors m a -> m (Either Errors a))
-> ExceptT Errors m a -> m (Either Errors a)
forall a b. (a -> b) -> a -> b
$ ReaderT Connection (ExceptT Errors m) a
-> Connection -> ExceptT Errors m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
Reader.runReaderT ReaderT Connection (ExceptT Errors m) a
action Connection
conn

{-# INLINE runQueryT #-}

-- | Like 'runQueryT' but throw the first 'Error' instead.
--
-- @since 0.0.0
runQueryTThrow
  :: MonadThrow m
  => Connection
  -> QueryT m a
  -> m a
runQueryTThrow :: Connection -> QueryT m a -> m a
runQueryTThrow Connection
conn QueryT m a
query = do
  Either Errors a
result <- Connection -> QueryT m a -> m (Either Errors a)
forall (m :: * -> *) a.
Connection -> QueryT m a -> m (Either Errors a)
runQueryT Connection
conn QueryT m a
query
  (Errors -> m a) -> (a -> m a) -> Either Errors a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Error -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Error -> m a) -> (Errors -> Error) -> Errors -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Errors -> Error
forall a. NonEmpty a -> a
NonEmpty.head) a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either Errors a
result

{-# INLINE runQueryTThrow #-}