{-# 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
    , upsertMaybe
    , upsertBy
    , upsertMaybeBy
    , insertSelectWithConflict
    , insertSelectWithConflictCount
    , noWait
    , wait
    , skipLocked
    , forUpdateOf
    , forNoKeyUpdateOf
    , forShare
    , forShareOf
    , forKeyShareOf
    , filterWhere
    , values
    , ilike
    , distinctOn
    , distinctOnOrderBy
    , withMaterialized
    , withNotMaterialized
    , ascNullsFirst
    , ascNullsLast
    , descNullsFirst
    , descNullsLast
    -- * Internal
    , unsafeSqlAggregateFunction
    ) where

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 qualified Control.Monad.Trans.Writer as W
import Data.Int (Int64)
import qualified Data.List.NonEmpty as NE
import Data.Maybe
import Data.Proxy (Proxy(..))
import qualified Data.Text as Text
import qualified Data.Text.Internal.Builder as TLB
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TLB
import Data.Time.Clock (UTCTime)
import qualified Database.Esqueleto.Experimental as Ex
import qualified Database.Esqueleto.Experimental.From as Ex
import Database.Esqueleto.Experimental.From.CommonTableExpression
import Database.Esqueleto.Experimental.From.SqlSetOperation
import Database.Esqueleto.Experimental.ToAlias
import Database.Esqueleto.Experimental.ToAliasReference
import Database.Esqueleto.Internal.Internal hiding
       (From(..), ilike, distinctOn, distinctOnOrderBy, from, on, random_)
import Database.Esqueleto.Internal.PersistentImport hiding
       (uniqueFields, upsert, upsertBy)
import Database.Persist (ConstraintNameDB(..), EntityNameDB(..))
import Database.Persist.Class (OnlyOneUniqueKey)
import Database.Persist.SqlBackend
import GHC.Stack

