{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | This module contain PostgreSQL-specific functions.
--
-- @since: 2.2.8
module Database.Esqueleto.PostgreSQL
    ( AggMode(..)
    , arrayAggDistinct
    , arrayAgg
    , arrayAggWith
    , arrayRemove
    , arrayRemoveNull
    , stringAgg
    , stringAggWith
    , maybeArray
    , chr
    , now_
    , random_
    , upsert
    , upsertBy
    , insertSelectWithConflict
    , insertSelectWithConflictCount
    , noWait
    , wait
    , skipLocked
    , forUpdateOf
    , forShareOf
    , filterWhere
    , values
    -- * Internal
    , unsafeSqlAggregateFunction
    ) where

#if __GLASGOW_HASKELL__ < 804
import Data.Semigroup
#endif
import Control.Arrow (first)
import Control.Exception (throw)
import Control.Monad (void)
import Control.Monad.IO.Class (MonadIO(..))
import qualified Control.Monad.Trans.Reader as R
import Data.Int (Int64)
import qualified Data.List.NonEmpty as NE
import Data.Maybe
import Data.Proxy (Proxy(..))
import qualified Data.Text.Internal.Builder as TLB
import qualified Data.Text.Lazy as TL
import Data.Time.Clock (UTCTime)
import qualified Database.Esqueleto.Experimental as Ex
import Database.Esqueleto.Internal.Internal hiding (random_)
import Database.Esqueleto.Internal.PersistentImport hiding
       (uniqueFields, upsert, upsertBy)
import Database.Persist.SqlBackend

-- | (@random()@) Split out into database specific modules
-- because MySQL uses `rand()`.
--
-- @since 2.6.0
random_ :: (PersistField a, Num a) => SqlExpr (Value a)
random_ :: forall a. (PersistField a, Num a) => SqlExpr (Value a)
random_ = forall a. Builder -> SqlExpr (Value a)
unsafeSqlValue Builder
"RANDOM()"

-- | Empty array literal. (@val []@) does unfortunately not work
emptyArray :: SqlExpr (Value [a])
emptyArray :: forall a. SqlExpr (Value [a])
emptyArray = forall a. Builder -> SqlExpr (Value a)
unsafeSqlValue Builder
"'{}'"

-- | Coalesce an array with an empty default value
maybeArray ::
     (PersistField a, PersistField [a])
  => SqlExpr (Value (Maybe [a]))
  -> SqlExpr (Value [a])
maybeArray :: forall a.
(PersistField a, PersistField [a]) =>
SqlExpr (Value (Maybe [a])) -> SqlExpr (Value [a])
maybeArray SqlExpr (Value (Maybe [a]))
x = forall a.
PersistField a =>
[SqlExpr (Value (Maybe a))]
-> SqlExpr (Value a) -> SqlExpr (Value a)
coalesceDefault [SqlExpr (Value (Maybe [a]))
x] (forall a. SqlExpr (Value [a])
emptyArray)

-- | Aggregate mode
data AggMode
    = AggModeAll -- ^ ALL
    | AggModeDistinct -- ^ DISTINCT
    deriving (Int -> AggMode -> ShowS
[AggMode] -> ShowS
AggMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AggMode] -> ShowS
$cshowList :: [AggMode] -> ShowS
show :: AggMode -> String
$cshow :: AggMode -> String
showsPrec :: Int -> AggMode -> ShowS
$cshowsPrec :: Int -> AggMode -> ShowS
Show)

-- | (Internal) Create a custom aggregate functions with aggregate mode
--
-- /Do/ /not/ use this function directly, instead define a new function and give
-- it a type (see `unsafeSqlBinOp`)
unsafeSqlAggregateFunction
    :: UnsafeSqlFunctionArgument a
    => TLB.Builder
    -> AggMode
    -> a
    -> [OrderByClause]
    -> SqlExpr (Value b)
unsafeSqlAggregateFunction :: forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> AggMode -> a -> [OrderByClause] -> SqlExpr (Value b)
unsafeSqlAggregateFunction Builder
name AggMode
mode a
args [OrderByClause]
orderByClauses = forall a.
SqlExprMeta
-> (NeedParens -> IdentInfo -> (Builder, [PersistValue]))
-> SqlExpr a
ERaw SqlExprMeta
noMeta forall a b. (a -> b) -> a -> b
$ \NeedParens
_ IdentInfo
info ->
    let (Builder
orderTLB, [PersistValue]
orderVals) = IdentInfo -> [OrderByClause] -> (Builder, [PersistValue])
makeOrderByNoNewline IdentInfo
info [OrderByClause]
orderByClauses
        -- Don't add a space if we don't have order by clauses
        orderTLBSpace :: Builder
