{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# 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
, noWait
, wait
, skipLocked
, forUpdateOf
, forShareOf
, filterWhere
, values
, unsafeSqlAggregateFunction
) where
#if __GLASGOW_HASKELL__ < 804
import Data.Semigroup
#endif
import Control.Arrow (first)
import Control.Exception (throw)
import Control.Monad (void)
import Control.Monad.IO.Class (MonadIO(..))
import qualified Control.Monad.Trans.Reader as R
import Data.Int (Int64)
import qualified Data.List.NonEmpty as NE
import Data.Maybe
import Data.Proxy (Proxy(..))
import qualified Data.Text.Internal.Builder as TLB
import qualified Data.Text.Lazy as TL
import Data.Time.Clock (UTCTime)
import qualified Database.Esqueleto.Experimental as Ex
import Database.Esqueleto.Internal.Internal hiding (random_)
import Database.Esqueleto.Internal.PersistentImport hiding
(uniqueFields, upsert, upsertBy)
import Database.Persist.SqlBackend
random_ :: (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()"
emptyArray :: SqlExpr (Value [a])
emptyArray :: forall a. 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 :: 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)
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
$cshowsPrec :: Int -> AggMode -> ShowS
showsPrec :: Int -> AggMode -> ShowS
$cshow :: AggMode -> String
show :: AggMode -> String
$cshowList :: [AggMode] -> ShowS
showList :: [AggMode] -> ShowS
Show)
unsafeSqlAggregateFunction
:: UnsafeSqlFunctionArgument a
=> TLB.Builder
-> AggMode
-> a
-> [OrderByClause]
-> SqlExpr (Value b)
unsafeSqlAggregateFunction :: forall a b.
UnsafeSqlFunctionArgument a =>
Builder -> AggMode -> a -> [OrderByClause] -> SqlExpr (Value b)
unsafeSqlAggregateFunction Builder
name AggMode
mode a
args [OrderByClause]
orderByClauses = 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 :: forall a.
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 :: forall a.
PersistField a =>
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 :: forall a.
(PersistField a, PersistField [a]) =>
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 :: 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')
arrayRemoveNull :: SqlExpr (Value [Maybe a]) -> SqlExpr (Value [a])
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")
stringAggWith ::
SqlString s
=> AggMode
-> SqlExpr (Value s)
-> SqlExpr (Value s)
-> [OrderByClause]
-> SqlExpr (Value (Maybe s))
stringAggWith :: forall s.
SqlString s =>
AggMode
-> SqlExpr (Value s)
-> SqlExpr (Value s)
-> [OrderByClause]
-> SqlExpr (Value (Maybe s))
stringAggWith AggMode
mode SqlExpr (Value s)
expr SqlExpr (Value s)
delim [OrderByClause]
os =
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 :: 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)
-> [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 :: 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" ()
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 :: forall (m :: * -> *) record.
(MonadIO m, PersistEntity record, OnlyOneUniqueKey record,
PersistRecordBackend record SqlBackend,
IsPersistBackend (PersistEntityBackend record)) =>
record
-> [SqlExpr (Entity record) -> SqlExpr Update]
-> ReaderT SqlBackend m (Entity record)
upsert record
record [SqlExpr (Entity record) -> SqlExpr Update]
updates = do
Unique record
uniqueKey <- 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 :: forall (m :: * -> *) record.
(MonadIO m, PersistEntity record,
IsPersistBackend (PersistEntityBackend record)) =>
Unique record
-> record
-> [SqlExpr (Entity record) -> SqlExpr Update]
-> ReaderT SqlBackend m (Entity record)
upsertBy Unique record
uniqueKey record
record [SqlExpr (Entity record) -> SqlExpr Update]
updates = do
SqlBackend
sqlB <- 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 = (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]
++ 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
#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 a. a -> ReaderT SqlBackend m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Entity record] -> Entity record
forall a. HasCallStack => [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 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 ()
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
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
filterWhere
:: SqlExpr (Value a)
-> SqlExpr (Value Bool)
-> 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
)
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)
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 :: OnLockedBehavior
noWait :: OnLockedBehavior
noWait = OnLockedBehavior
NoWait
skipLocked :: OnLockedBehavior
skipLocked :: OnLockedBehavior
skipLocked = OnLockedBehavior
SkipLocked
wait :: OnLockedBehavior
wait :: OnLockedBehavior
wait = OnLockedBehavior
Wait
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]
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]