Appease hlint

This commit is contained in:
Joe Nelson
2016-01-24 18:09:20 -08:00
parent 616541aaee
commit cbb2ba7d42
4 changed files with 24 additions and 24 deletions
+5 -5
View File
@@ -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
+2 -2
View File
@@ -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) <> ";"
{-|
+8 -8
View File
@@ -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|
+9 -9
View File
@@ -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<>"))) "