module Hasql.Session.Core where

import Hasql.Connection.Core qualified as Connection
import Hasql.Decoders.All qualified as Decoders
import Hasql.Decoders.Result qualified as Decoders.Result
import Hasql.Decoders.Results qualified as Decoders.Results
import Hasql.Encoders.All qualified as Encoders
import Hasql.Encoders.Params qualified as Encoders.Params
import Hasql.Errors
import Hasql.IO qualified as IO
import Hasql.Pipeline.Core qualified as Pipeline
import Hasql.Prelude
import Hasql.Statement qualified as Statement

-- |
-- A batch of actions to be executed in the context of a database connection.
newtype Session a
  = Session (ReaderT Connection.Connection (ExceptT SessionError IO) a)
  deriving ((forall a b. (a -> b) -> Session a -> Session b)
-> (forall a b. a -> Session b -> Session a) -> Functor Session
forall a b. a -> Session b -> Session a
forall a b. (a -> b) -> Session a -> Session b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Session a -> Session b
fmap :: forall a b. (a -> b) -> Session a -> Session b
$c<$ :: forall a b. a -> Session b -> Session a
<$ :: forall a b. a -> Session b -> Session a
Functor, Functor Session
Functor Session =>
(forall a. a -> Session a)
-> (forall a b. Session (a -> b) -> Session a -> Session b)
-> (forall a b c.
    (a -> b -> c) -> Session a -> Session b -> Session c)
-> (forall a b. Session a -> Session b -> Session b)
-> (forall a b. Session a -> Session b -> Session a)
-> Applicative Session
forall a. a -> Session a
forall a b. Session a -> Session b -> Session a
forall a b. Session a -> Session b -> Session b
forall a b. Session (a -> b) -> Session a -> Session b
forall a b c. (a -> b -> c) -> Session a -> Session b -> Session 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 a. a -> Session a
pure :: forall a. a -> Session a
$c<*> :: forall a b. Session (a -> b) -> Session a -> Session b
<*> :: forall a b. Session (a -> b) -> Session a -> Session b
$cliftA2 :: forall a b c. (a -> b -> c) -> Session a -> Session b -> Session c
liftA2 :: forall a b c. (a -> b -> c) -> Session a -> Session b -> Session c
$c*> :: forall a b. Session a -> Session b -> Session b
*> :: forall a b. Session a -> Session b -> Session b
$c<* :: forall a b. Session a -> Session b -> Session a
<* :: forall a b. Session a -> Session b -> Session a
Applicative, Applicative Session
Applicative Session =>
(forall a b. Session a -> (a -> Session b) -> Session b)
-> (forall a b. Session a -> Session b -> Session b)
-> (forall a. a -> Session a)
-> Monad Session
forall a. a -> Session a
forall a b. Session a -> Session b -> Session b
forall a b. Session a -> (a -> Session b) -> Session 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 a b. Session a -> (a -> Session b) -> Session b
>>= :: forall a b. Session a -> (a -> Session b) -> Session b
$c>> :: forall a b. Session a -> Session b -> Session b
>> :: forall a b. Session a -> Session b -> Session b
$creturn :: forall a. a -> Session a
return :: forall a. a -> Session a
Monad, MonadError SessionError, Monad Session
Monad Session => (forall a. IO a -> Session a) -> MonadIO Session
forall a. IO a -> Session a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> Session a
liftIO :: forall a. IO a -> Session a
MonadIO, MonadReader Connection.Connection)