orderTLBSpace =
            case [OrderByClause]
orderByClauses of
                []    -> Builder
""
                (OrderByClause
_:[OrderByClause]
_) -> Builder
" "
        (Builder
argsTLB, [PersistValue]
argsVals) =
            forall a. Monoid a => [(Builder, a)] -> (Builder, a)
uncommas' forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(ERaw SqlExprMeta
_ NeedParens -> IdentInfo -> (Builder, [PersistValue])
f) -> NeedParens -> IdentInfo -> (Builder, [PersistValue])
f NeedParens
Never IdentInfo
info) forall a b. (a -> b) -> a -> b
$ forall a. UnsafeSqlFunctionArgument a => a -> [SqlExpr (Value ())]
toArgList a
args
        aggMode :: Builder
aggMode =
            case AggMode
mode of
                AggMode
AggModeAll      -> Builder
""
                -- ALL is the default, so we don't need to
                -- specify it
                AggMode
AggModeDistinct -> Builder
"DISTINCT "
    in ( Builder
name forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
parens (Builder
aggMode forall a. Semigroup a => a -> a -> a
<> Builder
argsTLB forall a. Semigroup a => a -> a -> a
<> Builder
orderTLBSpace forall a. Semigroup a => a -> a -> a
<> Builder
orderTLB)
       , [PersistValue]
argsVals forall a. Semigroup a => a -> a -> a
<> [PersistValue]
orderVals
       )

--- | (@array_agg@) Concatenate input values, including @NULL@s,
--- into an array.
arrayAggWith
    :: AggMode
    -> SqlExpr (Value a)
    -> [OrderByClause]
    -> SqlExpr (Value (Maybe [a]))
arrayAggWith :: forall a.
AggMode
-> SqlExpr (Value a)
-> [OrderByClause]
-> SqlExpr (Value (Maybe [a]))
arrayAggWith = forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> AggMode -> a -> [OrderByClause] -> SqlExpr (Value b)
unsafeSqlAggregateFunction Builder
"array_agg"

--- | (@array_agg@) Concatenate input values, including @NULL@s,
--- into an array.
arrayAgg :: (PersistField a) => SqlExpr (Value a) -> SqlExpr (Value (Maybe [a]))
arrayAgg :: forall a.
PersistField a =>
SqlExpr (Value a) -> SqlExpr (Value (Maybe [a]))
arrayAgg SqlExpr (Value a)
x = forall a.
AggMode
-> SqlExpr (Value a)
-> [OrderByClause]
-> SqlExpr (Value (Maybe [a]))
arrayAggWith AggMode
AggModeAll SqlExpr (Value a)
x []

-- | (@array_agg@) Concatenate distinct input values, including @NULL@s, into
-- an array.
--
-- @since 2.5.3
arrayAggDistinct
    :: (PersistField a, PersistField [a])
    => SqlExpr (Value a)
    -> SqlExpr (Value (Maybe [a]))
arrayAggDistinct :: forall a.
(PersistField a, PersistField [a]) =>
SqlExpr (Value a) -> SqlExpr (Value (Maybe [a]))
arrayAggDistinct SqlExpr (Value a)
x = forall a.
AggMode
-> SqlExpr (Value a)
-> [OrderByClause]
-> SqlExpr (Value (Maybe [a]))
arrayAggWith AggMode
AggModeDistinct SqlExpr (Value a)
x []

-- | (@array_remove@) Remove all elements equal to the given value from the
-- array.
--
-- @since 2.5.3
arrayRemove :: SqlExpr (Value [a]) -> SqlExpr (Value a) -> SqlExpr (Value [a])
arrayRemove :: forall a.
SqlExpr (Value [a]) -> SqlExpr (Value a) -> SqlExpr (Value [a])
arrayRemove SqlExpr (Value [a])
arr SqlExpr (Value a)
elem' = forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"array_remove" (SqlExpr (Value [a])
arr, SqlExpr (Value a)
elem')

-- | Remove @NULL@ values from an array
arrayRemoveNull :: SqlExpr (Value [Maybe a]) -> SqlExpr (Value [a])
-- This can't be a call to arrayRemove because it changes the value type
arrayRemoveNull :: forall a. SqlExpr (Value [Maybe a]) -> SqlExpr (Value [a])
arrayRemoveNull SqlExpr (Value [Maybe a])
x = forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"array_remove" (SqlExpr (Value [Maybe a])
x, forall a. Builder -> SqlExpr (Value a)
unsafeSqlValue Builder
"NULL")


