snaplet-postgresql-simple 1.1.0.0 → 1.2.0.0

raw patch · 3 files changed

+35/−15 lines, 3 filesdep ~basedep ~lensdep ~postgresql-simple

Dependency ranges changed: base, lens, postgresql-simple

Files

• snaplet-postgresql-simple.cabal +8/−7
• src/Snap/Snaplet/PostgresqlSimple.hs +27/−1
• src/Snap/Snaplet/PostgresqlSimple/Internal.hs +0/−7

@@ -1,5 +1,5 @@ name:           snaplet-postgresql-simple-version:        1.1.0.0+version:        1.2.0.0 synopsis:       postgresql-simple snaplet for the Snap Framework description:    This snaplet contains support for using the Postgresql                 database with a Snap Framework application via the@@ -17,9 +17,10 @@ tested-with:   GHC == 7.8.4,   GHC == 7.10.3,-  GHC == 8.0.1,-  GHC == 8.2.1,-  GHC == 8.4.1+  GHC == 8.0.2,+  GHC == 8.2.2,+  GHC == 8.4.3,+  GHC == 8.6.4  extra-source-files:   LICENSE@@ -50,15 +51,15 @@     Paths_snaplet_postgresql_simple    build-depends:-    base                       >= 4       && < 4.12,+    base                       >= 4       && < 4.13,     bytestring                 >= 0.9.1   && < 0.11,     clientsession              >= 0.7.2   && < 0.10,     configurator               >= 0.2     && < 0.4,-    lens                       >= 3.7.6   && < 4.17,+    lens                       >= 3.7.6   && < 4.18,     lifted-base                >= 0.2     && < 0.3,     monad-control              >= 1.0     && < 1.1,     mtl                        >= 2       && < 2.3,-    postgresql-simple          >= 0.3     && < 0.6,+    postgresql-simple          >= 0.3     && < 0.7,     resource-pool              >= 0.2     && < 0.3,     snap                       >= 1.0     && < 1.2,     text                       >= 0.11    && < 1.3,

@@ -98,6 +98,8 @@   , withTransaction   , withTransactionLevel   , withTransactionMode+  , withTransactionEither+  , withTransactionModeEither   , formatMany   , formatQuery @@ -130,7 +132,6 @@    ) where -import           Control.Applicative import qualified Control.Exception                      as E import           Control.Lens                           (set, (^#)) import           Control.Monad                          (liftM)@@ -453,6 +454,31 @@         P.beginMode mode con         r <- unmask (run act) `E.onException` P.rollback con         P.commit con+        return r+    restoreM r++------------------------------------------------------------------------------+-- | Be careful that you do not call Snap's `finishWith` function anywhere+-- inside the function that you pass to `withTransactionMode`.  Doing so has+-- been known to cause DB connection leaks.+withTransactionEither :: (HasPostgres m)+                      => m (Either a b) -> m (Either a b)+withTransactionEither = withTransactionModeEither P.defaultTransactionMode++------------------------------------------------------------------------------+-- | Be careful that you do not call Snap's `finishWith` function anywhere+-- inside the function that you pass to `withTransactionMode`.  Doing so has+-- been known to cause DB connection leaks.+withTransactionModeEither :: (HasPostgres m)+                          => P.TransactionMode -> m (Either a b) -> m (Either a b)+withTransactionModeEither mode act = withPG $ do+    pg <- getPostgresState+    r <- liftBaseWith $ \run -> E.mask+                      $ \unmask -> withConnection pg+                      $ \con -> do+        P.beginMode mode con+        r <- unmask (run act) `E.onException` P.rollback con+        either (const $ P.rollback con) (const $ P.commit con) $ restoreM r         return r     restoreM r 

@@ -10,7 +10,6 @@ import           Control.Monad.Trans.Control       (MonadBaseControl (..),                                                     control) import           Control.Monad.Trans.Identity      (IdentityT (IdentityT))-import           Control.Monad.Trans.List          (ListT (ListT)) import           Control.Monad.Trans.Maybe         (MaybeT (MaybeT)) import           Control.Monad.Trans.Reader        (ReaderT (ReaderT)) import qualified Control.Monad.Trans.RWS.Lazy      as LRWS@@ -45,12 +44,6 @@ instance HasPostgres m => HasPostgres (IdentityT m) where     getPostgresState = lift getPostgresState     setLocalPostgresState pg (IdentityT m) = IdentityT $-      setLocalPostgresState pg m---instance HasPostgres m => HasPostgres (ListT m) where-    getPostgresState = lift getPostgresState-    setLocalPostgresState pg (ListT m) = ListT $       setLocalPostgresState pg m