-- |
-- Executes a bunch of commands on the provided connection.
run :: Session a -> Connection.Connection -> IO (Either SessionError a)
run :: forall a. Session a -> Connection -> IO (Either SessionError a)
run (Session ReaderT Connection (ExceptT SessionError IO) a
impl) Connection
connection =
  ExceptT SessionError IO a -> IO (Either SessionError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
    (ExceptT SessionError IO a -> IO (Either SessionError a))
-> ExceptT SessionError IO a -> IO (Either SessionError a)
forall a b. (a -> b) -> a -> b
$ ReaderT Connection (ExceptT SessionError IO) a
-> Connection -> ExceptT SessionError IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Connection (ExceptT SessionError IO) a
impl Connection
connection

-- |
-- Possibly a multi-statement query,
-- which however cannot be parameterized or prepared,
-- nor can any results of it be collected.
sql :: ByteString -> Session ()
sql :: ByteString -> Session ()
sql ByteString
sql =
  ReaderT Connection (ExceptT SessionError IO) () -> Session ()
forall a.
ReaderT Connection (ExceptT SessionError IO) a -> Session a
Session
    (ReaderT Connection (ExceptT SessionError IO) () -> Session ())
-> ReaderT Connection (ExceptT SessionError IO) () -> Session ()
forall a b. (a -> b) -> a -> b
$ (Connection -> ExceptT SessionError IO ())
-> ReaderT Connection (ExceptT SessionError IO) ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT
    ((Connection -> ExceptT SessionError IO ())
 -> ReaderT Connection (ExceptT SessionError IO) ())
-> (Connection -> ExceptT SessionError IO ())
-> ReaderT Connection (ExceptT SessionError IO) ()
forall a b. (a -> b) -> a -> b
$ \(Connection.Connection MVar Connection
pqConnectionRef Bool
integerDatetimes PreparedStatementRegistry
registry) ->
      IO (Either SessionError ()) -> ExceptT SessionError IO ()
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT
        (IO (Either SessionError ()) -> ExceptT SessionError IO ())
-> IO (Either SessionError ()) -> ExceptT SessionError IO ()
forall a b. (a -> b) -> a -> b
$ (Either CommandError () -> Either SessionError ())
-> IO (Either CommandError ()) -> IO (Either SessionError ())
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((CommandError -> SessionError)
-> Either CommandError () -> Either SessionError ()
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ByteString -> [Text] -> CommandError -> SessionError
QueryError ByteString
sql []))
        (IO (Either CommandError ()) -> IO (Either SessionError ()))
-> IO (Either CommandError ()) -> IO (Either SessionError ())
forall a b. (a -> b) -> a -> b
$ MVar Connection
-> (Connection -> IO (Either CommandError ()))
-> IO (Either CommandError ())
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar Connection
pqConnectionRef
        ((Connection -> IO (Either CommandError ()))
 -> IO (Either CommandError ()))
-> (Connection -> IO (Either CommandError ()))
-> IO (Either CommandError ())
forall a b. (a -> b) -> a -> b
$ \Connection
pqConnection -> do
          Either CommandError ()
r1 <- Connection -> ByteString -> IO (Either CommandError ())
IO.sendNonparametricStatement Connection
pqConnection ByteString
sql
          Either CommandError ()
r2 <- Connection -> Bool -> Results () -> IO (Either CommandError ())
forall a.
Connection -> Bool -> Results a -> IO (Either CommandError a)
IO.getResults Connection
pqConnection Bool
integerDatetimes Results ()
decoder
          return $ Either CommandError ()
r1 Either CommandError ()
-> Either CommandError () -> Either CommandError ()
forall a b.
Either CommandError a
-> Either CommandError b -> Either CommandError b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Either CommandError ()
r2
  where
    decoder :: Results ()
decoder =
      Result () -> Results ()
forall a. Result a -> Results a
Decoders.Results.single Result ()
Decoders.Result.noResult

-- |
-- Execute a statement by providing parameters to it.
statement :: params -> Statement.Statement params result -> Session result
statement :: forall params result.
params -> Statement params result -> Session result
statement params
input (Statement.Statement ByteString
template (Encoders.Params Params params
paramsEncoder) (Decoders.Result Results result
decoder) Bool
preparable) =
  ReaderT Connection (ExceptT SessionError IO) result
-> Session result
forall a.
ReaderT Connection (ExceptT SessionError IO) a -> Session a
Session
    (ReaderT Connection (ExceptT SessionError IO) result
 -> Session result)
-> ReaderT Connection (ExceptT SessionError IO) result
-> Session result
forall a b. (a -> b) -> a -> b
$ (Connection -> ExceptT SessionError IO result)
-> ReaderT Connection (ExceptT SessionError IO) result
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT
    ((Connection -> ExceptT SessionError IO result)
 -> ReaderT Connection (ExceptT SessionError IO) result)
