-- | Support for Postgres @SELECT@ locking clauses.
--
-- This functionality is new.  If you use it then please [open an
-- issue on
-- GitHub](https://github.com/tomjaguarpaw/haskell-opaleye/issues/new)
-- and let us know how it went, whether that is well or badly.
--
-- Not all Postgres locking clauses are supported.  If you need
-- another form of locking clause then please [open an issue on
-- GitHub](https://github.com/tomjaguarpaw/haskell-opaleye/issues/new).

module Opaleye.Internal.Locking where

import qualified Opaleye.Internal.QueryArr as Q
import qualified Opaleye.Internal.PrimQuery as PQ

-- | Adds a @FOR UPDATE@ clause to the 'Q.Select'.
--
-- Postgres has strong restrictions regarding the @SELECT@ clauses to
-- which a @FOR UPDATE@ can be added. Opaleye makes no attempt to
-- enforce those restrictions through its type system so it's very
-- easy to create queries that fail at run time using this operation.
forUpdate :: Q.Select a -> Q.Select a
forUpdate :: Select a -> Select a
forUpdate Select a
s =
  (((), PrimQuery, Tag) -> (a, PrimQuery, Tag)) -> Select a
forall a b.
((a, PrimQuery, Tag) -> (b, PrimQuery, Tag)) -> SelectArr a b
Q.QueryArr ((\(a
a, PrimQuery
pq, Tag
t) -> (a
a, PrimQuery -> PrimQuery
forall a. PrimQuery' a -> PrimQuery' a
PQ.ForUpdate PrimQuery
pq, Tag
t)) ((a, PrimQuery, Tag) -> (a, PrimQuery, Tag))
-> (((), PrimQuery, Tag) -> (a, PrimQuery, Tag))
-> ((), PrimQuery, Tag)
-> (a, PrimQuery, Tag)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Select a -> ((), PrimQuery, Tag) -> (a, PrimQuery, Tag)
forall a b.
QueryArr a b -> (a, PrimQuery, Tag) -> (b, PrimQuery, Tag)
Q.runQueryArr Select a
s)