diff --git a/hasql.cabal b/hasql.cabal index 0f9dcc3..9c48064 100644 --- a/hasql.cabal +++ b/hasql.cabal @@ -65,6 +65,8 @@ library loch-th == 0.2.*, placeholders == 0.1.*, -- general: + monad-control == 0.3.*, + transformers-base == 0.4.*, safe >= 0.3.8 && < 0.4, mmorph == 1.0.*, mtl-prelude == 2.*, diff --git a/library/Hasql.hs b/library/Hasql.hs index 7f7148b..f561c5e 100644 --- a/library/Hasql.hs +++ b/library/Hasql.hs @@ -1,22 +1,21 @@ module Hasql ( - -- * Connections Pool - Pool, - PoolSettings, - poolSettings, - acquirePool, - releasePool, - -- * Session Session, sessionInner, - + + -- * Error + Error(..), + -- * Transaction Tx, Mode, Backend.IsolationLevel(..), txSession, + -- * Statement Quasi-Quoter + QQ.q, + -- * Statement Execution StatementTx, unitTx, @@ -24,17 +23,11 @@ module Hasql streamTx, cursorStreamTx, - -- * Statement Quasi-Quoter - QQ.q, - - -- ** Error - Error(..), - - -- ** Results Stream + -- * Results Stream TxStream, TxStreamT, - -- ** Row parser + -- * Row parser RowParser.RowParser(..), ) where @@ -49,6 +42,38 @@ import qualified ListT import qualified Data.Pool as Pool +-- * Session +------------------------- + +-- | +-- A monad transformer, +-- which executes transactions. +type Session b = + ReaderT (Pool b) + +-- | +-- Given backend settings, pool settings, and a session monad transformer +-- execute it in the inner monad. +sessionInner :: + Backend.Backend b => MonadBaseControl IO m => + b -> PoolSettings -> Session b m r -> m r +sessionInner backend settings reader = + join $ liftM restoreM $ liftBaseWith $ \runInIO -> + mask $ \unmask -> do + p <- acquirePool backend settings + r <- ($ releasePool p) $ onException $ unmask $ runInIO $ runReaderT reader p + releasePool p + return r + +-- | +-- Execute a transaction in a session. +txSession :: + Backend.Backend b => MonadBase IO m => + Mode -> (forall s. Tx b s r) -> Session b m r +txSession m t = + ReaderT $ \p -> liftBase $ usePool (\c -> runTx c m t) p + + -- * Connections Pool ------------------------- @@ -102,22 +127,6 @@ usePool f (Pool p) = Pool.withResource p f --- * Session -------------------------- - --- | --- A session monad transformer, --- which is an adaptation of the 'ReaderT' API over the connections pool. -type Session b = - ReaderT (Pool b) - --- | --- Run the session monad transformer in the inner monad. -sessionInner :: Pool b -> Session b m r -> m r -sessionInner pool reader = - runReaderT reader pool - - -- * Transaction ------------------------- @@ -142,12 +151,10 @@ newtype Tx b s r = type Mode = Maybe (Backend.IsolationLevel, Bool) --- | --- Execute a transaction on a connection. -txIO :: +runTx :: Backend b => Backend.Connection b -> Mode -> (forall s. Tx b s r) -> IO r -txIO connection mode (Tx reader) = +runTx connection mode (Tx reader) = handle backendHandler $ maybe (const id) inTransaction mode connection (runReaderT reader connection) where @@ -173,14 +180,6 @@ txIO connection mode (Tx reader) = Backend.UnexpectedResultStructure t -> throwIO $ UnexpectedResultStructure t Backend.TransactionConflict -> $bug "Unexpected TransactionConflict exception" --- | --- Execute a transaction in a session. -txSession :: - Backend.Backend b => MonadIO m => - Mode -> (forall s. Tx b s r) -> Session b m r -txSession m t = - ReaderT $ \p -> liftIO $ usePool (\c -> txIO c m t) p - -- * Results Stream ------------------------- @@ -236,7 +235,7 @@ data Error = instance Exception Error --- * Transactions +-- * Statements execution ------------------------- -- | diff --git a/library/Hasql/Prelude.hs b/library/Hasql/Prelude.hs index a1a9990..2b36edd 100644 --- a/library/Hasql/Prelude.hs +++ b/library/Hasql/Prelude.hs @@ -19,6 +19,14 @@ import MTLPrelude as Exports hiding (shift) ------------------------- import Control.Monad.Morph as Exports +-- monad-control +------------------------- +import Control.Monad.Trans.Control as Exports + +-- transformers-base +------------------------- +import Control.Monad.Base as Exports + -- safe ------------------------- import Safe as Exports