{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Database.Esqueleto.PostgreSQL
( AggMode(..)
, arrayAggDistinct
, arrayAgg
, arrayAggWith
, arrayRemove
, arrayRemoveNull
, stringAgg
, stringAggWith
, maybeArray
, chr
, now_
, random_
, upsert
, upsertBy
, insertSelectWithConflict
, insertSelectWithConflictCount
, filterWhere
, unsafeSqlAggregateFunction
) where
#if __GLASGOW_HASKELL__ < 804
import Data.Semigroup
#endif
import Control.Arrow (first)
import Control.Exception (throw)
import Control.Monad (void)
import Control.Monad.IO.Class (MonadIO(..))
import qualified Control.Monad.Trans.Reader as R
import Data.Int (Int64)
import Data.Proxy (Proxy(..))
import qualified Data.Text.Internal.Builder as TLB
import Data.Time.Clock (UTCTime)
import Database.Esqueleto.Internal.Internal hiding (random_)
import Database.Esqueleto.Internal.PersistentImport hiding (upsert, upsertBy)
import Database.Persist.Class (OnlyOneUniqueKey)
import Database.Persist (ConstraintNameDB(..), EntityNameDB(..))
import Database.Persist.SqlBackend
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()"
emptyArray :: SqlExpr (Value [a])
emptyArray :: SqlExpr (Value [a])
emptyArray = Builder -> SqlExpr (Value [a])
forall a. Builder -> SqlExpr (Value a)
unsafeSqlValue Builder
"'{}'"
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)
data AggMode
= AggModeAll
| AggModeDistinct
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)
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 = 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 -> [OrderByClause] -> (Builder, [PersistValue])
makeOrderByNoNewline IdentInfo
info [OrderByClause]
orderByClauses
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 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
""
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
)
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"
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 []
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 []
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')
arrayRemoveNull :: SqlExpr (Value [Maybe a]) -> SqlExpr (Value [a])
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")
stringAggWith ::
SqlString s
=> AggMode
-> SqlExpr (Value s)
-> SqlExpr (Value s)
-> [OrderByClause]
-> SqlExpr (Value (Maybe s))
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
stringAgg ::
SqlString s
=> SqlExpr (Value s)
-> SqlExpr (Value s)
-> SqlExpr (Value (Maybe s))
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 :: 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
-> [SqlExpr (Entity record) -> SqlExpr Update]
-> R.ReaderT SqlBackend m (Entity record)
upsert :: record
-> [SqlExpr (Entity record) -> SqlExpr Update]
-> ReaderT SqlBackend m (Entity record)
upsert record
record [SqlExpr (Entity record) -> SqlExpr Update]
updates = do
Unique record
uniqueKey <- record -> ReaderT SqlBackend m (Unique record)
forall record backend (m :: * -> *).
(MonadIO m, PersistUniqueWrite backend,
PersistRecordBackend record backend, OnlyOneUniqueKey record) =>
record -> ReaderT backend m (Unique record)
onlyUnique record
record
Unique record
-> record
-> [SqlExpr (Entity record) -> SqlExpr Update]
-> ReaderT SqlBackend m (Entity record)
forall (m :: * -> *) record.
(MonadIO m, PersistEntity record,
IsPersistBackend (PersistEntityBackend record)) =>
Unique record
-> record
-> [SqlExpr (Entity record) -> SqlExpr Update]
-> ReaderT SqlBackend m (Entity record)
upsertBy Unique record
uniqueKey record
record [SqlExpr (Entity record) -> SqlExpr Update]
updates
upsertBy
::
(MonadIO m
, PersistEntity record
, IsPersistBackend (PersistEntityBackend record)
)
=> Unique record
-> record
-> [SqlExpr (Entity record) -> SqlExpr Update]
-> R.ReaderT SqlBackend m (Entity record)
upsertBy :: Unique record
-> record
-> [SqlExpr (Entity record) -> SqlExpr Update]
-> ReaderT SqlBackend m (Entity record)
upsertBy Unique record
uniqueKey record
record [SqlExpr (Entity record) -> SqlExpr Update]
updates = do
SqlBackend
sqlB <- 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 ->
EsqueletoError -> ReaderT SqlBackend m (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 (Entity record)
handler SqlBackend
sqlB EntityDef -> NonEmpty (FieldNameHS, FieldNameDB) -> Text -> Text
upsertSql
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 (proxy :: * -> *).
PersistEntity record =>
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 (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
#if MIN_VERSION_persistent(2,11,0)
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 (Entity record)
handler SqlBackend
sqlB EntityDef -> NonEmpty (FieldNameHS, FieldNameDB) -> Text -> Text
upsertSql = do
let (Text
updateText, [PersistValue]
updateVals) =
SqlBackend -> (Text, [PersistValue])
updatesText SqlBackend
sqlB
queryText :: Text
queryText =
EntityDef -> NonEmpty (FieldNameHS, FieldNameDB) -> Text -> Text
upsertSql EntityDef
entDef NonEmpty (FieldNameHS, FieldNameDB)
uniqueFields Text
updateText
queryVals :: [PersistValue]
queryVals =
[PersistValue] -> [PersistValue]
addVals [PersistValue]
updateVals
[Entity record]
xs <- 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
Entity record -> ReaderT SqlBackend m (Entity record)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Entity record] -> Entity record
forall a. [a] -> a
head [Entity record]
xs)
#else
uDef = toUniqueDef uniqueKey
handler conn f = fmap head $ uncurry rawSql $
(***) (f entDef (uDef :| [])) addVals $ updatesText conn
#endif
insertSelectWithConflict
:: forall a m val
. (FinalResult a, KnowResult a ~ Unique val, MonadIO m, PersistEntity val)
=> a
-> SqlQuery (SqlExpr (Insertion val))
-> (SqlExpr (Entity val) -> SqlExpr (Entity val) -> [SqlExpr (Entity val) -> SqlExpr Update])
-> SqlWriteT m ()
insertSelectWithConflict :: a
-> SqlQuery (SqlExpr (Insertion val))
-> (SqlExpr (Entity val)
-> SqlExpr (Entity val)
-> [SqlExpr (Entity val) -> SqlExpr Update])
-> SqlWriteT 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])
-> 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 (Entity val) -> SqlExpr Update])
-> SqlWriteT m Int64
insertSelectWithConflictCount a
unique SqlQuery (SqlExpr (Insertion val))
query SqlExpr (Entity val)
-> SqlExpr (Entity val) -> [SqlExpr (Entity val) -> SqlExpr Update]
a
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 (Entity val) -> SqlExpr Update])
-> SqlWriteT m Int64
insertSelectWithConflictCount :: a
-> SqlQuery (SqlExpr (Insertion val))
-> (SqlExpr (Entity val)
-> SqlExpr (Entity val)
-> [SqlExpr (Entity val) -> SqlExpr Update])
-> SqlWriteT 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
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 :: 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 (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])
forall backend.
BackendCompatible SqlBackend backend =>
backend -> (Builder, [PersistValue])
renderedUpdates backend
conn
filterWhere
:: SqlExpr (Value a)
-> SqlExpr (Value Bool)
-> SqlExpr (Value a)
filterWhere :: 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
)