Appease hlint
This commit is contained in:
@@ -86,7 +86,7 @@ app dbStructure conf reqBody req =
|
||||
else responseLBS status200 [contentTypeH] (cs body)
|
||||
else do
|
||||
let frm = toInteger $ rangeOffset range
|
||||
to = frm+(toInteger queryTotal)-1
|
||||
to = frm + toInteger queryTotal - 1
|
||||
contentRange = contentRangeH frm to (toInteger <$> tableTotal)
|
||||
status = rangeStatus frm to (toInteger <$> tableTotal)
|
||||
canonical = urlEncodeVars -- should this be moved to the dbStructure (location)?
|
||||
@@ -138,7 +138,7 @@ app dbStructure conf reqBody req =
|
||||
Left e -> return $ responseLBS status400 [jsonH] $ cs e
|
||||
Right (sq,mq) -> do
|
||||
let emptyUniform = UniformObjects V.empty
|
||||
let fakeload = PayloadJSON $ emptyUniform
|
||||
let fakeload = PayloadJSON emptyUniform
|
||||
let stm = createWriteStatement qi sq mq False (iPreferRepresentation apiRequest) [] (contentType == TextCSV) fakeload
|
||||
row <- H.query emptyUniform stm
|
||||
let (_, queryTotal, _, _) = extractQueryResult row
|
||||
@@ -151,7 +151,7 @@ app dbStructure conf reqBody req =
|
||||
pkeys = map pkName $ filter (filterPk tSchema tTable) allPrKeys
|
||||
body = encode (TableOptions cols pkeys)
|
||||
filterCol :: Schema -> TableName -> Column -> Bool
|
||||
filterCol sc tb (Column{colTable=Table{tableSchema=s, tableName=t}}) = s==sc && t==tb
|
||||
filterCol sc tb Column{colTable=Table{tableSchema=s, tableName=t}} = s==sc && t==tb
|
||||
filterCol _ _ _ = False
|
||||
return $ responseLBS status200 [jsonH, allOrigins] $ cs body
|
||||
|
||||
@@ -166,7 +166,7 @@ app dbStructure conf reqBody req =
|
||||
bodyJson <- H.query () (callProc qi p)
|
||||
returnJWT <- H.query qi doesProcReturnJWT
|
||||
return $ responseLBS status200 [jsonH]
|
||||
(let body = fromMaybe emptyArray $ bodyJson in
|
||||
(let body = fromMaybe emptyArray bodyJson in
|
||||
if returnJWT
|
||||
then "{\"token\":\"" <> cs (tokenJWT jwtSecret body) <> "\"}"
|
||||
else cs $ encode body)
|
||||
@@ -293,7 +293,7 @@ buildMutateRequest apiRequest =
|
||||
cond = first formatParserError $ map snd <$> mapM pRequestFilter mutateFilters
|
||||
|
||||
addFilter :: (Path, Filter) -> ReadRequest -> ReadRequest
|
||||
addFilter ([], flt) (Node (q@(Select {flt_=flts}), i) forest) = Node (q {flt_=flt:flts}, i) forest
|
||||
addFilter ([], flt) (Node (q@Select {flt_=flts}, i) forest) = Node (q {flt_=flt:flts}, i) forest
|
||||
addFilter (path, flt) (Node rn forest) =
|
||||
case targetNode of
|
||||
Nothing -> Node rn forest -- the filter is silenty dropped in the Request does not contain the required path
|
||||
|
||||
@@ -66,9 +66,9 @@ jwtClaims secret input time =
|
||||
claim prop = prop . JWT.claims <$> decoded
|
||||
customClaims = claim JWT.unregisteredClaims
|
||||
|
||||
-- | Receives the name of a role and returns a SET ROLE statement
|
||||
{-| Receives the name of a role and returns a SET ROLE statement -}
|
||||
setRole :: Text -> BS.ByteString
|
||||
setRole role = "set local role " <> cs (pgFmtLit role) <> ";"
|
||||
setRole r = "set local role " <> cs (pgFmtLit r) <> ";"
|
||||
|
||||
|
||||
{-|
|
||||
|
||||
@@ -31,7 +31,7 @@ import Prelude
|
||||
|
||||
getDbStructure :: Schema -> H.Session DbStructure
|
||||
getDbStructure schema = do
|
||||
tabs <- H.query () $ allTables
|
||||
tabs <- H.query () allTables
|
||||
cols <- H.query () $ allColumns tabs
|
||||
syns <- H.query () $ allSynonyms cols
|
||||
rels <- H.query () $ allRelations tabs cols
|
||||
@@ -172,9 +172,9 @@ addForeignKeys rels = map addFk
|
||||
addFk col = col { colFK = fk col }
|
||||
fk col = join $ relToFk col <$> find (lookupFn col) rels
|
||||
lookupFn :: Column -> Relation -> Bool
|
||||
lookupFn c (Relation{relColumns=cs, relType=rty}) = c `elem` cs && rty==Child
|
||||
lookupFn c Relation{relColumns=cs, relType=rty} = c `elem` cs && rty==Child
|
||||
-- lookupFn _ _ = False
|
||||
relToFk col (Relation{relColumns=cols, relFColumns=colsF}) = ForeignKey <$> colF
|
||||
relToFk col Relation{relColumns=cols, relFColumns=colsF} = ForeignKey <$> colF
|
||||
where
|
||||
pos = elemIndex col cols
|
||||
colF = (colsF !!) <$> pos
|
||||
@@ -196,7 +196,7 @@ addManyToManyRelations rels = rels ++ addMirrorRelation (mapMaybe link2Relation
|
||||
where
|
||||
links = join $ map (combinations 2) $ filter (not . null) $ groupWith groupFn $ filter ( (==Child). relType) rels
|
||||
groupFn :: Relation -> Text
|
||||
groupFn (Relation{relTable=Table{tableSchema=s, tableName=t}}) = s<>"_"<>t
|
||||
groupFn Relation{relTable=Table{tableSchema=s, tableName=t}} = s<>"_"<>t
|
||||
combinations k ns = filter ((k==).length) (subsequences ns)
|
||||
addMirrorRelation [] = []
|
||||
addMirrorRelation (rel@(Relation t c ft fc _ lt lc1 lc2):rels') = Relation ft fc t c Many lt lc2 lc1 : rel : addMirrorRelation rels'
|
||||
@@ -251,7 +251,7 @@ allTables =
|
||||
ORDER BY table_schema, table_name |]
|
||||
|
||||
allColumns :: [Table] -> H.Query () [Column]
|
||||
allColumns tabs = do
|
||||
allColumns tabs =
|
||||
H.statement sql HE.unit (decodeColumns tabs) True
|
||||
where
|
||||
sql = [q|
|
||||
@@ -402,7 +402,7 @@ columnFromRow tabs (s, t, n, pos, nul, typ, u, l, p, d, e) = buildColumn <$> tab
|
||||
parseEnum str = fromMaybe [] $ split (==',') <$> str
|
||||
|
||||
allRelations :: [Table] -> [Column] -> H.Query () [Relation]
|
||||
allRelations tabs cols = do
|
||||
allRelations tabs cols =
|
||||
H.statement sql HE.unit (decodeRelations tabs cols) True
|
||||
where
|
||||
sql = [q|
|
||||
@@ -443,7 +443,7 @@ relationFromRow allTabs allCols (rs, rt, rcs, frs, frt, frcs) =
|
||||
colsF = mapM (findCol frs frt) frcs
|
||||
|
||||
allPrimaryKeys :: [Table] -> H.Query () [PrimaryKey]
|
||||
allPrimaryKeys tabs = do
|
||||
allPrimaryKeys tabs =
|
||||
H.statement sql HE.unit (decodePks tabs) True
|
||||
where
|
||||
sql = [q|
|
||||
@@ -553,7 +553,7 @@ pkFromRow tabs (s, t, n) = PrimaryKey <$> table <*> pure n
|
||||
where table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
|
||||
|
||||
allSynonyms :: [Column] -> H.Query () [(Column,Column)]
|
||||
allSynonyms cols = do
|
||||
allSynonyms cols =
|
||||
H.statement sql HE.unit (decodeSynonyms cols) True
|
||||
where
|
||||
sql = [q|
|
||||
|
||||
@@ -187,9 +187,9 @@ addJoinConditions :: Schema -> ReadRequest -> Either Text ReadRequest
|
||||
addJoinConditions schema (Node (query, (n, r)) forest) =
|
||||
case r of
|
||||
Nothing -> Node (updatedQuery, (n,r)) <$> updatedForest -- this is the root node
|
||||
Just rel@(Relation{relType=Child}) -> Node (addCond updatedQuery (getJoinConditions rel),(n,r)) <$> updatedForest
|
||||
Just (Relation{relType=Parent}) -> Node (updatedQuery, (n,r)) <$> updatedForest
|
||||
Just rel@(Relation{relType=Many, relLTable=(Just linkTable)}) ->
|
||||
Just rel@Relation{relType=Child} -> Node (addCond updatedQuery (getJoinConditions rel),(n,r)) <$> updatedForest
|
||||
Just Relation{relType=Parent} -> Node (updatedQuery, (n,r)) <$> updatedForest
|
||||
Just rel@Relation{relType=Many, relLTable=(Just linkTable)} ->
|
||||
Node (qq, (n, r)) <$> updatedForest
|
||||
where
|
||||
query' = addCond updatedQuery (getJoinConditions rel)
|
||||
@@ -201,7 +201,7 @@ addJoinConditions schema (Node (query, (n, r)) forest) =
|
||||
where
|
||||
parentJoinConditions = map (getJoinConditions . snd) parents
|
||||
parents = mapMaybe (getParents . rootLabel) forest
|
||||
getParents (_, (tbl, Just rel@(Relation{relType=Parent}))) = Just (tbl, rel)
|
||||
getParents (_, (tbl, Just rel@Relation{relType=Parent})) = Just (tbl, rel)
|
||||
getParents _ = Nothing
|
||||
updatedForest = mapM (addJoinConditions schema) forest
|
||||
addCond query' con = query'{flt_=con ++ flt_ query'}
|
||||
@@ -259,8 +259,8 @@ requestToCountQuery schema (DbRead (Node (Select _ _ conditions _, (mainTbl, _))
|
||||
("WHERE " <> intercalate " AND " ( map (pgFmtCondition (QualifiedIdentifier schema mainTbl)) localConditions )) `emptyOnNull` localConditions
|
||||
]
|
||||
where
|
||||
fn (Filter{value=VText _}) = True
|
||||
fn (Filter{value=VForeignKey _ _}) = False
|
||||
fn Filter{value=VText _} = True
|
||||
fn Filter{value=VForeignKey _ _} = False
|
||||
localConditions = filter fn conditions
|
||||
|
||||
requestToQuery :: Schema -> DbRequest -> SqlQuery
|
||||
@@ -305,19 +305,19 @@ requestToQuery schema (DbRead (Node (Select colSelects tbls conditions ord, (nod
|
||||
filterParentConditions parentTable (Filter _ _ (VForeignKey (QualifiedIdentifier "" t) _)) = parentTable == t
|
||||
filterParentConditions _ _ = False
|
||||
getQueryParts :: Tree ReadNode -> ([(SqlFragment, TableName)], [SqlFragment]) -> ([(SqlFragment,TableName)], [SqlFragment])
|
||||
getQueryParts (Node n@(_, (name, Just (Relation {relType=Child,relTable=Table{tableName=table}}))) forst) (j,s) = (j,sel:s)
|
||||
getQueryParts (Node n@(_, (name, Just Relation{relType=Child,relTable=Table{tableName=table}})) forst) (j,s) = (j,sel:s)
|
||||
where
|
||||
sel = "COALESCE(("
|
||||
<> "SELECT array_to_json(array_agg(row_to_json("<>pgFmtIdent table<>"))) "
|
||||
<> "FROM (" <> subquery <> ") " <> pgFmtIdent table
|
||||
<> "), '[]') AS " <> pgFmtIdent name
|
||||
where subquery = requestToQuery schema (DbRead (Node n forst))
|
||||
getQueryParts (Node n@(_, (name, Just (Relation {relType=Parent,relTable=Table{tableName=table}}))) forst) (j,s) = (joi:j,sel:s)
|
||||
getQueryParts (Node n@(_, (name, Just Relation{relType=Parent,relTable=Table{tableName=table}})) forst) (j,s) = (joi:j,sel:s)
|
||||
where
|
||||
sel = "row_to_json(" <> pgFmtIdent table <> ".*) AS "<>pgFmtIdent name --TODO must be singular
|
||||
joi = ("( " <> subquery <> " ) AS " <> pgFmtIdent table, table)
|
||||
where subquery = requestToQuery schema (DbRead (Node n forst))
|
||||
getQueryParts (Node n@(_, (name, Just (Relation {relType=Many,relTable=Table{tableName=table}}))) forst) (j,s) = (j,sel:s)
|
||||
getQueryParts (Node n@(_, (name, Just Relation{relType=Many,relTable=Table{tableName=table}})) forst) (j,s) = (j,sel:s)
|
||||
where
|
||||
sel = "COALESCE (("
|
||||
<> "SELECT array_to_json(array_agg(row_to_json("<>pgFmtIdent table<>"))) "
|
||||
|
||||
Reference in New Issue
Block a user