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.Text (Text, intercalate, unwords, replace, isInfixOf, toLower, split)
import qualified Data.Text as T (map, takeWhile)
import qualified Data.Text.Encoding as T
import Data.String.Conversions (cs)
import Control.Applicative ((<|>))
import Control.Monad (join)
@@ -93,11 +94,11 @@ encodeUniformObjs =
createReadStatement :: SqlQuery -> SqlQuery -> NonnegRange -> Bool -> Bool -> Bool ->
H.Query () ResultsWithCount
createReadStatement selectQuery countQuery range isSingle countTotal asCsv =
H.statement (cs sql) HE.unit decodeStandard True
unicodeStatement sql HE.unit decodeStandard True
where
sql = [qc|
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"
cols = intercalate ", " [
countResultF <> " AS total_result_set",
@@ -116,20 +117,20 @@ createWriteStatement :: QualifiedIdentifier -> SqlQuery -> SqlQuery -> Bool ->
createWriteStatement _ _ _ _ _ _ _ (PayloadParseError _) = undefined
createWriteStatement _ _ mutateQuery _ None
_ _ (PayloadJSON (UniformObjects _)) =
H.statement (cs sql) encodeUniformObjs decodeStandardMay True
unicodeStatement sql encodeUniformObjs decodeStandardMay True
where
sql = [qc|
WITH {sourceCTEName} AS ({mutateQuery})
SELECT '', 0, '', '' |] :: Text
SELECT '', 0, '', '' |]
createWriteStatement qi _ mutateQuery isSingle HeadersOnly
pKeys _ (PayloadJSON (UniformObjects _)) =
H.statement (cs sql) encodeUniformObjs decodeStandardMay True
unicodeStatement sql encodeUniformObjs decodeStandardMay True
where
sql = [qc|
WITH {sourceCTEName} AS ({mutateQuery} RETURNING {fromQi qi}.*)
SELECT {cols}
FROM (SELECT 1 FROM {sourceCTEName}) t |] :: Text
FROM (SELECT 1 FROM {sourceCTEName}) t |]
cols = intercalate ", " [
"'' AS total_result_set",
"pg_catalog.count(t) AS page_total",
@@ -139,12 +140,12 @@ createWriteStatement qi _ mutateQuery isSingle HeadersOnly
createWriteStatement qi selectQuery mutateQuery isSingle Full
pKeys asCsv (PayloadJSON (UniformObjects _)) =
H.statement (cs sql) encodeUniformObjs decodeStandardMay True
unicodeStatement sql encodeUniformObjs decodeStandardMay True
where
sql = [qc|
WITH {sourceCTEName} AS ({mutateQuery} RETURNING {fromQi qi}.*)
SELECT {cols}
FROM ({selectQuery}) t |] :: Text
FROM ({selectQuery}) t |]
cols = intercalate ", " [
"'' AS total_result_set", -- when updateing it does not make sense
"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)
callProc :: QualifiedIdentifier -> JSON.Object -> NonnegRange -> Bool -> H.Query () (Maybe ProcResults)
callProc qi params range countTotal =
H.statement (cs sql) HE.unit decodeProc True
unicodeStatement sql HE.unit decodeProc True
where
sql = [qc|
WITH t AS (select * {_callSql})
@@ -217,7 +218,7 @@ callProc qi params range countTotal =
coalesce(array_agg(row_to_json(r)), '\{}')
)::character varying
FROM (select * from t {limitF range}) r;
|] :: Text
|]
_args = intercalate "," $ map _assignment (HM.toList params)
_assignment (n,v) = pgFmtIdent n <> ":=" <> insertableValue v
_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 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 val x = if null x then "" else val