{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings
           , GADTs, CPP, Rank2Types
           , 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
  , filterWhere
  -- * Internal
  , unsafeSqlAggregateFunction
  ) where

#if __GLASGOW_HASKELL__ < 804
import           Data.Semigroup
#endif
import qualified Data.Text.Internal.Builder                   as TLB
import           Data.Time.Clock                              (UTCTime)
import           Database.Esqueleto.Internal.Language         hiding (random_)
import           Database.Esqueleto.Internal.PersistentImport hiding (upsert, upsertBy)
import           Database.Esqueleto.Internal.Sql
import           Database.Esqueleto.Internal.Internal         (EsqueletoError(..), CompositeKeyError(..),
                                                              UnexpectedCaseError(..), SetClause, Ident(..),
                                                              uncommas, FinalResult(..), toUniqueDef,
                                                              KnowResult, renderUpdates, UnexpectedValueError(..))
import           Database.Persist.Class                       (OnlyOneUniqueKey)
import           Data.List.NonEmpty                           ( NonEmpty( (:|) ) )
import           Data.Int                                     (Int64)
import           Data.Proxy                                   (Proxy(..))
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

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

-- | Empty array literal. (@val []@) does unfortunately not work
emptyArray :: SqlExpr (Value [a])
emptyArray :: 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 :: 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
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 :: Builder -> AggMode -> a -> [OrderByClause] -> SqlExpr (Value b)
unsafeSqlAggregateFunction Builder
name AggMode
mode a
args [OrderByClause]
orderByClauses =
  NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value b)
forall a.
NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
ERaw NeedParens
Never ((IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value b))
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value b)
forall a b. (a -> b) -> a -> b
$ \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) =
          [(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 NeedParens
_ IdentInfo -> (Builder, [PersistValue])
f) -> IdentInfo -> (Builder, [PersistValue])
f 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 :: AggMode
-> SqlExpr (Value a)
-> [OrderByClause]
-> SqlExpr (Value (Maybe [a]))
arrayAggWith = Builder
-> AggMode
-> SqlExpr (Value a)
-> [OrderByClause]
-> SqlExpr (Value (Maybe [a]))
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 :: SqlExpr (Value a) -> SqlExpr (Value (Maybe [a]))
arrayAgg SqlExpr (Value a)
x = AggMode
-> SqlExpr (Value a)
-> [OrderByClause]
-> SqlExpr (Value (Maybe [a]))
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 :: SqlExpr (Value a) -> SqlExpr (Value (Maybe [a]))
arrayAggDistinct SqlExpr (Value a)
x = AggMode
-> SqlExpr (Value a)
-> [OrderByClause]
-> SqlExpr (Value (Maybe [a]))
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 :: 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 :: 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 :: 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 =
  Builder
-> AggMode
-> (SqlExpr (Value s), SqlExpr (Value s))
-> [OrderByClause]
-> SqlExpr (Value (Maybe s))
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 :: 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)
-> [OrderByClause]
-> SqlExpr (Value (Maybe s))
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 :: 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" ()

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

upsertBy :: (MonadIO m,
    PersistEntity record,
    IsPersistBackend (PersistEntityBackend record))
  => Unique record
  -- ^ uniqueness constraint to find by
  -> record
  -- ^ new record to insert
  -> [SqlExpr (Update record)]
  -- ^ updates to perform if the record already exists
  -> R.ReaderT SqlBackend m (Entity record)
  -- ^ the record in the database after the operation
upsertBy :: Unique record
-> record
-> [SqlExpr (Update record)]
-> ReaderT SqlBackend m (Entity record)
upsertBy Unique record
uniqueKey record
record [SqlExpr (Update record)]
updates = do
  SqlBackend
sqlB <- ReaderT SqlBackend m SqlBackend
forall (m :: * -> *) r. Monad m => ReaderT r m r
R.ask
  ReaderT SqlBackend m (Entity record)
-> ((EntityDef -> NonEmpty UniqueDef -> Text -> Text)
    -> ReaderT SqlBackend m (Entity record))
