hasql 0.2.3 → 0.3.0
raw patch · 3 files changed
+80/−29 lines, 3 filesdep ~hasql
Dependency ranges changed: hasql
Files
- hasql.cabal +7/−7
- library/Hasql.hs +72/−21
- postgres-tests/Main.hs +1/−1
hasql.cabal view
@@ -1,7 +1,7 @@ name: hasql version:- 0.2.3+ 0.3.0 synopsis: A minimalistic general high level API for relational databases description:@@ -105,7 +105,7 @@ bytestring == 0.10.*, text >= 1.0 && < 1.3, -- control:- list-t >= 0.2.4 && < 0.3,+ list-t >= 0.2.4 && < 0.4, monad-control == 0.3.*, transformers-base == 0.4.*, -- errors:@@ -137,10 +137,10 @@ default-language: Haskell2010 build-depends:- HTF == 0.12.*,- hasql == 0.2.*,+ hasql, hasql-backend == 0.2.*, base-prelude == 0.1.*,+ HTF == 0.12.*, base >= 4.5 && < 4.8 @@ -160,13 +160,13 @@ default-language: Haskell2010 build-depends:- HTF == 0.12.*,+ hasql, hasql-postgres == 0.7.*,- hasql == 0.2.*, scientific == 0.3.*, transformers >= 0.2 && < 0.5, mtl-prelude < 3, base-prelude == 0.1.*,+ HTF == 0.12.*, base >= 4.5 && < 4.8 @@ -188,8 +188,8 @@ default-language: Haskell2010 build-depends:+ hasql, hasql-postgres == 0.7.*,- hasql == 0.2.*, transformers >= 0.2 && < 0.5, base >= 4.5 && < 4.8
library/Hasql.hs view
@@ -8,6 +8,7 @@ -- * Session Session, session,+ sessionUnlifter, -- ** Session Settings SessionSettings,@@ -62,34 +63,81 @@ -- | -- A monad transformer, -- which executes transactions.-type Session b =- ReaderT (Pool.Pool (Backend.Connection b))+-- +-- * @b@ is a backend.+-- +-- * @s@ is an anonymous variable, +-- used to associate 'sessionUnlifter' with a specific session. +-- +-- * @m@ is an inner (transformed) monad.+-- +-- * @r@ is a result.+newtype Session b s m r =+ Session (ReaderT (Pool.Pool (Backend.Connection b)) m r)+ deriving (Functor, Applicative, Monad, MonadTrans, MonadIO) +instance MonadTransControl (Session b s) where+ newtype StT (Session b s) a = SessionStT a+ liftWith onRunner =+ Session $ ReaderT $ \e -> onRunner $ \(Session (ReaderT f)) -> liftM SessionStT $ f e+ restoreT = + Session . ReaderT . const . liftM (\(SessionStT a) -> a)++instance (MonadBase IO m) => MonadBase IO (Session b s m) where+ liftBase = Session . liftBase++instance (MonadBaseControl IO m) => MonadBaseControl IO (Session b s m) where+ newtype StM (Session b s m) a = SessionStM (ComposeSt (Session b s) m a)+ liftBaseWith = defaultLiftBaseWith SessionStM+ restoreM = defaultRestoreM $ \(SessionStM x) -> x++ -- | -- Given backend settings, session settings, and a session monad transformer, -- execute it in the inner monad.+-- +-- It uses the same trick as 'ST' with the anonymous @s@ type argument+-- to prohibit the use of the result of+-- 'sessionUnlifter' outside of its creator session. session :: (Backend.Backend b, MonadBaseControl IO m) =>- b -> SessionSettings -> Session b m r -> m r-session backend (SessionSettings size timeout) reader =- join $ liftM restoreM $ liftBaseWith $ \runInIO ->+ b -> SessionSettings -> (forall s. Session b s m r) -> m r+session backend (SessionSettings size timeout) s =+ control $ \runInIO -> mask $ \unmask -> do p <- Pool.createPool (Backend.connect backend) Backend.disconnect 1 timeout size- r <- try $ unmask $ runInIO $ runReaderT reader p+ r <- try $ unmask $ runInIO $ runSession p s Pool.purgePool p- either onException return r- where- onException =- \case- Backend.CantConnect t -> throwIO $ CantConnect t- Backend.ConnectionLost t -> throwIO $ ConnectionLost t- Backend.ErroneousResult t -> throwIO $ ErroneousResult t- Backend.UnexpectedResult t -> throwIO $ UnexpectedResult t- Backend.UnparsableTemplate t -> throwIO $ UnparsableTemplate t- Backend.TransactionConflict -> $bug "Unexpected TransactionConflict exception"- Backend.NotInTransaction -> throwIO $ NotInTransaction+ either (throwIO :: SomeException -> IO r) return r +-- |+-- Get a session unlifting function, +-- which allows to execute a session in the inner monad+-- using the resources of the current session.+-- +-- Using this function in combination with 'lift'+-- you can interleave 'Session' with other monad transformers.+-- +-- This function has the following property:+-- +-- > (sessionUnlifter >>= \unlift -> lift (unlift m)) ≡ m+sessionUnlifter :: (MonadBaseControl IO m) => Session b s m (Session b s m r -> m r)+sessionUnlifter =+ Session $ ReaderT $ return . runSession +runSession :: (MonadBaseControl IO m) => Pool.Pool (Backend.Connection b) -> Session b s m r -> m r+runSession e (Session r) =+ control $ \runInIO -> + catch (runInIO (runReaderT r e)) $ \case+ Backend.CantConnect t -> throwIO $ CantConnect t+ Backend.ConnectionLost t -> throwIO $ ConnectionLost t+ Backend.ErroneousResult t -> throwIO $ ErroneousResult t+ Backend.UnexpectedResult t -> throwIO $ UnexpectedResult t+ Backend.UnparsableTemplate t -> throwIO $ UnparsableTemplate t+ Backend.TransactionConflict -> $bug "Unexpected TransactionConflict exception"+ Backend.NotInTransaction -> throwIO $ NotInTransaction++ -- ** Session Settings ------------------------- @@ -160,8 +208,8 @@ ------------------------- -- |--- A transaction specialized for backend @b@, --- running on an anonymous state-thread @s@ +-- A transaction specialized for a backend @b@, +-- associated with its intermediate results using an anonymous type-argument @s@ (same as in 'ST') -- and producing a result @r@. newtype Tx b s r = Tx (ReaderT (Backend.Connection b) IO r)@@ -182,11 +230,14 @@ -- | -- Execute a transaction in a session.+-- +-- This function ensures on the type level, +-- that it's impossible to return @'TxListT' s m r@ from it. tx :: (Backend.Backend b, MonadBase IO m) =>- Mode -> (forall s. Tx b s r) -> Session b m r+ Mode -> (forall s. Tx b s r) -> Session b s m r tx m t =- ReaderT $ \p -> liftBase $ Pool.withResource p $ \c -> runTx c m t+ Session $ ReaderT $ \p -> liftBase $ Pool.withResource p $ \c -> runTx c m t where runTx :: Backend b =>
postgres-tests/Main.hs view
@@ -26,7 +26,7 @@ return () -session :: H.Session HP.Postgres IO r -> IO r+session :: (forall s. H.Session HP.Postgres s IO r) -> IO r session = H.session backendSettings poolSettings where