hpqtypes 1.4.1 → 1.4.2

raw patch · 4 files changed

+34/−25 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

CHANGELOG.md +4/−0
hpqtypes.cabal +1/−1
src/Database/PostgreSQL/PQTypes/Internal/Monad.hs +2/−2
src/Database/PostgreSQL/PQTypes/Transaction.hs +27/−22

CHANGELOG.md view

@@ -1,3 +1,7 @@+# hpqtypes-1.4.2 (2015-06-08)+* use strict StateT for DBT+* use catch in withTransaction only if it might be used+ # hpqtypes-1.4.1 (2015-05-15) * add support for json and jsonb sql types * add support for lazy ByteString and Text

hpqtypes.cabal view

@@ -1,5 +1,5 @@ name:                hpqtypes-version:             1.4.1+version:             1.4.2 synopsis:            Haskell bindings to libpqtypes  description:         Efficient and easy-to-use bindings to (slightly modified)

src/Database/PostgreSQL/PQTypes/Internal/Monad.hs view

@@ -13,11 +13,11 @@ import Control.Monad.Catch import Control.Monad.Error.Class import Control.Monad.Reader.Class-import Control.Monad.State+import Control.Monad.State.Strict import Control.Monad.Trans.Control import Control.Monad.Writer.Class import Data.Monoid-import qualified Control.Monad.Trans.State as S+import qualified Control.Monad.Trans.State.Strict as S  import Database.PostgreSQL.PQTypes.Class import Database.PostgreSQL.PQTypes.Internal.Connection

src/Database/PostgreSQL/PQTypes/Transaction.hs view

@@ -15,6 +15,7 @@  import Control.Monad import Control.Monad.Catch+import Data.Function import Data.String import Data.Typeable @@ -76,30 +77,34 @@ -- | Execute monadic action within a transaction using given transaction -- settings. Note that it won't work as expected if a transaction is already -- active (in such case 'withSavepoint' should be used instead).-withTransaction' :: forall m a. (MonadDB m, MonadMask m)+withTransaction' :: (MonadDB m, MonadMask m)                  => TransactionSettings -> m a -> m a-withTransaction' ts m = mask $ exec 1+withTransaction' ts m = mask $ \restore -> (`fix` 1) $ \loop n -> do+  -- Optimization for squashing possible space leaks.+  -- It looks like GHC doesn't like 'catch' and passes+  -- on introducing strictness in some cases.+  let maybeRestart = case tsRestartPredicate ts of+        Just _  -> handleJust (expred n) (\_ -> loop $ n+1)+        Nothing -> id+  maybeRestart $ do+    begin' ts+    res <- restore m `onException` rollback' ts+    commit' ts+    return res   where-    exec :: Integer -> (forall r. m r -> m r) -> m a-    exec !n restore = handleJust expred (const $ exec (succ n) restore) $ do-      begin' ts-      res <- restore m `onException` rollback' ts-      commit' ts-      return res-      where-        expred :: SomeException -> Maybe ()-        expred e = do-          -- check if the predicate exists-          RestartPredicate f <- tsRestartPredicate ts-          -- cast exception to the type expected by the predicate-          err <- msum [-              -- either cast the exception itself...-              fromException e-              -- ...or extract it from DBException-            , fromException e >>= \DBException{..} -> cast dbeError-            ]-          -- check if the predicate allows for the restart-          guard $ f err n+    expred :: Integer -> SomeException -> Maybe ()+    expred !n e = do+      -- check if the predicate exists+      RestartPredicate f <- tsRestartPredicate ts+      -- cast exception to the type expected by the predicate+      err <- msum [+          -- either cast the exception itself...+          fromException e+          -- ...or extract it from DBException+        , fromException e >>= \DBException{..} -> cast dbeError+        ]+      -- check if the predicate allows for the restart+      guard $ f err n  -- | Begin transaction using given transaction settings. begin' :: MonadDB m => TransactionSettings -> m ()