-> Maybe (EntityDef -> NonEmpty UniqueDef -> Text -> Text)
-> ReaderT SqlBackend m (Entity record)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (EsqueletoError -> ReaderT SqlBackend m (Entity record)
forall a e. Exception e => e -> a
throw (UnexpectedCaseError -> EsqueletoError
UnexpectedCaseErr UnexpectedCaseError
OperationNotSupported)) -- Postgres backend should have connUpsertSql, if this error is thrown, check changes on persistent
    (SqlBackend
-> (EntityDef -> NonEmpty UniqueDef -> Text -> Text)
-> ReaderT SqlBackend m (Entity record)
handler SqlBackend
sqlB)
    (SqlBackend
-> Maybe (EntityDef -> NonEmpty UniqueDef -> Text -> Text)
connUpsertSql SqlBackend
sqlB)
  where
    addVals :: [PersistValue] -> [PersistValue]
addVals [PersistValue]
l = (SomePersistField -> PersistValue)
-> [SomePersistField] -> [PersistValue]
forall a b. (a -> b) -> [a] -> [b]
map SomePersistField -> PersistValue
forall a. PersistField a => a -> PersistValue
toPersistValue (record -> [SomePersistField]
forall record. PersistEntity record => record -> [SomePersistField]
toPersistFields record
record) [PersistValue] -> [PersistValue] -> [PersistValue]
forall a. [a] -> [a] -> [a]
++ [PersistValue]
l [PersistValue] -> [PersistValue] -> [PersistValue]
forall a. [a] -> [a] -> [a]
++ Unique record -> [PersistValue]
forall record.
PersistEntity record =>
Unique record -> [PersistValue]
persistUniqueToValues Unique record
uniqueKey
    entDef :: EntityDef
entDef = Maybe record -> EntityDef
forall record (m :: * -> *).
(PersistEntity record, Monad m) =>
m record -> EntityDef
entityDef (record -> Maybe record
forall a. a -> Maybe a
Just record
record)
    uDef :: UniqueDef
uDef = Unique record -> UniqueDef
forall a val.
(KnowResult a ~ Unique val, PersistEntity val, FinalResult a) =>
a -> UniqueDef
toUniqueDef Unique record
uniqueKey
    updatesText :: SqlBackend -> (Text, [PersistValue])
updatesText SqlBackend
conn = (Builder -> Text)
-> (Builder, [PersistValue]) -> (Text, [PersistValue])
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 (Update record)] -> (Builder, [PersistValue])
forall backend val.
BackendCompatible SqlBackend backend =>
backend -> [SqlExpr (Update val)] -> (Builder, [PersistValue])
renderUpdates SqlBackend
conn [SqlExpr (Update record)]
updates
    handler :: SqlBackend
-> (EntityDef -> NonEmpty UniqueDef -> Text -> Text)
-> ReaderT SqlBackend m (Entity record)
handler SqlBackend
conn EntityDef -> NonEmpty UniqueDef -> Text -> Text
f = ([Entity record] -> Entity record)
-> ReaderT SqlBackend m [Entity record]
-> ReaderT SqlBackend m (Entity record)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Entity record] -> Entity record
forall a. [a] -> a
head (ReaderT SqlBackend m [Entity record]
 -> ReaderT SqlBackend m (Entity record))
-> ReaderT SqlBackend m [Entity record]
-> ReaderT SqlBackend m (Entity record)
forall a b. (a -> b) -> a -> b
$ (Text -> [PersistValue] -> ReaderT SqlBackend m [Entity record])
-> (Text, [PersistValue]) -> ReaderT SqlBackend m [Entity record]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry 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, [PersistValue]) -> ReaderT SqlBackend m [Entity record])
-> (Text, [PersistValue]) -> ReaderT SqlBackend m [Entity record]
forall a b. (a -> b) -> a -> b
$
      (Text -> Text)
