{-# 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.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
{-# DEPRECATED unique "use `uniqueSelect` instead of this." #-}
unique :: PersistableWidth p
=> Key Unique a p
-> Relation () a
-> Relation p a
unique = uniqueSelect
{-# DEPRECATED primary' "use `primarySelect` instead of this." #-}
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
{-# DEPRECATED primary "use `primarySelect` instead of this." #-}
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