module Hasql.Private.Session where

import qualified Database.PostgreSQL.LibPQ as LibPQ
import qualified Hasql.Private.Connection as Connection
import qualified Hasql.Private.Decoders.Result as Decoders.Result
import qualified Hasql.Private.Decoders.Results as Decoders.Results
import qualified Hasql.Private.Encoders as Encoders
import qualified Hasql.Private.Encoders.Params as Encoders.Params
import Hasql.Private.Errors
import qualified Hasql.Private.IO as IO
import Hasql.Private.Prelude
import qualified Hasql.Private.Settings as Settings
import qualified Hasql.Statement as Statement

-- |
-- A batch of actions to be executed in the context of a database connection.
newtype Session a
  = Session (ReaderT Connection.Connection (ExceptT QueryError IO) a)
  deriving (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
<$ :: forall a b. a -> Session b -> Session a
$c<$ :: forall a b. a -> Session b -> Session a
fmap :: forall a b. (a -> b) -> Session a -> Session b
$cfmap :: forall a b. (a -> b) -> Session a -> Session b
Functor, Functor 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
<* :: forall a b. Session a -> Session b -> Session a
$c<* :: forall a b. Session a -> Session b -> Session a
*> :: forall a b. Session a -> Session b -> Session b
$c*> :: forall a b. Session a -> Session b -> Session b
liftA2 :: forall a b c. (a -> b -> c) -> Session a -> Session b -> Session c
$cliftA2 :: forall a b c. (a -> b -> c) -> Session a -> Session b -> Session c
<*> :: forall a b. Session (a -> b) -> Session a -> Session b
$c<*> :: forall a b. Session (a -> b) -> Session a -> Session b
pure :: forall a. a -> Session a
$cpure :: forall a. a -> Session a
Applicative, Applicative 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
return :: forall a. a -> Session a
$creturn :: forall a. a -> Session a
>> :: forall a b. Session a -> Session b -> Session b
$c>> :: forall a b. Session a -> Session b -> Session b
>>= :: forall a b. Session a -> (a -> Session b) -> Session b
$c>>= :: forall a b. Session a -> (a -> Session b) -> Session b
Monad, MonadError QueryError, Monad Session
forall a. IO a -> Session a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> Session a
$cliftIO :: 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 QueryError a)
run :: forall a. Session a -> Connection -> IO (Either QueryError a)
run (Session ReaderT Connection (ExceptT QueryError IO) a
impl) Connection
connection =
  forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Connection (ExceptT QueryError 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 =
  forall a. ReaderT Connection (ExceptT QueryError IO) a -> Session a
Session forall a b. (a -> b) -> a -> b
$
    forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \(Connection.Connection MVar Connection
pqConnectionRef Bool
integerDatetimes PreparedStatementRegistry
registry) ->
      forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft (ByteString -> [Text] -> CommandError -> QueryError
QueryError ByteString
sql [])) forall a b. (a -> b) -> a -> b
$
          forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar Connection
pqConnectionRef 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 <- forall a.
Connection -> Bool -> Results a -> IO (Either CommandError a)
IO.getResults Connection
pqConnection Bool
integerDatetimes Results ()
decoder
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Either CommandError ()
r1 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Either CommandError ()
r2
  where
    decoder :: Results ()
decoder =
      forall a. Result a -> Results a
Decoders.Results.single Result ()
Decoders.Result.noResult

-- |
-- Parameters and a specification of a parametric single-statement query to apply them to.
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) Result result
decoder Bool
preparable) =
  forall a. ReaderT Connection (ExceptT QueryError IO) a -> Session a
Session forall a b. (a -> b) -> a -> b
$
    forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \(Connection.Connection MVar Connection
pqConnectionRef Bool
integerDatetimes PreparedStatementRegistry
registry) ->
      forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft (ByteString -> [Text] -> CommandError -> QueryError
QueryError ByteString
template [Text]
inputReps)) forall a b. (a -> b) -> a -> b
$
          forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar Connection
pqConnectionRef forall a b. (a -> b) -> a -> b
$ \Connection
pqConnection -> do
            Either CommandError ()
r1 <- 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 <- forall a.
Connection -> Bool -> Results a -> IO (Either CommandError a)
IO.getResults Connection
pqConnection Bool
integerDatetimes (forall a b. a -> b
unsafeCoerce Result result
decoder)
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Either CommandError ()
r1 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Either CommandError result
r2
  where
    inputReps :: [Text]
inputReps =
      let Encoders.Params.Params (Op params -> DList (Oid, Format, Bool -> Maybe ByteString, Text)
encoderOp) = Params params
paramsEncoder
          step :: (a, b, c, a) -> [a] -> [a]
step (a
_, b
_, c
_, a
rendering) [a]
acc =
            a
rendering forall a. a -> [a] -> [a]
: [a]
acc
       in forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a} {b} {c} {a}. (a, b, c, a) -> [a] -> [a]
step [] (params -> DList (Oid, Format, Bool -> Maybe ByteString, Text)
encoderOp params
input)