-- | (@string_agg@) Concatenate input values separated by a
-- delimiter.
stringAggWith ::
     SqlString s
  => AggMode -- ^ Aggregate mode (ALL or DISTINCT)
  -> SqlExpr (Value s) -- ^ Input values.
  -> SqlExpr (Value s) -- ^ Delimiter.
  -> [OrderByClause] -- ^ ORDER BY clauses
  -> SqlExpr (Value (Maybe s)) -- ^ Concatenation.
stringAggWith :: forall s.
SqlString s =>
AggMode
-> SqlExpr (Value s)
-> SqlExpr (Value s)
-> [OrderByClause]
-> SqlExpr (Value (Maybe s))
stringAggWith AggMode
mode SqlExpr (Value s)
expr SqlExpr (Value s)
delim [OrderByClause]
os =
  forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> AggMode -> a -> [OrderByClause] -> SqlExpr (Value b)
unsafeSqlAggregateFunction Builder
"string_agg" AggMode
mode (SqlExpr (Value s)
expr, SqlExpr (Value s)
delim) [OrderByClause]
os

-- | (@string_agg@) Concatenate input values separated by a
-- delimiter.
--
-- @since 2.2.8
stringAgg ::
     SqlString s
  => SqlExpr (Value s) -- ^ Input values.
  -> SqlExpr (Value s) -- ^ Delimiter.
  -> SqlExpr (Value (Maybe s)) -- ^ Concatenation.
stringAgg :: forall s.
SqlString s =>
SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value (Maybe s))
stringAgg SqlExpr (Value s)
expr SqlExpr (Value s)
delim = forall s.
SqlString s =>
AggMode
-> SqlExpr (Value s)
-> SqlExpr (Value s)
-> [OrderByClause]
-> SqlExpr (Value (Maybe s))
stringAggWith AggMode
AggModeAll SqlExpr (Value s)
expr SqlExpr (Value s)
delim []

-- | (@chr@) Translate the given integer to a character. (Note the result will
-- depend on the character set of your database.)
--
-- @since 2.2.11
chr :: SqlString s => SqlExpr (Value Int) -> SqlExpr (Value s)
chr :: forall s. SqlString s => SqlExpr (Value Int) -> SqlExpr (Value s)
chr = forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"chr"

now_ :: SqlExpr (Value UTCTime)
now_ :: SqlExpr (Value UTCTime)
now_ = forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"NOW" ()

upsert
    ::
    ( MonadIO m
    , PersistEntity record
    , OnlyOneUniqueKey record
    , PersistRecordBackend record SqlBackend
    , IsPersistBackend (PersistEntityBackend record)
    )
    => record
    -- ^ new record to insert
    -> [SqlExpr (Entity record) -> SqlExpr Update]
    -- ^ updates to perform if the record already exists
    -> R.ReaderT SqlBackend m (Entity record)
    -- ^ the record in the database after the operation
upsert :: forall (m :: * -> *) record.
(MonadIO m, PersistEntity record, OnlyOneUniqueKey record,
 PersistRecordBackend record SqlBackend,
 IsPersistBackend (PersistEntityBackend record)) =>
record
-> [SqlExpr (Entity record) -> SqlExpr Update]
-> ReaderT SqlBackend m (Entity record)
upsert record
record [SqlExpr (Entity record) -> SqlExpr Update]
updates = do
    Unique record
uniqueKey <- forall record backend (m :: * -> *).
(MonadIO m, PersistUniqueWrite backend,
 PersistRecordBackend record backend, OnlyOneUniqueKey record) =>
record -> ReaderT backend m (Unique record)
onlyUnique record
record
    forall (m :: * -> *) record.
(MonadIO m, PersistEntity record,
 IsPersistBackend (PersistEntityBackend record)) =>
Unique record
-> record
-> [SqlExpr (Entity record) -> SqlExpr Update]
-> ReaderT SqlBackend m (Entity record)
upsertBy Unique record
uniqueKey record
record [SqlExpr (Entity record) -> SqlExpr Update]
updates

upsertBy
    ::
    (MonadIO m
    , PersistEntity record
    , IsPersistBackend (PersistEntityBackend record)
    )
    => Unique record
    -- ^ uniqueness constraint to find by
    -> record
    -- ^ new record to insert
    -> [SqlExpr (Entity record) -> SqlExpr Update]
    -- ^ updates to perform if the record already exists
    -> R.ReaderT SqlBackend m (Entity record)
    -- ^ the record in the database after the operation
upsertBy :: forall (m :: * -> *) record.
(MonadIO m, PersistEntity record,
 IsPersistBackend (PersistEntityBackend record)) =>
