diff --git a/relational-join/src/Database/Relational/Query/Constraint.hs b/relational-join/src/Database/Relational/Query/Constraint.hs index 8e081a3b..32b7bfd4 100644 --- a/relational-join/src/Database/Relational/Query/Constraint.hs +++ b/relational-join/src/Database/Relational/Query/Constraint.hs @@ -4,7 +4,7 @@ {-# LANGUAGE UndecidableInstances #-} module Database.Relational.Query.Constraint ( - Key, defineConstraintKey, recordConstraint, projectionKey, + Key, index, defineConstraintKey, recordConstraint, projectionKey, returnKey, appendConstraint, diff --git a/relational-join/src/Database/Relational/Query/Derives.hs b/relational-join/src/Database/Relational/Query/Derives.hs index c68aab6b..9e61defa 100644 --- a/relational-join/src/Database/Relational/Query/Derives.hs +++ b/relational-join/src/Database/Relational/Query/Derives.hs @@ -3,18 +3,24 @@ module Database.Relational.Query.Derives ( unique, - primary', primary + primary', primary, + + updateByConstraintKey, + primaryUpdate ) where import Database.Record (PersistableWidth) +import Database.Relational.Query.Table (Table) +import qualified Database.Relational.Query.Table as Table import Database.Relational.Query.Relation (Relation, PrimeRelation) import Database.Relational.Query.Expr ((.=.)) import Database.Relational.Query.Projection (placeholder) import Database.Relational.Query.Join (relation, inner, wheres, (!)) import Database.Relational.Query.Constraint - (Key, Primary, Unique, projectionKey, + (Key, Primary, Unique, projectionKey, uniqueKey, HasConstraintKey(constraintKey)) import qualified Database.Relational.Query.Constraint as Constraint +import Database.Relational.Query.Type (Update, typedSingleKeyUpdate) unique :: PersistableWidth p => Key Unique a p @@ -35,3 +41,12 @@ primary :: (PersistableWidth p, HasConstraintKey Primary a p) => Relation a -> PrimeRelation p a primary = primary' constraintKey + + +updateByConstraintKey :: PersistableWidth p => Table r -> Key c r p -> Update p r +updateByConstraintKey table key = + typedSingleKeyUpdate table (table `Table.index` Constraint.index key) + +primaryUpdate :: (PersistableWidth p, HasConstraintKey Primary r p) + => Table r -> Update p r +primaryUpdate table = updateByConstraintKey table (uniqueKey constraintKey) diff --git a/relational-join/src/Database/Relational/Query/Table.hs b/relational-join/src/Database/Relational/Query/Table.hs index 4b0756b4..090910b5 100644 --- a/relational-join/src/Database/Relational/Query/Table.hs +++ b/relational-join/src/Database/Relational/Query/Table.hs @@ -1,7 +1,7 @@ module Database.Relational.Query.Table ( Untyped, name', width', columns', (!), - Table, unType, name, width, columns, table, outer, + Table, unType, name, width, columns, index, table, outer, ) where import Data.Array (Array, listArray, elems) @@ -31,6 +31,9 @@ width = width' . unType columns :: Table r -> [String] columns = columns' . unType +index :: Table r -> Int -> String +index = (!) . unType + outer :: Table r -> Table (Maybe r) outer (Table t) = (Table t)