Merge pull request #370 from ruslantalpa/add_type_syn

Add type synonyms to to beter explain things that used to be Text (2)

src/PostgREST/App.hs

@@ -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

@@ -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

@@ -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)