Unique record
-> record
-> [SqlExpr (Entity record) -> SqlExpr Update]
-> ReaderT SqlBackend m (Entity record)
upsertBy Unique record
uniqueKey record
record [SqlExpr (Entity record) -> SqlExpr Update]
updates = do
    SqlBackend
sqlB <- forall (m :: * -> *) r. Monad m => ReaderT r m r
R.ask
    case forall backend (m :: * -> *).
(BackendCompatible SqlBackend backend, MonadReader backend m) =>
m (Maybe
     (EntityDef -> NonEmpty (FieldNameHS, FieldNameDB) -> Text -> Text))
getConnUpsertSql SqlBackend
sqlB of
        Maybe
  (EntityDef -> NonEmpty (FieldNameHS, FieldNameDB) -> Text -> Text)
Nothing ->
            -- Postgres backend should have connUpsertSql, if this error is
            -- thrown, check changes on persistent
            forall a e. Exception e => e -> a
throw (UnexpectedCaseError -> EsqueletoError
UnexpectedCaseErr UnexpectedCaseError
OperationNotSupported)
        Just EntityDef -> NonEmpty (FieldNameHS, FieldNameDB) -> Text -> Text
upsertSql ->
            SqlBackend
-> (EntityDef
    -> NonEmpty (FieldNameHS, FieldNameDB) -> Text -> Text)
-> ReaderT SqlBackend m (Entity record)
handler SqlBackend
sqlB EntityDef -> NonEmpty (FieldNameHS, FieldNameDB) -> Text -> Text
upsertSql
  where
    addVals :: [PersistValue] -> [PersistValue]
addVals [PersistValue]
l = forall a b. (a -> b) -> [a] -> [b]
map forall a. PersistField a => a -> PersistValue
toPersistValue (forall record. PersistEntity record => record -> [PersistValue]
toPersistFields record
record) forall a. [a] -> [a] -> [a]
++ [PersistValue]
l forall a. [a] -> [a] -> [a]
++ forall record.
PersistEntity record =>
Unique record -> [PersistValue]
persistUniqueToValues Unique record
uniqueKey
    entDef :: EntityDef
entDef = forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef (forall a. a -> Maybe a
Just record
record)
    updatesText :: SqlBackend -> (Text, [PersistValue])
updatesText SqlBackend
conn = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Builder -> Text
builderToText forall a b. (a -> b) -> a -> b
$ forall backend val.
BackendCompatible SqlBackend backend =>
backend
-> [SqlExpr (Entity val) -> SqlExpr Update]
-> (Builder, [PersistValue])
renderUpdates SqlBackend
conn [SqlExpr (Entity record) -> SqlExpr Update]
updates
#if MIN_VERSION_persistent(2,11,0)
    uniqueFields :: NonEmpty (FieldNameHS, FieldNameDB)
uniqueFields = forall record.
PersistEntity record =>
Unique record -> NonEmpty (FieldNameHS, FieldNameDB)
persistUniqueToFieldNames Unique record
uniqueKey
    handler :: SqlBackend
-> (EntityDef
    -> NonEmpty (FieldNameHS, FieldNameDB) -> Text -> Text)
-> ReaderT SqlBackend m (Entity record)
handler SqlBackend
sqlB EntityDef -> NonEmpty (FieldNameHS, FieldNameDB) -> Text -> Text
upsertSql = do
        let (Text
updateText, [PersistValue]
updateVals) =
                SqlBackend -> (Text, [PersistValue])
updatesText SqlBackend
sqlB
            queryText :: Text
queryText =
                EntityDef -> NonEmpty (FieldNameHS, FieldNameDB) -> Text -> Text
upsertSql EntityDef
entDef NonEmpty (FieldNameHS, FieldNameDB)
uniqueFields Text
updateText
            queryVals :: [PersistValue]
queryVals =
                [PersistValue] -> [PersistValue]
addVals [PersistValue]
updateVals
        [Entity record]
xs <- forall a (m :: * -> *) backend.
(RawSql a, MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m [a]
rawSql Text
queryText [PersistValue]
queryVals
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. [a] -> a
head [Entity record]
xs)
#else
    uDef = toUniqueDef uniqueKey
    handler conn f = fmap head $ uncurry rawSql $
        (***) (f entDef (uDef :| [])) addVals $ updatesText conn
#endif

