refactor: rm schema arg from QueryBuilder funcs
* Change TableName to QualifiedIdentifier in ReadQuery and MutateQuery. * Move removeSourceCTESchema to DbRequestBuilder.
This commit is contained in:
committed by
Steve Chávez
parent
eebe319bfd
commit
50f2cc16ab
@@ -333,24 +333,23 @@ app dbStructure proc cols conf apiRequest =
|
|||||||
topLevelRange = iTopLevelRange apiRequest
|
topLevelRange = iTopLevelRange apiRequest
|
||||||
returnsScalar = maybe False procReturnsScalar proc
|
returnsScalar = maybe False procReturnsScalar proc
|
||||||
|
|
||||||
selectQuery = readRequestToQuery schema False
|
selectQuery = readRequestToQuery False
|
||||||
countQuery = readRequestToCountQuery schema
|
|
||||||
readSqlParts tableName =
|
readSqlParts tableName =
|
||||||
let
|
let
|
||||||
readReq = readRequest schema tableName maxRows (dbRelations dbStructure) apiRequest
|
readReq = readRequest schema tableName maxRows (dbRelations dbStructure) apiRequest
|
||||||
in
|
in
|
||||||
(,,) <$>
|
(,,) <$>
|
||||||
(selectQuery <$> readReq) <*>
|
(selectQuery <$> readReq) <*>
|
||||||
(countQuery <$> readReq) <*>
|
(readRequestToCountQuery <$> readReq) <*>
|
||||||
(binaryField contentType rawContentTypes returnsScalar =<< readReq)
|
(binaryField contentType rawContentTypes returnsScalar =<< readReq)
|
||||||
mutateSqlParts s t =
|
mutateSqlParts s t =
|
||||||
let
|
let
|
||||||
readReq = readRequest s t maxRows (dbRelations dbStructure) apiRequest
|
readReq = readRequest s t maxRows (dbRelations dbStructure) apiRequest
|
||||||
mutReq = mutateRequest apiRequest t cols (tablePKCols dbStructure s t) =<< readReq
|
mutReq = mutateRequest s t apiRequest cols (tablePKCols dbStructure s t) =<< readReq
|
||||||
in
|
in
|
||||||
(,) <$>
|
(,) <$>
|
||||||
(selectQuery <$> readReq) <*>
|
(selectQuery <$> readReq) <*>
|
||||||
(mutateRequestToQuery s <$> mutReq)
|
(mutateRequestToQuery <$> mutReq)
|
||||||
|
|
||||||
responseContentTypeOrError :: [ContentType] -> [ContentType] -> Action -> Target -> Either Response ContentType
|
responseContentTypeOrError :: [ContentType] -> [ContentType] -> Action -> Target -> Either Response ContentType
|
||||||
responseContentTypeOrError accepts rawContentTypes action target = serves contentTypesForRequest accepts
|
responseContentTypeOrError accepts rawContentTypes action target = serves contentTypesForRequest accepts
|
||||||
|
|||||||
@@ -50,15 +50,15 @@ readRequest schema rootTableName maxRows allRels apiRequest =
|
|||||||
(initReadRequest rootName <$> pRequestSelect sel)
|
(initReadRequest rootName <$> pRequestSelect sel)
|
||||||
where
|
where
|
||||||
sel = fromMaybe "*" $ iSelect apiRequest -- default to all columns requested (SELECT *) for a non existent ?select querystring param
|
sel = fromMaybe "*" $ iSelect apiRequest -- default to all columns requested (SELECT *) for a non existent ?select querystring param
|
||||||
(rootName, rootRels) = rootWithRelations rootTableName allRels (iAction apiRequest)
|
(rootName, rootRels) = rootWithRelations schema rootTableName allRels (iAction apiRequest)
|
||||||
|
|
||||||
-- Get the root table name with its relations according to the Action type.
|
-- Get the root table name with its relations according to the Action type.
|
||||||
-- This is done because of the shape of the final SQL Query. The mutation cases are wrapped in a WITH {sourceCTEName}(see Statements.hs).
|
-- This is done because of the shape of the final SQL Query. The mutation cases are wrapped in a WITH {sourceCTEName}(see Statements.hs).
|
||||||
-- So we need a FROM {sourceCTEName} instead of FROM {tableName}.
|
-- So we need a FROM {sourceCTEName} instead of FROM {tableName}.
|
||||||
rootWithRelations :: TableName -> [Relation] -> Action -> (TableName, [Relation])
|
rootWithRelations :: Schema -> TableName -> [Relation] -> Action -> (QualifiedIdentifier, [Relation])
|
||||||
rootWithRelations rootTableName allRels action = case action of
|
rootWithRelations schema rootTableName allRels action = case action of
|
||||||
ActionRead _ -> (rootTableName, allRels) -- normal read case
|
ActionRead _ -> (QualifiedIdentifier schema rootTableName, allRels) -- normal read case
|
||||||
_ -> (sourceCTEName, mapMaybe toSourceRelation allRels ++ allRels) -- mutation cases and calling proc
|
_ -> (QualifiedIdentifier mempty sourceCTEName, mapMaybe toSourceRelation allRels ++ allRels) -- mutation cases and calling proc
|
||||||
where
|
where
|
||||||
-- To enable embedding in the sourceCTEName cases we need to replace the foreign key tableName in the Relation
|
-- To enable embedding in the sourceCTEName cases we need to replace the foreign key tableName in the Relation
|
||||||
-- with {sourceCTEName}. This way findRelation can find Relations with sourceCTEName.
|
-- with {sourceCTEName}. This way findRelation can find Relations with sourceCTEName.
|
||||||
@@ -69,19 +69,24 @@ rootWithRelations rootTableName allRels action = case action of
|
|||||||
|
|
||||||
-- Build the initial tree with a Depth attribute so when a self join occurs we can differentiate the parent and child tables by having
|
-- Build the initial tree with a Depth attribute so when a self join occurs we can differentiate the parent and child tables by having
|
||||||
-- an alias like "table_depth", this is related to http://github.com/PostgREST/postgrest/issues/987.
|
-- an alias like "table_depth", this is related to http://github.com/PostgREST/postgrest/issues/987.
|
||||||
initReadRequest :: TableName -> [Tree SelectItem] -> ReadRequest
|
initReadRequest :: QualifiedIdentifier -> [Tree SelectItem] -> ReadRequest
|
||||||
initReadRequest rootTableName =
|
initReadRequest rootQi =
|
||||||
foldr (treeEntry rootDepth) initial
|
foldr (treeEntry rootDepth) initial
|
||||||
where
|
where
|
||||||
rootDepth = 0
|
rootDepth = 0
|
||||||
initial = Node (Select [] rootTableName Nothing [] [] [] [] allRange, (rootTableName, Nothing, Nothing, Nothing, rootDepth)) []
|
rootSchema = qiSchema rootQi
|
||||||
|
rootName = qiName rootQi
|
||||||
|
initial = Node (Select [] rootQi Nothing [] [] [] [] allRange, (rootName, Nothing, Nothing, Nothing, rootDepth)) []
|
||||||
treeEntry :: Depth -> Tree SelectItem -> ReadRequest -> ReadRequest
|
treeEntry :: Depth -> Tree SelectItem -> ReadRequest -> ReadRequest
|
||||||
treeEntry depth (Node fld@((fn, _),_,alias,relationDetail) fldForest) (Node (q, i) rForest) =
|
treeEntry depth (Node fld@((fn, _),_,alias,relationDetail) fldForest) (Node (q, i) rForest) =
|
||||||
let nxtDepth = succ depth in
|
let nxtDepth = succ depth in
|
||||||
case fldForest of
|
case fldForest of
|
||||||
[] -> Node (q {select=fld:select q}, i) rForest
|
[] -> Node (q {select=fld:select q}, i) rForest
|
||||||
_ -> Node (q, i) $
|
_ -> Node (q, i) $
|
||||||
foldr (treeEntry nxtDepth) (Node (Select [] fn Nothing [] [] [] [] allRange, (fn, Nothing, alias, relationDetail, nxtDepth)) []) fldForest:rForest
|
foldr (treeEntry nxtDepth)
|
||||||
|
(Node (Select [] (QualifiedIdentifier rootSchema fn) Nothing [] [] [] [] allRange,
|
||||||
|
(fn, Nothing, alias, relationDetail, nxtDepth)) [])
|
||||||
|
fldForest:rForest
|
||||||
|
|
||||||
treeRestrictRange :: Maybe Integer -> ReadRequest -> Either ApiRequestError ReadRequest
|
treeRestrictRange :: Maybe Integer -> ReadRequest -> Either ApiRequestError ReadRequest
|
||||||
treeRestrictRange maxRows request = pure $ nodeRestrictRange maxRows <$> request
|
treeRestrictRange maxRows request = pure $ nodeRestrictRange maxRows <$> request
|
||||||
@@ -97,9 +102,10 @@ augumentRequestWithJoin schema allRels request =
|
|||||||
addRelations :: Schema -> [Relation] -> Maybe ReadRequest -> ReadRequest -> Either ApiRequestError ReadRequest
|
addRelations :: Schema -> [Relation] -> Maybe ReadRequest -> ReadRequest -> Either ApiRequestError ReadRequest
|
||||||
addRelations schema allRelations parentNode (Node (query@Select{from=tbl}, (nodeName, _, alias, relationDetail, depth)) forest) =
|
addRelations schema allRelations parentNode (Node (query@Select{from=tbl}, (nodeName, _, alias, relationDetail, depth)) forest) =
|
||||||
case parentNode of
|
case parentNode of
|
||||||
Just (Node (Select{from=parentNodeTable}, _) _) ->
|
Just (Node (Select{from=parentNodeQi}, _) _) ->
|
||||||
let newFrom r = if tbl == nodeName then tableName (relTable r) else tbl
|
let newFrom r = if qiName tbl == nodeName then tableQi (relTable r) else tbl
|
||||||
newReadNode = (\r -> (query{from=newFrom r}, (nodeName, Just r, alias, Nothing, depth))) <$> rel
|
newReadNode = (\r -> (query{from=newFrom r}, (nodeName, Just r, alias, Nothing, depth))) <$> rel
|
||||||
|
parentNodeTable = qiName parentNodeQi
|
||||||
rel :: Either ApiRequestError Relation
|
rel :: Either ApiRequestError Relation
|
||||||
rel = note (NoRelationBetween parentNodeTable nodeName) $
|
rel = note (NoRelationBetween parentNodeTable nodeName) $
|
||||||
findRelation schema allRelations nodeName parentNodeTable relationDetail in
|
findRelation schema allRelations nodeName parentNodeTable relationDetail in
|
||||||
@@ -201,12 +207,12 @@ addJoinConditions schema previousAlias (Node node@(query@Select{from=tbl}, nodeP
|
|||||||
Just rel@Relation{relType=Child} -> Node (augmentQuery rel, nodeProps) <$> updatedForest
|
Just rel@Relation{relType=Child} -> Node (augmentQuery rel, nodeProps) <$> updatedForest
|
||||||
Just rel@Relation{relType=Many, relLinkTable=(Just linkTable)} ->
|
Just rel@Relation{relType=Many, relLinkTable=(Just linkTable)} ->
|
||||||
let rq = augmentQuery rel in
|
let rq = augmentQuery rel in
|
||||||
Node (rq{implicitJoins=tableName linkTable:implicitJoins rq}, nodeProps) <$> updatedForest
|
Node (rq{implicitJoins=tableQi linkTable:implicitJoins rq}, nodeProps) <$> updatedForest
|
||||||
_ -> Left UnknownRelation
|
_ -> Left UnknownRelation
|
||||||
where
|
where
|
||||||
newAlias = case isSelfJoin <$> relation of
|
newAlias = case isSelfJoin <$> relation of
|
||||||
Just True
|
Just True
|
||||||
| depth /= 0 -> Just (tbl <> "_" <> show depth) -- root node doesn't get aliased
|
| depth /= 0 -> Just (qiName tbl <> "_" <> show depth) -- root node doesn't get aliased
|
||||||
| otherwise -> Nothing
|
| otherwise -> Nothing
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
augmentQuery rel =
|
augmentQuery rel =
|
||||||
@@ -231,11 +237,17 @@ getJoinConditions previousAlias newAlias (Relation Table{tableSchema=tSchema, ta
|
|||||||
where
|
where
|
||||||
toJoinCondition :: Text -> Text -> Column -> Column -> JoinCondition
|
toJoinCondition :: Text -> Text -> Column -> Column -> JoinCondition
|
||||||
toJoinCondition tb ftb c fc =
|
toJoinCondition tb ftb c fc =
|
||||||
let qi1 = QualifiedIdentifier tSchema tb
|
let qi1 = removeSourceCTESchema tSchema tb
|
||||||
qi2 = QualifiedIdentifier tSchema ftb in
|
qi2 = removeSourceCTESchema tSchema ftb in
|
||||||
JoinCondition (maybe qi1 (QualifiedIdentifier mempty) newAlias, colName c)
|
JoinCondition (maybe qi1 (QualifiedIdentifier mempty) newAlias, colName c)
|
||||||
(maybe qi2 (QualifiedIdentifier mempty) previousAlias, colName fc)
|
(maybe qi2 (QualifiedIdentifier mempty) previousAlias, colName fc)
|
||||||
|
|
||||||
|
-- On mutation and calling proc cases we wrap the target table in a WITH {sourceCTEName}
|
||||||
|
-- if this happens remove the schema `FROM "schema"."{sourceCTEName}"` and use only the
|
||||||
|
-- `FROM "{sourceCTEName}"`. If the schema remains the FROM would be invalid.
|
||||||
|
removeSourceCTESchema :: Schema -> TableName -> QualifiedIdentifier
|
||||||
|
removeSourceCTESchema schema tbl = QualifiedIdentifier (if tbl == sourceCTEName then mempty else schema) tbl
|
||||||
|
|
||||||
addFiltersOrdersRanges :: ApiRequest -> Either ApiRequestError (ReadRequest -> ReadRequest)
|
addFiltersOrdersRanges :: ApiRequest -> Either ApiRequestError (ReadRequest -> ReadRequest)
|
||||||
addFiltersOrdersRanges apiRequest = foldr1 (liftA2 (.)) [
|
addFiltersOrdersRanges apiRequest = foldr1 (liftA2 (.)) [
|
||||||
flip (foldr addFilter) <$> filters,
|
flip (foldr addFilter) <$> filters,
|
||||||
@@ -297,11 +309,11 @@ addProperty f (targetNodeName:remainingPath, a) (Node rn forest) =
|
|||||||
where
|
where
|
||||||
pathNode = find (\(Node (_,(nodeName,_,alias,_,_)) _) -> nodeName == targetNodeName || alias == Just targetNodeName) forest
|
pathNode = find (\(Node (_,(nodeName,_,alias,_,_)) _) -> nodeName == targetNodeName || alias == Just targetNodeName) forest
|
||||||
|
|
||||||
mutateRequest :: ApiRequest -> TableName -> S.Set FieldName -> [FieldName] -> ReadRequest -> Either Response MutateRequest
|
mutateRequest :: Schema -> TableName -> ApiRequest -> S.Set FieldName -> [FieldName] -> ReadRequest -> Either Response MutateRequest
|
||||||
mutateRequest apiRequest tName cols pkCols readReq = mapLeft errorResponseFor $
|
mutateRequest schema tName apiRequest cols pkCols readReq = mapLeft errorResponseFor $
|
||||||
case action of
|
case action of
|
||||||
ActionCreate -> Right $ Insert tName cols ((,) <$> iPreferResolution apiRequest <*> Just pkCols) [] returnings
|
ActionCreate -> Right $ Insert qi cols ((,) <$> iPreferResolution apiRequest <*> Just pkCols) [] returnings
|
||||||
ActionUpdate -> Update tName cols <$> combinedLogic <*> pure returnings
|
ActionUpdate -> Update qi cols <$> combinedLogic <*> pure returnings
|
||||||
ActionSingleUpsert ->
|
ActionSingleUpsert ->
|
||||||
(\flts ->
|
(\flts ->
|
||||||
if null (iLogic apiRequest) &&
|
if null (iLogic apiRequest) &&
|
||||||
@@ -310,12 +322,13 @@ mutateRequest apiRequest tName cols pkCols readReq = mapLeft errorResponseFor $
|
|||||||
all (\case
|
all (\case
|
||||||
Filter _ (OpExpr False (Op "eq" _)) -> True
|
Filter _ (OpExpr False (Op "eq" _)) -> True
|
||||||
_ -> False) flts
|
_ -> False) flts
|
||||||
then Insert tName cols (Just (MergeDuplicates, pkCols)) <$> combinedLogic <*> pure returnings
|
then Insert qi cols (Just (MergeDuplicates, pkCols)) <$> combinedLogic <*> pure returnings
|
||||||
else
|
else
|
||||||
Left InvalidFilters) =<< filters
|
Left InvalidFilters) =<< filters
|
||||||
ActionDelete -> Delete tName <$> combinedLogic <*> pure returnings
|
ActionDelete -> Delete qi <$> combinedLogic <*> pure returnings
|
||||||
_ -> Left UnsupportedVerb
|
_ -> Left UnsupportedVerb
|
||||||
where
|
where
|
||||||
|
qi = QualifiedIdentifier schema tName
|
||||||
action = iAction apiRequest
|
action = iAction apiRequest
|
||||||
returnings =
|
returnings =
|
||||||
if iPreferRepresentation apiRequest == None
|
if iPreferRepresentation apiRequest == None
|
||||||
|
|||||||
@@ -7,7 +7,7 @@ Module : PostgREST.QueryBuilder
|
|||||||
Description : PostgREST SQL queries generating functions.
|
Description : PostgREST SQL queries generating functions.
|
||||||
|
|
||||||
This module provides functions to consume data types that
|
This module provides functions to consume data types that
|
||||||
represent database objects (e.g. Relation, Schema) and SqlFragment
|
represent database queries (e.g. ReadRequest, MutateRequest) and SqlFragment
|
||||||
to produce SqlQuery type outputs.
|
to produce SqlQuery type outputs.
|
||||||
-}
|
-}
|
||||||
module PostgREST.QueryBuilder (
|
module PostgREST.QueryBuilder (
|
||||||
@@ -34,8 +34,8 @@ import PostgREST.Types
|
|||||||
import Protolude hiding (cast, intercalate,
|
import Protolude hiding (cast, intercalate,
|
||||||
replace)
|
replace)
|
||||||
|
|
||||||
readRequestToQuery :: Schema -> Bool -> ReadRequest -> SqlQuery
|
readRequestToQuery :: Bool -> ReadRequest -> SqlQuery
|
||||||
readRequestToQuery schema isParent (Node (Select colSelects tbl tblAlias implJoins logicForest joinConditions_ ordts range, _) forest) =
|
readRequestToQuery isParent (Node (Select colSelects mainQi tblAlias implJoins logicForest joinConditions_ ordts range, _) forest) =
|
||||||
unwords [
|
unwords [
|
||||||
"SELECT " <> intercalate ", " (map (pgFmtSelectItem qi) colSelects ++ selects),
|
"SELECT " <> intercalate ", " (map (pgFmtSelectItem qi) colSelects ++ selects),
|
||||||
"FROM " <> intercalate ", " (tabl : implJs),
|
"FROM " <> intercalate ", " (tabl : implJs),
|
||||||
@@ -46,8 +46,7 @@ readRequestToQuery schema isParent (Node (Select colSelects tbl tblAlias implJoi
|
|||||||
("LIMIT " <> maybe "ALL" show (rangeLimit range) <> " OFFSET " <> show (rangeOffset range)) `emptyOnFalse` (isParent || range == allRange) ]
|
("LIMIT " <> maybe "ALL" show (rangeLimit range) <> " OFFSET " <> show (rangeOffset range)) `emptyOnFalse` (isParent || range == allRange) ]
|
||||||
|
|
||||||
where
|
where
|
||||||
implJs = fromQi . QualifiedIdentifier schema <$> implJoins
|
implJs = fromQi <$> implJoins
|
||||||
mainQi = removeSourceCTESchema schema tbl
|
|
||||||
tabl = fromQi mainQi <> maybe mempty (\a -> " AS " <> pgFmtIdent a) tblAlias
|
tabl = fromQi mainQi <> maybe mempty (\a -> " AS " <> pgFmtIdent a) tblAlias
|
||||||
qi = maybe mainQi (QualifiedIdentifier mempty) tblAlias
|
qi = maybe mainQi (QualifiedIdentifier mempty) tblAlias
|
||||||
|
|
||||||
@@ -60,37 +59,37 @@ readRequestToQuery schema isParent (Node (Select colSelects tbl tblAlias implJoi
|
|||||||
<> "SELECT json_agg(" <> pgFmtIdent table <> ".*) "
|
<> "SELECT json_agg(" <> pgFmtIdent table <> ".*) "
|
||||||
<> "FROM (" <> subquery <> ") " <> pgFmtIdent table
|
<> "FROM (" <> subquery <> ") " <> pgFmtIdent table
|
||||||
<> "), '[]') AS " <> pgFmtIdent (fromMaybe name alias)
|
<> "), '[]') AS " <> pgFmtIdent (fromMaybe name alias)
|
||||||
where subquery = readRequestToQuery schema False (Node n forst)
|
where subquery = readRequestToQuery False (Node n forst)
|
||||||
getQueryParts (Node n@(_, (name, Just Relation{relType=Parent,relTable=Table{tableName=table}}, alias, _, _)) forst) (j,s) = (joi:j,sel:s)
|
getQueryParts (Node n@(_, (name, Just Relation{relType=Parent,relTable=Table{tableName=table}}, alias, _, _)) forst) (j,s) = (joi:j,sel:s)
|
||||||
where
|
where
|
||||||
aliasOrName = fromMaybe name alias
|
aliasOrName = fromMaybe name alias
|
||||||
localTableName = pgFmtIdent $ table <> "_" <> aliasOrName
|
localTableName = pgFmtIdent $ table <> "_" <> aliasOrName
|
||||||
sel = "row_to_json(" <> localTableName <> ".*) AS " <> pgFmtIdent aliasOrName
|
sel = "row_to_json(" <> localTableName <> ".*) AS " <> pgFmtIdent aliasOrName
|
||||||
joi = " LEFT JOIN LATERAL( " <> subquery <> " ) AS " <> localTableName <> " ON TRUE "
|
joi = " LEFT JOIN LATERAL( " <> subquery <> " ) AS " <> localTableName <> " ON TRUE "
|
||||||
where subquery = readRequestToQuery schema True (Node n forst)
|
where subquery = readRequestToQuery True (Node n forst)
|
||||||
getQueryParts (Node n@(_, (name, Just Relation{relType=Many,relTable=Table{tableName=table}}, alias, _, _)) forst) (j,s) = (j,sel:s)
|
getQueryParts (Node n@(_, (name, Just Relation{relType=Many,relTable=Table{tableName=table}}, alias, _, _)) forst) (j,s) = (j,sel:s)
|
||||||
where
|
where
|
||||||
sel = "COALESCE (("
|
sel = "COALESCE (("
|
||||||
<> "SELECT json_agg(" <> pgFmtIdent table <> ".*) "
|
<> "SELECT json_agg(" <> pgFmtIdent table <> ".*) "
|
||||||
<> "FROM (" <> subquery <> ") " <> pgFmtIdent table
|
<> "FROM (" <> subquery <> ") " <> pgFmtIdent table
|
||||||
<> "), '[]') AS " <> pgFmtIdent (fromMaybe name alias)
|
<> "), '[]') AS " <> pgFmtIdent (fromMaybe name alias)
|
||||||
where subquery = readRequestToQuery schema False (Node n forst)
|
where subquery = readRequestToQuery False (Node n forst)
|
||||||
--the following is just to remove the warning
|
--the following is just to remove the warning
|
||||||
--getQueryParts is not total but readRequestToQuery is called only after addJoinConditions which ensures the only
|
--getQueryParts is not total but readRequestToQuery is called only after addJoinConditions which ensures the only
|
||||||
--posible relations are Child Parent Many
|
--posible relations are Child Parent Many
|
||||||
getQueryParts _ _ = witness
|
getQueryParts _ _ = witness
|
||||||
|
|
||||||
|
|
||||||
mutateRequestToQuery :: Schema -> MutateRequest -> SqlQuery
|
mutateRequestToQuery :: MutateRequest -> SqlQuery
|
||||||
mutateRequestToQuery schema (Insert mainTbl iCols onConflct putConditions returnings) =
|
mutateRequestToQuery (Insert mainQi iCols onConflct putConditions returnings) =
|
||||||
unwords [
|
unwords [
|
||||||
"WITH " <> normalizedBody,
|
"WITH " <> normalizedBody,
|
||||||
"INSERT INTO ", fromQi qi, if S.null iCols then " " else "(" <> cols <> ")",
|
"INSERT INTO ", fromQi mainQi, if S.null iCols then " " else "(" <> cols <> ")",
|
||||||
unwords [
|
unwords [
|
||||||
"SELECT " <> cols <> " FROM",
|
"SELECT " <> cols <> " FROM",
|
||||||
"json_populate_recordset", "(null::", fromQi qi, ", " <> selectBody <> ") _",
|
"json_populate_recordset", "(null::", fromQi mainQi, ", " <> selectBody <> ") _",
|
||||||
-- Only used for PUT
|
-- Only used for PUT
|
||||||
("WHERE " <> intercalate " AND " (pgFmtLogicTree (QualifiedIdentifier "" "_") <$> putConditions)) `emptyOnFalse` null putConditions],
|
("WHERE " <> intercalate " AND " (pgFmtLogicTree (QualifiedIdentifier mempty "_") <$> putConditions)) `emptyOnFalse` null putConditions],
|
||||||
maybe "" (\(oncDo, oncCols) -> (
|
maybe "" (\(oncDo, oncCols) -> (
|
||||||
"ON CONFLICT(" <> intercalate ", " (pgFmtIdent <$> oncCols) <> ") " <> case oncDo of
|
"ON CONFLICT(" <> intercalate ", " (pgFmtIdent <$> oncCols) <> ") " <> case oncDo of
|
||||||
IgnoreDuplicates ->
|
IgnoreDuplicates ->
|
||||||
@@ -100,33 +99,29 @@ mutateRequestToQuery schema (Insert mainTbl iCols onConflct putConditions return
|
|||||||
then "DO NOTHING"
|
then "DO NOTHING"
|
||||||
else "DO UPDATE SET " <> intercalate ", " (pgFmtIdent <> const " = EXCLUDED." <> pgFmtIdent <$> S.toList iCols)
|
else "DO UPDATE SET " <> intercalate ", " (pgFmtIdent <> const " = EXCLUDED." <> pgFmtIdent <$> S.toList iCols)
|
||||||
) `emptyOnFalse` null oncCols) onConflct,
|
) `emptyOnFalse` null oncCols) onConflct,
|
||||||
("RETURNING " <> intercalate ", " (map (pgFmtColumn qi) returnings)) `emptyOnFalse` null returnings]
|
("RETURNING " <> intercalate ", " (map (pgFmtColumn mainQi) returnings)) `emptyOnFalse` null returnings]
|
||||||
where
|
where
|
||||||
qi = QualifiedIdentifier schema mainTbl
|
|
||||||
cols = intercalate ", " $ pgFmtIdent <$> S.toList iCols
|
cols = intercalate ", " $ pgFmtIdent <$> S.toList iCols
|
||||||
mutateRequestToQuery schema (Update mainTbl uCols logicForest returnings) =
|
mutateRequestToQuery (Update mainQi uCols logicForest returnings) =
|
||||||
if S.null uCols
|
if S.null uCols
|
||||||
then "WITH " <> ignoredBody <> "SELECT null WHERE false" -- if there are no columns we cannot do UPDATE table SET {empty}, it'd be invalid syntax
|
then "WITH " <> ignoredBody <> "SELECT null WHERE false" -- if there are no columns we cannot do UPDATE table SET {empty}, it'd be invalid syntax
|
||||||
else
|
else
|
||||||
unwords [
|
unwords [
|
||||||
"WITH " <> normalizedBody,
|
"WITH " <> normalizedBody,
|
||||||
"UPDATE " <> fromQi qi <> " SET " <> cols,
|
"UPDATE " <> fromQi mainQi <> " SET " <> cols,
|
||||||
"FROM (SELECT * FROM json_populate_recordset", "(null::", fromQi qi, ", " <> selectBody <> ")) _ ",
|
"FROM (SELECT * FROM json_populate_recordset", "(null::", fromQi mainQi, ", " <> selectBody <> ")) _ ",
|
||||||
("WHERE " <> intercalate " AND " (pgFmtLogicTree qi <$> logicForest)) `emptyOnFalse` null logicForest,
|
("WHERE " <> intercalate " AND " (pgFmtLogicTree mainQi <$> logicForest)) `emptyOnFalse` null logicForest,
|
||||||
("RETURNING " <> intercalate ", " (pgFmtColumn qi <$> returnings)) `emptyOnFalse` null returnings
|
("RETURNING " <> intercalate ", " (pgFmtColumn mainQi <$> returnings)) `emptyOnFalse` null returnings
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
qi = QualifiedIdentifier schema mainTbl
|
|
||||||
cols = intercalate ", " (pgFmtIdent <> const " = _." <> pgFmtIdent <$> S.toList uCols)
|
cols = intercalate ", " (pgFmtIdent <> const " = _." <> pgFmtIdent <$> S.toList uCols)
|
||||||
mutateRequestToQuery schema (Delete mainTbl logicForest returnings) =
|
mutateRequestToQuery (Delete mainQi logicForest returnings) =
|
||||||
unwords [
|
unwords [
|
||||||
"WITH " <> ignoredBody,
|
"WITH " <> ignoredBody,
|
||||||
"DELETE FROM ", fromQi qi,
|
"DELETE FROM ", fromQi mainQi,
|
||||||
("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) logicForest)) `emptyOnFalse` null logicForest,
|
("WHERE " <> intercalate " AND " (map (pgFmtLogicTree mainQi) logicForest)) `emptyOnFalse` null logicForest,
|
||||||
("RETURNING " <> intercalate ", " (map (pgFmtColumn qi) returnings)) `emptyOnFalse` null returnings
|
("RETURNING " <> intercalate ", " (map (pgFmtColumn mainQi) returnings)) `emptyOnFalse` null returnings
|
||||||
]
|
]
|
||||||
where
|
|
||||||
qi = QualifiedIdentifier schema mainTbl
|
|
||||||
|
|
||||||
requestToCallProcQuery :: QualifiedIdentifier -> [PgArg] -> Bool -> Maybe PreferParameters -> SqlQuery
|
requestToCallProcQuery :: QualifiedIdentifier -> [PgArg] -> Bool -> Maybe PreferParameters -> SqlQuery
|
||||||
requestToCallProcQuery qi pgArgs returnsScalar preferParams =
|
requestToCallProcQuery qi pgArgs returnsScalar preferParams =
|
||||||
@@ -176,15 +171,13 @@ requestToCallProcQuery qi pgArgs returnsScalar preferParams =
|
|||||||
-- It only takes WHERE into account and doesn't include LIMIT/OFFSET because it would reduce the COUNT.
|
-- It only takes WHERE into account and doesn't include LIMIT/OFFSET because it would reduce the COUNT.
|
||||||
-- SELECT 1 is done instead of SELECT * to prevent doing expensive operations(like functions based on the columns)
|
-- SELECT 1 is done instead of SELECT * to prevent doing expensive operations(like functions based on the columns)
|
||||||
-- inside the FROM target.
|
-- inside the FROM target.
|
||||||
readRequestToCountQuery :: Schema -> ReadRequest -> SqlQuery
|
readRequestToCountQuery :: ReadRequest -> SqlQuery
|
||||||
readRequestToCountQuery schema (Node (Select{where_=logicForest}, (mainTbl, _, _, _, _)) _) =
|
readRequestToCountQuery (Node (Select{from=qi, where_=logicForest}, _) _) =
|
||||||
unwords [
|
unwords [
|
||||||
"SELECT 1",
|
"SELECT 1",
|
||||||
"FROM " <> fromQi qi,
|
"FROM " <> fromQi qi,
|
||||||
("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) logicForest)) `emptyOnFalse` null logicForest
|
("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) logicForest)) `emptyOnFalse` null logicForest
|
||||||
]
|
]
|
||||||
where
|
|
||||||
qi = removeSourceCTESchema schema mainTbl
|
|
||||||
|
|
||||||
limitedQuery :: SqlQuery -> Maybe Integer -> SqlQuery
|
limitedQuery :: SqlQuery -> Maybe Integer -> SqlQuery
|
||||||
limitedQuery query maxRows = query <> maybe mempty (\x -> " LIMIT " <> show x) maxRows
|
limitedQuery query maxRows = query <> maybe mempty (\x -> " LIMIT " <> show x) maxRows
|
||||||
|
|||||||
@@ -150,9 +150,8 @@ pgFmtFilter table (Filter fld (OpExpr hasNot oper)) = notOp <> " " <> case oper
|
|||||||
(find ((==) . toLower $ v) ["null","true","false"])
|
(find ((==) . toLower $ v) ["null","true","false"])
|
||||||
|
|
||||||
pgFmtJoinCondition :: JoinCondition -> SqlFragment
|
pgFmtJoinCondition :: JoinCondition -> SqlFragment
|
||||||
pgFmtJoinCondition (JoinCondition (QualifiedIdentifier schema1 tName, col1) (QualifiedIdentifier schema2 ftName, col2)) =
|
pgFmtJoinCondition (JoinCondition (qi1, col1) (qi2, col2)) =
|
||||||
pgFmtColumn (removeSourceCTESchema schema1 tName) col1 <> " = " <>
|
pgFmtColumn qi1 col1 <> " = " <> pgFmtColumn qi2 col2
|
||||||
pgFmtColumn (removeSourceCTESchema schema2 ftName) col2
|
|
||||||
|
|
||||||
pgFmtLogicTree :: QualifiedIdentifier -> LogicTree -> SqlFragment
|
pgFmtLogicTree :: QualifiedIdentifier -> LogicTree -> SqlFragment
|
||||||
pgFmtLogicTree qi (Expr hasNot op forest) = notOp <> " (" <> intercalate (" " <> show op <> " ") (pgFmtLogicTree qi <$> forest) <> ")"
|
pgFmtLogicTree qi (Expr hasNot op forest) = notOp <> " (" <> intercalate (" " <> show op <> " ") (pgFmtLogicTree qi <$> forest) <> ")"
|
||||||
@@ -183,12 +182,6 @@ pgFmtAs _ _ (Just alias) = " AS " <> pgFmtIdent alias
|
|||||||
trimNullChars :: Text -> Text
|
trimNullChars :: Text -> Text
|
||||||
trimNullChars = T.takeWhile (/= '\x0')
|
trimNullChars = T.takeWhile (/= '\x0')
|
||||||
|
|
||||||
-- On mutation and calling proc cases we wrap the target table in a WITH {sourceCTEName}
|
|
||||||
-- if this happens remove the schema `FROM "schema"."{sourceCTEName}"` and use only the
|
|
||||||
-- `FROM "{sourceCTEName}"`. If the schema remains the FROM would be invalid.
|
|
||||||
removeSourceCTESchema :: Schema -> TableName -> QualifiedIdentifier
|
|
||||||
removeSourceCTESchema schema tbl = QualifiedIdentifier (if tbl == sourceCTEName then mempty else schema) tbl
|
|
||||||
|
|
||||||
countF :: SqlQuery -> Bool -> (SqlFragment, SqlFragment)
|
countF :: SqlQuery -> Bool -> (SqlFragment, SqlFragment)
|
||||||
countF countQuery shouldCount =
|
countF countQuery shouldCount =
|
||||||
if shouldCount
|
if shouldCount
|
||||||
|
|||||||
@@ -188,6 +188,9 @@ data Table = Table {
|
|||||||
instance Eq Table where
|
instance Eq Table where
|
||||||
Table{tableSchema=s1,tableName=n1} == Table{tableSchema=s2,tableName=n2} = s1 == s2 && n1 == n2
|
Table{tableSchema=s1,tableName=n1} == Table{tableSchema=s2,tableName=n2} = s1 == s2 && n1 == n2
|
||||||
|
|
||||||
|
tableQi :: Table -> QualifiedIdentifier
|
||||||
|
tableQi Table{tableSchema=s, tableName=n} = QualifiedIdentifier s n
|
||||||
|
|
||||||
newtype ForeignKey = ForeignKey { fkCol :: Column } deriving (Show, Eq, Ord)
|
newtype ForeignKey = ForeignKey { fkCol :: Column } deriving (Show, Eq, Ord)
|
||||||
|
|
||||||
data Column =
|
data Column =
|
||||||
@@ -397,11 +400,11 @@ data JoinCondition = JoinCondition (QualifiedIdentifier, FieldName)
|
|||||||
|
|
||||||
data ReadQuery = Select {
|
data ReadQuery = Select {
|
||||||
select :: [SelectItem]
|
select :: [SelectItem]
|
||||||
, from :: TableName
|
, from :: QualifiedIdentifier
|
||||||
-- | A table alias is used in case of self joins
|
-- | A table alias is used in case of self joins
|
||||||
, fromAlias :: Maybe Alias
|
, fromAlias :: Maybe Alias
|
||||||
-- | Only used for Many to Many joins. Parent and Child joins use explicit joins.
|
-- | Only used for Many to Many joins. Parent and Child joins use explicit joins.
|
||||||
, implicitJoins :: [TableName]
|
, implicitJoins :: [QualifiedIdentifier]
|
||||||
, where_ :: [LogicTree]
|
, where_ :: [LogicTree]
|
||||||
, joinConditions :: [JoinCondition]
|
, joinConditions :: [JoinCondition]
|
||||||
, order :: [OrderTerm]
|
, order :: [OrderTerm]
|
||||||
@@ -410,20 +413,20 @@ data ReadQuery = Select {
|
|||||||
|
|
||||||
data MutateQuery =
|
data MutateQuery =
|
||||||
Insert {
|
Insert {
|
||||||
in_ :: TableName
|
in_ :: QualifiedIdentifier
|
||||||
, insCols :: S.Set FieldName
|
, insCols :: S.Set FieldName
|
||||||
, onConflict :: Maybe (PreferResolution, [FieldName])
|
, onConflict :: Maybe (PreferResolution, [FieldName])
|
||||||
, where_ :: [LogicTree]
|
, where_ :: [LogicTree]
|
||||||
, returning :: [FieldName]
|
, returning :: [FieldName]
|
||||||
}|
|
}|
|
||||||
Update {
|
Update {
|
||||||
in_ :: TableName
|
in_ :: QualifiedIdentifier
|
||||||
, updCols :: S.Set FieldName
|
, updCols :: S.Set FieldName
|
||||||
, where_ :: [LogicTree]
|
, where_ :: [LogicTree]
|
||||||
, returning :: [FieldName]
|
, returning :: [FieldName]
|
||||||
}|
|
}|
|
||||||
Delete {
|
Delete {
|
||||||
in_ :: TableName
|
in_ :: QualifiedIdentifier
|
||||||
, where_ :: [LogicTree]
|
, where_ :: [LogicTree]
|
||||||
, returning :: [FieldName]
|
, returning :: [FieldName]
|
||||||
} deriving (Show, Eq)
|
} deriving (Show, Eq)
|
||||||
|
|||||||
Reference in New Issue
Block a user