Add derived update SQLs.

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,
 

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)

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)