-- | Inserts into a table the results of a query similar to 'insertSelect' but allows
-- to update values that violate a constraint during insertions.
--
-- Example of usage:
--
-- @
-- share [ mkPersist sqlSettings
--       , mkDeleteCascade sqlSettings
--       , mkMigrate "migrate"
--       ] [persistLowerCase|
--   Bar
--     num Int
--     deriving Eq Show
--   Foo
--     num Int
--     UniqueFoo num
--     deriving Eq Show
-- |]
--
-- insertSelectWithConflict
--   UniqueFoo -- (UniqueFoo undefined) or (UniqueFoo anyNumber) would also work
--   (from $ \b ->
--     return $ Foo <# (b ^. BarNum)
--   )
--   (\current excluded ->
--     [FooNum =. (current ^. FooNum) +. (excluded ^. FooNum)]
--   )
-- @
--
-- Inserts to table Foo all Bar.num values and in case of conflict SomeFooUnique,
-- the conflicting value is updated to the current plus the excluded.
--
-- @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
    -- a unique "MyUnique 0", "MyUnique undefined" would work as well.
    -> SqlQuery (SqlExpr (Insertion val))
    -- ^ Insert query.
    -> (SqlExpr (Entity val) -> SqlExpr (Entity val) -> [SqlExpr (Entity val) -> SqlExpr Update])
    -- ^ A list of updates to be applied in case of the constraint being
    -- violated. The expression takes the current and excluded value to produce
    -- the updates.
    -> R.ReaderT backend m ()
insertSelectWithConflict :: forall a (m :: * -> *) val backend.
(FinalResult a, KnowResult a ~ Unique val, MonadIO m,
 PersistEntity val, SqlBackendCanWrite backend) =>
a
-> SqlQuery (SqlExpr (Insertion val))
-> (SqlExpr (Entity val)
    -> SqlExpr (Entity val)
    -> [SqlExpr (Entity val) -> SqlExpr Update])
-> ReaderT backend m ()
insertSelectWithConflict a
unique SqlQuery (SqlExpr (Insertion val))
query SqlExpr (Entity val)
-> SqlExpr (Entity val) -> [SqlExpr (Entity val) -> SqlExpr Update]
a =
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a val (m :: * -> *) backend.
(FinalResult a, KnowResult a ~ Unique val, MonadIO m,
 PersistEntity val, SqlBackendCanWrite backend) =>
a
-> SqlQuery (SqlExpr (Insertion val))
-> (SqlExpr (Entity val)
    -> SqlExpr (Entity val)
    -> [SqlExpr (Entity val) -> SqlExpr Update])
-> ReaderT backend m Int64
insertSelectWithConflictCount a
unique SqlQuery (SqlExpr (Insertion val))
query SqlExpr (Entity val)
-> SqlExpr (Entity val) -> [SqlExpr (Entity val) -> SqlExpr Update]
a

-- | Same as 'insertSelectWithConflict' but returns the number of rows affected.
--
-- @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))
    -> (SqlExpr (Entity val) -> SqlExpr (Entity val) -> [SqlExpr (Entity val) -> SqlExpr Update])
    -> R.ReaderT backend m Int64
insertSelectWithConflictCount :: forall a val (m :: * -> *) backend.
(FinalResult a, KnowResult a ~ Unique val, MonadIO m,
 PersistEntity val, SqlBackendCanWrite backend) =>
a
-> SqlQuery (SqlExpr (Insertion val))
-> (SqlExpr (Entity val)
    -> SqlExpr (Entity val)
    -> [SqlExpr (Entity val) -> SqlExpr Update])
-> ReaderT backend m Int64
insertSelectWithConflictCount a
unique SqlQuery (SqlExpr (Insertion val))
query SqlExpr (Entity val)
-> SqlExpr (Entity val) -> [SqlExpr (Entity val) -> SqlExpr Update]
conflictQuery = do
    backend
conn <- forall (m :: * -> *) r. Monad m => ReaderT r m r
R.ask
    forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (m :: * -> *) backend.
(MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m Int64
rawExecuteCount forall a b. (a -> b) -> a -> b
$
        forall {a}. (Builder, [a]) -> (Builder, [a]) -> (Text, [a])
combine
            (forall a r backend.
(SqlSelect a r, BackendCompatible SqlBackend backend) =>
Mode
-> (backend, IdentState) -> SqlQuery a -> (Builder, [PersistValue])
toRawSql Mode
INSERT_INTO (backend
conn, IdentState
initialIdentState) SqlQuery (SqlExpr (Insertion val))
query)
            (backend -> (Builder, [PersistValue])
conflict backend
conn)
  where
    proxy :: Proxy val
    proxy :: Proxy val
proxy = forall {k} (t :: k). Proxy t
Proxy
    updates :: [SqlExpr (Entity val) -> SqlExpr Update]
updates = SqlExpr (Entity val)
-> SqlExpr (Entity val) -> [SqlExpr (Entity val) -> SqlExpr Update]
conflictQuery SqlExpr (Entity val)
entCurrent SqlExpr (Entity val)
entExcluded
    combine :: (Builder, [a]) -> (Builder, [a]) -> (Text, [a])
combine (Builder
tlb1,[a]
vals1) (Builder
tlb2,[a]
vals2) = (Builder -> Text
builderToText (Builder
tlb1 forall a. Monoid a => a -> a -> a
`mappend` Builder
tlb2), [a]
vals1 forall a. [a] -> [a] -> [a]
++ [a]
vals2)
    entExcluded :: SqlExpr (Entity val)
entExcluded = forall ent. PersistEntity ent => Ident -> SqlExpr (Entity ent)
unsafeSqlEntity (Text -> Ident
I Text
"excluded")
    tableName :: proxy val -> Text
tableName = EntityNameDB -> Text
unEntityNameDB forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityDef -> EntityNameDB
getEntityDBName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef
    entCurrent :: SqlExpr (Entity val)
entCurrent = forall ent. PersistEntity ent => Ident -> SqlExpr (Entity ent)
unsafeSqlEntity (Text -> Ident
I (forall {proxy :: * -> *}. proxy val -> Text
tableName Proxy val
proxy))
    uniqueDef :: UniqueDef
uniqueDef = forall a val.
(KnowResult a ~ Unique val, PersistEntity val, FinalResult a) =>
a -> UniqueDef
toUniqueDef a
unique
    constraint :: Builder
constraint = Text -> Builder
TLB.fromText forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstraintNameDB -> Text
unConstraintNameDB forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniqueDef -> ConstraintNameDB
uniqueDBName forall a b. (a -> b) -> a -> b
$ UniqueDef
uniqueDef
    renderedUpdates :: (BackendCompatible SqlBackend backend) => backend -> (TLB.Builder, [PersistValue])
    renderedUpdates :: BackendCompatible SqlBackend backend =>
backend -> (Builder, [PersistValue])
renderedUpdates backend
conn = forall backend val.
BackendCompatible SqlBackend backend =>
backend
-> [SqlExpr (Entity val) -> SqlExpr Update]
-> (Builder, [PersistValue])
renderUpdates backend
conn [SqlExpr (Entity val) -> SqlExpr Update]
updates
    conflict :: backend -> (Builder, [PersistValue])
conflict backend
conn = (forall a. Monoid a => [a] -> a
mconcat ([
        Text -> Builder
TLB.fromText Text
"ON CONFLICT ON CONSTRAINT \"",
        Builder
constraint,
        Text -> Builder
TLB.fromText Text
"\" DO "
      ] forall a. [a] -> [a] -> [a]
++ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SqlExpr (Entity val) -> SqlExpr Update]
updates then [Text -> Builder
TLB.fromText Text
"NOTHING"] else [
        Text -> Builder
TLB.fromText Text
"UPDATE SET ",
        Builder
updatesTLB
      ]),[PersistValue]
values')
      where
        (Builder
updatesTLB,[PersistValue]
values') = BackendCompatible SqlBackend backend =>
backend -> (Builder, [PersistValue])
renderedUpdates backend
conn

-- | Allow aggregate functions to take a filter clause.
--
-- Example of usage:
--
-- @
-- share [mkPersist sqlSettings] [persistLowerCase|
--   User
--     name Text
--     deriving Eq Show
--   Task
--     userId UserId
--     completed Bool
--     deriving Eq Show
-- |]
--
-- select $ from $ \(users `InnerJoin` tasks) -> do
--   on $ users ^. UserId ==. tasks ^. TaskUserId
--   groupBy $ users ^. UserId
--   return
--    ( users ^. UserId
--    , count (tasks ^. TaskId) `filterWhere` (tasks ^. TaskCompleted ==. val True)
--    , count (tasks ^. TaskId) `filterWhere` (tasks ^. TaskCompleted ==. val False)
--    )
-- @
--
-- @since 3.3.3.3
filterWhere
    :: SqlExpr (Value a)
    -- ^ Aggregate function
    -> SqlExpr (Value Bool)
    -- ^ Filter clause
    -> SqlExpr (Value a)
filterWhere :: forall a.
SqlExpr (Value a) -> SqlExpr (Value Bool) -> SqlExpr (Value a)
filterWhere SqlExpr (Value a)
aggExpr SqlExpr (Value Bool)
clauseExpr = forall a.
SqlExprMeta
-> (NeedParens -> IdentInfo -> (Builder, [PersistValue]))
-> SqlExpr a
ERaw SqlExprMeta
noMeta forall a b. (a -> b) -> a -> b
$ \NeedParens
_ IdentInfo
info ->
    let (Builder
aggBuilder, [PersistValue]
aggValues) = case SqlExpr (Value a)
aggExpr of
            ERaw SqlExprMeta
_ NeedParens -> IdentInfo -> (Builder, [PersistValue])
aggF     -> NeedParens -> IdentInfo -> (Builder, [PersistValue])
aggF NeedParens
Never IdentInfo
info
        (Builder
clauseBuilder, [PersistValue]
clauseValues) = case SqlExpr (Value Bool)
clauseExpr of
            ERaw SqlExprMeta
_ NeedParens -> IdentInfo -> (Builder, [PersistValue])
clauseF  -> NeedParens -> IdentInfo -> (Builder, [PersistValue])
clauseF NeedParens
Never IdentInfo
info
    in ( Builder
aggBuilder forall a. Semigroup a => a -> a -> a
<> Builder
" FILTER (WHERE " forall a. Semigroup a => a -> a -> a
<> Builder
clauseBuilder forall a. Semigroup a => a -> a -> a
<> Builder
")"
       , [PersistValue]
aggValues forall a. Semigroup a => a -> a -> a
<> [PersistValue]
clauseValues
       )


-- | Allows to use `VALUES (..)` in-memory set of values
-- in RHS of `from` expressions. Useful for JOIN's on
-- known values which also can be additionally preprocessed
-- somehow on db side with usage of inner PostgreSQL capabilities.
--
--
-- Example of usage:
--
-- @
-- share [mkPersist sqlSettings] [persistLowerCase|
--   User
--     name Text
--     age Int
--     deriving Eq Show
--
-- select $ do
--  bound :& user <- from $
--      values (   (val (10 :: Int), val ("ten" :: Text))
--            :| [ (val 20, val "twenty")
--               , (val 30, val "thirty") ]
--            )
--      `InnerJoin` table User
--      `on` (\((bound, _boundName) :& user) -> user^.UserAge >=. bound)
--  groupBy bound
--  pure (bound, count @Int $ user^.UserName)
-- @
--
-- @since 3.5.2.3
values :: (ToSomeValues a, Ex.ToAliasReference a, Ex.ToAlias a) => NE.NonEmpty a -> Ex.From a
values :: forall a.
(ToSomeValues a, ToAliasReference a, ToAlias a) =>
NonEmpty a -> From a
values NonEmpty a
exprs = forall a.
SqlQuery (a, NeedParens -> IdentInfo -> (Builder, [PersistValue]))
-> From a
Ex.From forall a b. (a -> b) -> a -> b
$ do
    Ident
ident <- DBName -> SqlQuery Ident
newIdentFor forall a b. (a -> b) -> a -> b
$ Text -> DBName
DBName Text
"vq"
    a
alias <- forall a. ToAlias a => a -> SqlQuery a
Ex.toAlias forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> a
NE.head NonEmpty a
exprs
    a
ref   <- forall a. ToAliasReference a => Ident -> a -> SqlQuery a
Ex.toAliasReference Ident
ident a
alias
    let aliasIdents :: [Ident]
aliasIdents = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\SomeValue
someVal -> case SomeValue
someVal of
            SomeValue (ERaw SqlExprMeta
aliasMeta NeedParens -> IdentInfo -> (Builder, [PersistValue])
_) -> SqlExprMeta -> Maybe Ident
sqlExprMetaAlias SqlExprMeta
aliasMeta
            ) forall a b. (a -> b) -> a -> b
$ forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues a
ref
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
ref, forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Ident -> [Ident] -> IdentInfo -> (Builder, [PersistValue])
mkExpr Ident
ident [Ident]
aliasIdents)
  where
    someValueToSql :: IdentInfo -> SomeValue -> (TLB.Builder, [PersistValue])
    someValueToSql :: IdentInfo -> SomeValue -> (Builder, [PersistValue])
someValueToSql IdentInfo
info (SomeValue SqlExpr (Value a)
expr) = forall a.
IdentInfo -> SqlExpr (Value a) -> (Builder, [PersistValue])
materializeExpr IdentInfo
info SqlExpr (Value a)
expr

    mkValuesRowSql :: IdentInfo -> [SomeValue] -> (TLB.Builder, [PersistValue])
    mkValuesRowSql :: IdentInfo -> [SomeValue] -> (Builder, [PersistValue])
mkValuesRowSql IdentInfo
info [SomeValue]
vs =
        let materialized :: [(Builder, [PersistValue])]
materialized = IdentInfo -> SomeValue -> (Builder, [PersistValue])
someValueToSql IdentInfo
info forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SomeValue]
vs
            valsSql :: [Text]
