add all postgres row-level locking options

changelog.md

@@ -1,3 +1,9 @@
+3.5.13.0
+========
+- @ac251
+    - [#402](https://github.com/bitemyapp/esqueleto/pull/402)
+      - Add `forNoKeyUpdate` and `forKeyShare` locking kinds for postgres
+
 3.5.12.0
 ========
 - @csamak

esqueleto.cabal

@@ -2,7 +2,7 @@ cabal-version: 1.12
 
 name:           esqueleto
 
-version:        3.5.12.0
+version:        3.5.13.0
 synopsis:       Type-safe EDSL for SQL queries on persistent backends.
 description:    @esqueleto@ is a bare bones, type-safe EDSL for SQL queries that works with unmodified @persistent@ SQL backends.  Its language closely resembles SQL, so you don't have to learn new concepts, just new syntax, and it's fairly easy to predict the generated SQL and optimize it for your backend. Most kinds of errors committed when writing SQL are caught as compile-time errors---although it is possible to write type-checked @esqueleto@ queries that fail at runtime.
                 .

src/Database/Esqueleto/Internal/Internal.hs

@@ -60,7 +60,7 @@
 import Data.Kind (Type)
 import qualified Data.List as List
 import qualified Data.Map.Strict as Map
 import qualified Data.Monoid as Monoid
 import Data.Proxy (Proxy(..))
 import Data.Set (Set)
 import qualified Data.Set as Set
@@ -70,7 +70,7 @@
 import Data.Typeable (Typeable)
 import Database.Esqueleto.Internal.ExprParser (TableAccess(..), parseOnExpr)
 import Database.Esqueleto.Internal.PersistentImport
 import Database.Persist (EntityNameDB(..), FieldNameDB(..), SymbolToField(..))
 import qualified Database.Persist
 import Database.Persist.Sql.Util
        ( entityColumnCount
@@ -1319,7 +1319,7 @@
     unique = finalR uniqueConstructor
     -- there must be a better way to get the constrain name from a unique, make this not a list search
     filterF = (==) (persistUniqueToFieldNames unique) . uniqueFields
     uniqueDef = head . filter filterF . getEntityUniques . entityDef $ proxy
 
 -- | Render updates to be use in a SET clause for a given sql backend.
 --
@@ -1485,7 +1485,9 @@
 -- Arranged in order of lock strength
 data PostgresRowLevelLockStrength =
     PostgresForUpdate
+    | PostgresForNoKeyUpdate
     | PostgresForShare
+    | PostgresForKeyShare
   deriving (Ord, Eq)
 
 data LockingOfClause where
@@ -3254,7 +3256,9 @@
                     <> makeLockingBehavior (postgresOnLockedBehavior l)
             makeLockingStrength :: PostgresRowLevelLockStrength -> (TLB.Builder, [PersistValue])
             makeLockingStrength PostgresForUpdate = plain "FOR UPDATE"
+            makeLockingStrength PostgresForNoKeyUpdate = plain "FOR NO KEY UPDATE"
             makeLockingStrength PostgresForShare = plain "FOR SHARE"
+            makeLockingStrength PostgresForKeyShare = plain "FOR KEY SHARE"
 
             makeLockingBehavior :: OnLockedBehavior -> (TLB.Builder, [PersistValue])
             makeLockingBehavior NoWait = plain "NOWAIT"

src/Database/Esqueleto/PostgreSQL.hs

@@ -31,7 +31,9 @@
     , wait
     , skipLocked
     , forUpdateOf
+    , forNoKeyUpdateOf
     , forShareOf
+    , forKeyShareOf
     , filterWhere
     , values
     -- * Internal
@@ -238,7 +240,7 @@
             queryVals =
                 addVals updateVals
         xs <- rawSql queryText queryVals
         pure (head xs)
 #else
     uDef = toUniqueDef uniqueKey
     handler conn f = fmap head $ uncurry rawSql $
@@ -280,7 +282,7 @@
 -- @since 3.1.3
 insertSelectWithConflict
     :: forall a m val backend
      . (FinalResult a, KnowResult a ~ Unique val, MonadIO m, PersistEntity val, SqlBackendCanWrite backend)
     => a
     -- ^ Unique constructor or a unique, this is used just to get the name of
     -- the postgres constraint, the value(s) is(are) never used, so if you have
@@ -300,7 +302,7 @@
 -- @since 3.1.3
 insertSelectWithConflictCount
     :: forall a val m backend
      . (FinalResult a, KnowResult a ~ Unique val, MonadIO m, PersistEntity val,
      SqlBackendCanWrite backend)
     => a
     -> SqlQuery (SqlExpr (Insertion val))
@@ -469,11 +471,26 @@
 forUpdateOf lockableEntities onLockedBehavior =
   putLocking $ PostgresLockingClauses [PostgresLockingKind PostgresForUpdate (Just $ LockingOfClause lockableEntities) onLockedBehavior]
 
+-- | `FOR NO KEY UPDATE OF` syntax for postgres locking
+-- allows locking of specific tables with a no key update lock in a view or join
+--
+-- @since 3.5.13.0
+forNoKeyUpdateOf :: LockableEntity a => a -> OnLockedBehavior -> SqlQuery ()
+forNoKeyUpdateOf lockableEntities onLockedBehavior =
+  putLocking $ PostgresLockingClauses [PostgresLockingKind PostgresForNoKeyUpdate (Just $ LockingOfClause lockableEntities) onLockedBehavior]
+
 -- | `FOR SHARE OF` syntax for postgres locking
 -- allows locking of specific tables with a share lock in a view or join
 --
 -- @since 3.5.9.0
-
 forShareOf :: LockableEntity a => a -> OnLockedBehavior -> SqlQuery ()
 forShareOf lockableEntities onLockedBehavior =
   putLocking $ PostgresLockingClauses [PostgresLockingKind PostgresForShare (Just $ LockingOfClause lockableEntities) onLockedBehavior]
+
+-- | `FOR KEY SHARE OF` syntax for postgres locking
+-- allows locking of specific tables with a key share lock in a view or join
+--
+-- @since 3.5.13.0
+forKeyShareOf :: LockableEntity a => a -> OnLockedBehavior -> SqlQuery ()
+forKeyShareOf lockableEntities onLockedBehavior =
+  putLocking $ PostgresLockingClauses [PostgresLockingKind PostgresForKeyShare (Just $ LockingOfClause lockableEntities) onLockedBehavior]

test/PostgreSQL/Test.hs

@@ -1243,7 +1243,9 @@ testPostgresqlLocking = do
                     p <- Experimental.from $ table @Person
                     EP.forUpdateOf p EP.skipLocked
                     EP.forUpdateOf p EP.skipLocked
+                    EP.forNoKeyUpdateOf p EP.skipLocked
                     EP.forShareOf p EP.skipLocked
+                    EP.forKeyShareOf p EP.skipLocked
             conn <- ask
             let res1 = toText conn multipleLockingQuery
                 resExpected =
@@ -1253,7 +1255,9 @@ testPostgresqlLocking = do
                     ,"FROM \"Person\""
                     ,"FOR UPDATE OF \"Person\" SKIP LOCKED"
                     ,"FOR UPDATE OF \"Person\" SKIP LOCKED"
+                    ,"FOR NO KEY UPDATE OF \"Person\" SKIP LOCKED"
                     ,"FOR SHARE OF \"Person\" SKIP LOCKED"
+                    ,"FOR KEY SHARE OF \"Person\" SKIP LOCKED"
                     ]
 
             asserting $ res1 `shouldBe` resExpected