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

Merge pull request #370 from ruslantalpa/add_type_syn

Browse Source 
Add type synonyms to to beter explain things that used to be Text (2)
This commit is contained in:
Joe Nelson
2015-11-16 08:52:06 -08:00
parent 57aad6baa6 75646247f2
commit 8711362cf6
3 changed files with 46 additions and 38 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/PostgREST/App.hs
+10 -5
View File
@@ -322,7 +322,7 @@ whereFilters qParams = [ (k, fromJust v) | (k,v) <- qParams, k `notElem` ["selec
orderStr :: [(String, Maybe String)] -> Maybe String
orderStr qParams = join $ lookup "order" qParams
buildSelectApiRequest :: Text -> String -> [(String, String)] -> Maybe String -> Either Text ApiRequest
buildSelectApiRequest :: TableName -> String -> [(String, String)] -> Maybe String -> Either Text ApiRequest
buildSelectApiRequest rootTableName sel wher orderS =
first formatParserError $ foldr addFilter <$> (addOrder <$> apiRequest <*> ord) <*> flts
where
@@ -346,7 +346,12 @@ addFilter (path, flt) (Node rn forest) =
Just node -> (Just node, delete node forest)
where maybeNode = find ((name==).fst.snd.rootLabel) forst
toSourceRelation :: Text -> Relation -> Maybe Relation
-- in a relation where one of the tables mathces "TableName"
-- replace the name to that table with pg_source
-- this "fake" relations is needed so that in a mutate query
-- we can look a the "returning *" part which is wrapped with a "with"
-- as just another table that has relations with other tables
toSourceRelation :: TableName -> Relation -> Maybe Relation
toSourceRelation mt r@(Relation t _ ft _ _ rt _ _)
| mt == tableName t = Just $ r {relTable=t {tableName=sourceSubqueryName}}
| mt == tableName ft = Just $ r {relFTable=t {tableName=sourceSubqueryName}}
@@ -363,7 +368,7 @@ instance ToJSON TableOptions where
"columns" .= tblOptcolumns t
, "pkey" .= tblOptpkey t ]
parseRequest :: Schema -> [Relation] -> NodeName -> Request -> BL.ByteString -> Either Text (Text, Text, Bool)
parseRequest :: Schema -> [Relation] -> TableName -> Request -> BL.ByteString -> Either Text (SqlQuery, SqlQuery, Bool)
parseRequest schema allRels rootTableName httpRequest reqBody =
(,,) <$> selectQuery
<*> (if method == "GET" then pure "" else mutateQuery)
@@ -385,7 +390,7 @@ parseRequest schema allRels rootTableName httpRequest reqBody =
allFilters = whereFilters qParams
mutateFilters = filter (not . ( '.' `elem` ) . fst) allFilters -- update/delete filters can be only on the root table
cond = first formatParserError $ map snd <$> mapM pRequestFilter mutateFilters
fakeSourceRelations = mapMaybe (toSourceRelation rootTableName) allRels
fakeSourceRelations = mapMaybe (toSourceRelation rootTableName) allRels -- see comment in toSourceRelation
rels = case method of
"POST" -> fakeSourceRelations ++ allRels
"PATCH" -> fakeSourceRelations ++ allRels
@@ -409,7 +414,7 @@ parseRequest schema allRels rootTableName httpRequest reqBody =
"DELETE" -> Node <$> ((,) <$> (Delete [rootTableName] <$> cond) <*> pure (rootTableName, Nothing)) <*> pure []
_ -> undefined
createStatement :: Text -> Maybe (Text, Bool) -> Bool -> Maybe NonnegRange -> [Text] -> Bool -> Bool -> Text
createStatement :: SqlQuery -> Maybe (Text, Bool) -> Bool -> Maybe NonnegRange -> [Text] -> Bool -> Bool -> SqlQuery
createStatement selectQuery Nothing _ range _ countTable asCsv =
wrapQuery selectQuery [
if countTable then countAllF else countNoneF,
src/PostgREST/QueryBuilder.hs
+31 -31
View File
@@ -48,7 +48,7 @@ import Data.Scientific ( FPFormat (..)
, formatScientific
, isInteger
)
import Prelude hiding (unwords)
import Prelude hiding (unwords)
type PStmt = H.Stmt P.Postgres
instance Monoid PStmt where
@@ -97,7 +97,7 @@ addJoinConditions schema (Node (query, (n, r)) forest) =
updatedForest = mapM (addJoinConditions schema) forest
addCond q con = q{where_=con ++ where_ q}
asCsvF :: Text
asCsvF :: SqlFragment
asCsvF = asCsvHeaderF <> " || '\n' || " <> asCsvBodyF
where
asCsvHeaderF =
@@ -117,10 +117,10 @@ asJson s = s {
"array_to_json(coalesce(array_agg(row_to_json(t)), '{}'))::character varying from ("
<> B.stmtTemplate s <> ") t" }
asJsonF :: Text
asJsonF :: SqlFragment
asJsonF = "array_to_json(array_agg(row_to_json(t)))::character varying"
asJsonSingleF :: Text --TODO! unsafe when the query actually returns multiple rows, used only on inserting and returning single element
asJsonSingleF :: SqlFragment --TODO! unsafe when the query actually returns multiple rows, used only on inserting and returning single element
asJsonSingleF = "string_agg(row_to_json(t)::text, ',')::character varying "
callProc :: QualifiedIdentifier -> JSON.Object -> PStmt
@@ -130,16 +130,16 @@ callProc qi params = do
where
assignment (n,v) = pgFmtIdent n <> ":=" <> insertableValue v
countAllF :: Text
countAllF :: SqlFragment
countAllF = "(SELECT pg_catalog.count(1) FROM (SELECT * FROM " <> sourceSubqueryName <> ") a )"
countF :: Text
countF :: SqlFragment
countF = "pg_catalog.count(t)"
countNoneF :: Text
countNoneF :: SqlFragment
countNoneF = "null"
locationF :: [Text] -> Text
locationF :: [Text] -> SqlFragment
locationF pKeys =
"(" <>
" WITH s AS (SELECT row_to_json(ss) as r from " <> sourceSubqueryName <> " as ss limit 1)" <>
@@ -152,7 +152,7 @@ locationF pKeys =
) <>
")"
operators :: [(Text, Text)]
operators :: [(Text, SqlFragment)]
operators = [
("eq", "="),
("gte", ">="), -- has to be before gt (parsers)
@@ -171,7 +171,7 @@ operators = [
("<@", "<@")
]
pgFmtIdent :: Text -> Text
pgFmtIdent :: SqlFragment -> SqlFragment
pgFmtIdent x =
let escaped = replace "\"" "\"\"" (trimNullChars $ cs x) in
if (cs escaped :: BS.ByteString) =~ danger
@@ -179,7 +179,7 @@ pgFmtIdent x =
else escaped
where danger = "^$|^[^a-z_]|[^a-z_0-9]" :: BS.ByteString
pgFmtLit :: Text -> Text
pgFmtLit :: SqlFragment -> SqlFragment
pgFmtLit x =
let trimmed = trimNullChars x
escaped = "'" <> replace "'" "''" trimmed <> "'"
@@ -188,7 +188,7 @@ pgFmtLit x =
then "E" <> slashed
else slashed
requestToQuery :: Schema -> ApiRequest -> Text
requestToQuery :: Schema -> ApiRequest -> SqlQuery
requestToQuery schema (Node (Select colSelects tbls conditions ord, (mainTbl, _)) forest) =
query
where
@@ -205,7 +205,7 @@ requestToQuery schema (Node (Select colSelects tbls conditions ord, (mainTbl, _)
orderF (fromMaybe [] ord)
]
(withs, selects) = foldr getQueryParts ([],[]) forest
getQueryParts :: Tree ApiNode -> ([Text], [Text]) -> ([Text], [Text])
getQueryParts :: Tree ApiNode -> ([SqlFragment], [SqlFragment]) -> ([SqlFragment], [SqlFragment])
getQueryParts (Node n@(_, (table, Just (Relation {relType=Child}))) forst) (w,s) = (w,sel:s)
where
sel = "("
@@ -266,10 +266,10 @@ requestToQuery schema (Node (Delete _ conditions, (mainTbl, _)) _) =
"RETURNING " <> fromQi qi <> ".*"
]
selectStarF :: Text
selectStarF :: SqlFragment
selectStarF = "SELECT * FROM " <> sourceSubqueryName
sourceSubqueryName :: Text
sourceSubqueryName :: SqlFragment
sourceSubqueryName = "pg_source"
unquoted :: JSON.Value -> Text
@@ -279,7 +279,7 @@ unquoted (JSON.Number n) =
unquoted (JSON.Bool b) = cs . show $ b
unquoted v = cs $ JSON.encode v
wrapQuery :: Text -> [Text] -> Text -> Maybe NonnegRange -> Text
wrapQuery :: SqlQuery -> [Text] -> Text -> Maybe NonnegRange -> SqlQuery
wrapQuery source selectColumns returnSelect range =
withSourceF source <>
" SELECT " <>
@@ -288,7 +288,7 @@ wrapQuery source selectColumns returnSelect range =
fromF returnSelect ( limitF range )
-- private functions
fromQi :: QualifiedIdentifier -> Text
fromQi :: QualifiedIdentifier -> SqlFragment
fromQi t = (if s == "" then "" else pgFmtIdent s <> ".") <> pgFmtIdent n
where
n = qiName t
@@ -311,7 +311,7 @@ getJoinConditions (Relation t cols ft fcs typ lt lc1 lc2) =
emptyOnNull :: Text -> [a] -> Text
emptyOnNull val x = if null x then "" else val
orderF :: [OrderTerm] -> Text
orderF :: [OrderTerm] -> SqlFragment
orderF ts =
if null ts
then ""
@@ -324,27 +324,27 @@ orderF ts =
<> cs (otDirection t) <> " "
<> maybe "" cs (otNullOrder t) <> " "
insertableValue :: JSON.Value -> Text
insertableValue :: JSON.Value -> SqlFragment
insertableValue JSON.Null = "null"
insertableValue v = (<> "::unknown") . pgFmtLit $ unquoted v
whiteList :: Text -> Text
whiteList :: Text -> SqlFragment
whiteList val = fromMaybe
(cs (pgFmtLit val) <> "::unknown ")
(find ((==) . toLower $ val) ["null","true","false"])
pgFmtColumn :: QualifiedIdentifier -> Text -> Text
pgFmtColumn :: QualifiedIdentifier -> Text -> SqlFragment
pgFmtColumn table "*" = fromQi table <> ".*"
pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c
pgFmtField :: QualifiedIdentifier -> Field -> Text
pgFmtField :: QualifiedIdentifier -> Field -> SqlFragment
pgFmtField table (c, jp) = pgFmtColumn table c <> pgFmtJsonPath jp
pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> Text
pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> SqlFragment
pgFmtSelectItem table (f@(_, jp), Nothing) = pgFmtField table f <> pgFmtAsJsonPath jp
pgFmtSelectItem table (f@(_, jp), Just cast ) = "CAST (" <> pgFmtField table f <> " AS " <> cast <> " )" <> pgFmtAsJsonPath jp
pgFmtCondition :: QualifiedIdentifier -> Filter -> Text
pgFmtCondition :: QualifiedIdentifier -> Filter -> SqlFragment
pgFmtCondition table (Filter (col,jp) ops val) =
notOp <> " " <> sqlCol <> " " <> pgFmtOperator opCode <> " " <>
if opCode `elem` ["is","isnot"] then whiteList (getInner val) else sqlValue
@@ -366,7 +366,7 @@ pgFmtCondition table (Filter (col,jp) ops val) =
where qi = QualifiedIdentifier (if ft == sourceSubqueryName then "" else s) ft
_ -> ""
pgFmtValue :: Text -> Text -> Text
pgFmtValue :: Text -> Text -> SqlFragment
pgFmtValue opCode val =
case opCode of
"like" -> unknownLiteral $ T.map star val
@@ -379,30 +379,30 @@ pgFmtValue opCode val =
star c = if c == '*' then '%' else c
unknownLiteral = (<> "::unknown ") . pgFmtLit
pgFmtOperator :: Text -> Text
pgFmtOperator :: Text -> SqlFragment
pgFmtOperator opCode = fromMaybe "=" $ M.lookup opCode operatorsMap
where
operatorsMap = M.fromList operators
pgFmtJsonPath :: Maybe JsonPath -> Text
pgFmtJsonPath :: Maybe JsonPath -> SqlFragment
pgFmtJsonPath (Just [x]) = "->>" <> pgFmtLit x
pgFmtJsonPath (Just (x:xs)) = "->" <> pgFmtLit x <> pgFmtJsonPath ( Just xs )
pgFmtJsonPath _ = ""
pgFmtAsJsonPath :: Maybe JsonPath -> Text
pgFmtAsJsonPath :: Maybe JsonPath -> SqlFragment
pgFmtAsJsonPath Nothing = ""
pgFmtAsJsonPath (Just xx) = " AS " <> last xx
trimNullChars :: Text -> Text
trimNullChars = T.takeWhile (/= '\x0')
withSourceF :: Text -> Text
withSourceF :: SqlFragment -> SqlFragment
withSourceF s = "WITH " <> sourceSubqueryName <> " AS (" <> s <>")"
fromF :: Text -> Text -> Text
fromF :: SqlFragment -> SqlFragment -> SqlFragment
fromF sel limit = "FROM (" <> sel <> " " <> limit <> ") t"
limitF :: Maybe NonnegRange -> Text
limitF :: Maybe NonnegRange -> SqlFragment
limitF r = "LIMIT " <> limit <> " OFFSET " <> offset
where
limit = maybe "ALL" (cs . show) $ join $ rangeLimit <$> r
src/PostgREST/Types.hs
+5 -2
View File
@@ -13,10 +13,13 @@ data DbStructure = DbStructure {
} deriving (Show, Eq)
type Schema = Text
type TableName = Text
type SqlQuery = Text
type SqlFragment = Text
data Table = Table {
tableSchema :: Schema
, tableName :: Text
, tableName :: TableName
, tableInsertable :: Bool
} deriving (Show, Ord)
@@ -54,7 +57,7 @@ data OrderTerm = OrderTerm {
data QualifiedIdentifier = QualifiedIdentifier {
qiSchema :: Schema
, qiName :: Text
, qiName :: TableName
} deriving (Show, Eq)