-> ([PersistValue] -> [PersistValue])
-> (Text, [PersistValue])
-> (Text, [PersistValue])
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
(***) (EntityDef -> NonEmpty UniqueDef -> Text -> Text
f EntityDef
entDef (UniqueDef
uDef UniqueDef -> [UniqueDef] -> NonEmpty UniqueDef
forall a. a -> [a] -> NonEmpty a
:| [])) [PersistValue] -> [PersistValue]
addVals ((Text, [PersistValue]) -> (Text, [PersistValue]))
-> (Text, [PersistValue]) -> (Text, [PersistValue])
forall a b. (a -> b) -> a -> b
$ SqlBackend -> (Text, [PersistValue])
updatesText SqlBackend
conn

-- | 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. (
    FinalResult a,
    KnowResult a ~ (Unique val),
    MonadIO m,
    PersistEntity val) =>
  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 (Update val)])
  -- ^ 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.
  -> SqlWriteT m ()
insertSelectWithConflict :: a
-> SqlQuery (SqlExpr (Insertion val))
-> (SqlExpr (Entity val)
    -> SqlExpr (Entity val) -> [SqlExpr (Update val)])
-> SqlWriteT m ()
insertSelectWithConflict a
unique SqlQuery (SqlExpr (Insertion val))
query = ReaderT backend m Int64 -> ReaderT backend m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT backend m Int64 -> ReaderT backend m ())
-> ((SqlExpr (Entity val)
     -> SqlExpr (Entity val) -> [SqlExpr (Update val)])
    -> ReaderT backend m Int64)
-> (SqlExpr (Entity val)
    -> SqlExpr (Entity val) -> [SqlExpr (Update val)])
-> ReaderT backend m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a
-> SqlQuery (SqlExpr (Insertion val))
-> (SqlExpr (Entity val)
    -> SqlExpr (Entity val) -> [SqlExpr (Update val)])
-> SqlWriteT m Int64
forall a val (m :: * -> *).
(FinalResult a, KnowResult a ~ Unique val, MonadIO m,
 PersistEntity val) =>
a
-> SqlQuery (SqlExpr (Insertion val))
-> (SqlExpr (Entity val)
    -> SqlExpr (Entity val) -> [SqlExpr (Update val)])
-> SqlWriteT m Int64
insertSelectWithConflictCount a
unique SqlQuery (SqlExpr (Insertion val))
query

-- | Same as 'insertSelectWithConflict' but returns the number of rows affected.
--
-- @since 3.1.3
insertSelectWithConflictCount :: forall a val m. (
    FinalResult a,
    KnowResult a ~ (Unique val),
    MonadIO m,
    PersistEntity val) =>
  a
  -> SqlQuery (SqlExpr (Insertion val))
  -> (SqlExpr (Entity val) -> SqlExpr (Entity val) -> [SqlExpr (Update val)])
  -> SqlWriteT m Int64
insertSelectWithConflictCount :: a
-> SqlQuery (SqlExpr (Insertion val))
-> (SqlExpr (Entity val)
    -> SqlExpr (Entity val) -> [SqlExpr (Update val)])
