version changed to 3, circle ci to use ghc 7.10.1, stricter import/export in PgQuery and remove of dead code

This commit is contained in:
Ruslan Talpa
2015-10-23 12:23:46 +03:00
parent c606149c43
commit f5fb78ec99
8 changed files with 184 additions and 217 deletions
+1 -1
View File
@@ -3,7 +3,7 @@ machine:
- createuser --superuser --no-password postgrest_test - createuser --superuser --no-password postgrest_test
- createdb -O postgrest_test -U ubuntu postgrest_test - createdb -O postgrest_test -U ubuntu postgrest_test
ghc: ghc:
version: 7.8.3 version: 7.10.1
dependencies: dependencies:
override: override:
- cabal update - cabal update
+6 -1
View File
@@ -2,7 +2,7 @@ name: postgrest
description: Reads the schema of a PostgreSQL database and creates RESTful routes description: Reads the schema of a PostgreSQL database and creates RESTful routes
for the tables and views, supporting all HTTP verbs that security for the tables and views, supporting all HTTP verbs that security
permits. permits.
version: 0.2.11.1 version: 0.3.0.0
synopsis: REST API for any Postgres database synopsis: REST API for any Postgres database
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
@@ -22,6 +22,11 @@ Flag CI
Default: False Default: False
executable postgrest executable postgrest
if flag(ci)
ghc-options: -Wall -W -Werror
else
ghc-options: -Wall -W -O2
main-is: PostgREST/Main.hs main-is: PostgREST/Main.hs
default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes
default-language: Haskell2010 default-language: Haskell2010
+1 -1
View File
@@ -19,7 +19,7 @@ module PostgREST.Auth (
) where ) where
--line needed for ghc 7.8 --line needed for ghc 7.8
import Data.Functor ((<$>)) --import Data.Functor ((<$>))
import Data.Aeson (Value (..), Object) import Data.Aeson (Value (..), Object)
import Data.Aeson.Types (emptyObject, emptyArray) import Data.Aeson.Types (emptyObject, emptyArray)
+8 -7
View File
@@ -13,7 +13,7 @@ import PostgREST.Types
import Control.Monad (unless) import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Data.Aeson.Encode.Pretty (encodePretty) import Data.Aeson (encode)
import Data.Functor.Identity import Data.Functor.Identity
import Data.Monoid ((<>)) import Data.Monoid ((<>))
import Data.String.Conversions (cs) import Data.String.Conversions (cs)
@@ -34,7 +34,7 @@ isServerVersionSupported = do
return $ read (cs row) >= minimumPgVersion return $ read (cs row) >= minimumPgVersion
hasqlError :: PgError -> IO a hasqlError :: PgError -> IO a
hasqlError = error . cs . encodePretty hasqlError = error . cs . encode
main :: IO () main :: IO ()
main = do main = do
@@ -71,11 +71,12 @@ main = do
<> show minimumPgVersion) <> show minimumPgVersion)
) supportedOrError ) supportedOrError
roleOrError <- H.session pool $ do -- what was this code for?
Identity (role :: Text) <- H.tx Nothing $ H.singleEx -- roleOrError <- H.session pool $ do
[H.stmt|SELECT SESSION_USER|] -- Identity (role :: Text) <- H.tx Nothing $ H.singleEx
return role -- [H.stmt|SELECT SESSION_USER|]
authenticator <- either hasqlError return roleOrError -- return role
-- authenticator <- either hasqlError return roleOrError
let txSettings = Just (H.ReadCommitted, Just True) let txSettings = Just (H.ReadCommitted, Just True)
metadata <- H.session pool $ H.tx txSettings $ do metadata <- H.session pool $ H.tx txSettings $ do
+1 -1
View File
@@ -4,7 +4,7 @@
module PostgREST.Middleware where module PostgREST.Middleware where
-- needed for ghc 7.8 -- needed for ghc 7.8
import Data.Functor ((<$>)) -- import Data.Functor ((<$>))
import Data.Maybe (fromMaybe, isNothing) import Data.Maybe (fromMaybe, isNothing)
import Data.Monoid import Data.Monoid
+2 -2
View File
@@ -5,8 +5,8 @@ where
import Control.Applicative hiding ((<$>)) import Control.Applicative hiding ((<$>))
--lines needed for ghc 7.8 --lines needed for ghc 7.8
import Data.Functor ((<$>)) -- import Data.Functor ((<$>))
import Data.Traversable (traverse) -- import Data.Traversable (traverse)
--import Control.Monad (join) --import Control.Monad (join)
--import Data.List (delete, find) --import Data.List (delete, find)
+161 -156
View File
@@ -3,14 +3,57 @@
{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
module PostgREST.PgQuery where module PostgREST.PgQuery (
fromQi
, insertableValue
, wrapQuery
, asJson
, callProc
, iffNotT
, update
, insertSelect
, deleteFrom
, asCsvWithCount
, asJsonWithCount
, unquoted
-- format functions
, pgFmtLit
, pgFmtIdent
, pgFmtValue
, pgFmtCondition
, pgFmtColumn
, pgFmtJsonPath
, pgFmtTable
, pgFmtField
, pgFmtSelectItem
, pgFmtAsJsonPath
-- query transformers (to be removed)
, withT
, countT
, returningStarT
, whereT
-- query fragments
, orderF
, countNoneF
, countAllF
, countF
, locationF
, asCsvF
, asJsonSingleF
, asJsonF
, StatementT
) where
import qualified Hasql as H import qualified Hasql as H
import qualified Hasql.Backend as B import qualified Hasql.Backend as B
import qualified Hasql.Postgres as P import qualified Hasql.Postgres as P
import PostgREST.RangeQuery import PostgREST.RangeQuery
import PostgREST.Types (OrderTerm (..), QualifiedIdentifier(..)) import PostgREST.Types
import Control.Monad (join) import Control.Monad (join)
import qualified Data.Aeson as JSON import qualified Data.Aeson as JSON
@@ -25,7 +68,6 @@ import Data.Scientific (FPFormat (..), formatScientific,
import Data.String.Conversions (cs) import Data.String.Conversions (cs)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Vector (empty) import Data.Vector (empty)
import qualified Data.Vector as V
import qualified Network.HTTP.Types.URI as Net import qualified Network.HTTP.Types.URI as Net
import Text.Regex.TDFA ((=~)) import Text.Regex.TDFA ((=~))
@@ -37,14 +79,12 @@ instance Monoid PStmt where
B.Stmt (query <> query') (params <> params') (prep && prep') B.Stmt (query <> query') (params <> params') (prep && prep')
mempty = B.Stmt "" empty True mempty = B.Stmt "" empty True
type StatementT = PStmt -> PStmt type StatementT = PStmt -> PStmt
data JsonbPath =
ColIdentifier T.Text
limitT :: Maybe NonnegRange -> StatementT | KeyIdentifier T.Text
limitT r q = | SingleArrow JsonbPath JsonbPath
q <> B.Stmt (" LIMIT " <> limit <> " OFFSET " <> offset <> " ") empty True | DoubleArrow JsonbPath JsonbPath
where deriving (Show)
limit = maybe "ALL" (cs . show) $ join $ rangeLimit <$> r
offset = cs . show $ fromMaybe 0 $ rangeOffset <$> r
whereT :: QualifiedIdentifier -> Net.Query -> StatementT whereT :: QualifiedIdentifier -> Net.Query -> StatementT
whereT table params q = whereT table params q =
@@ -62,24 +102,6 @@ withT (B.Stmt eq ep epre) v (B.Stmt wq wp wpre) =
(ep <> wp) (ep <> wp)
(epre && wpre) (epre && wpre)
orderT :: [OrderTerm] -> StatementT
orderT ts q =
if L.null ts
then q
else q <> B.Stmt " order by " empty True <> clause
where
clause = mconcat $ L.intersperse commaq (map queryTerm ts)
queryTerm :: OrderTerm -> PStmt
queryTerm t = B.Stmt
(" " <> cs (pgFmtIdent $ otTerm t) <> " "
<> cs (otDirection t) <> " "
<> maybe "" cs (otNullOrder t) <> " ")
empty True
parentheticT :: StatementT
parentheticT s =
s { B.stmtTemplate = " (" <> B.stmtTemplate s <> ") " }
iffNotT :: PStmt -> StatementT iffNotT :: PStmt -> StatementT
iffNotT (B.Stmt aq ap apre) (B.Stmt bq bp bpre) = iffNotT (B.Stmt aq ap apre) (B.Stmt bq bp bpre) =
B.Stmt B.Stmt
@@ -92,36 +114,9 @@ countT :: StatementT
countT s = countT s =
s { B.stmtTemplate = "WITH qqq AS (" <> B.stmtTemplate s <> ") SELECT pg_catalog.count(1) FROM qqq" } s { B.stmtTemplate = "WITH qqq AS (" <> B.stmtTemplate s <> ") SELECT pg_catalog.count(1) FROM qqq" }
countRows :: QualifiedIdentifier -> PStmt
countRows t = B.Stmt ("select pg_catalog.count(1) from " <> fromQi t) empty True
countNone :: PStmt
countNone = B.Stmt "select null" empty True
asCsvWithCount :: QualifiedIdentifier -> StatementT asCsvWithCount :: QualifiedIdentifier -> StatementT
asCsvWithCount table = withCount . asCsv table asCsvWithCount table = withCount . asCsv table
{--
WITH source AS (
SELECT * FROM projects
)
SELECT
(
SELECT string_agg(k.kk, ',')
FROM (
SELECT json_object_keys(j)::TEXT as kk
FROM (
SELECT row_to_json(source) as j from source limit 1
) l
) k
)
|| '\r' ||
coalesce(string_agg(substring(t::text, 2, length(t::text) - 2), '\r'), '')
FROM (
SELECT * FROM source
) t;
--}
asCsv :: QualifiedIdentifier -> StatementT asCsv :: QualifiedIdentifier -> StatementT
asCsv table s = s { asCsv table s = s {
B.stmtTemplate = B.stmtTemplate =
@@ -143,34 +138,12 @@ asJson s = s {
withCount :: StatementT withCount :: StatementT
withCount s = s { B.stmtTemplate = "pg_catalog.count(t), " <> B.stmtTemplate s } withCount s = s { B.stmtTemplate = "pg_catalog.count(t), " <> B.stmtTemplate s }
asJsonRow :: StatementT
asJsonRow s = s { B.stmtTemplate = "row_to_json(t) from (" <> B.stmtTemplate s <> ") t" }
returningStarT :: StatementT returningStarT :: StatementT
returningStarT s = s { B.stmtTemplate = B.stmtTemplate s <> " RETURNING *" } returningStarT s = s { B.stmtTemplate = B.stmtTemplate s <> " RETURNING *" }
deleteFrom :: QualifiedIdentifier -> PStmt deleteFrom :: QualifiedIdentifier -> PStmt
deleteFrom t = B.Stmt ("delete from " <> fromQi t) empty True deleteFrom t = B.Stmt ("delete from " <> fromQi t) empty True
insertInto :: QualifiedIdentifier
-> V.Vector T.Text
-> V.Vector (V.Vector JSON.Value)
-> PStmt
insertInto t cols vals
| V.null cols = B.Stmt ("insert into " <> fromQi t <> " default values returning *") empty True
| otherwise = B.Stmt
("insert into " <> fromQi t <> " (" <>
T.intercalate ", " (V.toList $ V.map pgFmtIdent cols) <>
") values "
<> T.intercalate ", "
(V.toList $ V.map (\v -> "("
<> T.intercalate ", " (V.toList $ V.map insertableValue v)
<> ")"
) vals
)
<> " returning row_to_json(" <> fromQi t <> ".*)")
empty True
insertSelect :: QualifiedIdentifier -> [T.Text] -> [JSON.Value] -> PStmt insertSelect :: QualifiedIdentifier -> [T.Text] -> [JSON.Value] -> PStmt
insertSelect t [] _ = B.Stmt insertSelect t [] _ = B.Stmt
("insert into " <> fromQi t <> " default values returning *") empty True ("insert into " <> fromQi t <> " default values returning *") empty True
@@ -200,7 +173,7 @@ callProc qi params = do
wherePred :: QualifiedIdentifier -> Net.QueryItem -> PStmt wherePred :: QualifiedIdentifier -> Net.QueryItem -> PStmt
wherePred table (col, predicate) = wherePred table (col, predicate) =
B.Stmt (notOp <> " " <> pgFmtJsonbPath table (cs col) <> " " <> op <> " " <> B.Stmt (notOp <> " " <> pgFmtJsonbPath table (cs col) <> " " <> op <> " " <>
if opCode `elem` ["is","isnot"] then whiteList value if opCode `elem` ["is","isnot"] then whiteList val
else cs sqlValue) else cs sqlValue)
empty True empty True
@@ -209,60 +182,18 @@ wherePred table (col, predicate) =
hasNot caseTrue caseFalse = if headPredicate == "not" then caseTrue else caseFalse hasNot caseTrue caseFalse = if headPredicate == "not" then caseTrue else caseFalse
opCode = hasNot (head rest) headPredicate opCode = hasNot (head rest) headPredicate
notOp = hasNot headPredicate "" notOp = hasNot headPredicate ""
value = hasNot (T.intercalate "." $ tail rest) (T.intercalate "." rest) val = hasNot (T.intercalate "." $ tail rest) (T.intercalate "." rest)
sqlValue = pgFmtValue opCode value sqlValue = pgFmtValue opCode val
op = pgFmtOperator opCode op = pgFmtOperator opCode
whiteList :: T.Text -> T.Text whiteList :: T.Text -> T.Text
whiteList val = fromMaybe whiteList val = fromMaybe
(cs (pgFmtLit val) <> "::unknown ") (cs (pgFmtLit val) <> "::unknown ")
(L.find ((==) . T.toLower $ val) ["null","true","false"]) (L.find ((==) . T.toLower $ val) ["null","true","false"])
pgFmtValue :: T.Text -> T.Text -> T.Text
pgFmtValue opCode value =
case opCode of
"like" -> unknownLiteral $ T.map star value
"ilike" -> unknownLiteral $ T.map star value
"in" -> "(" <> T.intercalate ", " (map unknownLiteral $ T.split (==',') value) <> ") "
"notin" -> "(" <> T.intercalate ", " (map unknownLiteral $ T.split (==',') value) <> ") "
"@@" -> "to_tsquery(" <> unknownLiteral value <> ") "
_ -> unknownLiteral value
where
star c = if c == '*' then '%' else c
unknownLiteral = (<> "::unknown ") . pgFmtLit
pgFmtOperator :: T.Text -> T.Text
pgFmtOperator opCode =
case opCode of
"eq" -> "="
"gt" -> ">"
"lt" -> "<"
"gte" -> ">="
"lte" -> "<="
"neq" -> "<>"
"like"-> "like"
"ilike"-> "ilike"
"in" -> "in"
"notin" -> "not in"
"is" -> "is"
"isnot" -> "is not"
"@@" -> "@@"
_ -> "="
commaq :: PStmt
commaq = B.Stmt ", " empty True
andq :: PStmt andq :: PStmt
andq = B.Stmt " and " empty True andq = B.Stmt " and " empty True
data JsonbPath =
ColIdentifier T.Text
| KeyIdentifier T.Text
| SingleArrow JsonbPath JsonbPath
| DoubleArrow JsonbPath JsonbPath
deriving (Show)
parseJsonbPath :: T.Text -> Maybe JsonbPath parseJsonbPath :: T.Text -> Maybe JsonbPath
parseJsonbPath p = parseJsonbPath p =
case T.splitOn "->>" p of case T.splitOn "->>" p of
@@ -273,35 +204,6 @@ parseJsonbPath p =
(KeyIdentifier b) (KeyIdentifier b)
_ -> Nothing _ -> Nothing
pgFmtJsonbPath :: QualifiedIdentifier -> T.Text -> T.Text
pgFmtJsonbPath table p =
pgFmtJsonbPath' $ fromMaybe (ColIdentifier p) (parseJsonbPath p)
where
pgFmtJsonbPath' (ColIdentifier i) = fromQi table <> "." <> pgFmtIdent i
pgFmtJsonbPath' (KeyIdentifier i) = pgFmtLit i
pgFmtJsonbPath' (SingleArrow a b) =
pgFmtJsonbPath' a <> "->" <> pgFmtJsonbPath' b
pgFmtJsonbPath' (DoubleArrow a b) =
pgFmtJsonbPath' a <> "->>" <> pgFmtJsonbPath' b
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
trimNullChars :: T.Text -> T.Text trimNullChars :: T.Text -> T.Text
trimNullChars = T.takeWhile (/= '\x0') trimNullChars = T.takeWhile (/= '\x0')
@@ -325,10 +227,6 @@ insertableValue :: JSON.Value -> T.Text
insertableValue JSON.Null = "null" insertableValue JSON.Null = "null"
insertableValue v = insertableText $ unquoted v insertableValue v = insertableText $ unquoted v
paramFilter :: JSON.Value -> T.Text
paramFilter JSON.Null = "is.null"
paramFilter v = "eq." <> unquoted v
wrapQuery :: T.Text -> [T.Text] -> Maybe NonnegRange -> T.Text wrapQuery :: T.Text -> [T.Text] -> Maybe NonnegRange -> T.Text
wrapQuery source selectColumns range = wrapQuery source selectColumns range =
withSourceF source <> withSourceF source <>
@@ -337,6 +235,8 @@ wrapQuery source selectColumns range =
" " <> " " <>
fromF ( limitF range ) fromF ( limitF range )
-- query fragments
withSourceF :: T.Text -> T.Text withSourceF :: T.Text -> T.Text
withSourceF s = "WITH source AS (" <> s <>")" withSourceF s = "WITH source AS (" <> s <>")"
@@ -406,3 +306,108 @@ orderF ts =
<> cs (pgFmtIdent $ otTerm t) <> " " <> cs (pgFmtIdent $ otTerm t) <> " "
<> cs (otDirection t) <> " " <> cs (otDirection t) <> " "
<> maybe "" cs (otNullOrder 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 =
case opCode of
"eq" -> "="
"gt" -> ">"
"lt" -> "<"
"gte" -> ">="
"lte" -> "<="
"neq" -> "<>"
"like"-> "like"
"ilike"-> "ilike"
"in" -> "in"
"notin" -> "not in"
"is" -> "is"
"isnot" -> "is not"
"@@" -> "@@"
_ -> "="
pgFmtJsonbPath :: QualifiedIdentifier -> T.Text -> T.Text
pgFmtJsonbPath table p =
pgFmtJsonbPath' $ fromMaybe (ColIdentifier p) (parseJsonbPath p)
where
pgFmtJsonbPath' (ColIdentifier i) = fromQi table <> "." <> pgFmtIdent i
pgFmtJsonbPath' (KeyIdentifier i) = pgFmtLit i
pgFmtJsonbPath' (SingleArrow a b) =
pgFmtJsonbPath' a <> "->" <> pgFmtJsonbPath' b
pgFmtJsonbPath' (DoubleArrow a b) =
pgFmtJsonbPath' a <> "->>" <> pgFmtJsonbPath' b
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 ft fc) -> pgFmtColumn (QualifiedIdentifier s ft) fc
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
+3 -47
View File
@@ -10,9 +10,9 @@ import Data.Text hiding (filter, find, foldr, head, last, map,
null, zipWith) null, zipWith)
import Control.Applicative import Control.Applicative
import Data.Tree import Data.Tree
import PostgREST.PgQuery (fromQi, import PostgREST.PgQuery (fromQi, pgFmtCondition, pgFmtSelectItem,
pgFmtIdent, pgFmtLit, pgFmtOperator, pgFmtIdent, pgFmtCondition,
pgFmtValue, whiteList, insertableValue, orderF) insertableValue, orderF)
import PostgREST.Types import PostgREST.Types
--import qualified Data.Vector as V (empty) --import qualified Data.Vector as V (empty)
--import qualified Hasql.Backend as B --import qualified Hasql.Backend as B
@@ -161,47 +161,3 @@ requestToQuery schema (Node (Insert _ flds vals, (mainTbl, _)) _) =
-- ) vals -- ) vals
-- ) -- )
-- <> " returning row_to_json(" <> fromQi t <> ".*)") -- <> " returning row_to_json(" <> fromQi t <> ".*)")
pgFmtCondition :: QualifiedIdentifier -> Filter -> 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 = 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 ft fc) -> pgFmtColumn (QualifiedIdentifier s ft) fc
pgFmtColumn :: QualifiedIdentifier -> Text -> Text
pgFmtColumn table "*" = fromQi table <> ".*"
pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c
pgFmtJsonPath :: Maybe JsonPath -> Text
pgFmtJsonPath (Just [x]) = "->>" <> pgFmtLit x
pgFmtJsonPath (Just (x:xs)) = "->" <> pgFmtLit x <> pgFmtJsonPath ( Just xs )
pgFmtJsonPath _ = ""
pgFmtTable :: Table -> Text
pgFmtTable Table{tableSchema=s, tableName=n} = fromQi $ QualifiedIdentifier s n
pgFmtField :: QualifiedIdentifier -> Field -> Text
pgFmtField table (c, jp) = pgFmtColumn table c <> pgFmtJsonPath jp
pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> Text
pgFmtSelectItem table (f@(_, jp), Nothing) = pgFmtField table f <> asJsonPath jp
pgFmtSelectItem table (f@(_, jp), Just cast ) = "CAST (" <> pgFmtField table f <> " AS " <> cast <> " )" <> asJsonPath jp
asJsonPath :: Maybe JsonPath -> Text
asJsonPath Nothing = ""
asJsonPath (Just xx) = " AS " <> last xx