-> (Connection -> ExceptT SessionError IO result)
-> ReaderT Connection (ExceptT SessionError IO) result
forall a b. (a -> b) -> a -> b
$ \(Connection.Connection MVar Connection
pqConnectionRef Bool
integerDatetimes PreparedStatementRegistry
registry) ->
      IO (Either SessionError result) -> ExceptT SessionError IO result
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT
        (IO (Either SessionError result) -> ExceptT SessionError IO result)
-> IO (Either SessionError result)
-> ExceptT SessionError IO result
forall a b. (a -> b) -> a -> b
$ (Either CommandError result -> Either SessionError result)
-> IO (Either CommandError result)
-> IO (Either SessionError result)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((CommandError -> SessionError)
-> Either CommandError result -> Either SessionError result
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ByteString -> [Text] -> CommandError -> SessionError
QueryError ByteString
template (Params params -> params -> [Text]
forall a. Params a -> a -> [Text]
Encoders.Params.renderReadable Params params
paramsEncoder params
input)))
        (IO (Either CommandError result)
 -> IO (Either SessionError result))
-> IO (Either CommandError result)
-> IO (Either SessionError result)
forall a b. (a -> b) -> a -> b
$ MVar Connection
-> (Connection -> IO (Either CommandError result))
-> IO (Either CommandError result)
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar Connection
pqConnectionRef
        ((Connection -> IO (Either CommandError result))
 -> IO (Either CommandError result))
-> (Connection -> IO (Either CommandError result))
-> IO (Either CommandError result)
forall a b. (a -> b) -> a -> b
$ \Connection
pqConnection -> do
          Either CommandError ()
r1 <- Connection
-> Bool
-> PreparedStatementRegistry
-> ByteString
-> Params params
-> Bool
-> params
-> IO (Either CommandError ())
forall a.
Connection
-> Bool
-> PreparedStatementRegistry
-> ByteString
-> Params a
-> Bool
-> a
-> IO (Either CommandError ())
IO.sendParametricStatement Connection
pqConnection Bool
integerDatetimes PreparedStatementRegistry
registry ByteString
template Params params
paramsEncoder Bool
preparable params
input
          Either CommandError result
r2 <- Connection
-> Bool -> Results result -> IO (Either CommandError result)
forall a.
Connection -> Bool -> Results a -> IO (Either CommandError a)
IO.getResults Connection
pqConnection Bool
integerDatetimes Results result
decoder
          return $ Either CommandError ()
r1 Either CommandError ()
-> Either CommandError result -> Either CommandError result
forall a b.
Either CommandError a
-> Either CommandError b -> Either CommandError b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Either CommandError result
r2

-- |
-- Execute a pipeline.
pipeline :: Pipeline.Pipeline result -> Session result
pipeline :: forall result. Pipeline result -> Session result
pipeline Pipeline result
pipeline =
  ReaderT Connection (ExceptT SessionError IO) result
-> Session result
forall a.
ReaderT Connection (ExceptT SessionError IO) a -> Session a
Session (ReaderT Connection (ExceptT SessionError IO) result
 -> Session result)
-> ReaderT Connection (ExceptT SessionError IO) result
-> Session result
forall a b. (a -> b) -> a -> b
$ (Connection -> ExceptT SessionError IO result)
-> ReaderT Connection (ExceptT SessionError IO) result
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT \(Connection.Connection MVar Connection
pqConnectionRef Bool
integerDatetimes PreparedStatementRegistry
registry) ->
    IO (Either SessionError result) -> ExceptT SessionError IO result
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either SessionError result) -> ExceptT SessionError IO result)
-> IO (Either SessionError result)
-> ExceptT SessionError IO result
forall a b. (a -> b) -> a -> b
$ MVar Connection
-> (Connection -> IO (Either SessionError result))
-> IO (Either SessionError result)
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar Connection
pqConnectionRef \Connection
pqConnection ->
      Pipeline result
-> Connection
-> PreparedStatementRegistry
-> Bool
-> IO (Either SessionError result)
forall a.
Pipeline a
-> Connection
-> PreparedStatementRegistry
-> Bool
-> IO (Either SessionError a)
Pipeline.run Pipeline result
pipeline Connection
pqConnection PreparedStatementRegistry
registry Bool
integerDatetimes