mirror of
https://github.com/khibino/haskell-relational-record.git
synced 2024-12-15 23:03:19 +03:00
Update placeholder propergation method.
This commit is contained in:
parent
0def28fa95
commit
3f8aa4808b
@ -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
|
||||||
|
@ -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)
|
||||||
|
@ -14,8 +14,6 @@ module Database.Relational.Query.Relation (
|
|||||||
|
|
||||||
sqlFromRelation,
|
sqlFromRelation,
|
||||||
|
|
||||||
-- subQueryFromRelation,
|
|
||||||
|
|
||||||
nested, width
|
nested, width
|
||||||
) where
|
) where
|
||||||
|
|
||||||
@ -45,8 +43,8 @@ import qualified Database.Relational.Query.Sub as SubQuery
|
|||||||
|
|
||||||
|
|
||||||
data Relation p r = SubQuery SubQuery
|
data Relation p r = SubQuery SubQuery
|
||||||
| SimpleRel (SimpleQuery r)
|
| SimpleRel (SimpleQuery r)
|
||||||
| AggregateRel (AggregatedQuery r)
|
| AggregateRel (AggregatedQuery r)
|
||||||
|
|
||||||
|
|
||||||
table :: Table r -> Relation () r
|
table :: Table r -> Relation () r
|
||||||
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user