-> SqlWriteT m Int64
insertSelectWithConflictCount a
unique SqlQuery (SqlExpr (Insertion val))
query SqlExpr (Entity val)
-> SqlExpr (Entity val) -> [SqlExpr (Update val)]
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 InsertFinal)
-> (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) ((SqlExpr (Insertion val) -> SqlExpr InsertFinal)
-> SqlQuery (SqlExpr (Insertion val))
-> SqlQuery (SqlExpr InsertFinal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SqlExpr (Insertion val) -> SqlExpr InsertFinal
forall a.
PersistEntity a =>
SqlExpr (Insertion a) -> SqlExpr InsertFinal
EInsertFinal 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 (Update val)]
updates = SqlExpr (Entity val)
-> SqlExpr (Entity val) -> [SqlExpr (Update val)]
conflictQuery SqlExpr (Entity val)
entCurrent SqlExpr (Entity val)
forall val. 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 val. Ident -> SqlExpr (Entity val)
EEntity (Ident -> SqlExpr (Entity val)) -> Ident -> SqlExpr (Entity val)
forall a b. (a -> b) -> a -> b
$ Text -> Ident
I Text
"excluded"
    tableName :: Proxy val -> Text
tableName = DBName -> Text
unDBName (DBName -> Text) -> (Proxy val -> DBName) -> Proxy val -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityDef -> DBName
entityDB (EntityDef -> DBName)
-> (Proxy val -> EntityDef) -> Proxy val -> DBName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy val -> EntityDef
forall record (m :: * -> *).
(PersistEntity record, Monad m) =>
m record -> EntityDef
entityDef
    entCurrent :: SqlExpr (Entity val)
entCurrent = Ident -> SqlExpr (Entity val)
forall val. Ident -> SqlExpr (Entity val)
EEntity (Ident -> SqlExpr (Entity val)) -> Ident -> SqlExpr (Entity val)
forall a b. (a -> b) -> a -> b
$ Text -> Ident
I (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
. DBName -> Text
unDBName (DBName -> Text) -> (UniqueDef -> DBName) -> UniqueDef -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniqueDef -> DBName
uniqueDBName (UniqueDef -> Builder) -> UniqueDef -> Builder
forall a b. (a -> b) -> a -> b
$ UniqueDef
uniqueDef
    renderedUpdates :: (BackendCompatible SqlBackend backend) => backend -> (TLB.Builder, [PersistValue])
    renderedUpdates :: backend -> (Builder, [PersistValue])
renderedUpdates backend
conn = backend -> [SqlExpr (Update val)] -> (Builder, [PersistValue])
forall backend val.
BackendCompatible SqlBackend backend =>
backend -> [SqlExpr (Update val)] -> (Builder, [PersistValue])
renderUpdates backend
conn [SqlExpr (Update val)]
updates
    conflict :: backend -> (Builder, [PersistValue])
conflict backend
conn = ((Builder -> Builder -> Builder) -> [Builder] -> Builder
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
mappend ([
        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 (Update val)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SqlExpr (Update val)]
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])
forall backend.
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 :: SqlExpr (Value a) -> SqlExpr (Value Bool) -> SqlExpr (Value a)
filterWhere SqlExpr (Value a)
aggExpr SqlExpr (Value Bool)
clauseExpr = NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
forall a.
NeedParens
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
ERaw NeedParens
Never ((IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a))
-> (IdentInfo -> (Builder, [PersistValue])) -> SqlExpr (Value a)
forall a b. (a -> b) -> a -> b
$ \IdentInfo
info ->
  let (Builder
aggBuilder, [PersistValue]
aggValues) = case SqlExpr (Value a)
aggExpr of
        ERaw NeedParens
_ IdentInfo -> (Builder, [PersistValue])
aggF     -> IdentInfo -> (Builder, [PersistValue])
aggF IdentInfo
info
        ECompositeKey IdentInfo -> [Builder]
_ -> EsqueletoError -> (Builder, [PersistValue])
forall a e. Exception e => e -> a
throw (EsqueletoError -> (Builder, [PersistValue]))
-> EsqueletoError -> (Builder, [PersistValue])
forall a b. (a -> b) -> a -> b
$ CompositeKeyError -> EsqueletoError
CompositeKeyErr CompositeKeyError
FilterWhereAggError
      (Builder
clauseBuilder, [PersistValue]
clauseValues) = case SqlExpr (Value Bool)
clauseExpr of
        ERaw NeedParens
_ IdentInfo -> (Builder, [PersistValue])
clauseF  -> IdentInfo -> (Builder, [PersistValue])
clauseF IdentInfo
info
        ECompositeKey IdentInfo -> [Builder]
_ -> EsqueletoError -> (Builder, [PersistValue])
forall a e. Exception e => e -> a
throw (EsqueletoError -> (Builder, [PersistValue]))
-> EsqueletoError -> (Builder, [PersistValue])
forall a b. (a -> b) -> a -> b
$ CompositeKeyError -> EsqueletoError
CompositeKeyErr CompositeKeyError
FilterWhereClauseError
  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
     )