jimmy/postgrest
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Makes exports explicit and move some functions around

Browse Source
This commit is contained in:
Diogo Biazus
2015-11-14 22:43:03 -05:00
parent a6cfecbc29
commit fbe6600ff1
1 changed files with 25 additions and 15 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/PostgREST/QueryBuilder.hs
+25 -15
View File
@@ -1,7 +1,9 @@
{-# LANGUAGE TupleSections #-}
module PostgREST.QueryBuilder
where
module PostgREST.QueryBuilder (
addRelations
, addJoinConditions
, requestToQuery
) where
import Control.Error
import Data.List (find)
@@ -10,16 +12,11 @@ import Data.Text hiding (filter, find, foldr, head, last, map,
null, zipWith, concatMap)
import Control.Applicative
import Data.Tree
import PostgREST.PgQuery (fromQi, pgFmtCondition, pgFmtSelectItem,
pgFmtIdent, pgFmtCondition,
insertableValue, orderF, sourceSubqueryName, pgFmtJsonPath)
import PostgREST.PgQuery (fromQi, pgFmtCondition, pgFmtSelectItem, pgFmtCondition, insertableValue
, orderF, pgFmtJsonPath, sourceSubqueryName, pgFmtIdent)
import PostgREST.Types
import qualified Data.Map as M
findRelation :: [Relation] -> Schema -> Text -> Text -> Maybe Relation
findRelation allRelations s t1 t2 =
find (\r -> s == (tableSchema . relTable) r && t1 == (tableName . relTable) r && t2 == (tableName . relFTable) r) allRelations
addRelations :: Schema -> [Relation] -> Maybe ApiRequest -> ApiRequest -> Either Text ApiRequest
addRelations schema allRelations parentNode node@(Node n@(query, (table, _)) forest) =
case parentNode of
@@ -27,12 +24,14 @@ addRelations schema allRelations parentNode node@(Node n@(query, (table, _)) for
(Just (Node (_, (parentTable, _)) _)) -> Node <$> (addRel n <$> rel) <*> updatedForest
where
rel = note ("no relation between " <> table <> " and " <> parentTable)
$ findRelation allRelations schema table parentTable
<|> findRelation allRelations schema parentTable table
$ findRelation schema table parentTable
<|> findRelation schema parentTable table
addRel :: (Query, (NodeName, Maybe Relation)) -> Relation -> (Query, (NodeName, Maybe Relation))
addRel (q, (t, _)) r = (q, (t, Just r))
where
updatedForest = mapM (addRelations schema allRelations (Just node)) forest
findRelation s t1 t2 =
find (\r -> s == tableSchema r && t1 == relTable r && t2 == relFTable r) allRelations
getJoinConditions :: Relation -> [Filter]
getJoinConditions (Relation t cs ft fcs typ lt lc1 lc2) =
@@ -72,9 +71,6 @@ addJoinConditions schema (Node (query, (n, r)) forest) =
updatedForest = mapM (addJoinConditions schema) forest
addCond q con = q{where_=con ++ where_ q}
emptyOnNull :: Text -> [a] -> Text
emptyOnNull val x = if null x then "" else val
requestToQuery :: Text -> ApiRequest -> Text
requestToQuery schema (Node (Select colSelects tbls conditions ord, (mainTbl, _)) forest) =
query
@@ -152,3 +148,17 @@ requestToQuery schema (Node (Delete _ conditions, (mainTbl, _)) _) =
("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,
"RETURNING " <> fromQi qi <> ".*"
]
-- private functions
getJoinConditions :: Relation -> [Filter]
getJoinConditions (Relation s t cs ft fcs typ lt lc1 lc2) =
case typ of
Child -> zipWith (toFilter t ft) cs fcs
Parent -> zipWith (toFilter t ft) cs fcs
Many -> zipWith (toFilter t (fromMaybe "" lt)) cs (fromMaybe [] lc1) ++ zipWith (toFilter ft (fromMaybe "" lt)) fcs (fromMaybe [] lc2)
where
toFilter :: Text -> Text -> FieldName -> FieldName -> Filter
toFilter tb ftb c fc = Filter (c, Nothing) "=" (VForeignKey (QualifiedIdentifier s tb) (ForeignKey ftb fc))
emptyOnNull :: Text -> [a] -> Text
emptyOnNull val x = if null x then "" else val