traction 0.1.0 → 0.2.0

raw patch · 3 files changed

+28/−18 lines, 3 filesdep ~exceptionsPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: exceptions

API changes (from Hackage documentation)

Files

• src/Traction/Control.hs +24/−14
• src/Traction/Sql.hs +2/−2
• traction.cabal +2/−2

@@ -4,7 +4,8 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} module Traction.Control (-    Db (..)+    Db+  , DbT (..)   , DbError (..)   , renderDbError   , DbPool (..)@@ -26,9 +27,9 @@   , failWith   ) where -import           Control.Monad.Catch (Exception, MonadMask (..), Handler (..), handle, catches, bracket_, throwM)+import           Control.Monad.Catch (Exception, MonadMask (..), MonadThrow, MonadCatch, Handler (..), handle, catches, bracket_, throwM) import           Control.Monad.IO.Class (MonadIO (..))-import           Control.Monad.Morph (squash)+import           Control.Monad.Morph (MFunctor (..), squash) import           Control.Monad.Trans.Class (MonadTrans (..)) import           Control.Monad.Trans.Except (ExceptT(..)) import           Control.Monad.Trans.Reader (ReaderT (..), ask)@@ -56,11 +57,20 @@     InTransaction Postgresql.Connection   | NotInTransaction DbPool -newtype Db a =-  Db {-      _runDb :: ReaderT TransactionContext (EitherT DbError IO) a-    }  deriving (Functor, Applicative, Monad, MonadIO)+type Db =+  DbT IO +newtype DbT m a =+  DbT {+      _runDb :: ReaderT TransactionContext (EitherT DbError m) a+    }  deriving (Functor, Applicative, Monad, MonadIO, MonadMask, MonadThrow, MonadCatch)++instance MFunctor DbT where+  hoist = hoist++instance MonadTrans DbT where+  lift = DbT . lift . lift+ data DbError =     DbSqlError Postgresql.Query Postgresql.SqlError   | DbQueryError Postgresql.Query Postgresql.QueryError@@ -90,10 +100,10 @@       mconcat ["Query could not decode results, expected to be able to decode [", Text.unpack field, "], to type, [", Text.unpack encoding, "], for query: ", show q]  class MonadIO m => MonadDb m where-  liftDb :: Db a -> m a+  liftDb :: DbT IO a -> m a -instance MonadDb Db where-  liftDb = id+instance MonadIO m => MonadDb (DbT m) where+  liftDb = hoist liftIO  instance MonadDb m => MonadDb (ExceptT e m) where   liftDb = lift . liftDb@@ -104,7 +114,7 @@  failWith :: DbError -> Db a failWith =-  Db . lift . left+  DbT . lift . left  runDb :: DbPool -> Db a -> EitherT DbError IO a runDb pool db =@@ -128,7 +138,7 @@  transaction :: Db a -> Db a transaction db =-  Db $ ask >>= \cc -> lift $ case cc of+  DbT $ ask >>= \cc -> lift $ case cc of     InTransaction c ->       runReaderT (_runDb db) (InTransaction c)     NotInTransaction pool ->@@ -141,7 +151,7 @@  transactional :: (Monad m, Monad n) => (m a -> Db (n a)) -> (Db (n a) -> m a) -> m a -> m a transactional sifter lifter db =-  lifter . Db $ ask >>= \cc -> lift $ case cc of+  lifter . DbT $ ask >>= \cc -> lift $ case cc of     InTransaction c ->       runReaderT (_runDb $ sifter db) (InTransaction c)     NotInTransaction pool ->@@ -220,7 +230,7 @@  withConnection :: Postgresql.Query -> (Postgresql.Connection -> IO a) -> Db a withConnection query f =-  Db $ ask >>= \cc -> case cc of+  DbT $ ask >>= \cc -> case cc of     InTransaction c ->       lift . safely query . f $ c     NotInTransaction pool ->

@@ -167,7 +167,7 @@  bracketSavepoint :: Savepoint -> Db a -> Db a bracketSavepoint savepoint db =-  Db $ ask >>= \c -> lift $ do+  DbT $ ask >>= \c -> lift $ do     r <- liftIO . runEitherT $ flip runReaderT c $ _runDb (createSavepoint savepoint >> db)     case r of       Left _ -> do@@ -200,7 +200,7 @@  withUniqueCheckSavepoint :: MonadDb m => Savepoint -> Db a -> m (Unique a) withUniqueCheckSavepoint savepoint db =-  liftDb . Db $ ask >>= \c -> lift $ do+  liftDb . DbT $ ask >>= \c -> lift $ do     r <- liftIO . runEitherT $ flip runReaderT c $ _runDb (bracketSavepoint savepoint db)     case r of       Left (DbSqlError q e) -> do

@@ -1,5 +1,5 @@ name: traction-version: 0.1.0+version: 0.2.0 license: BSD3 license-file: LICENSE author: Mark Hibberd <mark@hibberd.id.au>@@ -22,7 +22,7 @@       base >= 3 && < 5     , bytestring == 0.10.*     , containers >= 0.5.8 && < 0.7-    , exceptions >= 0.9 && < 0.11+    , exceptions == 0.10.*     , mmorph == 1.*     , postgresql-simple == 0.5.*     , resource-pool == 0.2.*