-- | (@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_ = Builder -> SqlExpr (Value a)
forall a. Builder -> SqlExpr (Value a)
unsafeSqlValue Builder
"RANDOM()"

-- | @DISTINCT ON@.  Change the current @SELECT@ into
-- @SELECT DISTINCT ON (SqlExpressions)@.  For example:
--
-- @
-- select $ do
--   foo <- 'from' $ table \@Foo
--   'distinctOn' ['don' (foo ^. FooName), 'don' (foo ^. FooState)]
--   pure foo
-- @
--
-- You can also chain different calls to 'distinctOn'.  The
-- above is equivalent to:
--
-- @
-- select $ do
--   foo <- 'from' $ table \@Foo
--   'distinctOn' ['don' (foo ^. FooName)]
--   'distinctOn' ['don' (foo ^. FooState)]
--   pure foo
-- @
--
-- Each call to 'distinctOn' adds more SqlExpressions.  Calls to
-- 'distinctOn' override any calls to 'distinct'.
--
-- Note that PostgreSQL requires the SqlExpressions on @DISTINCT
-- ON@ to be the first ones to appear on a @ORDER BY@.  This is
-- not managed automatically by esqueleto, keeping its spirit
-- of trying to be close to raw SQL.
--
-- @since 3.6.0
distinctOn :: [SqlExpr DistinctOn] -> SqlQuery ()
distinctOn :: [SqlExpr DistinctOn] -> SqlQuery ()
distinctOn [SqlExpr DistinctOn]
exprs = WriterT SideData (State IdentState) () -> SqlQuery ()
forall a. WriterT SideData (State IdentState) a -> SqlQuery a
Q (SideData -> WriterT SideData (State IdentState) ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
W.tell SideData
forall a. Monoid a => a
mempty { sdDistinctClause = DistinctOn exprs })

-- | A convenience function that calls both 'distinctOn' and
-- 'orderBy'.  In other words,
--
-- @
-- 'distinctOnOrderBy' [asc foo, desc bar, desc quux]
-- @
--
-- is the same as:
--
-- @
-- 'distinctOn' [don foo, don  bar, don  quux]
-- 'orderBy'  [asc foo, desc bar, desc quux]
--   ...
-- @
--
-- @since 3.6.0.0
distinctOnOrderBy :: [SqlExpr OrderBy] -> SqlQuery ()
distinctOnOrderBy :: [SqlExpr OrderBy] -> SqlQuery ()
distinctOnOrderBy [SqlExpr OrderBy]
exprs = do
    [SqlExpr DistinctOn] -> SqlQuery ()
distinctOn (SqlExpr OrderBy -> SqlExpr DistinctOn
toDistinctOn (SqlExpr OrderBy -> SqlExpr DistinctOn)
-> [SqlExpr OrderBy] -> [SqlExpr DistinctOn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SqlExpr OrderBy]
exprs)
    [SqlExpr OrderBy] -> SqlQuery ()
orderBy [SqlExpr OrderBy]
exprs
  where
    toDistinctOn :: SqlExpr OrderBy -> SqlExpr DistinctOn
    toDistinctOn :: SqlExpr OrderBy -> SqlExpr DistinctOn
toDistinctOn (ERaw SqlExprMeta
m NeedParens -> IdentInfo -> (Builder, [PersistValue])
f) = SqlExprMeta
-> (NeedParens -> IdentInfo -> (Builder, [PersistValue]))
-> SqlExpr DistinctOn
forall a.
SqlExprMeta
-> (NeedParens -> IdentInfo -> (Builder, [PersistValue]))
-> SqlExpr a
ERaw SqlExprMeta
m ((NeedParens -> IdentInfo -> (Builder, [PersistValue]))
 -> SqlExpr DistinctOn)
-> (NeedParens -> IdentInfo -> (Builder, [PersistValue]))
-> SqlExpr DistinctOn
forall a b. (a -> b) -> a -> b
$ \NeedParens
p IdentInfo
info ->
        let (Builder
b, [PersistValue]
vals) = NeedParens -> IdentInfo -> (Builder, [PersistValue])
f NeedParens
p IdentInfo
info
        in  ( Text -> Builder
TLB.fromLazyText
              (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
TL.replace Text
" DESC" Text
""
              (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
TL.replace Text
" ASC" Text
""
              (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Builder -> Text
TLB.toLazyText Builder
b
            , [PersistValue]
vals )

-- | Empty array literal. (@val []@) does unfortunately not work
emptyArray :: SqlExpr (Value [a])
emptyArray :: forall a. SqlExpr (Value [a])
emptyArray = Builder -> SqlExpr (Value [a])
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 = [SqlExpr (Value (Maybe [a]))]
-> SqlExpr (Value [a]) -> SqlExpr (Value [a])
forall a.
PersistField a =>
[SqlExpr (Value (Maybe a))]
-> SqlExpr (Value a) -> SqlExpr (Value a)
coalesceDefault [SqlExpr (Value (Maybe [a]))
x] (SqlExpr (Value [a])
forall a. SqlExpr (Value [a])
emptyArray)

-- | Aggregate mode
data AggMode
    = AggModeAll -- ^ ALL
    | AggModeDistinct -- ^ DISTINCT
    deriving (Int -> AggMode -> ShowS
[AggMode] -> ShowS
AggMode -> String
(Int -> AggMode -> ShowS)
-> (AggMode -> String) -> ([AggMode] -> ShowS) -> Show AggMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AggMode -> ShowS
showsPrec :: Int -> AggMode -> ShowS
$cshow :: AggMode -> String
show :: AggMode -> String
$cshowList :: [AggMode] -> ShowS
showList :: [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 -> [SqlExpr OrderBy] -> SqlExpr (Value b)
unsafeSqlAggregateFunction Builder
name AggMode
mode a
args [SqlExpr OrderBy]
orderByClauses = SqlExprMeta
-> (NeedParens -> IdentInfo -> (Builder, [PersistValue]))
-> SqlExpr (Value b)
forall a.
SqlExprMeta
-> (NeedParens -> IdentInfo -> (Builder, [PersistValue]))
-> SqlExpr a
ERaw SqlExprMeta
noMeta ((NeedParens -> IdentInfo -> (Builder, [PersistValue]))
 -> SqlExpr (Value b))
-> (NeedParens -> IdentInfo -> (Builder, [PersistValue]))
-> SqlExpr (Value b)
forall a b. (a -> b) -> a -> b
$ \NeedParens
_ IdentInfo
info ->
    let (Builder
orderTLB, [PersistValue]
orderVals) = IdentInfo -> [SqlExpr OrderBy] -> (Builder, [PersistValue])
makeOrderByNoNewline IdentInfo
info [SqlExpr OrderBy]
orderByClauses
        -- Don't add a space if we don't have order by clauses
        orderTLBSpace :: Builder
orderTLBSpace =
            case [SqlExpr OrderBy]
orderByClauses of
                []    -> Builder
""
                (SqlExpr OrderBy
_:[SqlExpr OrderBy]
_) -> Builder
" "
        (Builder
argsTLB, [PersistValue]
argsVals) =
            [(Builder, [PersistValue])] -> (Builder, [PersistValue])
forall a. Monoid a => [(Builder, a)] -> (Builder, a)
uncommas' ([(Builder, [PersistValue])] -> (Builder, [PersistValue]))
-> [(Builder, [PersistValue])] -> (Builder, [PersistValue])
forall a b. (a -> b) -> a -> b
$ (SqlExpr (Value ()) -> (Builder, [PersistValue]))
-> [SqlExpr (Value ())] -> [(Builder, [PersistValue])]
forall a b. (a -> b) -> [a] -> [b]
map (\(ERaw SqlExprMeta
_ NeedParens -> IdentInfo -> (Builder, [PersistValue])
f) -> NeedParens -> IdentInfo -> (Builder, [PersistValue])
f NeedParens
Never IdentInfo
info) ([SqlExpr (Value ())] -> [(Builder, [PersistValue])])
-> [SqlExpr (Value ())] -> [(Builder, [PersistValue])]
forall a b. (a -> b) -> a -> b
$ a -> [SqlExpr (Value ())]
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 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
parens (Builder
aggMode Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
argsTLB Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
orderTLBSpace Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
orderTLB)
       , [PersistValue]
argsVals [PersistValue] -> [PersistValue] -> [PersistValue]
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)
-> [SqlExpr OrderBy]
-> SqlExpr (Value (Maybe [a]))
arrayAggWith = Builder
-> AggMode
-> SqlExpr (Value a)
-> [SqlExpr OrderBy]
-> SqlExpr (Value (Maybe [a]))
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> AggMode -> a -> [SqlExpr OrderBy] -> 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 = AggMode
-> SqlExpr (Value a)
-> [SqlExpr OrderBy]
-> SqlExpr (Value (Maybe [a]))
forall a.
AggMode
-> SqlExpr (Value a)
-> [SqlExpr OrderBy]
-> 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 = AggMode
-> SqlExpr (Value a)
-> [SqlExpr OrderBy]
-> SqlExpr (Value (Maybe [a]))
forall a.
AggMode
-> SqlExpr (Value a)
-> [SqlExpr OrderBy]
-> 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' = Builder
-> (SqlExpr (Value [a]), SqlExpr (Value a)) -> SqlExpr (Value [a])
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 = Builder
-> (SqlExpr (Value [Maybe a]), SqlExpr (Value Any))
-> SqlExpr (Value [a])
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"array_remove" (SqlExpr (Value [Maybe a])
x, Builder -> SqlExpr (Value Any)
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)
-> [SqlExpr OrderBy]
-> SqlExpr (Value (Maybe s))
stringAggWith AggMode
mode SqlExpr (Value s)
expr SqlExpr (Value s)
delim [SqlExpr OrderBy]
os =
  Builder
-> AggMode
-> (SqlExpr (Value s), SqlExpr (Value s))
-> [SqlExpr OrderBy]
-> SqlExpr (Value (Maybe s))
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> AggMode -> a -> [SqlExpr OrderBy] -> SqlExpr (Value b)
unsafeSqlAggregateFunction Builder
"string_agg" AggMode
mode (SqlExpr (Value s)
expr, SqlExpr (Value s)
delim) [SqlExpr OrderBy]
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 = AggMode
-> SqlExpr (Value s)
-> SqlExpr (Value s)
-> [SqlExpr OrderBy]
-> SqlExpr (Value (Maybe s))
forall s.
SqlString s =>
AggMode
-> SqlExpr (Value s)
-> SqlExpr (Value s)
-> [SqlExpr OrderBy]
-> 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 = Builder -> SqlExpr (Value Int) -> SqlExpr (Value s)
forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> a -> SqlExpr (Value b)
unsafeSqlFunction Builder
"chr"

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

-- | Perform an @upsert@ operation on the given record.
--
-- If the record exists in the database already, then the updates will be
-- performed on that record. If the record does not exist, then the
-- provided record will be inserted.
--
-- If you wish to provide an empty list of updates (ie "if the record
-- exists, do nothing"), then you will need to call 'upsertMaybe'. Postgres
-- will not return anything if there are no modifications or inserts made.
upsert
    ::
    ( MonadIO m
    , PersistEntity record
    , OnlyOneUniqueKey record
    , PersistRecordBackend record SqlBackend
    , IsPersistBackend (PersistEntityBackend record)
    )
    => record
    -- ^ new record to insert
    -> NE.NonEmpty (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
-> NonEmpty (SqlExpr (Entity record) -> SqlExpr Update)
-> ReaderT SqlBackend m (Entity record)
upsert record
record =
    Unique record
-> record
-> NonEmpty (SqlExpr (Entity record) -> SqlExpr Update)
-> ReaderT SqlBackend m (Entity record)
forall (m :: * -> *) record.
(MonadIO m, PersistEntity record,
 IsPersistBackend (PersistEntityBackend record), HasCallStack) =>
Unique record
-> record
-> NonEmpty (SqlExpr (Entity record) -> SqlExpr Update)
-> ReaderT SqlBackend m (Entity record)
upsertBy (record -> Unique record
forall record. OnlyOneUniqueKey record => record -> Unique record
onlyUniqueP record
record) record
record

-- | Like 'upsert', but permits an empty list of updates to be performed.
--
-- If no updates are provided and the record already was present in the
-- database, then this will return 'Nothing'. If you want to fetch the
-- record out of the database, you can write:
--
-- @
--  mresult <- upsertMaybe record []
--  case mresult of
--      Nothing ->
--          'getBy' ('onlyUniqueP' record)
--      Just res ->
--          pure (Just res)
-- @
--
-- @since 3.6.0.0
upsertMaybe
    ::
    ( 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 (Maybe (Entity record))
    -- ^ the record in the database after the operation
upsertMaybe :: forall (m :: * -> *) record.
(MonadIO m, PersistEntity record, OnlyOneUniqueKey record,
 PersistRecordBackend record SqlBackend,
 IsPersistBackend (PersistEntityBackend record)) =>
record
-> [SqlExpr (Entity record) -> SqlExpr Update]
-> ReaderT SqlBackend m (Maybe (Entity record))
upsertMaybe record
rec [SqlExpr (Entity record) -> SqlExpr Update]
upds = do
    Unique record
-> record
-> [SqlExpr (Entity record) -> SqlExpr Update]
-> ReaderT SqlBackend m (Maybe (Entity record))
forall (m :: * -> *) record.
(MonadIO m, PersistEntity record,
 IsPersistBackend (PersistEntityBackend record)) =>
Unique record
-> record
-> [SqlExpr (Entity record) -> SqlExpr Update]
-> ReaderT SqlBackend m (Maybe (Entity record))
upsertMaybeBy (record -> Unique record
forall record. OnlyOneUniqueKey record => record -> Unique record
onlyUniqueP record
rec) record
rec [SqlExpr (Entity record) -> SqlExpr Update]
upds

-- | Attempt to insert a @record@ into the database. If the @record@
-- already exists for the given @'Unique' record@, then a list of updates
-- will be performed.
--
-- If you provide an empty list of updates, then this function will return
-- 'Nothing' if the record already exists in the database.
--
-- @since 3.6.0.0
upsertMaybeBy
    ::
    ( 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 (Maybe (Entity record))
    -- ^ the record in the database after the operation
upsertMaybeBy :: forall (m :: * -> *) record.
(MonadIO m, PersistEntity record,
 IsPersistBackend (PersistEntityBackend record)) =>
Unique record
-> record
-> [SqlExpr (Entity record) -> SqlExpr Update]
-> ReaderT SqlBackend m (Maybe (Entity record))
upsertMaybeBy Unique record
uniqueKey record
record [SqlExpr (Entity record) -> SqlExpr Update]
updates = do
    SqlBackend
sqlB <- ReaderT SqlBackend m SqlBackend
forall (m :: * -> *) r. Monad m => ReaderT r m r
R.ask
    case SqlBackend
-> Maybe
     (EntityDef -> NonEmpty (FieldNameHS, FieldNameDB) -> Text -> Text)
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
            EsqueletoError -> ReaderT SqlBackend m (Maybe (Entity record))
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 (Maybe (Entity record))
handler SqlBackend
sqlB EntityDef -> NonEmpty (FieldNameHS, FieldNameDB) -> Text -> Text
upsertSql
  where
    addVals :: [PersistValue] -> [PersistValue]
addVals [PersistValue]
l =
        (PersistValue -> PersistValue) -> [PersistValue] -> [PersistValue]
forall a b. (a -> b) -> [a] -> [b]
map PersistValue -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (record -> [PersistValue]
forall record. PersistEntity record => record -> [PersistValue]
toPersistFields record
record) [PersistValue] -> [PersistValue] -> [PersistValue]
forall a. [a] -> [a] -> [a]
++ [PersistValue]
l [PersistValue] -> [PersistValue] -> [PersistValue]
forall a. [a] -> [a] -> [a]
++ case [SqlExpr (Entity record) -> SqlExpr Update]
updates of
            [] ->
                []
            [SqlExpr (Entity record) -> SqlExpr Update]
_ ->
                Unique record -> [PersistValue]
forall record.
PersistEntity record =>
Unique record -> [PersistValue]
persistUniqueToValues Unique record
uniqueKey
    entDef :: EntityDef
entDef =
        Maybe record -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
forall (proxy :: * -> *). proxy record -> EntityDef
entityDef (record -> Maybe record
forall a. a -> Maybe a
Just record
record)
    updatesText :: SqlBackend -> (Text, [PersistValue])
updatesText SqlBackend
conn =
        (Builder -> Text)
-> (Builder, [PersistValue]) -> (Text, [PersistValue])
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Builder -> Text
builderToText ((Builder, [PersistValue]) -> (Text, [PersistValue]))
-> (Builder, [PersistValue]) -> (Text, [PersistValue])
forall a b. (a -> b) -> a -> b
$ SqlBackend
-> [SqlExpr (Entity record) -> SqlExpr Update]
-> (Builder, [PersistValue])
forall backend val.
BackendCompatible SqlBackend backend =>
backend
-> [SqlExpr (Entity val) -> SqlExpr Update]
-> (Builder, [PersistValue])
renderUpdates SqlBackend
conn [SqlExpr (Entity record) -> SqlExpr Update]
updates
    uniqueFields :: NonEmpty (FieldNameHS, FieldNameDB)
uniqueFields = Unique record -> NonEmpty (FieldNameHS, FieldNameDB)
forall record.
PersistEntity record =>
Unique record -> NonEmpty (FieldNameHS, FieldNameDB)
persistUniqueToFieldNames Unique record
uniqueKey
    handler :: SqlBackend
-> (EntityDef
    -> NonEmpty (FieldNameHS, FieldNameDB) -> Text -> Text)
-> ReaderT SqlBackend m (Maybe (Entity record))
handler SqlBackend
sqlB EntityDef -> NonEmpty (FieldNameHS, FieldNameDB) -> Text -> Text
upsertSql = do
        let (Text
updateText, [PersistValue]
updateVals) =
                SqlBackend -> (Text, [PersistValue])
updatesText SqlBackend
sqlB
            queryTextUnmodified :: Text
queryTextUnmodified =
                EntityDef -> NonEmpty (FieldNameHS, FieldNameDB) -> Text -> Text
upsertSql EntityDef
entDef NonEmpty (FieldNameHS, FieldNameDB)
uniqueFields Text
updateText
            queryText :: Text
queryText =
                case [SqlExpr (Entity record) -> SqlExpr Update]
updates of
                    [] ->
                        let
                            (Text
okay, Text
_bad) =
                                HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
Text.breakOn Text
"DO UPDATE" Text
queryTextUnmodified
                            good :: Text
good =
                                Text
okay Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"DO NOTHING RETURNING ??"
                        in
                            Text
good
                    [SqlExpr (Entity record) -> SqlExpr Update]
_ ->
                        Text
queryTextUnmodified

            queryVals :: [PersistValue]
queryVals =
                [PersistValue] -> [PersistValue]
addVals [PersistValue]
updateVals
        [Entity record]
xs <- Text -> [PersistValue] -> ReaderT SqlBackend m [Entity record]
forall a (m :: * -> *) backend.
(RawSql a, MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m [a]
rawSql Text
queryText [PersistValue]
queryVals
        Maybe (Entity record)
-> ReaderT SqlBackend m (Maybe (Entity record))
forall a. a -> ReaderT SqlBackend m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Entity record] -> Maybe (Entity record)
forall a. [a] -> Maybe a
listToMaybe [Entity record]
xs)

upsertBy
    ::
    ( MonadIO m
    , PersistEntity record
    , IsPersistBackend (PersistEntityBackend record)
    , HasCallStack
    )
    => Unique record
    -- ^ uniqueness constraint to find by
    -> record
    -- ^ new record to insert
    -> NE.NonEmpty (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), HasCallStack) =>
Unique record
-> record
-> NonEmpty (SqlExpr (Entity record) -> SqlExpr Update)
-> ReaderT SqlBackend m (Entity record)
upsertBy Unique record
uniqueKey record
record NonEmpty (SqlExpr (Entity record) -> SqlExpr Update)
updates = do
    Maybe (Entity record)
mrec <- Unique record
-> record
-> [SqlExpr (Entity record) -> SqlExpr Update]
-> ReaderT SqlBackend m (Maybe (Entity record))
forall (m :: * -> *) record.
(MonadIO m, PersistEntity record,
 IsPersistBackend (PersistEntityBackend record)) =>
Unique record
-> record
-> [SqlExpr (Entity record) -> SqlExpr Update]
-> ReaderT SqlBackend m (Maybe (Entity record))
upsertMaybeBy Unique record
uniqueKey record
record (NonEmpty (SqlExpr (Entity record) -> SqlExpr Update)
-> [SqlExpr (Entity record) -> SqlExpr Update]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (SqlExpr (Entity record) -> SqlExpr Update)
updates)
    case Maybe (Entity record)
mrec of
        Maybe (Entity record)
Nothing ->
            String -> ReaderT SqlBackend m (Entity record)
forall a. HasCallStack => String -> a
error String
"non-empty list of updates should have resulted in a row being returned"
        Just Entity record
rec ->
            Entity record -> ReaderT SqlBackend m (Entity record)
forall a. a -> ReaderT SqlBackend m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Entity record
rec

-- | 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:
--
-- @
-- 'mkPersist' 'sqlSettings' ['persistLowerCase'|
--   Bar
--     num Int
--     deriving Eq Show
--   Foo
--     num Int
--     UniqueFoo num
--     deriving Eq Show
-- |]
--
-- action = do
--     'insertSelectWithConflict'
--         UniqueFoo -- (UniqueFoo undefined) or (UniqueFoo anyNumber) would also work
--         (do
--             b <- from $ table \@Bar
--             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 =
    ReaderT backend m Int64 -> ReaderT backend m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT backend m Int64 -> ReaderT backend m ())
-> ReaderT backend m Int64 -> ReaderT backend m ()
forall a b. (a -> b) -> a -> b
$ a
-> SqlQuery (SqlExpr (Insertion val))
-> (SqlExpr (Entity val)
    -> SqlExpr (Entity val)
    -> [SqlExpr (Entity val) -> SqlExpr Update])
-> ReaderT backend m Int64
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 <- ReaderT backend m backend
forall (m :: * -> *) r. Monad m => ReaderT r m r
R.ask
    (Text -> [PersistValue] -> ReaderT backend m Int64)
-> (Text, [PersistValue]) -> ReaderT backend m Int64
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> [PersistValue] -> ReaderT backend m Int64
forall (m :: * -> *) backend.
(MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m Int64
rawExecuteCount ((Text, [PersistValue]) -> ReaderT backend m Int64)
-> (Text, [PersistValue]) -> ReaderT backend m Int64
forall a b. (a -> b) -> a -> b
$
        (Builder, [PersistValue])
-> (Builder, [PersistValue]) -> (Text, [PersistValue])
forall {a}. (Builder, [a]) -> (Builder, [a]) -> (Text, [a])
combine
            (Mode
-> (backend, IdentState)
-> SqlQuery (SqlExpr (Insertion val))
-> (Builder, [PersistValue])
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 = Proxy val
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 Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
tlb2), [a]
vals1 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
vals2)
    entExcluded :: SqlExpr (Entity val)
entExcluded = Ident -> SqlExpr (Entity val)
forall ent. PersistEntity ent => Ident -> SqlExpr (Entity ent)
unsafeSqlEntity (Text -> Ident
I Text
"excluded")
    tableName :: proxy val -> Text
tableName = EntityNameDB -> Text
unEntityNameDB (EntityNameDB -> Text)
-> (proxy val -> EntityNameDB) -> proxy val -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityDef -> EntityNameDB
getEntityDBName (EntityDef -> EntityNameDB)
-> (proxy val -> EntityDef) -> proxy val -> EntityNameDB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. proxy val -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
forall (proxy :: * -> *). proxy val -> EntityDef
entityDef
    entCurrent :: SqlExpr (Entity val)
entCurrent = Ident -> SqlExpr (Entity val)
forall ent. PersistEntity ent => Ident -> SqlExpr (Entity ent)
unsafeSqlEntity (Text -> Ident
I (Proxy val -> Text
forall {proxy :: * -> *}. proxy val -> Text
tableName Proxy val
proxy))
    uniqueDef :: UniqueDef
uniqueDef = a -> UniqueDef
forall a val.
(KnowResult a ~ Unique val, PersistEntity val, FinalResult a) =>
a -> UniqueDef
toUniqueDef a
unique
    constraint :: Builder
constraint = Text -> Builder
TLB.fromText (Text -> Builder) -> (UniqueDef -> Text) -> UniqueDef -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstraintNameDB -> Text
unConstraintNameDB (ConstraintNameDB -> Text)
-> (UniqueDef -> ConstraintNameDB) -> UniqueDef -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniqueDef -> ConstraintNameDB
uniqueDBName (UniqueDef -> Builder) -> UniqueDef -> Builder
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 = backend
-> [SqlExpr (Entity val) -> SqlExpr Update]
-> (Builder, [PersistValue])
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 = ([Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([
        Text -> Builder
TLB.fromText Text
"ON CONFLICT ON CONSTRAINT \"",
        Builder
constraint,
        Text -> Builder
TLB.fromText Text
"\" DO "
      ] [Builder] -> [Builder] -> [Builder]
forall a. [a] -> [a] -> [a]
++ if [SqlExpr (Entity val) -> SqlExpr Update] -> Bool
forall a. [a] -> Bool
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') = backend -> (Builder, [PersistValue])
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 = SqlExprMeta
-> (NeedParens -> IdentInfo -> (Builder, [PersistValue]))
-> SqlExpr (Value a)
forall a.
SqlExprMeta
-> (NeedParens -> IdentInfo -> (Builder, [PersistValue]))
-> SqlExpr a
ERaw SqlExprMeta
noMeta ((NeedParens -> IdentInfo -> (Builder, [PersistValue]))
 -> SqlExpr (Value a))
-> (NeedParens -> IdentInfo -> (Builder, [PersistValue]))
-> SqlExpr (Value a)
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 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" FILTER (WHERE " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
clauseBuilder Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"
       , [PersistValue]
aggValues [PersistValue] -> [PersistValue] -> [PersistValue]
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 = SqlQuery (a, NeedParens -> IdentInfo -> (Builder, [PersistValue]))
-> From a
forall a.
SqlQuery (a, NeedParens -> IdentInfo -> (Builder, [PersistValue]))
-> From a
Ex.From (SqlQuery (a, NeedParens -> IdentInfo -> (Builder, [PersistValue]))
 -> From a)
-> SqlQuery
     (a, NeedParens -> IdentInfo -> (Builder, [PersistValue]))
-> From a
forall a b. (a -> b) -> a -> b
$ do
    Ident
ident <- DBName -> SqlQuery Ident
newIdentFor (DBName -> SqlQuery Ident) -> DBName -> SqlQuery Ident
forall a b. (a -> b) -> a -> b
$ Text -> DBName
DBName Text
"vq"
    a
alias <- a -> SqlQuery a
forall a. ToAlias a => a -> SqlQuery a
Ex.toAlias (a -> SqlQuery a) -> a -> SqlQuery a
forall a b. (a -> b) -> a -> b
$ NonEmpty a -> a
forall a. NonEmpty a -> a
NE.head NonEmpty a
exprs
    a
ref   <- Ident -> a -> SqlQuery a
forall a. ToAliasReference a => Ident -> a -> SqlQuery a
Ex.toAliasReference Ident
ident a
alias
    let aliasIdents :: [Ident]
aliasIdents = (SomeValue -> Maybe Ident) -> [SomeValue] -> [Ident]
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
            ) ([SomeValue] -> [Ident]) -> [SomeValue] -> [Ident]
forall a b. (a -> b) -> a -> b
$ a -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues a
ref
    (a, NeedParens -> IdentInfo -> (Builder, [PersistValue]))
-> SqlQuery
     (a, NeedParens -> IdentInfo -> (Builder, [PersistValue]))
forall a. a -> SqlQuery a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
ref, (IdentInfo -> (Builder, [PersistValue]))
-> NeedParens -> IdentInfo -> (Builder, [PersistValue])
forall a b. a -> b -> a
const ((IdentInfo -> (Builder, [PersistValue]))
 -> NeedParens -> IdentInfo -> (Builder, [PersistValue]))
-> (IdentInfo -> (Builder, [PersistValue]))
-> NeedParens
-> IdentInfo
-> (Builder, [PersistValue])
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) = IdentInfo -> SqlExpr (Value a) -> (Builder, [PersistValue])
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 (SomeValue -> (Builder, [PersistValue]))
-> [SomeValue] -> [(Builder, [PersistValue])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SomeValue]
vs
            valsSql :: [Text]
valsSql = Builder -> Text
TLB.toLazyText (Builder -> Text)
-> ((Builder, [PersistValue]) -> Builder)
-> (Builder, [PersistValue])
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder, [PersistValue]) -> Builder
forall a b. (a, b) -> a
fst ((Builder, [PersistValue]) -> Text)
-> [(Builder, [PersistValue])] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Builder, [PersistValue])]
materialized
            params :: [PersistValue]
params = ((Builder, [PersistValue]) -> [PersistValue])
-> [(Builder, [PersistValue])] -> [PersistValue]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Builder, [PersistValue]) -> [PersistValue]
forall a b. (a, b) -> b
snd [(Builder, [PersistValue])]
materialized
        in (Text -> Builder
TLB.fromLazyText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
TL.intercalate Text
"," [Text]
valsSql Text -> Text -> Text
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 ([SomeValue] -> (Builder, [PersistValue]))
-> (a -> [SomeValue]) -> a -> (Builder, [PersistValue])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [SomeValue]
forall a. ToSomeValues a => a -> [SomeValue]
toSomeValues (a -> (Builder, [PersistValue]))
-> [a] -> [(Builder, [PersistValue])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty a
exprs
            (Text
valsSql, [PersistValue]
params) =
                ( Text -> [Text] -> Text
TL.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ((Builder, [PersistValue]) -> Text)
-> [(Builder, [PersistValue])] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Builder -> Text
TLB.toLazyText (Builder -> Text)
-> ((Builder, [PersistValue]) -> Builder)
-> (Builder, [PersistValue])
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder, [PersistValue]) -> Builder
forall a b. (a, b) -> a
fst) [(Builder, [PersistValue])]
materialized
                , ((Builder, [PersistValue]) -> [PersistValue])
-> [(Builder, [PersistValue])] -> [PersistValue]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Builder, [PersistValue]) -> [PersistValue]
forall a b. (a, b) -> b
snd [(Builder, [PersistValue])]
materialized
                )
            colsAliases :: Text
colsAliases = Text -> [Text] -> Text
TL.intercalate Text
"," ((Ident -> Text) -> [Ident] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Builder -> Text
TLB.toLazyText (Builder -> Text) -> (Ident -> Builder) -> Ident -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentInfo -> Ident -> Builder
useIdent IdentInfo
info) [Ident]
colIdents)
        in
            ( Builder
"(VALUES " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TLB.fromLazyText Text
valsSql Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
") AS "
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> IdentInfo -> Ident -> Builder
useIdent IdentInfo
info Ident
valsIdent
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TLB.fromLazyText Text
colsAliases Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"
            , [PersistValue]
params
            )

-- | `NOWAIT` 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 (LockingClause -> SqlQuery ()) -> LockingClause -> SqlQuery ()
forall a b. (a -> b) -> a -> b
$ [PostgresLockingKind] -> LockingClause
PostgresLockingClauses [PostgresRowLevelLockStrength
-> Maybe LockingOfClause -> OnLockedBehavior -> PostgresLockingKind
PostgresLockingKind PostgresRowLevelLockStrength
PostgresForUpdate (LockingOfClause -> Maybe LockingOfClause
forall a. a -> Maybe a
Just (LockingOfClause -> Maybe LockingOfClause)
-> LockingOfClause -> Maybe LockingOfClause
forall a b. (a -> b) -> a -> b
$ a -> LockingOfClause
forall a. LockableEntity a => a -> LockingOfClause
LockingOfClause a
lockableEntities) OnLockedBehavior
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 :: forall a. LockableEntity a => a -> OnLockedBehavior -> SqlQuery ()
forNoKeyUpdateOf a
lockableEntities OnLockedBehavior
onLockedBehavior =
  LockingClause -> SqlQuery ()
putLocking (LockingClause -> SqlQuery ()) -> LockingClause -> SqlQuery ()
forall a b. (a -> b) -> a -> b
$ [PostgresLockingKind] -> LockingClause
PostgresLockingClauses [PostgresRowLevelLockStrength
-> Maybe LockingOfClause -> OnLockedBehavior -> PostgresLockingKind
PostgresLockingKind PostgresRowLevelLockStrength
PostgresForNoKeyUpdate (LockingOfClause -> Maybe LockingOfClause
forall a. a -> Maybe a
Just (LockingOfClause -> Maybe LockingOfClause)
-> LockingOfClause -> Maybe LockingOfClause
forall a b. (a -> b) -> a -> b
$ a -> LockingOfClause
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 (LockingClause -> SqlQuery ()) -> LockingClause -> SqlQuery ()
forall a b. (a -> b) -> a -> b
$ [PostgresLockingKind] -> LockingClause
PostgresLockingClauses [PostgresRowLevelLockStrength
-> Maybe LockingOfClause -> OnLockedBehavior -> PostgresLockingKind
PostgresLockingKind PostgresRowLevelLockStrength
PostgresForShare (LockingOfClause -> Maybe LockingOfClause
forall a. a -> Maybe a
Just (LockingOfClause -> Maybe LockingOfClause)
-> LockingOfClause -> Maybe LockingOfClause
forall a b. (a -> b) -> a -> b
$ a -> LockingOfClause
forall a. LockableEntity a => a -> LockingOfClause
LockingOfClause a
lockableEntities) OnLockedBehavior
onLockedBehavior]

-- | @FOR SHARE@ syntax for Postgres locking.
--
-- Example use:
--
-- @
--  'locking' 'forShare'
-- @
--
-- @since 3.6.0.0
forShare :: LockingKind
forShare :: LockingKind
forShare = LockingKind
ForShare

-- | `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 :: forall a. LockableEntity a => a -> OnLockedBehavior -> SqlQuery ()
forKeyShareOf a
lockableEntities OnLockedBehavior
onLockedBehavior =
  LockingClause -> SqlQuery ()
putLocking (LockingClause -> SqlQuery ()) -> LockingClause -> SqlQuery ()
forall a b. (a -> b) -> a -> b
$ [PostgresLockingKind] -> LockingClause
PostgresLockingClauses [PostgresRowLevelLockStrength
-> Maybe LockingOfClause -> OnLockedBehavior -> PostgresLockingKind
PostgresLockingKind PostgresRowLevelLockStrength
PostgresForKeyShare (LockingOfClause -> Maybe LockingOfClause
forall a. a -> Maybe a
Just (LockingOfClause -> Maybe LockingOfClause)
-> LockingOfClause -> Maybe LockingOfClause
forall a b. (a -> b) -> a -> b
$ a -> LockingOfClause
forall a. LockableEntity a => a -> LockingOfClause
LockingOfClause a
lockableEntities) OnLockedBehavior
onLockedBehavior]

-- | @ILIKE@ operator (case-insensitive @LIKE@).
--
-- @since 2.2.3
ilike :: SqlString s => SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value Bool)
ilike :: forall s.
SqlString s =>
SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value Bool)
ilike   = Builder
-> SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value Bool)
forall a b c.
Builder
-> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c)
unsafeSqlBinOp    Builder
" ILIKE "

-- | @WITH@ @MATERIALIZED@ clause is used to introduce a
-- [Common Table Expression (CTE)](https://en.wikipedia.org/wiki/Hierarchical_and_recursive_queries_in_SQL#Common_table_expression)
-- with the MATERIALIZED keyword. The MATERIALIZED keyword is only supported in PostgreSQL >= version 12.
-- In Esqueleto, CTEs should be used as a subquery memoization tactic. PostgreSQL treats a materialized CTE as an optimization fence.
-- A materialized CTE is always fully calculated, and is not "inlined" with other table joins.
-- Without the MATERIALIZED keyword, PostgreSQL >= 12 may "inline" the CTE as though it was any other join.
-- You should always verify that using a materialized CTE will in fact improve your performance
-- over a regular subquery.
--
-- @
-- select $ do
-- cte <- withMaterialized subQuery
-- cteResult <- from cte
-- where_ $ cteResult ...
-- pure cteResult
-- @
--
--
-- For more information on materialized CTEs, see the PostgreSQL manual documentation on
-- [Common Table Expression Materialization](https://www.postgresql.org/docs/14/queries-with.html#id-1.5.6.12.7).
--
-- @since 3.5.14.0
withMaterialized :: ( ToAlias a
                    , ToAliasReference a
                    , SqlSelect a r
                    ) => SqlQuery a -> SqlQuery (Ex.From a)
withMaterialized :: forall a r.
(ToAlias a, ToAliasReference a, SqlSelect a r) =>
SqlQuery a -> SqlQuery (From a)
withMaterialized SqlQuery a
query = do
    (a
ret, SideData
sideData) <- WriterT SideData (State IdentState) (a, SideData)
-> SqlQuery (a, SideData)
forall a. WriterT SideData (State IdentState) a -> SqlQuery a
Q (WriterT SideData (State IdentState) (a, SideData)
 -> SqlQuery (a, SideData))
-> WriterT SideData (State IdentState) (a, SideData)
-> SqlQuery (a, SideData)
forall a b. (a -> b) -> a -> b
$ (SideData -> SideData)
-> WriterT SideData (State IdentState) (a, SideData)
-> WriterT SideData (State IdentState) (a, SideData)
forall (m :: * -> *) w a.
Monad m =>
(w -> w) -> WriterT w m a -> WriterT w m a
W.censor (\SideData
_ -> SideData
forall a. Monoid a => a
mempty) (WriterT SideData (State IdentState) (a, SideData)
 -> WriterT SideData (State IdentState) (a, SideData))
-> WriterT SideData (State IdentState) (a, SideData)
-> WriterT SideData (State IdentState) (a, SideData)
forall a b. (a -> b) -> a -> b
$ WriterT SideData (State IdentState) a
-> WriterT SideData (State IdentState) (a, SideData)
forall (m :: * -> *) w a.
Monad m =>
WriterT w m a -> WriterT w m (a, w)
W.listen (WriterT SideData (State IdentState) a
 -> WriterT SideData (State IdentState) (a, SideData))
-> WriterT SideData (State IdentState) a
-> WriterT SideData (State IdentState) (a, SideData)
forall a b. (a -> b) -> a -> b
$ SqlQuery a -> WriterT SideData (State IdentState) a
forall a. SqlQuery a -> WriterT SideData (State IdentState) a
unQ SqlQuery a
query
    a
aliasedValue <- a -> SqlQuery a
forall a. ToAlias a => a -> SqlQuery a
toAlias a
ret
    let aliasedQuery :: SqlQuery a
aliasedQuery = WriterT SideData (State IdentState) a -> SqlQuery a
forall a. WriterT SideData (State IdentState) a -> SqlQuery a
Q (WriterT SideData (State IdentState) a -> SqlQuery a)
-> WriterT SideData (State IdentState) a -> SqlQuery a
forall a b. (a -> b) -> a -> b
$ State IdentState (a, SideData)
-> WriterT SideData (State IdentState) a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
W.WriterT (State IdentState (a, SideData)
 -> WriterT SideData (State IdentState) a)
-> State IdentState (a, SideData)
-> WriterT SideData (State IdentState) a
forall a b. (a -> b) -> a -> b
$ (a, SideData) -> State IdentState (a, SideData)
forall a. a -> StateT IdentState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
aliasedValue, SideData
sideData)
    Ident
ident <- DBName -> SqlQuery Ident
newIdentFor (Text -> DBName
DBName Text
"cte")
    let clause :: CommonTableExpressionClause
clause = CommonTableExpressionKind
-> CommonTableExpressionModifierAfterAs
-> Ident
-> (IdentInfo -> (Builder, [PersistValue]))
-> CommonTableExpressionClause
CommonTableExpressionClause CommonTableExpressionKind
NormalCommonTableExpression (\CommonTableExpressionClause
_ IdentInfo
_ -> Builder
"MATERIALIZED ") Ident
ident (\IdentInfo
info -> Mode -> IdentInfo -> SqlQuery a -> (Builder, [PersistValue])
forall a r backend.
(SqlSelect a r, BackendCompatible SqlBackend backend) =>
Mode
-> (backend, IdentState) -> SqlQuery a -> (Builder, [PersistValue])
toRawSql Mode
SELECT IdentInfo
info SqlQuery a
aliasedQuery)
    WriterT SideData (State IdentState) () -> SqlQuery ()
forall a. WriterT SideData (State IdentState) a -> SqlQuery a
Q (WriterT SideData (State IdentState) () -> SqlQuery ())
-> WriterT SideData (State IdentState) () -> SqlQuery ()
forall a b. (a -> b) -> a -> b
$ SideData -> WriterT SideData (State IdentState) ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
W.tell SideData
forall a. Monoid a => a
mempty{sdCteClause = [clause]}
    a
ref <- Ident -> a -> SqlQuery a
forall a. ToAliasReference a => Ident -> a -> SqlQuery a
toAliasReference Ident
ident a
aliasedValue
    From a -> SqlQuery (From a)
forall a. a -> SqlQuery a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (From a -> SqlQuery (From a)) -> From a -> SqlQuery (From a)
forall a b. (a -> b) -> a -> b
$ SqlQuery (a, NeedParens -> IdentInfo -> (Builder, [PersistValue]))
-> From a
forall a.
SqlQuery (a, NeedParens -> IdentInfo -> (Builder, [PersistValue]))
-> From a
Ex.From (SqlQuery (a, NeedParens -> IdentInfo -> (Builder, [PersistValue]))
 -> From a)
-> SqlQuery
     (a, NeedParens -> IdentInfo -> (Builder, [PersistValue]))
-> From a
forall a b. (a -> b) -> a -> b
$ (a, NeedParens -> IdentInfo -> (Builder, [PersistValue]))
-> SqlQuery
     (a, NeedParens -> IdentInfo -> (Builder, [PersistValue]))
forall a. a -> SqlQuery a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
ref, (\NeedParens
_ IdentInfo
info -> (IdentInfo -> Ident -> Builder
useIdent IdentInfo
info Ident
ident, [PersistValue]
forall a. Monoid a => a
mempty)))

-- | @WITH@ @NOT@ @MATERIALIZED@ clause is used to introduce a
-- [Common Table Expression (CTE)](https://en.wikipedia.org/wiki/Hierarchical_and_recursive_queries_in_SQL#Common_table_expression)
-- with the NOT MATERIALIZED keywords. These are only supported in PostgreSQL >=
-- version 12. In Esqueleto, CTEs should be used as a subquery memoization
-- tactic. PostgreSQL treats a materialized CTE as an optimization fence. A
-- MATERIALIZED CTE is always fully calculated, and is not "inlined" with other
-- table joins. Sometimes, this is undesirable, so postgres provides the NOT
-- MATERIALIZED modifier to prevent this behavior, thus enabling it to possibly
-- decide to treat the CTE as any other join.
--
-- Given the above, it is unlikely that this function will be useful, as a
-- normal join should be used instead, but is provided for completeness.
--
-- @
-- select $ do
-- cte <- withNotMaterialized subQuery
-- cteResult <- from cte
-- where_ $ cteResult ...
-- pure cteResult
-- @
--
--
-- For more information on materialized CTEs, see the PostgreSQL manual documentation on
-- [Common Table Expression Materialization](https://www.postgresql.org/docs/14/queries-with.html#id-1.5.6.12.7).
--
-- @since 3.5.14.0
withNotMaterialized :: ( ToAlias a
                    , ToAliasReference a
                    , SqlSelect a r
                    ) => SqlQuery a -> SqlQuery (Ex.From a)
withNotMaterialized :: forall a r.
(ToAlias a, ToAliasReference a, SqlSelect a r) =>
SqlQuery a -> SqlQuery (From a)
withNotMaterialized SqlQuery a
query = do
    (a
ret, SideData
sideData) <- WriterT SideData (State IdentState) (a, SideData)
-> SqlQuery (a, SideData)
forall a. WriterT SideData (State IdentState) a -> SqlQuery a
Q (WriterT SideData (State IdentState) (a, SideData)
 -> SqlQuery (a, SideData))
-> WriterT SideData (State IdentState) (a, SideData)
-> SqlQuery (a, SideData)
forall a b. (a -> b) -> a -> b
$ (SideData -> SideData)
-> WriterT SideData (State IdentState) (a, SideData)
-> WriterT SideData (State IdentState) (a, SideData)
forall (m :: * -> *) w a.
Monad m =>
(w -> w) -> WriterT w m a -> WriterT w m a
W.censor (\SideData
_ -> SideData
forall a. Monoid a => a
mempty) (WriterT SideData (State IdentState) (a, SideData)
 -> WriterT SideData (State IdentState) (a, SideData))
-> WriterT SideData (State IdentState) (a, SideData)
-> WriterT SideData (State IdentState) (a, SideData)
forall a b. (a -> b) -> a -> b
$ WriterT SideData (State IdentState) a
-> WriterT SideData (State IdentState) (a, SideData)
forall (m :: * -> *) w a.
Monad m =>
WriterT w m a -> WriterT w m (a, w)
W.listen (WriterT SideData (State IdentState) a
 -> WriterT SideData (State IdentState) (a, SideData))
-> WriterT SideData (State IdentState) a
-> WriterT SideData (State IdentState) (a, SideData)
forall a b. (a -> b) -> a -> b
$ SqlQuery a -> WriterT SideData (State IdentState) a
forall a. SqlQuery a -> WriterT SideData (State IdentState) a
unQ SqlQuery a
query
    a
aliasedValue <- a -> SqlQuery a
forall a. ToAlias a => a -> SqlQuery a
toAlias a
ret
    let aliasedQuery :: SqlQuery a
aliasedQuery = WriterT SideData (State IdentState) a -> SqlQuery a
forall a. WriterT SideData (State IdentState) a -> SqlQuery a
Q (WriterT SideData (State IdentState) a -> SqlQuery a)
-> WriterT SideData (State IdentState) a -> SqlQuery a
forall a b. (a -> b) -> a -> b
$ State IdentState (a, SideData)
-> WriterT SideData (State IdentState) a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
W.WriterT (State IdentState (a, SideData)
 -> WriterT SideData (State IdentState) a)
-> State IdentState (a, SideData)
-> WriterT SideData (State IdentState) a
forall a b. (a -> b) -> a -> b
$ (a, SideData) -> State IdentState (a, SideData)
forall a. a -> StateT IdentState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
aliasedValue, SideData
sideData)
    Ident
ident <- DBName -> SqlQuery Ident
newIdentFor (Text -> DBName
DBName Text
"cte")
    let clause :: CommonTableExpressionClause
clause = CommonTableExpressionKind
-> CommonTableExpressionModifierAfterAs
-> Ident
-> (IdentInfo -> (Builder, [PersistValue]))
-> CommonTableExpressionClause
CommonTableExpressionClause CommonTableExpressionKind
NormalCommonTableExpression (\CommonTableExpressionClause
_ IdentInfo
_ -> Builder
"NOT MATERIALIZED ") Ident
ident (\IdentInfo
info -> Mode -> IdentInfo -> SqlQuery a -> (Builder, [PersistValue])
forall a r backend.
(SqlSelect a r, BackendCompatible SqlBackend backend) =>
Mode
-> (backend, IdentState) -> SqlQuery a -> (Builder, [PersistValue])
toRawSql Mode
SELECT IdentInfo
info SqlQuery a
aliasedQuery)
    WriterT SideData (State IdentState) () -> SqlQuery ()
forall a. WriterT SideData (State IdentState) a -> SqlQuery a
Q (WriterT SideData (State IdentState) () -> SqlQuery ())
-> WriterT SideData (State IdentState) () -> SqlQuery ()
forall a b. (a -> b) -> a -> b
$ SideData -> WriterT SideData (State IdentState) ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
W.tell SideData
forall a. Monoid a => a
mempty{sdCteClause = [clause]}
    a
ref <- Ident -> a -> SqlQuery a
forall a. ToAliasReference a => Ident -> a -> SqlQuery a
toAliasReference Ident
ident a
aliasedValue
    From a -> SqlQuery (From a)
forall a. a -> SqlQuery a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (From a -> SqlQuery (From a)) -> From a -> SqlQuery (From a)
forall a b. (a -> b) -> a -> b
$ SqlQuery (a, NeedParens -> IdentInfo -> (Builder, [PersistValue]))
-> From a
forall a.
SqlQuery (a, NeedParens -> IdentInfo -> (Builder, [PersistValue]))
-> From a
Ex.From (SqlQuery (a, NeedParens -> IdentInfo -> (Builder, [PersistValue]))
 -> From a)
-> SqlQuery
     (a, NeedParens -> IdentInfo -> (Builder, [PersistValue]))
-> From a
forall a b. (a -> b) -> a -> b
$ (a, NeedParens -> IdentInfo -> (Builder, [PersistValue]))
-> SqlQuery
     (a, NeedParens -> IdentInfo -> (Builder, [PersistValue]))
forall a. a -> SqlQuery a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
ref, (\NeedParens
_ IdentInfo
info -> (IdentInfo -> Ident -> Builder
useIdent IdentInfo
info Ident
ident, [PersistValue]
forall a. Monoid a => a
mempty)))

-- | Ascending order of this field or SqlExpression with nulls coming first.
--
-- @since 3.5.14.0
ascNullsFirst :: PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
ascNullsFirst :: forall a. PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
ascNullsFirst = Builder -> SqlExpr (Value a) -> SqlExpr OrderBy
forall a. Builder -> SqlExpr (Value a) -> SqlExpr OrderBy
orderByExpr Builder
" ASC NULLS FIRST"

-- | Ascending order of this field or SqlExpression with nulls coming last.
-- Note that this is the same as normal ascending ordering in Postgres, but it has been included for completeness.
--
-- @since 3.5.14.0
ascNullsLast :: PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
ascNullsLast :: forall a. PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
ascNullsLast = Builder -> SqlExpr (Value a) -> SqlExpr OrderBy
forall a. Builder -> SqlExpr (Value a) -> SqlExpr OrderBy
orderByExpr Builder
" ASC NULLS LAST"

-- | Descending order of this field or SqlExpression with nulls coming first.
-- Note that this is the same as normal ascending ordering in Postgres, but it has been included for completeness.
--
-- @since 3.5.14.0
descNullsFirst :: PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
descNullsFirst :: forall a. PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
descNullsFirst = Builder -> SqlExpr (Value a) -> SqlExpr OrderBy
forall a. Builder -> SqlExpr (Value a) -> SqlExpr OrderBy
orderByExpr Builder
" DESC NULLS FIRST"

-- | Descending order of this field or SqlExpression with nulls coming last.
--
-- @since 3.5.14.0
descNullsLast :: PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
descNullsLast :: forall a. PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
descNullsLast = Builder -> SqlExpr (Value a) -> SqlExpr OrderBy
forall a. Builder -> SqlExpr (Value a) -> SqlExpr OrderBy
orderByExpr Builder
" DESC NULLS LAST"