From 3f8aa4808bacecaa7c3791cd8641ff134d1f4e9c Mon Sep 17 00:00:00 2001 From: Kei Hibino Date: Wed, 5 Jun 2013 11:50:46 +0900 Subject: [PATCH] Update placeholder propergation method. --- .../src/Database/Relational/Query/Derives.hs | 9 ++++--- .../Database/Relational/Query/Projectable.hs | 6 ++--- .../src/Database/Relational/Query/Relation.hs | 10 +++----- .../src/Database/Relational/Schema/IBMDB2.hs | 25 +++++++++++-------- .../Database/Relational/Schema/PostgreSQL.hs | 15 ++++++----- 5 files changed, 36 insertions(+), 29 deletions(-) diff --git a/relational-join/src/Database/Relational/Query/Derives.hs b/relational-join/src/Database/Relational/Query/Derives.hs index d3a036d8..233e5540 100644 --- a/relational-join/src/Database/Relational/Query/Derives.hs +++ b/relational-join/src/Database/Relational/Query/Derives.hs @@ -15,7 +15,7 @@ import qualified Database.Relational.Query.Table as Table import Database.Relational.Query.Projectable (placeholder, (.=.)) import Database.Relational.Query.ProjectableExtended ((!)) 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 (Key, Primary, Unique, projectionKey, uniqueKey, HasConstraintKey(constraintKey)) @@ -26,10 +26,11 @@ unique :: PersistableWidth p => Key Unique a p -> Relation () a -> Relation p a -unique uk rel = relation $ do +unique uk rel = relation' $ do q <- query rel - wheres $ q ! projectionKey uk .=. placeholder - return q + let (param, ph) = placeholder + wheres $ q ! projectionKey uk .=. ph + return (param, q) primary' :: PersistableWidth p => Key Primary a p diff --git a/relational-join/src/Database/Relational/Query/Projectable.hs b/relational-join/src/Database/Relational/Query/Projectable.hs index c4a66e04..5d710ad0 100644 --- a/relational-join/src/Database/Relational/Query/Projectable.hs +++ b/relational-join/src/Database/Relational/Query/Projectable.hs @@ -89,9 +89,6 @@ instance SqlProjectable Aggregation where valueNull :: SqlProjectable p => p (Maybe a) valueNull = unsafeProjectSql "NULL" -placeholder :: SqlProjectable p => p t -placeholder = unsafeProjectSql "?" - value :: (ShowConstantSQL t, SqlProjectable p) => t -> p t value = unsafeProjectSql . showConstantSQL @@ -220,6 +217,9 @@ addPlaceHolders = fmap ((,) PlaceHolders) unsafeCastPlaceHolders :: PlaceHolders a -> PlaceHolders b unsafeCastPlaceHolders PlaceHolders = PlaceHolders +placeholder :: SqlProjectable p => (PlaceHolders t, p t) +placeholder = (PlaceHolders, unsafeProjectSql "?") + class ProjectableZip p where projectZip :: p a -> p b -> p (a, b) diff --git a/relational-join/src/Database/Relational/Query/Relation.hs b/relational-join/src/Database/Relational/Query/Relation.hs index df9c41b7..026efef6 100644 --- a/relational-join/src/Database/Relational/Query/Relation.hs +++ b/relational-join/src/Database/Relational/Query/Relation.hs @@ -14,8 +14,6 @@ module Database.Relational.Query.Relation ( sqlFromRelation, - -- subQueryFromRelation, - nested, width ) where @@ -45,8 +43,8 @@ import qualified Database.Relational.Query.Sub as SubQuery data Relation p r = SubQuery SubQuery - | SimpleRel (SimpleQuery r) - | AggregateRel (AggregatedQuery r) + | SimpleRel (SimpleQuery r) + | AggregateRel (AggregatedQuery r) table :: Table r -> Relation () r @@ -85,13 +83,13 @@ queryMaybe' pr = do queryMaybe :: MonadQuery m => Relation () r -> m (Projection (Maybe r)) queryMaybe = fmap snd . queryMaybe' -relation :: QuerySimple (Projection r) -> Relation p r +relation :: QuerySimple (Projection r) -> Relation () r relation = SimpleRel relation' :: QuerySimple (PlaceHolders p, Projection r) -> Relation p r relation' = SimpleRel . fmap snd -aggregateRelation :: QueryAggregate (Aggregation r) -> Relation p r +aggregateRelation :: QueryAggregate (Aggregation r) -> Relation () r aggregateRelation = AggregateRel aggregateRelation' :: QueryAggregate (PlaceHolders p, Aggregation r) -> Relation p r diff --git a/relational-join/src/Database/Relational/Schema/IBMDB2.hs b/relational-join/src/Database/Relational/Schema/IBMDB2.hs index 8d6ff524..625e16a4 100644 --- a/relational-join/src/Database/Relational/Schema/IBMDB2.hs +++ b/relational-join/src/Database/Relational/Schema/IBMDB2.hs @@ -18,8 +18,8 @@ import Database.Record.Instances () import Database.Relational.Query.Type (fromRelation) import Database.Relational.Query - (Query, Relation, query, relation, - wheres, (.=.), (!), placeholder, asc, value) + (Query, Relation, query, relation', + wheres, (.=.), (!), (><), placeholder, asc, value) import Control.Applicative ((<|>)) @@ -62,19 +62,21 @@ getType mapFromSql rec = do else [t| Maybe $(typ) |] columnsRelationFromTable :: Relation (String, String) Columns -columnsRelationFromTable = relation $ do +columnsRelationFromTable = relation' $ do c <- query columns - wheres $ c ! Columns.tabschema' .=. placeholder - wheres $ c ! Columns.tabname' .=. placeholder + let (schemaParam, schemaPh) = placeholder + (nameParam , namePh) = placeholder + wheres $ c ! Columns.tabschema' .=. schemaPh + wheres $ c ! Columns.tabname' .=. namePh asc $ c ! Columns.colno' - return c + return (schemaParam >< nameParam, c) columnsQuerySQL :: Query (String, String) Columns columnsQuerySQL = fromRelation columnsRelationFromTable primaryKeyRelation :: Relation (String, String) String -primaryKeyRelation = relation $ do +primaryKeyRelation = relation' $ do cons <- query tabconst key <- query keycoluse col <- query columns @@ -88,10 +90,13 @@ primaryKeyRelation = relation $ do wheres $ cons ! Tabconst.type' .=. value "P" wheres $ cons ! Tabconst.enforced' .=. value "Y" - wheres $ cons ! Tabconst.tabschema' .=. placeholder - wheres $ cons ! Tabconst.tabname' .=. placeholder + let (schemaParam, schemaPh) = 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 = fromRelation primaryKeyRelation diff --git a/relational-join/src/Database/Relational/Schema/PostgreSQL.hs b/relational-join/src/Database/Relational/Schema/PostgreSQL.hs index 78dee576..0c1bdd8a 100644 --- a/relational-join/src/Database/Relational/Schema/PostgreSQL.hs +++ b/relational-join/src/Database/Relational/Schema/PostgreSQL.hs @@ -24,7 +24,7 @@ import Database.Record.Instances () import Database.Relational.Query.Type (fromRelation) import Database.Relational.Query - (Query, Relation, query, relation, query', relation', expr, + (Query, Relation, query, query', relation', expr, wheres, (.=.), (.>.), in', values, (!), just, placeholder, asc, value, unsafeProjectSql, (><)) @@ -96,15 +96,18 @@ getType mapFromSql column@(pgAttr, pgTyp) = do else [t| Maybe $typ |] relOidRelation :: Relation (String, String) Int32 -relOidRelation = relation $ do +relOidRelation = relation' $ do nsp <- query pgNamespace cls <- query pgClass - wheres $ cls ! Class.relnamespace' .=. nsp ! Namespace.oid' - wheres $ nsp ! Namespace.nspname' .=. placeholder - wheres $ cls ! Class.relname' .=. placeholder + let (nspParam, nspPh) = placeholder + (relParam, relPh) = 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' $ do