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

Moves all PgQuery module to QueryBuilder

Browse Source
This commit is contained in:
Diogo Biazus
2015-11-14 22:54:55 -05:00
parent fbe6600ff1
commit f47d5e52f4
7 changed files with 311 additions and 358 deletions
Download Patch File Download Diff File Expand all files Collapse all files
postgrest.cabal
-3
View File
@@ -69,7 +69,6 @@ executable postgrest
, PostgREST.Error , PostgREST.Error
, PostgREST.Middleware , PostgREST.Middleware
, PostgREST.Parsers , PostgREST.Parsers
, PostgREST.PgQuery
, PostgREST.DbStructure , PostgREST.DbStructure
, PostgREST.QueryBuilder , PostgREST.QueryBuilder
, PostgREST.RangeQuery , PostgREST.RangeQuery
@@ -133,7 +132,6 @@ library
, PostgREST.Error , PostgREST.Error
, PostgREST.Middleware , PostgREST.Middleware
, PostgREST.Parsers , PostgREST.Parsers
, PostgREST.PgQuery
, PostgREST.DbStructure , PostgREST.DbStructure
, PostgREST.QueryBuilder , PostgREST.QueryBuilder
, PostgREST.RangeQuery , PostgREST.RangeQuery
@@ -164,7 +162,6 @@ Test-Suite spec
, PostgREST.Error , PostgREST.Error
, PostgREST.Middleware , PostgREST.Middleware
, PostgREST.Parsers , PostgREST.Parsers
, PostgREST.PgQuery
, PostgREST.DbStructure , PostgREST.DbStructure
, PostgREST.QueryBuilder , PostgREST.QueryBuilder
, PostgREST.RangeQuery , PostgREST.RangeQuery
src/PostgREST/App.hs
+16 -2
View File
@@ -45,9 +45,23 @@ import qualified Hasql.Postgres as P
import PostgREST.Config (AppConfig (..)) import PostgREST.Config (AppConfig (..))
import PostgREST.Parsers import PostgREST.Parsers
import PostgREST.PgQuery
import PostgREST.DbStructure import PostgREST.DbStructure
import PostgREST.QueryBuilder import PostgREST.QueryBuilder ( asJson
, callProc
, asCsvF
, asJsonF
, selectStarF
, countF
, locationF
, asJsonSingleF
, addJoinConditions
, sourceSubqueryName
, requestToQuery
, wrapQuery
, countAllF
, countNoneF
, addRelations
)
import PostgREST.RangeQuery import PostgREST.RangeQuery
import PostgREST.Types import PostgREST.Types
import PostgREST.Auth (tokenJWT) import PostgREST.Auth (tokenJWT)
src/PostgREST/Auth.hs
+1 -1
View File
@@ -27,7 +27,7 @@ import Data.Monoid ((<>))
import Data.String.Conversions (cs) import Data.String.Conversions (cs)
import Data.Text (Text) import Data.Text (Text)
import Data.Time.Clock (NominalDiffTime) import Data.Time.Clock (NominalDiffTime)
import PostgREST.PgQuery (pgFmtLit, pgFmtIdent, unquoted) import PostgREST.QueryBuilder (pgFmtLit, pgFmtIdent, unquoted)
import qualified Web.JWT as JWT import qualified Web.JWT as JWT
import qualified Data.HashMap.Lazy as H import qualified Data.HashMap.Lazy as H
src/PostgREST/DbStructure.hs
-1
View File
@@ -20,7 +20,6 @@ import Data.Text (Text, split)
import qualified Hasql as H import qualified Hasql as H
import qualified Hasql.Postgres as P import qualified Hasql.Postgres as P
import qualified Hasql.Backend as B import qualified Hasql.Backend as B
import PostgREST.PgQuery ()
import PostgREST.Types import PostgREST.Types
import GHC.Exts (groupWith) import GHC.Exts (groupWith)
src/PostgREST/Parsers.hs
+1 -1
View File
@@ -10,7 +10,7 @@ import Data.Text (Text)
import Data.Tree import Data.Tree
import PostgREST.Types import PostgREST.Types
import Text.ParserCombinators.Parsec hiding (many, (<|>)) import Text.ParserCombinators.Parsec hiding (many, (<|>))
import PostgREST.PgQuery (operators) import PostgREST.QueryBuilder (operators)
pRequestSelect :: Text -> Parser ApiRequest pRequestSelect :: Text -> Parser ApiRequest
pRequestSelect rootNodeName = do pRequestSelect rootNodeName = do
src/PostgREST/PgQuery.hs
-309
View File
@@ -1,309 +0,0 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module PostgREST.PgQuery (
fromQi
, insertableValue
, wrapQuery
, asJson
, callProc
, unquoted
, operators
-- format functions
, pgFmtLit
, pgFmtIdent
, pgFmtValue
, pgFmtCondition
, pgFmtColumn
, pgFmtJsonPath
, pgFmtTable
, pgFmtField
, pgFmtSelectItem
, pgFmtAsJsonPath
-- query fragments
, sourceSubqueryName
, orderF
, countNoneF
, countAllF
, countF
, locationF
, asCsvF
, asJsonSingleF
, asJsonF
, selectStarF
, StatementT
) where
import qualified Hasql as H
import qualified Hasql.Backend as B
import qualified Hasql.Postgres as P
import PostgREST.RangeQuery
import PostgREST.Types
import Control.Monad (join)
import qualified Data.Aeson as JSON
import qualified Data.ByteString.Char8 as BS
import Data.Functor
import qualified Data.HashMap.Strict as H
import qualified Data.List as L
import Data.Maybe (fromMaybe)
import Data.Monoid
import Data.Scientific (FPFormat (..), formatScientific,
isInteger)
import Data.String.Conversions (cs)
import qualified Data.Text as T
import Data.Vector (empty)
import Text.Regex.TDFA ((=~))
import Prelude
import qualified Data.Map as M
type PStmt = H.Stmt P.Postgres
instance Monoid PStmt where
mappend (B.Stmt query params prep) (B.Stmt query' params' prep') =
B.Stmt (query <> query') (params <> params') (prep && prep')
mempty = B.Stmt "" empty True
type StatementT = PStmt -> PStmt
data JsonbPath =
ColIdentifier T.Text
| KeyIdentifier T.Text
| SingleArrow JsonbPath JsonbPath
| DoubleArrow JsonbPath JsonbPath
deriving (Show)
operators :: [(T.Text, T.Text)]
operators = [
("eq", "="),
("gte", ">="), -- has to be before gt (parsers)
("gt", ">"),
("lte", "<="), -- has to be before lt (parsers)
("lt", "<"),
("neq", "<>"),
("like", "like"),
("ilike", "ilike"),
("in", "in"),
("notin", "not in"),
("isnot", "is not"), -- has to be before is (parsers)
("is", "is"),
("@@", "@@"),
("@>", "@>"),
("<@", "<@")
]
operatorsMap :: M.Map T.Text T.Text
operatorsMap = M.fromList operators
asJson :: StatementT
asJson s = s {
B.stmtTemplate =
"array_to_json(coalesce(array_agg(row_to_json(t)), '{}'))::character varying from ("
<> B.stmtTemplate s <> ") t" }
callProc :: QualifiedIdentifier -> JSON.Object -> PStmt
callProc qi params = do
let args = T.intercalate "," $ map assignment (H.toList params)
B.Stmt ("select * from " <> fromQi qi <> "(" <> args <> ")") empty True
where
assignment (n,v) = pgFmtIdent n <> ":=" <> insertableValue v
whiteList :: T.Text -> T.Text
whiteList val = fromMaybe
(cs (pgFmtLit val) <> "::unknown ")
(L.find ((==) . T.toLower $ val) ["null","true","false"])
trimNullChars :: T.Text -> T.Text
trimNullChars = T.takeWhile (/= '\x0')
fromQi :: QualifiedIdentifier -> T.Text
fromQi t = (if s == "" then "" else pgFmtIdent s <> ".") <> pgFmtIdent n
where
n = qiName t
s = qiSchema t
unquoted :: JSON.Value -> T.Text
unquoted (JSON.String t) = t
unquoted (JSON.Number n) =
cs $ formatScientific Fixed (if isInteger n then Just 0 else Nothing) n
unquoted (JSON.Bool b) = cs . show $ b
unquoted v = cs $ JSON.encode v
insertableText :: T.Text -> T.Text
insertableText = (<> "::unknown") . pgFmtLit
insertableValue :: JSON.Value -> T.Text
insertableValue JSON.Null = "null"
insertableValue v = insertableText $ unquoted v
wrapQuery :: T.Text -> [T.Text] -> T.Text -> Maybe NonnegRange -> T.Text
wrapQuery source selectColumns returnSelect range =
withSourceF source <>
" SELECT " <>
T.intercalate ", " selectColumns <>
" " <>
fromF returnSelect ( limitF range )
-- query fragments
sourceSubqueryName :: T.Text
sourceSubqueryName = "pg_source"
withSourceF :: T.Text -> T.Text
withSourceF s = "WITH " <> sourceSubqueryName <> " AS (" <> s <>")"
countF :: T.Text
countF = "pg_catalog.count(t)"
countAllF :: T.Text
countAllF = "(SELECT pg_catalog.count(1) FROM (SELECT * FROM " <> sourceSubqueryName <> ") a )"
countNoneF :: T.Text
countNoneF = "null"
asJsonF :: T.Text
asJsonF = "array_to_json(array_agg(row_to_json(t)))::character varying"
asJsonSingleF :: T.Text --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 "
asCsvF :: T.Text
asCsvF = asCsvHeaderF <> " || '\n' || " <> asCsvBodyF
asCsvHeaderF :: T.Text
asCsvHeaderF =
"(SELECT string_agg(a.k, ',')" <>
" FROM (" <>
" SELECT json_object_keys(r)::TEXT as k" <>
" FROM ( " <>
" SELECT row_to_json(hh) as r from " <> sourceSubqueryName <> " as hh limit 1" <>
" ) s" <>
" ) a" <>
")"
asCsvBodyF :: T.Text
asCsvBodyF = "coalesce(string_agg(substring(t::text, 2, length(t::text) - 2), '\n'), '')"
selectStarF :: T.Text
selectStarF = "SELECT * FROM " <> sourceSubqueryName
fromF :: T.Text -> T.Text -> T.Text
fromF sel limit = "FROM (" <> sel <> " " <> limit <> ") t"
limitF :: Maybe NonnegRange -> T.Text
limitF r = "LIMIT " <> limit <> " OFFSET " <> offset
where
limit = maybe "ALL" (cs . show) $ join $ rangeLimit <$> r
offset = cs . show $ fromMaybe 0 $ rangeOffset <$> r
locationF :: [T.Text] -> T.Text
locationF pKeys =
"(" <>
" WITH s AS (SELECT row_to_json(ss) as r from " <> sourceSubqueryName <> " as ss limit 1)" <>
" SELECT string_agg(json_data.key || '=' || coalesce( 'eq.' || json_data.value, 'is.null'), '&')" <>
" FROM s, json_each_text(s.r) AS json_data" <>
(
if null pKeys
then ""
else " WHERE json_data.key IN ('" <> T.intercalate "','" pKeys <> "')"
) <>
")"
orderF :: [OrderTerm] -> T.Text
orderF ts =
if L.null ts
then ""
else "ORDER BY " <> clause
where
clause = T.intercalate "," (map queryTerm ts)
queryTerm :: OrderTerm -> T.Text
queryTerm t = " "
<> cs (pgFmtIdent $ otTerm t) <> " "
<> cs (otDirection t) <> " "
<> maybe "" cs (otNullOrder t) <> " "
-- formating functions
pgFmtValue :: T.Text -> T.Text -> T.Text
pgFmtValue opCode val =
case opCode of
"like" -> unknownLiteral $ T.map star val
"ilike" -> unknownLiteral $ T.map star val
"in" -> "(" <> T.intercalate ", " (map unknownLiteral $ T.split (==',') val) <> ") "
"notin" -> "(" <> T.intercalate ", " (map unknownLiteral $ T.split (==',') val) <> ") "
"@@" -> "to_tsquery(" <> unknownLiteral val <> ") "
_ -> unknownLiteral val
where
star c = if c == '*' then '%' else c
unknownLiteral = (<> "::unknown ") . pgFmtLit
pgFmtOperator :: T.Text -> T.Text
pgFmtOperator opCode = fromMaybe "=" $ M.lookup opCode operatorsMap
pgFmtIdent :: T.Text -> T.Text
pgFmtIdent x =
let escaped = T.replace "\"" "\"\"" (trimNullChars $ cs x) in
if (cs escaped :: BS.ByteString) =~ danger
then "\"" <> escaped <> "\""
else escaped
where danger = "^$|^[^a-z_]|[^a-z_0-9]" :: BS.ByteString
pgFmtLit :: T.Text -> T.Text
pgFmtLit x =
let trimmed = trimNullChars x
escaped = "'" <> T.replace "'" "''" trimmed <> "'"
slashed = T.replace "\\" "\\\\" escaped in
if T.isInfixOf "\\\\" escaped
then "E" <> slashed
else slashed
pgFmtCondition :: QualifiedIdentifier -> Filter -> T.Text
pgFmtCondition table (Filter (col,jp) ops val) =
notOp <> " " <> sqlCol <> " " <> pgFmtOperator opCode <> " " <>
if opCode `elem` ["is","isnot"] then whiteList (getInner val) else sqlValue
where
headPredicate:rest = T.split (=='.') ops
hasNot caseTrue caseFalse = if headPredicate == "not" then caseTrue else caseFalse
opCode = hasNot (head rest) headPredicate
notOp = hasNot headPredicate ""
sqlCol = case val of
VText _ -> pgFmtColumn table col <> pgFmtJsonPath jp
VForeignKey qi _ -> pgFmtColumn qi col
sqlValue = valToStr val
getInner v = case v of
VText s -> s
_ -> ""
valToStr v = case v of
VText s -> pgFmtValue opCode s
VForeignKey (QualifiedIdentifier s _) (ForeignKey Column{colTable=Table{tableName=ft}, colName=fc}) -> pgFmtColumn qi fc
where qi = QualifiedIdentifier (if ft == sourceSubqueryName then "" else s) ft
_ -> ""
pgFmtColumn :: QualifiedIdentifier -> T.Text -> T.Text
pgFmtColumn table "*" = fromQi table <> ".*"
pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c
pgFmtJsonPath :: Maybe JsonPath -> T.Text
pgFmtJsonPath (Just [x]) = "->>" <> pgFmtLit x
pgFmtJsonPath (Just (x:xs)) = "->" <> pgFmtLit x <> pgFmtJsonPath ( Just xs )
pgFmtJsonPath _ = ""
pgFmtTable :: Table -> T.Text
pgFmtTable Table{tableSchema=s, tableName=n} = fromQi $ QualifiedIdentifier s n
pgFmtField :: QualifiedIdentifier -> Field -> T.Text
pgFmtField table (c, jp) = pgFmtColumn table c <> pgFmtJsonPath jp
pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> T.Text
pgFmtSelectItem table (f@(_, jp), Nothing) = pgFmtField table f <> pgFmtAsJsonPath jp
pgFmtSelectItem table (f@(_, jp), Just cast ) = "CAST (" <> pgFmtField table f <> " AS " <> cast <> " )" <> pgFmtAsJsonPath jp
pgFmtAsJsonPath :: Maybe JsonPath -> T.Text
pgFmtAsJsonPath Nothing = ""
pgFmtAsJsonPath (Just xx) = " AS " <> last xx
src/PostgREST/QueryBuilder.hs
+293 -41
View File
@@ -1,21 +1,156 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TupleSections #-} {-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module PostgREST.QueryBuilder ( module PostgREST.QueryBuilder (
addRelations addRelations
, addJoinConditions , addJoinConditions
, requestToQuery , requestToQuery
, callProc
, pgFmtLit
, pgFmtIdent
, unquoted
, wrapQuery
, operators
, asJson
, asJsonF
, asJsonSingleF
, asCsvF
, countF
, selectStarF
, locationF
, sourceSubqueryName
, countAllF
, countNoneF
) where ) where
import qualified Hasql as H
import qualified Hasql.Backend as B
import qualified Hasql.Postgres as P
import qualified Data.Aeson as JSON
import PostgREST.RangeQuery (NonnegRange, rangeLimit, rangeOffset)
import Control.Error import Control.Error
import Control.Monad (join)
import Data.List (find) import Data.List (find)
import Data.Monoid import Data.Monoid
import Data.Text hiding (filter, find, foldr, head, last, map, import Data.Text (Text)
null, zipWith, concatMap) import qualified Data.Text as T
import Data.String.Conversions (cs)
import qualified Data.HashMap.Strict as H
import Control.Applicative import Control.Applicative
import Data.Tree import Data.Tree
import PostgREST.PgQuery (fromQi, pgFmtCondition, pgFmtSelectItem, pgFmtCondition, insertableValue
, orderF, pgFmtJsonPath, sourceSubqueryName, pgFmtIdent)
import PostgREST.Types import PostgREST.Types
import qualified Data.Map as M import qualified Data.Map as M
import Text.Regex.TDFA ((=~))
import qualified Data.ByteString.Char8 as BS
import Data.Scientific (FPFormat (..), formatScientific,
isInteger)
type PStmt = H.Stmt P.Postgres
instance Monoid PStmt where
mappend (B.Stmt query params prep) (B.Stmt query' params' prep') =
B.Stmt (query <> query') (params <> params') (prep && prep')
mempty = B.Stmt "" empty True
type StatementT = PStmt -> PStmt
sourceSubqueryName :: T.Text
sourceSubqueryName = "pg_source"
countAllF :: T.Text
countAllF = "(SELECT pg_catalog.count(1) FROM (SELECT * FROM " <> sourceSubqueryName <> ") a )"
countNoneF :: T.Text
countNoneF = "null"
asCsvHeaderF :: T.Text
asCsvHeaderF =
"(SELECT string_agg(a.k, ',')" <>
" FROM (" <>
" SELECT json_object_keys(r)::TEXT as k" <>
" FROM ( " <>
" SELECT row_to_json(hh) as r from " <> sourceSubqueryName <> " as hh limit 1" <>
" ) s" <>
" ) a" <>
")"
asCsvBodyF :: T.Text
asCsvBodyF = "coalesce(string_agg(substring(t::text, 2, length(t::text) - 2), '\n'), '')"
selectStarF :: T.Text
selectStarF = "SELECT * FROM " <> sourceSubqueryName
locationF :: [T.Text] -> T.Text
locationF pKeys =
"(" <>
" WITH s AS (SELECT row_to_json(ss) as r from " <> sourceSubqueryName <> " as ss limit 1)" <>
" SELECT string_agg(json_data.key || '=' || coalesce( 'eq.' || json_data.value, 'is.null'), '&')" <>
" FROM s, json_each_text(s.r) AS json_data" <>
(
if null pKeys
then ""
else " WHERE json_data.key IN ('" <> T.intercalate "','" pKeys <> "')"
) <>
")"
countF :: T.Text
countF = "pg_catalog.count(t)"
asJsonSingleF :: T.Text --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 "
asJsonF :: T.Text
asJsonF = "array_to_json(array_agg(row_to_json(t)))::character varying"
asCsvF :: T.Text
asCsvF = asCsvHeaderF <> " || '\n' || " <> asCsvBodyF
asJson :: StatementT
asJson s = s {
B.stmtTemplate =
"array_to_json(array_agg(row_to_json(t)))::character varying from ("
<> B.stmtTemplate s <> ") t" }
operators :: [(T.Text, T.Text)]
operators = [
("eq", "="),
("gte", ">="), -- has to be before gt (parsers)
("gt", ">"),
("lte", "<="), -- has to be before lt (parsers)
("lt", "<"),
("neq", "<>"),
("like", "like"),
("ilike", "ilike"),
("in", "in"),
("notin", "not in"),
("isnot", "is not"), -- has to be before is (parsers)
("is", "is"),
("@@", "@@"),
("@>", "@>"),
("<@", "<@")
]
wrapQuery :: T.Text -> [T.Text] -> T.Text -> Maybe NonnegRange -> T.Text
wrapQuery source selectColumns returnSelect range =
withSourceF source <>
" SELECT " <>
T.intercalate ", " selectColumns <>
" " <>
fromF returnSelect ( limitF range )
unquoted :: JSON.Value -> T.Text
unquoted (JSON.String t) = t
unquoted (JSON.Number n) =
cs $ formatScientific Fixed (if isInteger n then Just 0 else Nothing) n
unquoted (JSON.Bool b) = cs . show $ b
unquoted v = cs $ JSON.encode v
callProc :: QualifiedIdentifier -> JSON.Object -> PStmt
callProc qi params = do
let args = T.intercalate "," $ map assignment (H.toList params)
B.Stmt ("select * from " <> fromQi qi <> "(" <> args <> ")") empty True
where
assignment (n,v) = pgFmtIdent n <> ":=" <> insertableValue v
addRelations :: Schema -> [Relation] -> Maybe ApiRequest -> ApiRequest -> Either Text ApiRequest addRelations :: Schema -> [Relation] -> Maybe ApiRequest -> ApiRequest -> Either Text ApiRequest
addRelations schema allRelations parentNode node@(Node n@(query, (table, _)) forest) = addRelations schema allRelations parentNode node@(Node n@(query, (table, _)) forest) =
@@ -31,21 +166,7 @@ addRelations schema allRelations parentNode node@(Node n@(query, (table, _)) for
where where
updatedForest = mapM (addRelations schema allRelations (Just node)) forest updatedForest = mapM (addRelations schema allRelations (Just node)) forest
findRelation s t1 t2 = findRelation s t1 t2 =
find (\r -> s == tableSchema r && t1 == relTable r && t2 == relFTable r) allRelations find (\r -> s == (tableSchema . relTable) r && t1 == (tableName . relTable) r && t2 == (tableName . relFTable) r) allRelations
getJoinConditions :: Relation -> [Filter]
getJoinConditions (Relation t cs ft fcs typ lt lc1 lc2) =
case typ of
Child -> zipWith (toFilter tN ftN) cs fcs
Parent -> zipWith (toFilter tN ftN) cs fcs
Many -> zipWith (toFilter tN ltN) cs (fromMaybe [] lc1) ++ zipWith (toFilter ftN ltN) fcs (fromMaybe [] lc2)
where
s = tableSchema t
tN = tableName t
ftN = tableName ft
ltN = fromMaybe "" (tableName <$> lt)
toFilter :: Text -> Text -> Column -> Column -> Filter
toFilter tb ftb c fc = Filter (colName c, Nothing) "=" (VForeignKey (QualifiedIdentifier s tb) (ForeignKey fc{colTable=(colTable fc){tableName=ftb}}))
addJoinConditions :: Text -> ApiRequest -> Either Text ApiRequest addJoinConditions :: Text -> ApiRequest -> Either Text ApiRequest
addJoinConditions schema (Node (query, (n, r)) forest) = addJoinConditions schema (Node (query, (n, r)) forest) =
@@ -80,11 +201,11 @@ requestToQuery schema (Node (Select colSelects tbls conditions ord, (mainTbl, _)
tblSchema tbl = if tbl == sourceSubqueryName then "" else schema tblSchema tbl = if tbl == sourceSubqueryName then "" else schema
qi = QualifiedIdentifier (tblSchema mainTbl) mainTbl qi = QualifiedIdentifier (tblSchema mainTbl) mainTbl
toQi t = QualifiedIdentifier (tblSchema t) t toQi t = QualifiedIdentifier (tblSchema t) t
query = Data.Text.unwords [ query = T.unwords [
("WITH " <> intercalate ", " withs) `emptyOnNull` withs, ("WITH " <> T.intercalate ", " withs) `emptyOnNull` withs,
"SELECT ", intercalate ", " (map (pgFmtSelectItem qi) colSelects ++ selects), "SELECT ", T.intercalate ", " (map (pgFmtSelectItem qi) colSelects ++ selects),
"FROM ", intercalate ", " (map (fromQi . toQi) tbls), "FROM ", T.intercalate ", " (map (fromQi . toQi) tbls),
("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions, ("WHERE " <> T.intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,
orderF (fromMaybe [] ord) orderF (fromMaybe [] ord)
] ]
(withs, selects) = foldr getQueryParts ([],[]) forest (withs, selects) = foldr getQueryParts ([],[]) forest
@@ -116,13 +237,13 @@ requestToQuery schema (Node (Insert _ flds vals, (mainTbl, _)) _) =
query query
where where
qi = QualifiedIdentifier schema mainTbl qi = QualifiedIdentifier schema mainTbl
query = Data.Text.unwords [ query = T.unwords [
"INSERT INTO ", fromQi qi, "INSERT INTO ", fromQi qi,
" (" <> intercalate ", " (map (pgFmtIdent . fst) flds) <> ") ", " (" <> T.intercalate ", " (map (pgFmtIdent . fst) flds) <> ") ",
"VALUES " <> intercalate ", " "VALUES " <> T.intercalate ", "
( map (\v -> ( map (\v ->
"(" <> "(" <>
intercalate ", " ( map insertableValue v ) <> T.intercalate ", " ( map insertableValue v ) <>
")" ")"
) vals ) vals
), ),
@@ -132,10 +253,10 @@ requestToQuery schema (Node (Update _ setWith conditions, (mainTbl, _)) _) =
query query
where where
qi = QualifiedIdentifier schema mainTbl qi = QualifiedIdentifier schema mainTbl
query = Data.Text.unwords [ query = T.unwords [
"UPDATE ", fromQi qi, "UPDATE ", fromQi qi,
" SET " <> intercalate ", " (map formatSet (M.toList setWith)) <> " ", " SET " <> T.intercalate ", " (map formatSet (M.toList setWith)) <> " ",
("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions, ("WHERE " <> T.intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,
"RETURNING " <> fromQi qi <> ".*" "RETURNING " <> fromQi qi <> ".*"
] ]
formatSet ((c, jp), v) = pgFmtIdent c <> pgFmtJsonPath jp <> " = " <> insertableValue v formatSet ((c, jp), v) = pgFmtIdent c <> pgFmtJsonPath jp <> " = " <> insertableValue v
@@ -143,22 +264,153 @@ requestToQuery schema (Node (Delete _ conditions, (mainTbl, _)) _) =
query query
where where
qi = QualifiedIdentifier schema mainTbl qi = QualifiedIdentifier schema mainTbl
query = Data.Text.unwords [ query = T.unwords [
"DELETE FROM ", fromQi qi, "DELETE FROM ", fromQi qi,
("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions, ("WHERE " <> T.intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,
"RETURNING " <> fromQi qi <> ".*" "RETURNING " <> fromQi qi <> ".*"
] ]
-- private functions -- private functions
getJoinConditions :: Relation -> [Filter] fromQi :: QualifiedIdentifier -> T.Text
getJoinConditions (Relation s t cs ft fcs typ lt lc1 lc2) = fromQi t = (if s == "" then "" else pgFmtIdent s <> ".") <> pgFmtIdent n
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 where
toFilter :: Text -> Text -> FieldName -> FieldName -> Filter n = qiName t
toFilter tb ftb c fc = Filter (c, Nothing) "=" (VForeignKey (QualifiedIdentifier s tb) (ForeignKey ftb fc)) s = qiSchema t
getJoinConditions :: Relation -> [Filter]
getJoinConditions (Relation t cols ft fcs typ lt lc1 lc2) =
case typ of
Child -> zipWith (toFilter tN ftN) cols fcs
Parent -> zipWith (toFilter tN ftN) cols fcs
Many -> zipWith (toFilter tN ltN) cols (fromMaybe [] lc1) ++ zipWith (toFilter ftN ltN) fcs (fromMaybe [] lc2)
where
s = tableSchema t
tN = tableName t
ftN = tableName ft
ltN = fromMaybe "" (tableName <$> lt)
toFilter :: Text -> Text -> Column -> Column -> Filter
toFilter tb ftb c fc = Filter (colName c, Nothing) "=" (VForeignKey (QualifiedIdentifier s tb) (ForeignKey fc{colTable=(colTable fc){tableName=ftb}}))
emptyOnNull :: Text -> [a] -> Text emptyOnNull :: Text -> [a] -> Text
emptyOnNull val x = if null x then "" else val emptyOnNull val x = if null x then "" else val
orderF :: [OrderTerm] -> T.Text
orderF ts =
if null ts
then ""
else "ORDER BY " <> clause
where
clause = T.intercalate "," (map queryTerm ts)
queryTerm :: OrderTerm -> T.Text
queryTerm t = " "
<> cs (pgFmtIdent $ otTerm t) <> " "
<> cs (otDirection t) <> " "
<> maybe "" cs (otNullOrder t) <> " "
insertableText :: T.Text -> T.Text
insertableText = (<> "::unknown") . pgFmtLit
insertableValue :: JSON.Value -> T.Text
insertableValue JSON.Null = "null"
insertableValue v = insertableText $ unquoted v
whiteList :: T.Text -> T.Text
whiteList val = fromMaybe
(cs (pgFmtLit val) <> "::unknown ")
(find ((==) . T.toLower $ val) ["null","true","false"])
-- formating functions
pgFmtColumn :: QualifiedIdentifier -> T.Text -> T.Text
pgFmtColumn table "*" = fromQi table <> ".*"
pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c
pgFmtField :: QualifiedIdentifier -> Field -> T.Text
pgFmtField table (c, jp) = pgFmtColumn table c <> pgFmtJsonPath jp
pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> T.Text
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 -> T.Text
pgFmtCondition table (Filter (col,jp) ops val) =
notOp <> " " <> sqlCol <> " " <> pgFmtOperator opCode <> " " <>
if opCode `elem` ["is","isnot"] then whiteList (getInner val) else sqlValue
where
headPredicate:rest = T.split (=='.') ops
hasNot caseTrue caseFalse = if headPredicate == "not" then caseTrue else caseFalse
opCode = hasNot (head rest) headPredicate
notOp = hasNot headPredicate ""
sqlCol = case val of
VText _ -> pgFmtColumn table col <> pgFmtJsonPath jp
VForeignKey qi _ -> pgFmtColumn qi col
sqlValue = valToStr val
getInner v = case v of
VText s -> s
_ -> ""
valToStr v = case v of
VText s -> pgFmtValue opCode s
VForeignKey (QualifiedIdentifier s _) (ForeignKey Column{colTable=Table{tableName=ft}, colName=fc}) -> pgFmtColumn qi fc
where qi = QualifiedIdentifier (if ft == sourceSubqueryName then "" else s) ft
_ -> ""
pgFmtValue :: T.Text -> T.Text -> T.Text
pgFmtValue opCode val =
case opCode of
"like" -> unknownLiteral $ T.map star val
"ilike" -> unknownLiteral $ T.map star val
"in" -> "(" <> T.intercalate ", " (map unknownLiteral $ T.split (==',') val) <> ") "
"notin" -> "(" <> T.intercalate ", " (map unknownLiteral $ T.split (==',') val) <> ") "
"@@" -> "to_tsquery(" <> unknownLiteral val <> ") "
_ -> unknownLiteral val
where
star c = if c == '*' then '%' else c
unknownLiteral = (<> "::unknown ") . pgFmtLit
pgFmtOperator :: T.Text -> T.Text
pgFmtOperator opCode = fromMaybe "=" $ M.lookup opCode operatorsMap
pgFmtIdent :: T.Text -> T.Text
pgFmtIdent x =
let escaped = T.replace "\"" "\"\"" (trimNullChars $ cs x) in
if (cs escaped :: BS.ByteString) =~ danger
then "\"" <> escaped <> "\""
else escaped
where danger = "^$|^[^a-z_]|[^a-z_0-9]" :: BS.ByteString
pgFmtLit :: T.Text -> T.Text
pgFmtLit x =
let trimmed = trimNullChars x
escaped = "'" <> T.replace "'" "''" trimmed <> "'"
slashed = T.replace "\\" "\\\\" escaped in
if T.isInfixOf "\\\\" escaped
then "E" <> slashed
else slashed
pgFmtJsonPath :: Maybe JsonPath -> T.Text
pgFmtJsonPath (Just [x]) = "->>" <> pgFmtLit x
pgFmtJsonPath (Just (x:xs)) = "->" <> pgFmtLit x <> pgFmtJsonPath ( Just xs )
pgFmtJsonPath _ = ""
pgFmtAsJsonPath :: Maybe JsonPath -> T.Text
pgFmtAsJsonPath Nothing = ""
pgFmtAsJsonPath (Just xx) = " AS " <> last xx
operatorsMap :: M.Map T.Text T.Text
operatorsMap = M.fromList operators
trimNullChars :: T.Text -> T.Text
trimNullChars = T.takeWhile (/= '\x0')
withSourceF :: T.Text -> T.Text
withSourceF s = "WITH " <> sourceSubqueryName <> " AS (" <> s <>")"
fromF :: T.Text -> T.Text -> T.Text
fromF sel limit = "FROM (" <> sel <> " " <> limit <> ") t"
limitF :: Maybe NonnegRange -> T.Text
limitF r = "LIMIT " <> limit <> " OFFSET " <> offset
where
limit = maybe "ALL" (cs . show) $ join $ rangeLimit <$> r
offset = cs . show $ fromMaybe 0 $ rangeOffset <$> r