Update about placeholder propagation.

relational-join/src/Database/Relational/Query/Derives.hs

@@ -28,8 +28,7 @@ unique :: PersistableWidth p
        -> Relation p a
 unique uk rel = relation' $ do
   q <- query rel
-  let (param, ph) = placeholder
-  wheres $ q ! projectionKey uk .=. ph
+  (param, ()) <- placeholder (\ph -> wheres $ q ! projectionKey uk .=. ph)
   return (param, q)
 
 primary' :: PersistableWidth p

relational-join/src/Database/Relational/Query/Projectable.hs

@@ -10,7 +10,7 @@ module Database.Relational.Query.Projectable (
   values,
 
   SqlProjectable (unsafeProjectSql),
-  valueNull, placeholder,
+  valueNull, placeholder', placeholder,
 
   unsafeAggregateOp,
   count, sum', avg, max', min', every, any', some',
@@ -217,8 +217,14 @@ addPlaceHolders =  fmap ((,) PlaceHolders)
 unsafeCastPlaceHolders :: PlaceHolders a -> PlaceHolders b
 unsafeCastPlaceHolders PlaceHolders = PlaceHolders
 
-placeholder :: SqlProjectable p => (PlaceHolders t, p t)
-placeholder =  (PlaceHolders, unsafeProjectSql "?")
+placeholder' :: SqlProjectable p => (p t -> a) ->  (PlaceHolders t, a)
+placeholder' f = (PlaceHolders, f $ unsafeProjectSql "?")
+
+placeholder :: (SqlProjectable p, Monad m) => (p t -> m a) -> m (PlaceHolders t, a)
+placeholder f = do
+  let (ph, ma) = placeholder' f
+  a <- ma
+  return (ph, a)
 
 
 class ProjectableZip p where

relational-join/src/Database/Relational/Schema/IBMDB2.hs

@@ -64,12 +64,10 @@ getType mapFromSql rec = do
 columnsRelationFromTable :: Relation (String, String) Columns
 columnsRelationFromTable =  relation' $ do
   c <- query columns
-  let (schemaParam, schemaPh) = placeholder
-      (nameParam  , namePh)   = placeholder
-  wheres $ c ! Columns.tabschema' .=. schemaPh
-  wheres $ c ! Columns.tabname'   .=. namePh
+  (schemaP, ()) <- placeholder (\ph -> wheres $ c ! Columns.tabschema' .=. ph)
+  (nameP  , ()) <- placeholder (\ph -> wheres $ c ! Columns.tabname'   .=. ph)
   asc $ c ! Columns.colno'
-  return (schemaParam >< nameParam, c)
+  return (schemaP >< nameP, c)
 
 columnsQuerySQL :: Query (String, String) Columns
 columnsQuerySQL =  fromRelation columnsRelationFromTable
@@ -90,13 +88,10 @@ primaryKeyRelation =  relation' $ do
   wheres $ cons ! Tabconst.type'     .=. value "P"
   wheres $ cons ! Tabconst.enforced' .=. value "Y"
 
-  let (schemaParam, schemaPh) = placeholder
-      (nameParam  , namePh)   = placeholder
+  (schemaP, ()) <- placeholder (\ph -> wheres $ cons ! Tabconst.tabschema' .=. ph)
+  (nameP  , ()) <- placeholder (\ph -> wheres $ cons ! Tabconst.tabname'   .=. ph)
 
-  wheres $ cons ! Tabconst.tabschema' .=. schemaPh
-  wheres $ cons ! Tabconst.tabname'   .=. namePh
-
-  return   (schemaParam >< nameParam, key ! Keycoluse.colname')
+  return   (schemaP >< nameP, key ! Keycoluse.colname')
 
 primaryKeyQuerySQL :: Query (String, String) String
 primaryKeyQuerySQL =  fromRelation primaryKeyRelation

relational-join/src/Database/Relational/Schema/PostgreSQL.hs

@@ -100,14 +100,11 @@ relOidRelation = relation' $ do
   nsp <- query pgNamespace
   cls <- query pgClass
 
-  let (nspParam, nspPh) = placeholder
-      (relParam, relPh) = placeholder
-
   wheres $ cls ! Class.relnamespace' .=. nsp ! Namespace.oid'
-  wheres $ nsp ! Namespace.nspname'  .=. nspPh
-  wheres $ cls ! Class.relname'      .=. relPh
+  (nspP, ()) <- placeholder (\ph -> wheres $ nsp ! Namespace.nspname'  .=. ph)
+  (relP, ()) <- placeholder (\ph -> wheres $ cls ! Class.relname'      .=. ph)
 
-  return   (nspParam >< relParam, cls ! Class.oid')
+  return   (nspP >< relP, cls ! Class.oid')
 
 attributeRelation :: Relation (String, String) PgAttribute
 attributeRelation =  relation' $ do