valsSql = Builder -> Text
TLB.toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Builder, [PersistValue])]
materialized
            params :: [PersistValue]
params = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd [(Builder, [PersistValue])]
materialized
        in (Text -> Builder
TLB.fromLazyText forall a b. (a -> b) -> a -> b
$ Text
"(" forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
TL.intercalate Text
"," [Text]
valsSql forall a. Semigroup a => a -> a -> a
<> Text
")", [PersistValue]
params)

    -- (VALUES (v11, v12,..), (v21, v22,..)) as "vq"("v1", "v2",..)
    mkExpr :: Ident -> [Ident] -> IdentInfo -> (TLB.Builder, [PersistValue])
    mkExpr :: Ident -> [Ident] -> IdentInfo -> (Builder, [PersistValue])
mkExpr Ident
valsIdent [Ident]
colIdents IdentInfo
info =
        let materialized :: [(Builder, [PersistValue])]
materialized = IdentInfo -> [SomeValue] -> (Builder, [PersistValue])
mkValuesRowSql IdentInfo
info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. NonEmpty a -> [a]
NE.toList NonEmpty a
exprs
            (Text
valsSql, [PersistValue]
params) =
                ( Text -> [Text] -> Text
TL.intercalate Text
"," forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Builder -> Text
TLB.toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Builder, [PersistValue])]
materialized
                , forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd [(Builder, [PersistValue])]
