{-# LANGUAGE FlexibleContexts #-}
module Database.Relational.Derives (
specifiedKey,
uniqueSelect,
primarySelect,
updateByConstraintKey,
primaryUpdate,
updateValuesWithKey,
derivedUniqueRelation,
unique,
primary', primary,
) where
import Database.Record (PersistableWidth, ToSql)
import Database.Record.ToSql (unsafeUpdateValuesWithIndexes)
import Database.Relational.SqlSyntax (Record)
import Database.Relational.Table (Table, TableDerivable)
import Database.Relational.Pi (Pi, expandIndexes)
import qualified Database.Relational.Record as Record
import Database.Relational.Projectable (placeholder, (.=.), (!))
import Database.Relational.Monad.Class (wheres)
import Database.Relational.Monad.BaseType (Relation, relationWidth)
import Database.Relational.Relation
(derivedRelation, relation, relation', query, UniqueRelation, unsafeUnique)
import Database.Relational.Constraint
(Key, Primary, Unique, projectionKey, uniqueKey,
HasConstraintKey(constraintKey))
import qualified Database.Relational.Constraint as Constraint
import Database.Relational.Type (KeyUpdate, typedKeyUpdate)
specifiedKey :: PersistableWidth p
=> Pi a p
-> Relation () a
-> Relation p a
specifiedKey :: forall p a.
PersistableWidth p =>
Pi a p -> Relation () a -> Relation p a
specifiedKey Pi a p
key Relation () a
rel = forall p r. SimpleQuery p r -> Relation p r
relation' forall a b. (a -> b) -> a -> b
$ do
Record Flat a
q <- forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat r)
query Relation () a
rel
(PlaceHolders p
param, ()) <- forall t c (m :: * -> *) a.
(PersistableWidth t, SqlContext c, Monad m) =>
(Record c t -> m a) -> m (PlaceHolders t, a)
placeholder (\Record Flat p
ph -> forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres forall a b. (a -> b) -> a -> b
$ forall a c b.
PersistableRecordWidth a -> Record c a -> Pi a b -> Record c b
Record.wpi (forall p r. Relation p r -> PersistableRecordWidth r
relationWidth Relation () a
rel) Record Flat a
q Pi a p
key forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat p
ph)
forall (m :: * -> *) a. Monad m => a -> m a
return (PlaceHolders p
param, Record Flat a
q)
uniqueSelect :: PersistableWidth p
=> Key Unique a p
-> Relation () a
-> Relation p a
uniqueSelect :: forall p a.
PersistableWidth p =>
Key Unique a p -> Relation () a -> Relation p a
uniqueSelect = forall p a.
PersistableWidth p =>
Pi a p -> Relation () a -> Relation p a
specifiedKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c r ct. Key c r ct -> Pi r ct
projectionKey
{-# DEPRECATED unique "use `uniqueSelect` instead of this." #-}
unique :: PersistableWidth p
=> Key Unique a p
-> Relation () a
-> Relation p a
unique :: forall p a.
PersistableWidth p =>
Key Unique a p -> Relation () a -> Relation p a
unique = forall p a.
PersistableWidth p =>
Key Unique a p -> Relation () a -> Relation p a
uniqueSelect
{-# DEPRECATED primary' "use `primarySelect` instead of this." #-}
primary' :: PersistableWidth p
=> Key Primary a p
-> Relation () a
-> Relation p a
primary' :: forall p a.
PersistableWidth p =>
Key Primary a p -> Relation () a -> Relation p a
primary' = forall p a.
PersistableWidth p =>
Pi a p -> Relation () a -> Relation p a
specifiedKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c r ct. Key c r ct -> Pi r ct
projectionKey
primarySelect :: HasConstraintKey Primary a p
=> Relation () a
-> Relation p a
primarySelect :: forall a p.
HasConstraintKey Primary a p =>
Relation () a -> Relation p a
primarySelect = forall p a.
PersistableWidth p =>
Key Primary a p -> Relation () a -> Relation p a
primary' forall c r ct. HasConstraintKey c r ct => Key c r ct
constraintKey
{-# DEPRECATED primary "use `primarySelect` instead of this." #-}
primary :: HasConstraintKey Primary a p
=> Relation () a
-> Relation p a
primary :: forall a p.
HasConstraintKey Primary a p =>
Relation () a -> Relation p a
primary = forall a p.
HasConstraintKey Primary a p =>
Relation () a -> Relation p a
primarySelect
updateValuesWithKey :: ToSql q r
=> Pi r p
-> r
-> [q]
updateValuesWithKey :: forall q r p. ToSql q r => Pi r p -> r -> [q]
updateValuesWithKey = forall q ra. ToSql q ra => [Int] -> ra -> [q]
unsafeUpdateValuesWithIndexes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. PersistableWidth a => Pi a b -> [Int]
expandIndexes
updateByConstraintKey :: Table r
-> Key c r p
-> KeyUpdate p r
updateByConstraintKey :: forall r c p. Table r -> Key c r p -> KeyUpdate p r
updateByConstraintKey Table r
table' = forall a p. Table a -> Pi a p -> KeyUpdate p a
typedKeyUpdate Table r
table' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c r ct. Key c r ct -> Pi r ct
Constraint.projectionKey
primaryUpdate :: (HasConstraintKey Primary r p)
=> Table r
-> KeyUpdate p r
primaryUpdate :: forall r p.
HasConstraintKey Primary r p =>
Table r -> KeyUpdate p r
primaryUpdate Table r
table' = forall r c p. Table r -> Key c r p -> KeyUpdate p r
updateByConstraintKey Table r
table' (forall ct r.
PersistableWidth ct =>
Key Primary r ct -> Key Unique r ct
uniqueKey forall c r ct. HasConstraintKey c r ct => Key c r ct
constraintKey)
derivedUniqueRelation :: TableDerivable r
=> Key Unique r k
-> Record c k
-> UniqueRelation () c r
derivedUniqueRelation :: forall r k c.
TableDerivable r =>
Key Unique r k -> Record c k -> UniqueRelation () c r
derivedUniqueRelation Key Unique r k
uk Record c k
kp = forall p r c. Relation p r -> UniqueRelation p c r
unsafeUnique forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. QuerySimple (Record Flat r) -> Relation () r
relation forall a b. (a -> b) -> a -> b
$ do
Record Flat r
r <- forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat r)
query forall r. TableDerivable r => Relation () r
derivedRelation
forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres forall a b. (a -> b) -> a -> b
$ Record Flat r
r forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! forall c r ct. Key c r ct -> Pi r ct
projectionKey Key Unique r k
uk forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. forall c r c'. Record c r -> Record c' r
Record.unsafeChangeContext Record c k
kp
forall (m :: * -> *) a. Monad m => a -> m a
return Record Flat r
r