Update placeholder propergation method.

This commit is contained in:
Kei Hibino 2013-06-05 11:50:46 +09:00
parent 0def28fa95
commit 3f8aa4808b
5 changed files with 36 additions and 29 deletions

View File

@ -15,7 +15,7 @@ import qualified Database.Relational.Query.Table as Table
import Database.Relational.Query.Projectable (placeholder, (.=.)) import Database.Relational.Query.Projectable (placeholder, (.=.))
import Database.Relational.Query.ProjectableExtended ((!)) import Database.Relational.Query.ProjectableExtended ((!))
import Database.Relational.Query.Monad.Class (wheres) import Database.Relational.Query.Monad.Class (wheres)
import Database.Relational.Query.Relation (Relation, relation, query) import Database.Relational.Query.Relation (Relation, relation', query)
import Database.Relational.Query.Constraint import Database.Relational.Query.Constraint
(Key, Primary, Unique, projectionKey, uniqueKey, (Key, Primary, Unique, projectionKey, uniqueKey,
HasConstraintKey(constraintKey)) HasConstraintKey(constraintKey))
@ -26,10 +26,11 @@ unique :: PersistableWidth p
=> Key Unique a p => Key Unique a p
-> Relation () a -> Relation () a
-> Relation p a -> Relation p a
unique uk rel = relation $ do unique uk rel = relation' $ do
q <- query rel q <- query rel
wheres $ q ! projectionKey uk .=. placeholder let (param, ph) = placeholder
return q wheres $ q ! projectionKey uk .=. ph
return (param, q)
primary' :: PersistableWidth p primary' :: PersistableWidth p
=> Key Primary a p => Key Primary a p

View File

@ -89,9 +89,6 @@ instance SqlProjectable Aggregation where
valueNull :: SqlProjectable p => p (Maybe a) valueNull :: SqlProjectable p => p (Maybe a)
valueNull = unsafeProjectSql "NULL" valueNull = unsafeProjectSql "NULL"
placeholder :: SqlProjectable p => p t
placeholder = unsafeProjectSql "?"
value :: (ShowConstantSQL t, SqlProjectable p) => t -> p t value :: (ShowConstantSQL t, SqlProjectable p) => t -> p t
value = unsafeProjectSql . showConstantSQL value = unsafeProjectSql . showConstantSQL
@ -220,6 +217,9 @@ addPlaceHolders = fmap ((,) PlaceHolders)
unsafeCastPlaceHolders :: PlaceHolders a -> PlaceHolders b unsafeCastPlaceHolders :: PlaceHolders a -> PlaceHolders b
unsafeCastPlaceHolders PlaceHolders = PlaceHolders unsafeCastPlaceHolders PlaceHolders = PlaceHolders
placeholder :: SqlProjectable p => (PlaceHolders t, p t)
placeholder = (PlaceHolders, unsafeProjectSql "?")
class ProjectableZip p where class ProjectableZip p where
projectZip :: p a -> p b -> p (a, b) projectZip :: p a -> p b -> p (a, b)

View File

@ -14,8 +14,6 @@ module Database.Relational.Query.Relation (
sqlFromRelation, sqlFromRelation,
-- subQueryFromRelation,
nested, width nested, width
) where ) where
@ -85,13 +83,13 @@ queryMaybe' pr = do
queryMaybe :: MonadQuery m => Relation () r -> m (Projection (Maybe r)) queryMaybe :: MonadQuery m => Relation () r -> m (Projection (Maybe r))
queryMaybe = fmap snd . queryMaybe' queryMaybe = fmap snd . queryMaybe'
relation :: QuerySimple (Projection r) -> Relation p r relation :: QuerySimple (Projection r) -> Relation () r
relation = SimpleRel relation = SimpleRel
relation' :: QuerySimple (PlaceHolders p, Projection r) -> Relation p r relation' :: QuerySimple (PlaceHolders p, Projection r) -> Relation p r
relation' = SimpleRel . fmap snd relation' = SimpleRel . fmap snd
aggregateRelation :: QueryAggregate (Aggregation r) -> Relation p r aggregateRelation :: QueryAggregate (Aggregation r) -> Relation () r
aggregateRelation = AggregateRel aggregateRelation = AggregateRel
aggregateRelation' :: QueryAggregate (PlaceHolders p, Aggregation r) -> Relation p r aggregateRelation' :: QueryAggregate (PlaceHolders p, Aggregation r) -> Relation p r

View File

