postgresql-tx-squeal 0.1.0.0 → 0.2.0.0

raw patch · 5 files changed

+385/−114 lines, 5 filesdep +unliftiodep ~postgresql-txdep ~squeal-postgresqlnew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: unliftio

Dependency ranges changed: postgresql-tx, squeal-postgresql

API changes (from Hackage documentation)

Files

• CHANGELOG.md +10/−1
• package.yaml +5/−4
• postgresql-tx-squeal.cabal +7/−6
• src/Database/PostgreSQL/Tx/Squeal.hs +188/−103
• src/Database/PostgreSQL/Tx/Squeal/Internal.hs +175/−0

@@ -1,5 +1,14 @@ # Change log +## 0.2.0.0++* Updated for postgresql-tx-0.2.0.0.+* Updated `SquealM` encoding.+* Added `SquealTxM` and `SquealTxM'`.+* Updated `transactionallyRetry` to allow for retrying on a predicate.+* Added `transactionallySerializable`.+* Moved internals to an `Internal` module.+ ## 0.1.0.0 -Initial release+* Initial release

@@ -1,6 +1,6 @@ name:                postgresql-tx-squeal-version:             0.1.0.0-github:              "simspace/postgresql-tx/squeal"+version:             0.2.0.0+github:              "simspace/postgresql-tx" license:             BSD3 license-file:        LICENSE.md author:              "Cary Robbins"@@ -23,9 +23,10 @@ - bytestring >= 0.10.10.0 && < 0.11 - generics-sop >= 0.5.1.0 && < 0.6 - postgresql-libpq >= 0.9.4.2 && < 0.10-- postgresql-tx >= 0.1.0.0 && < 0.2+- postgresql-tx >= 0.2.0.0 && < 0.3 - records-sop >= 0.1.0.3 && < 0.2-- squeal-postgresql >= 0.6.0.2 && < 0.7+- squeal-postgresql >= 0.7.0.1 && < 0.8+- unliftio >= 0.2.13 && < 0.3  library:   source-dirs: src

@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.33.0.+-- This file has been generated from package.yaml by hpack version 0.31.2. -- -- see: https://github.com/sol/hpack ----- hash: ec2093cdd28764a2714fde9b8bb6779e505a1ebb631618e8362b78c63e60d8ab+-- hash: e701f125cf44879463dd9939bb3949bfcb0630c866cf1314ee8a603d80a588e5  name:           postgresql-tx-squeal-version:        0.1.0.0+version:        0.2.0.0 synopsis:       postgresql-tx interfacing for use with squeal-postgresql. description:    Please see the README on GitHub at <https://github.com/simspace/postgresql-tx#readme> category:       Database@@ -27,11 +27,11 @@ source-repository head   type: git   location: https://github.com/simspace/postgresql-tx-  subdir: squeal  library   exposed-modules:       Database.PostgreSQL.Tx.Squeal+      Database.PostgreSQL.Tx.Squeal.Internal       Database.PostgreSQL.Tx.Squeal.Internal.Reexport   other-modules:       Paths_postgresql_tx_squeal@@ -43,7 +43,8 @@     , bytestring >=0.10.10.0 && <0.11     , generics-sop >=0.5.1.0 && <0.6     , postgresql-libpq >=0.9.4.2 && <0.10-    , postgresql-tx >=0.1.0.0 && <0.2+    , postgresql-tx >=0.2.0.0 && <0.3     , records-sop >=0.1.0.3 && <0.2-    , squeal-postgresql >=0.6.0.2 && <0.7+    , squeal-postgresql >=0.7.0.1 && <0.8+    , unliftio >=0.2.13 && <0.3   default-language: Haskell2010

