module Hasql.Private.Session.UnliftIO where

-- mtl
import Control.Monad.Reader.Class (ask)
import Control.Monad.Error.Class (throwError)

-- unliftio-core
import Control.Monad.IO.Unlift

-- safe-exceptions
import Control.Exception.Safe

--hasql
import Hasql.Session

instance MonadUnliftIO Session where
  withRunInIO :: forall b. ((forall a. Session a -> IO a) -> IO b) -> Session b
withRunInIO (forall a. Session a -> IO a) -> IO b
inner = do
    Connection
conn <- forall r (m :: * -> *). MonadReader r m => m r
ask
    Either QueryError b
res <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try forall a b. (a -> b) -> a -> b
$ (forall a. Session a -> IO a) -> IO b
inner forall a b. (a -> b) -> a -> b
$ \Session a
sess -> do
      forall a. Session a -> Connection -> IO (Either QueryError a)
run Session a
sess Connection
conn forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO forall (f :: * -> *) a. Applicative f => a -> f a
pure
    case Either QueryError b
res of
      Left QueryError
e -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError QueryError
e
      Right b
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a