traction 0.2.0 → 0.2.1

raw patch · 3 files changed

+15/−25 lines, 3 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• src/Traction/Control.hs +12/−22
• src/Traction/Sql.hs +2/−2
• traction.cabal +1/−1

@@ -4,8 +4,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} module Traction.Control (-    Db-  , DbT (..)+    Db (..)   , DbError (..)   , renderDbError   , DbPool (..)@@ -29,7 +28,7 @@  import           Control.Monad.Catch (Exception, MonadMask (..), MonadThrow, MonadCatch, Handler (..), handle, catches, bracket_, throwM) import           Control.Monad.IO.Class (MonadIO (..))-import           Control.Monad.Morph (MFunctor (..), squash)+import           Control.Monad.Morph (squash) import           Control.Monad.Trans.Class (MonadTrans (..)) import           Control.Monad.Trans.Except (ExceptT(..)) import           Control.Monad.Trans.Reader (ReaderT (..), ask)@@ -57,20 +56,11 @@     InTransaction Postgresql.Connection   | NotInTransaction DbPool -type Db =-  DbT IO--newtype DbT m a =-  DbT {-      _runDb :: ReaderT TransactionContext (EitherT DbError m) a+newtype Db a =+  Db {+      _runDb :: ReaderT TransactionContext (EitherT DbError IO) 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@@ -100,10 +90,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 :: DbT IO a -> m a+  liftDb :: Db a -> m a -instance MonadIO m => MonadDb (DbT m) where-  liftDb = hoist liftIO+instance MonadDb Db where+  liftDb = id  instance MonadDb m => MonadDb (ExceptT e m) where   liftDb = lift . liftDb@@ -114,7 +104,7 @@  failWith :: DbError -> Db a failWith =-  DbT . lift . left+  Db . lift . left  runDb :: DbPool -> Db a -> EitherT DbError IO a runDb pool db =@@ -138,7 +128,7 @@  transaction :: Db a -> Db a transaction db =-  DbT $ ask >>= \cc -> lift $ case cc of+  Db $ ask >>= \cc -> lift $ case cc of     InTransaction c ->       runReaderT (_runDb db) (InTransaction c)     NotInTransaction pool ->@@ -151,7 +141,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 . DbT $ ask >>= \cc -> lift $ case cc of+  lifter . Db $ ask >>= \cc -> lift $ case cc of     InTransaction c ->       runReaderT (_runDb $ sifter db) (InTransaction c)     NotInTransaction pool ->@@ -230,7 +220,7 @@  withConnection :: Postgresql.Query -> (Postgresql.Connection -> IO a) -> Db a withConnection query f =-  DbT $ ask >>= \cc -> case cc of+  Db $ 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 =-  DbT $ ask >>= \c -> lift $ do+  Db $ 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 . DbT $ ask >>= \c -> lift $ do+  liftDb . Db $ 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.2.0+version: 0.2.1 license: BSD3 license-file: LICENSE author: Mark Hibberd <mark@hibberd.id.au>