From 95c6996599d4d5aeb2d0f5f7c7b190102b586087 Mon Sep 17 00:00:00 2001
From: Nikita Volkov <nikita.y.volkov@mail.ru>
Date: Sat, 27 Dec 2014 06:17:24 +0300
Subject: [PATCH] Make Session a newtype

---
 hasql.cabal      |  2 +-
 library/Hasql.hs | 30 +++++++++++++++++++++++++-----
 2 files changed, 26 insertions(+), 6 deletions(-)

diff --git a/hasql.cabal b/hasql.cabal
index 579c10f..3767412 100644
--- a/hasql.cabal
+++ b/hasql.cabal
@@ -109,7 +109,7 @@ library
     list-t >= 0.3.1 && < 0.5,
     mmorph == 1.0.*,
     mtl >= 2.1 && < 2.3,
-    monad-control >= 0.3 && < 1.1,
+    monad-control == 1.0.*,
     transformers-base == 0.4.*,
     transformers >= 0.3 && < 0.5,
     base-prelude >= 0.1.3 && < 0.2,
diff --git a/library/Hasql.hs b/library/Hasql.hs
index 489df2d..386c9c0 100644
--- a/library/Hasql.hs
+++ b/library/Hasql.hs
@@ -141,9 +141,29 @@ poolSettings size timeout =
 
 -- |
 -- A convenience wrapper around 'ReaderT', 
--- which provides a shared context for execution of transactions.
-type Session c m =
-  ReaderT (Pool c) (EitherT (TxError c) m)
+-- which provides a shared context for execution and error-handling of transactions.
+newtype Session c m r =
+  Session (ReaderT (Pool c) (EitherT (TxError c) m) r)
+  deriving (Functor, Applicative, Monad, MonadIO, MonadError (TxError c))
+
+instance MonadTrans (Session c) where
+  lift = Session . lift . lift
+
+instance MonadTransControl (Session c) where
+  type StT (Session c) a = Either (TxError c) a
+  liftWith onUnlift =
+    Session $ ReaderT $ \e -> 
+      lift $ onUnlift $ \(Session m) -> 
+        runEitherT $ flip runReaderT e $ m
+  restoreT = 
+    Session . ReaderT . const . EitherT
+
+deriving instance MonadBase IO m => MonadBase IO (Session c m)
+
+instance (MonadBaseControl IO m) => MonadBaseControl IO (Session c m) where
+  type StM (Session c m) a = ComposeSt (Session c) m a
+  liftBaseWith = defaultLiftBaseWith
+  restoreM = defaultRestoreM
 
 -- |
 -- Execute a session using an established connection pool.
@@ -153,7 +173,7 @@ type Session c m =
 -- if you want.
 session :: Pool c -> Session c m a -> m (Either (TxError c) a)
 session pool m =
-  runEitherT $ flip runReaderT pool $ m
+  runEitherT $ flip runReaderT pool $ case m of Session m -> m
 
 
 -- * Transaction
@@ -199,7 +219,7 @@ deriving instance (Eq (Bknd.CxError c), Eq (Bknd.TxError c)) => Eq (TxError c)
 -- that it's impossible to return @'TxListT' s m r@ from it.
 tx :: (Bknd.CxTx c, MonadBaseControl IO m) => Bknd.TxMode -> (forall s. Tx c s r) -> Session c m r
 tx mode (Tx m) =
-  ReaderT $ \(Pool pool) ->
+  Session $ ReaderT $ \(Pool pool) ->
     Pool.withResource pool $ \e -> do
       c <- hoistEither $ mapLeft BackendCxError e
       let