Create monomorphic statement function to force use of Text

This commit is contained in:
Joe Nelson
2016-03-16 21:04:18 -07:00
parent e5fed86965
commit 3bfe64dd06
+14 -10
View File
@@ -43,6 +43,7 @@ import Data.List (find, (\\))
import Data.Monoid ((<>)) import Data.Monoid ((<>))
import Data.Text (Text, intercalate, unwords, replace, isInfixOf, toLower, split) import Data.Text (Text, intercalate, unwords, replace, isInfixOf, toLower, split)
import qualified Data.Text as T (map, takeWhile) import qualified Data.Text as T (map, takeWhile)
import qualified Data.Text.Encoding as T
import Data.String.Conversions (cs) import Data.String.Conversions (cs)
import Control.Applicative ((<|>)) import Control.Applicative ((<|>))
import Control.Monad (join) import Control.Monad (join)
@@ -93,11 +94,11 @@ encodeUniformObjs =
createReadStatement :: SqlQuery -> SqlQuery -> NonnegRange -> Bool -> Bool -> Bool -> createReadStatement :: SqlQuery -> SqlQuery -> NonnegRange -> Bool -> Bool -> Bool ->
H.Query () ResultsWithCount H.Query () ResultsWithCount
createReadStatement selectQuery countQuery range isSingle countTotal asCsv = createReadStatement selectQuery countQuery range isSingle countTotal asCsv =
H.statement (cs sql) HE.unit decodeStandard True unicodeStatement sql HE.unit decodeStandard True
where where
sql = [qc| sql = [qc|
WITH {sourceCTEName} AS ({selectQuery}) SELECT {cols} WITH {sourceCTEName} AS ({selectQuery}) SELECT {cols}
FROM ( SELECT * FROM {sourceCTEName} {limitF range}) t |] :: Text FROM ( SELECT * FROM {sourceCTEName} {limitF range}) t |]
countResultF = if countTotal then "("<>countQuery<>")" else "null" countResultF = if countTotal then "("<>countQuery<>")" else "null"
cols = intercalate ", " [ cols = intercalate ", " [
countResultF <> " AS total_result_set", countResultF <> " AS total_result_set",
@@ -116,20 +117,20 @@ createWriteStatement :: QualifiedIdentifier -> SqlQuery -> SqlQuery -> Bool ->
createWriteStatement _ _ _ _ _ _ _ (PayloadParseError _) = undefined createWriteStatement _ _ _ _ _ _ _ (PayloadParseError _) = undefined
createWriteStatement _ _ mutateQuery _ None createWriteStatement _ _ mutateQuery _ None
_ _ (PayloadJSON (UniformObjects _)) = _ _ (PayloadJSON (UniformObjects _)) =
H.statement (cs sql) encodeUniformObjs decodeStandardMay True unicodeStatement sql encodeUniformObjs decodeStandardMay True
where where
sql = [qc| sql = [qc|
WITH {sourceCTEName} AS ({mutateQuery}) WITH {sourceCTEName} AS ({mutateQuery})
SELECT '', 0, '', '' |] :: Text SELECT '', 0, '', '' |]
createWriteStatement qi _ mutateQuery isSingle HeadersOnly createWriteStatement qi _ mutateQuery isSingle HeadersOnly
pKeys _ (PayloadJSON (UniformObjects _)) = pKeys _ (PayloadJSON (UniformObjects _)) =
H.statement (cs sql) encodeUniformObjs decodeStandardMay True unicodeStatement sql encodeUniformObjs decodeStandardMay True
where where
sql = [qc| sql = [qc|
WITH {sourceCTEName} AS ({mutateQuery} RETURNING {fromQi qi}.*) WITH {sourceCTEName} AS ({mutateQuery} RETURNING {fromQi qi}.*)
SELECT {cols} SELECT {cols}
FROM (SELECT 1 FROM {sourceCTEName}) t |] :: Text FROM (SELECT 1 FROM {sourceCTEName}) t |]
cols = intercalate ", " [ cols = intercalate ", " [
"'' AS total_result_set", "'' AS total_result_set",
"pg_catalog.count(t) AS page_total", "pg_catalog.count(t) AS page_total",
@@ -139,12 +140,12 @@ createWriteStatement qi _ mutateQuery isSingle HeadersOnly
createWriteStatement qi selectQuery mutateQuery isSingle Full createWriteStatement qi selectQuery mutateQuery isSingle Full
pKeys asCsv (PayloadJSON (UniformObjects _)) = pKeys asCsv (PayloadJSON (UniformObjects _)) =
H.statement (cs sql) encodeUniformObjs decodeStandardMay True unicodeStatement sql encodeUniformObjs decodeStandardMay True
where where
sql = [qc| sql = [qc|
WITH {sourceCTEName} AS ({mutateQuery} RETURNING {fromQi qi}.*) WITH {sourceCTEName} AS ({mutateQuery} RETURNING {fromQi qi}.*)
SELECT {cols} SELECT {cols}
FROM ({selectQuery}) t |] :: Text FROM ({selectQuery}) t |]
cols = intercalate ", " [ cols = intercalate ", " [
"'' AS total_result_set", -- when updateing it does not make sense "'' AS total_result_set", -- when updateing it does not make sense
"pg_catalog.count(t) AS page_total", "pg_catalog.count(t) AS page_total",
@@ -206,7 +207,7 @@ addJoinConditions schema (Node (query, (n, r)) forest) =
type ProcResults = (Maybe Int64, Int64, JSON.Value) type ProcResults = (Maybe Int64, Int64, JSON.Value)
callProc :: QualifiedIdentifier -> JSON.Object -> NonnegRange -> Bool -> H.Query () (Maybe ProcResults) callProc :: QualifiedIdentifier -> JSON.Object -> NonnegRange -> Bool -> H.Query () (Maybe ProcResults)
callProc qi params range countTotal = callProc qi params range countTotal =
H.statement (cs sql) HE.unit decodeProc True unicodeStatement sql HE.unit decodeProc True
where where
sql = [qc| sql = [qc|
WITH t AS (select * {_callSql}) WITH t AS (select * {_callSql})
@@ -217,7 +218,7 @@ callProc qi params range countTotal =
coalesce(array_agg(row_to_json(r)), '\{}') coalesce(array_agg(row_to_json(r)), '\{}')
)::character varying )::character varying
FROM (select * from t {limitF range}) r; FROM (select * from t {limitF range}) r;
|] :: Text |]
_args = intercalate "," $ map _assignment (HM.toList params) _args = intercalate "," $ map _assignment (HM.toList params)
_assignment (n,v) = pgFmtIdent n <> ":=" <> insertableValue v _assignment (n,v) = pgFmtIdent n <> ":=" <> insertableValue v
_callSql = [qc| from {fromQi qi}({_args}) |] :: Text _callSql = [qc| from {fromQi qi}({_args}) |] :: Text
@@ -439,6 +440,9 @@ getJoinConditions (Relation t cols ft fcs typ lt lc1 lc2) =
toFilter :: Text -> Text -> Column -> Column -> Filter 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}})) toFilter tb ftb c fc = Filter (colName c, Nothing) "=" (VForeignKey (QualifiedIdentifier s tb) (ForeignKey fc{colTable=(colTable fc){tableName=ftb}}))
unicodeStatement :: Text -> HE.Params a -> HD.Result b -> Bool -> H.Query a b
unicodeStatement = H.statement . T.encodeUtf8
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