materialized
                )
            colsAliases :: Text
colsAliases = Text -> [Text] -> Text
TL.intercalate Text
"," (forall a b. (a -> b) -> [a] -> [b]
map (Builder -> Text
TLB.toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentInfo -> Ident -> Builder
useIdent IdentInfo
info) [Ident]
colIdents)
        in
            ( Builder
"(VALUES " forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TLB.fromLazyText Text
valsSql forall a. Semigroup a => a -> a -> a
<> Builder
") AS "
            forall a. Semigroup a => a -> a -> a
<> IdentInfo -> Ident -> Builder
useIdent IdentInfo
info Ident
valsIdent
            forall a. Semigroup a => a -> a -> a
<> Builder
"(" forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TLB.fromLazyText Text
colsAliases forall a. Semigroup a => a -> a -> a
<> Builder
")"
            , [PersistValue]
params
            )

-- | `NO WAIT` syntax for postgres locking
-- error will be thrown if locked rows are attempted to be selected
--
-- @since 3.5.9.0
noWait :: OnLockedBehavior
noWait :: OnLockedBehavior
noWait = OnLockedBehavior
NoWait

-- | `SKIP LOCKED` syntax for postgres locking
-- locked rows will be skipped
--
-- @since 3.5.9.0
skipLocked :: OnLockedBehavior
skipLocked :: OnLockedBehavior
skipLocked = OnLockedBehavior
SkipLocked

-- | default behaviour of postgres locks. will attempt to wait for locks to expire
--
-- @since 3.5.9.0
wait :: OnLockedBehavior
wait :: OnLockedBehavior
wait = OnLockedBehavior
Wait

-- | `FOR UPDATE OF` syntax for postgres locking
-- allows locking of specific tables with an update lock in a view or join
--
-- @since 3.5.9.0
forUpdateOf :: LockableEntity a => a -> OnLockedBehavior -> SqlQuery ()
forUpdateOf :: forall a. LockableEntity a => a -> OnLockedBehavior -> SqlQuery ()
forUpdateOf a
lockableEntities OnLockedBehavior
onLockedBehavior =
  LockingClause -> SqlQuery ()
putLocking forall a b. (a -> b) -> a -> b
$ [PostgresLockingKind] -> LockingClause
PostgresLockingClauses [PostgresRowLevelLockStrength
-> Maybe LockingOfClause -> OnLockedBehavior -> PostgresLockingKind
PostgresLockingKind PostgresRowLevelLockStrength
PostgresForUpdate (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. LockableEntity a => a -> LockingOfClause
LockingOfClause a
lockableEntities) OnLockedBehavior
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 :: forall a. LockableEntity a => a -> OnLockedBehavior -> SqlQuery ()
forShareOf a
lockableEntities OnLockedBehavior
onLockedBehavior =
  LockingClause -> SqlQuery ()
putLocking forall a b. (a -> b) -> a -> b
$ [PostgresLockingKind] -> LockingClause
PostgresLockingClauses [PostgresRowLevelLockStrength
-> Maybe LockingOfClause -> OnLockedBehavior -> PostgresLockingKind
PostgresLockingKind PostgresRowLevelLockStrength
PostgresForShare (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. LockableEntity a => a -> LockingOfClause
LockingOfClause a
lockableEntities) OnLockedBehavior
onLockedBehavior]