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.Unsafe (Pi, unsafeExpandIndexes)
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 key rel = relation' $ do
q <- query rel
(param, ()) <- placeholder (\ph -> wheres $ Record.wpi (relationWidth rel) q key .=. ph)
return (param, q)
uniqueSelect :: PersistableWidth p
=> Key Unique a p
-> Relation () a
-> Relation p a
uniqueSelect = specifiedKey . projectionKey
unique :: PersistableWidth p
=> Key Unique a p
-> Relation () a
-> Relation p a
unique = uniqueSelect
primary' :: PersistableWidth p
=> Key Primary a p
-> Relation () a
-> Relation p a
primary' = specifiedKey . projectionKey
primarySelect :: HasConstraintKey Primary a p
=> Relation () a
-> Relation p a
primarySelect = primary' constraintKey
primary :: HasConstraintKey Primary a p
=> Relation () a
-> Relation p a
primary = primarySelect
updateValuesWithKey :: ToSql q r
=> Pi r p
-> r
-> [q]
updateValuesWithKey = unsafeUpdateValuesWithIndexes . 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
-> Record c k
-> UniqueRelation () c r
derivedUniqueRelation uk kp = unsafeUnique . relation $ do
r <- query derivedRelation
wheres $ r ! projectionKey uk .=. Record.unsafeChangeContext kp
return r