@ -18,8 +18,8 @@ import Database.Record.Instances ()
import Database.Relational.Query.Type (fromRelation) import Database.Relational.Query.Type (fromRelation)
import Database.Relational.Query import Database.Relational.Query
(Query, Relation, query, relation, (Query, Relation, query, relation',
wheres, (.=.), (!), placeholder, asc, value) wheres, (.=.), (!), (><), placeholder, asc, value)
import Control.Applicative ((<|>)) import Control.Applicative ((<|>))
@ -62,19 +62,21 @@ getType mapFromSql rec = do
else [t| Maybe $(typ) |] else [t| Maybe $(typ) |]
columnsRelationFromTable :: Relation (String, String) Columns columnsRelationFromTable :: Relation (String, String) Columns
columnsRelationFromTable = relation $ do columnsRelationFromTable = relation' $ do
c <- query columns c <- query columns
wheres $ c ! Columns.tabschema' .=. placeholder let (schemaParam, schemaPh) = placeholder
wheres $ c ! Columns.tabname' .=. placeholder (nameParam , namePh) = placeholder
wheres $ c ! Columns.tabschema' .=. schemaPh
wheres $ c ! Columns.tabname' .=. namePh
asc $ c ! Columns.colno' asc $ c ! Columns.colno'
return c return (schemaParam >< nameParam, c)
columnsQuerySQL :: Query (String, String) Columns columnsQuerySQL :: Query (String, String) Columns
columnsQuerySQL = fromRelation columnsRelationFromTable columnsQuerySQL = fromRelation columnsRelationFromTable
primaryKeyRelation :: Relation (String, String) String primaryKeyRelation :: Relation (String, String) String
primaryKeyRelation = relation $ do primaryKeyRelation = relation' $ do
cons <- query tabconst cons <- query tabconst
key <- query keycoluse key <- query keycoluse
col <- query columns col <- query columns
@ -88,10 +90,13 @@ primaryKeyRelation = relation $ do
wheres $ cons ! Tabconst.type' .=. value "P" wheres $ cons ! Tabconst.type' .=. value "P"
wheres $ cons ! Tabconst.enforced' .=. value "Y" wheres $ cons ! Tabconst.enforced' .=. value "Y"
wheres $ cons ! Tabconst.tabschema' .=. placeholder let (schemaParam, schemaPh) = placeholder
wheres $ cons ! Tabconst.tabname' .=. placeholder (nameParam , namePh) = placeholder
return $ key ! Keycoluse.colname' wheres $ cons ! Tabconst.tabschema' .=. schemaPh
wheres $ cons ! Tabconst.tabname' .=. namePh
return (schemaParam >< nameParam, key ! Keycoluse.colname')
primaryKeyQuerySQL :: Query (String, String) String primaryKeyQuerySQL :: Query (String, String) String
primaryKeyQuerySQL = fromRelation primaryKeyRelation primaryKeyQuerySQL = fromRelation primaryKeyRelation

View File

@ -24,7 +24,7 @@ import Database.Record.Instances ()
import Database.Relational.Query.Type (fromRelation) import Database.Relational.Query.Type (fromRelation)
import Database.Relational.Query import Database.Relational.Query
(Query, Relation, query, relation, query', relation', expr, (Query, Relation, query, query', relation', expr,
wheres, (.=.), (.>.), in', values, (!), just, wheres, (.=.), (.>.), in', values, (!), just,
placeholder, asc, value, unsafeProjectSql, (><)) placeholder, asc, value, unsafeProjectSql, (><))
@ -96,15 +96,18 @@ getType mapFromSql column@(pgAttr, pgTyp) = do
else [t| Maybe $typ |] else [t| Maybe $typ |]
relOidRelation :: Relation (String, String) Int32 relOidRelation :: Relation (String, String) Int32
relOidRelation = relation $ do relOidRelation = relation' $ do
nsp <- query pgNamespace nsp <- query pgNamespace
cls <- query pgClass cls <- query pgClass
wheres $ cls ! Class.relnamespace' .=. nsp ! Namespace.oid' let (nspParam, nspPh) = placeholder
wheres $ nsp ! Namespace.nspname' .=. placeholder (relParam, relPh) = placeholder
wheres $ cls ! Class.relname' .=. placeholder
return $ cls ! Class.oid' wheres $ cls ! Class.relnamespace' .=. nsp ! Namespace.oid'
wheres $ nsp ! Namespace.nspname' .=. nspPh
wheres $ cls ! Class.relname' .=. relPh
return (nspParam >< relParam, cls ! Class.oid')
attributeRelation :: Relation (String, String) PgAttribute attributeRelation :: Relation (String, String) PgAttribute
attributeRelation = relation' $ do attributeRelation = relation' $ do