@@ -1,135 +1,191 @@-{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE UndecidableInstances #-}-{-# OPTIONS_GHC -fno-warn-orphans #-} module Database.PostgreSQL.Tx.Squeal-  ( module Database.PostgreSQL.Tx.Squeal+  ( SquealEnv+  , SquealM+  , SquealTxM'(SquealTxM, fromSquealTxM)+  , SquealTxM+  , SquealConnection+  , mkSquealConnection+  , module Database.PostgreSQL.Tx.Squeal   , module Database.PostgreSQL.Tx.Squeal.Internal.Reexport   ) where +import Control.Exception (Exception) import Data.ByteString (ByteString)-import Database.PostgreSQL.Tx (Tx(TxEnv, tx), UnsafeTx(unsafeIOTx), TxM, unsafeRunTxM)+import Database.PostgreSQL.Tx (TxM, shouldRetryTx)+import Database.PostgreSQL.Tx.Squeal.Internal import Database.PostgreSQL.Tx.Squeal.Internal.Reexport import qualified Database.PostgreSQL.LibPQ as LibPQ import qualified Generics.SOP as SOP import qualified Generics.SOP.Record as SOP import qualified Squeal.PostgreSQL as Squeal -type SquealM db0 db1 = PQ db0 db1 TxM--unsafeSquealIOTx :: PQ db0 db1 IO a -> SquealM db0 db1 a-unsafeSquealIOTx = unsafeIOTx--unsafeSquealIOTx1-  :: (x1 -> PQ db0 db1 IO a)-  -> x1 -> SquealM db0 db1 a-unsafeSquealIOTx1 f x1 = unsafeSquealIOTx $ f x1--unsafeSquealIOTx2-  :: (x1 -> x2 -> PQ db0 db1 IO a)-  -> x1 -> x2 -> SquealM db0 db1 a-unsafeSquealIOTx2 f x1 x2 = unsafeSquealIOTx $ f x1 x2--unsafeSquealIOTx3-  :: (x1 -> x2 -> x3 -> PQ db0 db1 IO a)-  -> x1 -> x2 -> x3 -> SquealM db0 db1 a-unsafeSquealIOTx3 f x1 x2 x3 = unsafeSquealIOTx $ f x1 x2 x3--getRow :: LibPQ.Row -> Result y -> SquealM db db y-getRow = unsafeSquealIOTx2 Squeal.getRow+-- | Analogue of 'Squeal.getRow'.+--+-- @since 0.1.0.0+getRow :: LibPQ.Row -> Result y -> SquealTxM db y+getRow = unsafeSquealIOTxM2 Squeal.getRow -firstRow :: Result y -> SquealM db db (Maybe y)-firstRow = unsafeSquealIOTx1 Squeal.firstRow+-- | Analogue of 'Squeal.firstRow'.+--+-- @since 0.1.0.0+firstRow :: Result y -> SquealTxM db (Maybe y)+firstRow = unsafeSquealIOTxM1 Squeal.firstRow -getRows :: Result y -> SquealM db db [y]-getRows = unsafeSquealIOTx1 Squeal.getRows+-- | Analogue of 'Squeal.getRows'.+--+-- @since 0.1.0.0+getRows :: Result y -> SquealTxM db [y]+getRows = unsafeSquealIOTxM1 Squeal.getRows -nextRow :: LibPQ.Row -> Result y -> LibPQ.Row -> SquealM db db (Maybe (LibPQ.Row, y))-nextRow = unsafeSquealIOTx3 Squeal.nextRow+-- | Analogue of 'Squeal.nextRow'.+--+-- @since 0.1.0.0+nextRow :: LibPQ.Row -> Result y -> LibPQ.Row -> SquealTxM db (Maybe (LibPQ.Row, y))+nextRow = unsafeSquealIOTxM3 Squeal.nextRow -ntuples :: Result y -> SquealM db db LibPQ.Row-ntuples = unsafeSquealIOTx1 Squeal.ntuples+-- | Analogue of 'Squeal.ntuples'.+--+-- @since 0.1.0.0+ntuples :: Result y -> SquealTxM db LibPQ.Row+ntuples = unsafeSquealIOTxM1 Squeal.ntuples -nfields :: Result y -> SquealM db db LibPQ.Column-nfields = unsafeSquealIOTx1 Squeal.nfields+-- | Analogue of 'Squeal.nfields'.+--+-- @since 0.1.0.0+nfields :: Result y -> SquealTxM db LibPQ.Column+nfields = unsafeSquealIOTxM1 Squeal.nfields -resultStatus :: Result y -> SquealM db db ExecStatus-resultStatus = unsafeSquealIOTx1 Squeal.resultStatus+-- | Analogue of 'Squeal.resultStatus'.+--+-- @since 0.1.0.0+resultStatus :: Result y -> SquealTxM db ExecStatus+resultStatus = unsafeSquealIOTxM1 Squeal.resultStatus -okResult :: K LibPQ.Result row -> SquealM db db ()-okResult = unsafeSquealIOTx1 Squeal.okResult+-- | Analogue of 'Squeal.okResult'.+--+-- @since 0.2.0.0+okResult :: Result y -> SquealTxM db ()+okResult = unsafeSquealIOTxM1 Squeal.okResult -resultErrorMessage :: Result y -> SquealM db db (Maybe ByteString)-resultErrorMessage = unsafeSquealIOTx1 Squeal.resultErrorMessage+-- | Analogue of 'Squeal.resultErrorMessage'.+--+-- @since 0.1.0.0+resultErrorMessage :: Result y -> SquealTxM db (Maybe ByteString)+resultErrorMessage = unsafeSquealIOTxM1 Squeal.resultErrorMessage -resultErrorCode :: Result y -> SquealM db db (Maybe ByteString)-resultErrorCode = unsafeSquealIOTx1 Squeal.resultErrorCode+-- | Analogue of 'Squeal.resultErrorCode'.+--+-- @since 0.1.0.0+resultErrorCode :: Result y -> SquealTxM db (Maybe ByteString)+resultErrorCode = unsafeSquealIOTxM1 Squeal.resultErrorCode -executeParams :: Statement db x y -> x -> SquealM db db (Result y)-executeParams = unsafeSquealIOTx2 Squeal.executeParams+-- | Analogue of 'Squeal.executeParams'.+--+-- @since 0.1.0.0+executeParams :: Statement db x y -> x -> SquealTxM db (Result y)+executeParams = unsafeSquealIOTxM2 Squeal.executeParams -executeParams_ :: Statement db x () -> x -> SquealM db db ()-executeParams_ = unsafeSquealIOTx2 Squeal.executeParams_+-- | Analogue of 'Squeal.executeParams_'.+--+-- @since 0.1.0.0+executeParams_ :: Statement db x () -> x -> SquealTxM db ()+executeParams_ = unsafeSquealIOTxM2 Squeal.executeParams_ -execute :: Statement db () y -> SquealM db db (Result y)-execute = unsafeSquealIOTx1 Squeal.execute+-- | Analogue of 'Squeal.execute'.+--+-- @since 0.1.0.0+execute :: Statement db () y -> SquealTxM db (Result y)+execute = unsafeSquealIOTxM1 Squeal.execute -execute_ :: Statement db () () -> SquealM db db ()-execute_ = unsafeSquealIOTx1 Squeal.execute_+-- | Analogue of 'Squeal.execute_'.+--+-- @since 0.1.0.0+execute_ :: Statement db () () -> SquealTxM db ()+execute_ = unsafeSquealIOTxM1 Squeal.execute_ +-- | Analogue of 'Squeal.executePrepared'.+--+-- @since 0.1.0.0 executePrepared   :: (Traversable list)-  => Statement db x y -> list x -> SquealM db db (list (Result y))-executePrepared = unsafeSquealIOTx2 Squeal.executePrepared+  => Statement db x y -> list x -> SquealTxM db (list (Result y))+executePrepared = unsafeSquealIOTxM2 Squeal.executePrepared +-- | Analogue of 'Squeal.executePrepared_'.+--+-- @since 0.1.0.0 executePrepared_   :: (Foldable list)-  => Statement db x () -> list x -> SquealM db db ()-executePrepared_ = unsafeSquealIOTx2 Squeal.executePrepared_+  => Statement db x () -> list x -> SquealTxM db ()+executePrepared_ = unsafeSquealIOTxM2 Squeal.executePrepared_ +-- | Analogue of 'Squeal.manipulateParams'.+--+-- @since 0.1.0.0 manipulateParams   :: ( GenericParams db params x xs      , Squeal.GenericRow row y ys      )   => Manipulation '[] db params row   -> x-  -> SquealM db db (Result y)-manipulateParams = unsafeSquealIOTx2 Squeal.manipulateParams+  -> SquealTxM db (Result y)+manipulateParams = unsafeSquealIOTxM2 Squeal.manipulateParams +-- | Analogue of 'Squeal.manipulateParams_'.+--+-- @since 0.1.0.0 manipulateParams_   :: (GenericParams db params x xs)-  => Manipulation '[] db params '[] -> x -> SquealM db db ()-manipulateParams_ = unsafeSquealIOTx2 Squeal.manipulateParams_+  => Manipulation '[] db params '[] -> x -> SquealTxM db ()+manipulateParams_ = unsafeSquealIOTxM2 Squeal.manipulateParams_ +-- | Analogue of 'Squeal.manipulate'.+--+-- @since 0.1.0.0 manipulate   :: (Squeal.GenericRow row y ys)-  => Manipulation '[] db '[] row -> SquealM db db (Result y)-manipulate = unsafeSquealIOTx1 Squeal.manipulate+  => Manipulation '[] db '[] row -> SquealTxM db (Result y)+manipulate = unsafeSquealIOTxM1 Squeal.manipulate +-- | Analogue of 'Squeal.manipulate_'.+--+-- @since 0.1.0.0 manipulate_-  :: Manipulation '[] db '[] '[] -> SquealM db db ()-manipulate_ = unsafeSquealIOTx1 Squeal.manipulate_+  :: Manipulation '[] db '[] '[] -> SquealTxM db ()+manipulate_ = unsafeSquealIOTxM1 Squeal.manipulate_ +-- | Analogue of 'Squeal.runQueryParams'.+--+-- @since 0.1.0.0 runQueryParams   :: ( GenericParams db params x xs      , SOP.IsRecord y ys      , SOP.AllZip Squeal.FromField row ys      )-  => Squeal.Query '[] '[] db params row -> x -> SquealM db db (Result y)-runQueryParams = unsafeSquealIOTx2 Squeal.runQueryParams+  => Squeal.Query '[] '[] db params row -> x -> SquealTxM db (Result y)+runQueryParams = unsafeSquealIOTxM2 Squeal.runQueryParams +-- | Analogue of 'Squeal.runQuery'.+--+-- @since 0.1.0.0 runQuery   :: ( SOP.IsRecord y ys      , SOP.AllZip Squeal.FromField row ys      )-  => Squeal.Query '[] '[] db '[] row -> SquealM db db (Result y)-runQuery = unsafeSquealIOTx1 Squeal.runQuery+  => Squeal.Query '[] '[] db '[] row -> SquealTxM db (Result y)+runQuery = unsafeSquealIOTxM1 Squeal.runQuery +-- | Analogue of 'Squeal.traversePrepared'.+--+-- @since 0.1.0.0 traversePrepared   :: ( GenericParams db params x xs      , Traversable list@@ -138,9 +194,12 @@      )   => Manipulation '[] db params row   -> list x-  -> SquealM db db (list (Result y))-traversePrepared = unsafeSquealIOTx2 Squeal.traversePrepared+  -> SquealTxM db (list (Result y))+traversePrepared = unsafeSquealIOTxM2 Squeal.traversePrepared +-- | Analogue of 'Squeal.forPrepared'.+--+-- @since 0.1.0.0 forPrepared   :: ( GenericParams db params x xs      , Traversable list@@ -149,55 +208,81 @@      )   => list x   -> Manipulation '[] db params row-  -> SquealM db db (list (Result y))-forPrepared = unsafeSquealIOTx2 Squeal.forPrepared+  -> SquealTxM db (list (Result y))+forPrepared = unsafeSquealIOTxM2 Squeal.forPrepared +-- | Analogue of 'Squeal.traversePrepared_'.+--+-- @since 0.1.0.0 traversePrepared_   :: ( GenericParams db params x xs      , Foldable list      )   => Manipulation '[] db params '[]   -> list x-  -> SquealM db db ()-traversePrepared_ = unsafeSquealIOTx2 Squeal.traversePrepared_+  -> SquealTxM db ()+traversePrepared_ = unsafeSquealIOTxM2 Squeal.traversePrepared_ +-- | Analogue of 'Squeal.forPrepared_'.+--+-- @since 0.1.0.0 forPrepared_   :: ( GenericParams db params x xs      , Foldable list      )   => list x   -> Manipulation '[] db params '[]-  -> SquealM db db ()-forPrepared_ = unsafeSquealIOTx2 Squeal.forPrepared_+  -> SquealTxM db ()+forPrepared_ = unsafeSquealIOTxM2 Squeal.forPrepared_ -transactionally :: TransactionMode -> Connection -> TxM a -> IO a+-- | Analogue of 'Squeal.transactionally'.+--+-- @since 0.1.0.0+transactionally :: (SquealEnv r) => TransactionMode -> r -> TxM r a -> IO a transactionally m = unsafeRunSquealTransaction (Squeal.transactionally m) -transactionally_ :: Connection -> TxM a -> IO a+-- | Analogue of 'Squeal.transactionally_'.+--+-- @since 0.1.0.0+transactionally_ :: (SquealEnv r) => r -> TxM r a -> IO a transactionally_ = unsafeRunSquealTransaction Squeal.transactionally_ -transactionallyRetry :: TransactionMode -> Connection -> TxM a -> IO a-transactionallyRetry m = unsafeRunSquealTransaction (Squeal.transactionallyRetry m)+-- | Specialization of 'transactionallyRetry' which uses 'Serializable'+-- and 'shouldRetryTx' to automatically retry the transaction on+-- @serialization_failure@ or @deadlock_detected@.+--+-- Note that any 'IO' that occurs inside the 'TxM' may be executed multiple times.+--+-- @since 0.2.0.0+transactionallySerializable :: (SquealEnv r) => r -> TxM r a -> IO a+transactionallySerializable =+  transactionallyRetry mode shouldRetryTx+  where+  mode =+    TransactionMode+      Serializable+      ReadWrite+      NotDeferrable -ephemerally :: TransactionMode -> Connection -> TxM a -> IO a+-- | Analogue of 'Squeal.transactionallyRetry'.+--+-- Note that any 'IO' that occurs inside the 'TxM' may be executed multiple times.+--+-- @since 0.2.0.0+transactionallyRetry+  :: (SquealEnv r, Exception e)+  => TransactionMode -> (e -> Bool) -> r -> TxM r a -> IO a+transactionallyRetry m shouldRetry =+  unsafeRunSquealTransaction (transactionallyRetry' m shouldRetry)++-- | Analogue of 'Squeal.ephemerally'.+--+-- @since 0.1.0.0+ephemerally :: (SquealEnv r) => TransactionMode -> r -> TxM r a -> IO a ephemerally m = unsafeRunSquealTransaction (Squeal.ephemerally m) -ephemerally_ :: Connection -> TxM a -> IO a+-- | Analogue of 'Squeal.ephemerally_'.+--+-- @since 0.1.0.0+ephemerally_ :: (SquealEnv r) => r -> TxM r a -> IO a ephemerally_ = unsafeRunSquealTransaction Squeal.ephemerally_--unsafeRunSquealTransaction-  :: (PQ db0 db1 IO a -> PQ db0 db1 IO a)-  -> Connection-  -> TxM a-  -> IO a-unsafeRunSquealTransaction f conn x =-  flip Squeal.evalPQ (Squeal.K conn)-    $ f-    $ PQ \_ -> Squeal.K <$> unsafeRunTxM x--instance Tx (SquealM db0 db1) where-  type TxEnv (SquealM db0 db1) = Connection-  tx conn x = evalPQ x (Squeal.K conn)--instance (UnsafeTx io t) => UnsafeTx (PQ db0 db1 io) (PQ db0 db1 t) where-  unsafeIOTx x = PQ \kConn -> unsafeIOTx (Squeal.unPQ x kConn)

@@ -0,0 +1,175 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralisedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE UndecidableInstances #-}+module Database.PostgreSQL.Tx.Squeal.Internal+  ( -- * Disclaimer+    -- $disclaimer++    -- ** Internals+    module Database.PostgreSQL.Tx.Squeal.Internal+  ) where++import Control.Exception (Exception(fromException))+import Control.Monad.IO.Class (MonadIO(liftIO))+import Data.Kind (Constraint)+import Database.PostgreSQL.Tx (TxEnv, TxException, TxM, askTxEnv, mapExceptionTx)+import Database.PostgreSQL.Tx.Squeal.Internal.Reexport+import Database.PostgreSQL.Tx.Unsafe (unsafeLookupTxEnvIO, unsafeMkTxException, unsafeRunIOInTxM, unsafeRunTxM)+import GHC.TypeLits (ErrorMessage(Text), TypeError)+import UnliftIO (MonadUnliftIO)+import qualified Data.ByteString.Char8 as Char8+import qualified Database.PostgreSQL.LibPQ as LibPQ+import qualified Squeal.PostgreSQL as Squeal+import qualified UnliftIO++-- | Runtime environment needed to run @squeal-postgresql@ via @postgresql-tx@.+--+-- @since 0.2.0.0+type SquealEnv r =+  (TxEnv SquealConnection r) :: Constraint++-- | Monad type alias for running @squeal-postgresql@ via @postgresql-tx@.+--+-- @since 0.2.0.0+type SquealM a = forall r. (SquealEnv r) => TxM r a++-- | Alias for 'SquealTxM'' but has the 'SquealEnv' constraint applied to @r@.+--+-- @since 0.2.0.0+type SquealTxM (db :: SchemasType) a =+  forall r. (SquealEnv r) => SquealTxM' db r a++-- | A newtype wrapper around 'TxM' which includes the @squeal@ 'SchemasType'+-- parameter @db@. This is used only as type information.+-- You can easily convert 'TxM' to and from 'SquealTxM'' by using the+-- 'SquealTxM'' constructor and 'fromSquealTxM' function, respectively.+--+-- In practice, you will likely prefer to use the 'SquealTxM' type alias+-- as it includes the 'SquealEnv' constraint on @r@.+--+-- @since 0.2.0.0+newtype SquealTxM' (db :: SchemasType) r a =+  SquealTxM+    { -- | Convert a 'SquealTxM'' to a 'TxM'.+      --+      -- @since 0.2.0.0+      fromSquealTxM :: TxM r a+    }+  deriving newtype (Functor, Applicative, Monad)++-- | The 'SquealTxM'' monad discourages performing arbitrary 'IO' within a+-- transaction, so this instance generates a type error when client code tries+-- to call 'liftIO'.+--+-- Note that we specialize this instance for 'SquealTxM'' rather than derive it+-- via newtype so we can provide a better error message.+--+-- @since 0.2.0.0+instance+  ( TypeError+      ('Text "MonadIO is banned in SquealTxM'; use 'SquealTxM . unsafeRunIOInTxM' if you are sure this is safe IO")+  ) => MonadIO (SquealTxM' db r)+  where+  liftIO = undefined++-- | Used in the 'SquealEnv' to specify the 'LibPQ.Connection' to use.+-- Should produce the same 'LibPQ.Connection' if called multiple times+-- in the same transaction. Usually you will want to use 'mkSquealConnection'+-- to get one.+--+-- @since 0.2.0.0+newtype SquealConnection =+  UnsafeSquealConnection+    { unsafeGetLibPQConnection :: IO LibPQ.Connection+    }++-- | Construct a 'SquealConnection' from a 'LibPQ.Connection'.+--+-- @since 0.2.0.0+mkSquealConnection :: LibPQ.Connection -> SquealConnection+mkSquealConnection conn = UnsafeSquealConnection (pure conn)++fromSquealException :: SquealException -> TxException+fromSquealException =+  unsafeMkTxException \case+    SQLException SQLState { sqlStateCode } -> Just $ Char8.unpack sqlStateCode+    _ -> Nothing++unsafeSquealIOTxM+  :: PQ db db IO a+  -> SquealTxM db a+unsafeSquealIOTxM (PQ f) = SquealTxM $ mapExceptionTx (Just . fromSquealException) do+  UnsafeSquealConnection { unsafeGetLibPQConnection } <- askTxEnv+  unsafeRunIOInTxM do+    conn <- unsafeGetLibPQConnection+    K a <- f (K conn)+    pure a++unsafeSquealIOTxM1+  :: (x1 -> PQ db db IO a)+  -> x1 -> SquealTxM db a+unsafeSquealIOTxM1 f x1 = unsafeSquealIOTxM $ f x1++unsafeSquealIOTxM2+  :: (x1 -> x2 -> PQ db db IO a)+  -> x1 -> x2 -> SquealTxM db a+unsafeSquealIOTxM2 f x1 x2 = unsafeSquealIOTxM $ f x1 x2++unsafeSquealIOTxM3+  :: (x1 -> x2 -> x3 -> PQ db db IO a)+  -> x1 -> x2 -> x3 -> SquealTxM db a+unsafeSquealIOTxM3 f x1 x2 x3 = unsafeSquealIOTxM $ f x1 x2 x3++unsafeRunSquealTransaction+  :: forall r a. (SquealEnv r)+  => (forall db. PQ db db IO a -> PQ db db IO a)+  -> r+  -> TxM r a+  -> IO a+unsafeRunSquealTransaction f r x = do+  UnsafeSquealConnection { unsafeGetLibPQConnection } <- unsafeLookupTxEnvIO r+  conn <- unsafeGetLibPQConnection+  flip evalPQ (K conn)+    $ f+    $ PQ \_ -> K <$> unsafeRunTxM r x++-- | A variant of 'transactionallyRetry' which takes a predicate+-- for determining when to retry instead of only doing so on+-- @serialization_failure@.+transactionallyRetry'+  :: (MonadUnliftIO m, MonadPQ db m, Exception e)+  => TransactionMode+  -> (e -> Bool)+  -> m a+  -> m a+transactionallyRetry' mode shouldRetry action = UnliftIO.mask $ \restore ->+  loop . UnliftIO.try $ do+    x <- restore action+    Squeal.manipulate_ commit+    return x+  where+  loop attempt = do+    Squeal.manipulate_ $ begin mode+    attempt >>= \case+      Right a -> return a+      Left e -> do+        Squeal.manipulate_ rollback+        if any shouldRetry (fromException e) then+          loop attempt+        else+          UnliftIO.throwIO e++-- $disclaimer+--+-- Changes to this module will not be reflected in the library's version+-- updates.