module Database.Relational.Query.Derives (
specifiedKey,
unique,
primary', primary,
updateByConstraintKey,
primaryUpdate,
updateValuesWithKey,
derivedUniqueRelation
) where
import Database.Record (PersistableWidth, ToSql (recordToSql))
import Database.Record.ToSql (unsafeUpdateValuesWithIndexes)
import Database.Relational.Query.Table (Table, TableDerivable)
import Database.Relational.Query.Pi.Unsafe (Pi, unsafeExpandIndexes)
import Database.Relational.Query.Projection (Projection)
import qualified Database.Relational.Query.Projection as Projection
import Database.Relational.Query.Projectable (placeholder, (.=.))
import Database.Relational.Query.ProjectableExtended ((!))
import Database.Relational.Query.Monad.Class (wheres)
import Database.Relational.Query.Monad.BaseType (Relation, relationWidth)
import Database.Relational.Query.Relation
(derivedRelation, relation, relation', query, UniqueRelation, unsafeUnique)
import Database.Relational.Query.Constraint
(Key, Primary, Unique, projectionKey, uniqueKey,
HasConstraintKey(constraintKey))
import qualified Database.Relational.Query.Constraint as Constraint
import Database.Relational.Query.Type (KeyUpdate, typedKeyUpdate)
specifiedKey :: PersistableWidth p
=> Pi a p
-> Relation () a
-> Relation p a
specifiedKey key rel = relation' $ do
q <- query rel
(param, ()) <- placeholder (\ph -> wheres $ Projection.wpi (relationWidth rel) q key .=. ph)
return (param, q)
unique :: PersistableWidth p
=> Key Unique a p
-> Relation () a
-> Relation p a
unique = specifiedKey . projectionKey
primary' :: PersistableWidth p
=> Key Primary a p
-> Relation () a
-> Relation p a
primary' = specifiedKey . projectionKey
primary :: HasConstraintKey Primary a p
=> Relation () a
-> Relation p a
primary = primary' constraintKey
updateValuesWithKey :: ToSql q r
=> Pi r p
-> r
-> [q]
updateValuesWithKey = unsafeUpdateValuesWithIndexes recordToSql . unsafeExpandIndexes
updateByConstraintKey :: Table r
-> Key c r p
-> KeyUpdate p r
updateByConstraintKey table' = typedKeyUpdate table' . Constraint.projectionKey
primaryUpdate :: (HasConstraintKey Primary r p)
=> Table r
-> KeyUpdate p r
primaryUpdate table' = updateByConstraintKey table' (uniqueKey constraintKey)
derivedUniqueRelation :: TableDerivable r
=> Key Unique r k
-> Projection c k
-> UniqueRelation () c r
derivedUniqueRelation uk kp = unsafeUnique . relation $ do
r <- query derivedRelation
wheres $ r ! projectionKey uk .=. Projection.unsafeChangeContext kp
return r