{-# 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 :: Pi a p -> Relation () a -> Relation p a
specifiedKey Pi a p
key Relation () a
rel = SimpleQuery p a -> Relation p a
forall p r. SimpleQuery p r -> Relation p r
relation' (SimpleQuery p a -> Relation p a)
-> SimpleQuery p a -> Relation p a
forall a b. (a -> b) -> a -> b
$ do
Record Flat a
q <- Relation () a -> Orderings Flat QueryCore (Record Flat a)
forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat r)
query Relation () a
rel
(PlaceHolders p
param, ()) <- (Record Flat p -> Orderings Flat QueryCore ())
-> Orderings Flat QueryCore (PlaceHolders p, ())
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 -> Predicate Flat -> Orderings Flat QueryCore ()
forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres (Predicate Flat -> Orderings Flat QueryCore ())
-> Predicate Flat -> Orderings Flat QueryCore ()
forall a b. (a -> b) -> a -> b
$ PersistableRecordWidth a
-> Record Flat a -> Pi a p -> Record Flat p
forall a c b.
PersistableRecordWidth a -> Record c a -> Pi a b -> Record c b
Record.wpi (Relation () a -> PersistableRecordWidth a
forall p r. Relation p r -> PersistableRecordWidth r
relationWidth Relation () a
rel) Record Flat a
q Pi a p
key Record Flat p -> Record Flat p -> Predicate Flat
forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat p
ph)
(PlaceHolders p, Record Flat a) -> SimpleQuery p a
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 :: Key Unique a p -> Relation () a -> Relation p a
uniqueSelect = Pi a p -> Relation () a -> Relation p a
forall p a.
PersistableWidth p =>
Pi a p -> Relation () a -> Relation p a
specifiedKey (Pi a p -> Relation () a -> Relation p a)
-> (Key Unique a p -> Pi a p)
-> Key Unique a p
-> Relation () a
-> Relation p a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key Unique a p -> Pi a p
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 :: Key Unique a p -> Relation () a -> Relation p a
unique = Key Unique a p -> Relation () a -> Relation p a
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' :: Key Primary a p -> Relation () a -> Relation p a
primary' = Pi a p -> Relation () a -> Relation p a
forall p a.
PersistableWidth p =>
Pi a p -> Relation () a -> Relation p a
specifiedKey (Pi a p -> Relation () a -> Relation p a)
-> (Key Primary a p -> Pi a p)
-> Key Primary a p
-> Relation () a
-> Relation p a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key Primary a p -> Pi a p
forall c r ct. Key c r ct -> Pi r ct
projectionKey
primarySelect :: HasConstraintKey Primary a p
=> Relation () a
-> Relation p a
primarySelect :: Relation () a -> Relation p a
primarySelect = Key Primary a p -> Relation () a -> Relation p a
forall p a.
PersistableWidth p =>
Key Primary a p -> Relation () a -> Relation p a
primary' Key Primary a p
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 :: Relation () a -> Relation p a
primary = Relation () a -> Relation p a
forall a p.
HasConstraintKey Primary a p =>
Relation () a -> Relation p a
primarySelect
updateValuesWithKey :: ToSql q r
=> Pi r p
-> r
-> [q]
updateValuesWithKey :: Pi r p -> r -> [q]
updateValuesWithKey = [Int] -> r -> [q]
forall q ra. ToSql q ra => [Int] -> ra -> [q]
unsafeUpdateValuesWithIndexes ([Int] -> r -> [q]) -> (Pi r p -> [Int]) -> Pi r p -> r -> [q]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pi r p -> [Int]
forall a b. PersistableWidth a => Pi a b -> [Int]
expandIndexes
updateByConstraintKey :: Table r
-> Key c r p
-> KeyUpdate p r
updateByConstraintKey :: Table r -> Key c r p -> KeyUpdate p r
updateByConstraintKey Table r
table' = Table r -> Pi r p -> KeyUpdate p r
forall a p. Table a -> Pi a p -> KeyUpdate p a
typedKeyUpdate Table r
table' (Pi r p -> KeyUpdate p r)
-> (Key c r p -> Pi r p) -> Key c r p -> KeyUpdate p r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key c r p -> Pi r p
forall c r ct. Key c r ct -> Pi r ct
Constraint.projectionKey
primaryUpdate :: (HasConstraintKey Primary r p)
=> Table r
-> KeyUpdate p r
primaryUpdate :: Table r -> KeyUpdate p r
primaryUpdate Table r
table' = Table r -> Key Unique r p -> KeyUpdate p r
forall r c p. Table r -> Key c r p -> KeyUpdate p r
updateByConstraintKey Table r
table' (Key Primary r p -> Key Unique r p
forall ct r.
PersistableWidth ct =>
Key Primary r ct -> Key Unique r ct
uniqueKey Key Primary r p
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 :: Key Unique r k -> Record c k -> UniqueRelation () c r
derivedUniqueRelation Key Unique r k
uk Record c k
kp = Relation () r -> UniqueRelation () c r
forall p r c. Relation p r -> UniqueRelation p c r
unsafeUnique (Relation () r -> UniqueRelation () c r)
-> (QuerySimple (Record Flat r) -> Relation () r)
-> QuerySimple (Record Flat r)
-> UniqueRelation () c r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuerySimple (Record Flat r) -> Relation () r
forall r. QuerySimple (Record Flat r) -> Relation () r
relation (QuerySimple (Record Flat r) -> UniqueRelation () c r)
-> QuerySimple (Record Flat r) -> UniqueRelation () c r
forall a b. (a -> b) -> a -> b
$ do
Record Flat r
r <- Relation () r -> QuerySimple (Record Flat r)
forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat r)
query Relation () r
forall r. TableDerivable r => Relation () r
derivedRelation
Predicate Flat -> Orderings Flat QueryCore ()
forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres (Predicate Flat -> Orderings Flat QueryCore ())
-> Predicate Flat -> Orderings Flat QueryCore ()
forall a b. (a -> b) -> a -> b
$ Record Flat r
r Record Flat r -> Pi r k -> Record Flat k
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Key Unique r k -> Pi r k
forall c r ct. Key c r ct -> Pi r ct
projectionKey Key Unique r k
uk Record Flat k -> Record Flat k -> Predicate Flat
forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record c k -> Record Flat k
forall c r c'. Record c r -> Record c' r
Record.unsafeChangeContext Record c k
kp
Record Flat r -> QuerySimple (Record Flat r)
forall (m :: * -> *) a. Monad m => a -> m a
return Record Flat r
r