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

Upgrade hasql to 1.4 (#1325)

Browse Source
This commit is contained in:
Robert
2019-06-17 16:54:45 -05:00
committed by Steve Chávez
parent 51d3a7864a
commit 9bcf39f41f
4 changed files with 85 additions and 55 deletions
Download Patch File Download Diff File Expand all files Collapse all files
postgrest.cabal
+6 -6
View File
@@ -56,9 +56,9 @@ library
, cookie >= 0.4.2 && < 0.5
, either >= 4.4.1 && < 5.1
, gitrev >= 1.2 && < 1.4
, hasql >= 1.3 && < 1.4
, hasql >= 1.4 && < 1.5
, hasql-pool >= 0.5 && < 0.6
, hasql-transaction >= 0.7 && < 0.8
, hasql-transaction >= 0.7.2 && < 0.8
, heredoc >= 0.2 && < 0.3
, http-types >= 0.12.2 && < 0.13
, insert-ordered-containers >= 0.1 && < 0.3
@@ -94,9 +94,9 @@ executable postgrest
, base64-bytestring >= 1 && < 1.1
, bytestring >= 0.10.8 && < 0.11
, directory >= 1.2.6 && < 1.4
, hasql >= 1.3 && < 1.4
, hasql >= 1.4 && < 1.5
, hasql-pool >= 0.5 && < 0.6
, hasql-transaction >= 0.7 && < 0.8
, hasql-transaction >= 0.7.2 && < 0.8
, network < 2.9
, postgrest
, protolude >= 0.2.2 && < 0.3
@@ -155,9 +155,9 @@ test-suite spec
, cassava >= 0.4.5 && < 0.6
, containers >= 0.5.7 && < 0.7
, contravariant >= 1.4 && < 1.6
, hasql >= 1.3 && < 1.4
, hasql >= 1.4 && < 1.5
, hasql-pool >= 0.5 && < 0.6
, hasql-transaction >= 0.7 && < 0.8
, hasql-transaction >= 0.7.2 && < 0.8
, heredoc >= 0.2 && < 0.3
, hspec >= 2.3 && < 2.8
, hspec-wai >= 0.7 && < 0.10
src/PostgREST/DbStructure.hs
+53 -41
View File
@@ -43,6 +43,18 @@ import Control.Applicative
import PostgREST.Types
import Protolude
column :: HD.Value a -> HD.Row a
column = HD.column . HD.nonNullable
nullableColumn :: HD.Value a -> HD.Row (Maybe a)
nullableColumn = HD.column . HD.nullable
element :: HD.Value a -> HD.Array a
element = HD.element . HD.nonNullable
param :: HE.Value a -> HE.Params a
param = HE.param . HE.nonNullable
getDbStructure :: Schema -> PgVersion -> HT.Transaction DbStructure
getDbStructure schema pgVer = do
HT.sql "set local schema ''" -- for getting the fully qualified name(schema.name) of every db object
@@ -70,10 +82,10 @@ decodeTables :: HD.Result [Table]
decodeTables =
HD.rowList tblRow
where
tblRow = Table <$> HD.column HD.text
<*> HD.column HD.text
<*> HD.nullableColumn HD.text
<*> HD.column HD.bool
tblRow = Table <$> column HD.text
<*> column HD.text
<*> nullableColumn HD.text
<*> column HD.bool
decodeColumns :: [Table] -> HD.Result [Column]
decodeColumns tables =
@@ -81,41 +93,41 @@ decodeColumns tables =
where
colRow =
(,,,,,,,,,,,)
<$> HD.column HD.text <*> HD.column HD.text
<*> HD.column HD.text <*> HD.nullableColumn HD.text
<*> HD.column HD.int4 <*> HD.column HD.bool
<*> HD.column HD.text <*> HD.column HD.bool
<*> HD.nullableColumn HD.int4
<*> HD.nullableColumn HD.int4
<*> HD.nullableColumn HD.text
<*> HD.nullableColumn HD.text
<$> column HD.text <*> column HD.text
<*> column HD.text <*> nullableColumn HD.text
<*> column HD.int4 <*> column HD.bool
<*> column HD.text <*> column HD.bool
<*> nullableColumn HD.int4
<*> nullableColumn HD.int4
<*> nullableColumn HD.text
<*> nullableColumn HD.text
decodeRelations :: [Table] -> [Column] -> HD.Result [Relation]
decodeRelations tables cols =
mapMaybe (relationFromRow tables cols) <$> HD.rowList relRow
where
relRow = (,,,,,)
<$> HD.column HD.text
<*> HD.column HD.text
<*> HD.column (HD.array (HD.dimension replicateM (HD.element HD.text)))
<*> HD.column HD.text
<*> HD.column HD.text
<*> HD.column (HD.array (HD.dimension replicateM (HD.element HD.text)))
<$> column HD.text
<*> column HD.text
<*> column (HD.array (HD.dimension replicateM (element HD.text)))
<*> column HD.text
<*> column HD.text
<*> column (HD.array (HD.dimension replicateM (element HD.text)))
decodePks :: [Table] -> HD.Result [PrimaryKey]
decodePks tables =
mapMaybe (pkFromRow tables) <$> HD.rowList pkRow
where
pkRow = (,,) <$> HD.column HD.text <*> HD.column HD.text <*> HD.column HD.text
pkRow = (,,) <$> column HD.text <*> column HD.text <*> column HD.text
decodeSynonyms :: [Column] -> HD.Result [Synonym]
decodeSynonyms cols =
mapMaybe (synonymFromRow cols) <$> HD.rowList synRow
where
synRow = (,,,,,)
<$> HD.column HD.text <*> HD.column HD.text
<*> HD.column HD.text <*> HD.column HD.text
<*> HD.column HD.text <*> HD.column HD.text
<$> column HD.text <*> column HD.text
<*> column HD.text <*> column HD.text
<*> column HD.text <*> column HD.text
decodeProcs :: HD.Result (M.HashMap Text [ProcDescription])
decodeProcs =
@@ -123,15 +135,15 @@ decodeProcs =
map sort . M.fromListWith (++) . map ((\(x,y) -> (x, [y])) . addName) <$> HD.rowList tblRow
where
tblRow = ProcDescription
<$> HD.column HD.text
<*> HD.nullableColumn HD.text
<*> (parseArgs <$> HD.column HD.text)
<$> column HD.text
<*> nullableColumn HD.text
<*> (parseArgs <$> column HD.text)
<*> (parseRetType
<$> HD.column HD.text
<*> HD.column HD.text
<*> HD.column HD.bool
<*> HD.column HD.char)
<*> (parseVolatility <$> HD.column HD.char)
<$> column HD.text
<*> column HD.text
<*> column HD.bool
<*> column HD.char)
<*> (parseVolatility <$> column HD.char)
addName :: ProcDescription -> (Text, ProcDescription)
addName pd = (pdName pd, pd)
@@ -168,10 +180,10 @@ decodeProcs =
| otherwise = Volatile -- only 'v' can happen here
allProcs :: H.Statement Schema (M.HashMap Text [ProcDescription])
allProcs = H.Statement (toS procsSqlQuery) (HE.param HE.text) decodeProcs True
allProcs = H.Statement (toS procsSqlQuery) (param HE.text) decodeProcs True
accessibleProcs :: H.Statement Schema (M.HashMap Text [ProcDescription])
accessibleProcs = H.Statement (toS sql) (HE.param HE.text) decodeProcs True
accessibleProcs = H.Statement (toS sql) (param HE.text) decodeProcs True
where
sql = procsSqlQuery <> " AND has_function_privilege(p.oid, 'execute')"
@@ -196,7 +208,7 @@ procsSqlQuery = [q|
schemaDescription :: H.Statement Schema (Maybe Text)
schemaDescription =
H.Statement sql (HE.param HE.text) (join <$> HD.rowMaybe (HD.nullableColumn HD.text)) True
H.Statement sql (param HE.text) (join <$> HD.rowMaybe (nullableColumn HD.text)) True
where
sql = [q|
select
@@ -209,7 +221,7 @@ schemaDescription =
accessibleTables :: H.Statement Schema [Table]
accessibleTables =
H.Statement sql (HE.param HE.text) decodeTables True
H.Statement sql (param HE.text) decodeTables True
where
sql = [q|
select
@@ -351,7 +363,7 @@ addViewPrimaryKeys syns = concatMap (\pk ->
allTables :: H.Statement () [Table]
allTables =
H.Statement sql HE.unit decodeTables True
H.Statement sql HE.noParams decodeTables True
where
sql = [q|
SELECT
@@ -374,7 +386,7 @@ allTables =
allColumns :: [Table] -> H.Statement Schema [Column]
allColumns tabs =
H.Statement sql (HE.param HE.text) (decodeColumns tabs) True
H.Statement sql (param HE.text) (decodeColumns tabs) True
where
sql = [q|
SELECT DISTINCT
@@ -561,7 +573,7 @@ columnFromRow tabs (s, t, n, desc, pos, nul, typ, u, l, p, d, e) = buildColumn <
allChildRelations :: [Table] -> [Column] -> H.Statement () [Relation]
allChildRelations tabs cols =
H.Statement sql HE.unit (decodeRelations tabs cols) True
H.Statement sql HE.noParams (decodeRelations tabs cols) True
where
sql = [q|
SELECT ns1.nspname AS table_schema,
@@ -602,7 +614,7 @@ relationFromRow allTabs allCols (rs, rt, rcs, frs, frt, frcs) =
allPrimaryKeys :: [Table] -> H.Statement () [PrimaryKey]
allPrimaryKeys tabs =
H.Statement sql HE.unit (decodePks tabs) True
H.Statement sql HE.noParams (decodePks tabs) True
where
sql = [q|
/*
@@ -712,7 +724,7 @@ pkFromRow tabs (s, t, n) = PrimaryKey <$> table <*> pure n
allSynonyms :: [Column] -> PgVersion -> H.Statement Schema [Synonym]
allSynonyms cols pgVer =
H.Statement sql (HE.param HE.text) (decodeSynonyms cols) True
H.Statement sql (param HE.text) (decodeSynonyms cols) True
-- query explanation at https://gist.github.com/steve-chavez/7ee0e6590cddafb532e5f00c46275569
where
subselectRegex :: Text
@@ -787,7 +799,7 @@ synonymFromRow allCols (s1,t1,c1,s2,t2,c2) = (,) <$> col1 <*> col2
findCol s t c = find (\col -> (tableSchema . colTable) col == s && (tableName . colTable) col == t && colName col == c) allCols
getPgVersion :: H.Session PgVersion
getPgVersion = H.statement () $ H.Statement sql HE.unit versionRow False
getPgVersion = H.statement () $ H.Statement sql HE.noParams versionRow False
where
sql = "SELECT current_setting('server_version_num')::integer, current_setting('server_version')"
versionRow = HD.singleRow $ PgVersion <$> HD.column HD.int4 <*> HD.column HD.text
versionRow = HD.singleRow $ PgVersion <$> column HD.int4 <*> column HD.text
src/PostgREST/QueryBuilder.hs
+20 -8
View File
@@ -51,6 +51,18 @@ import PostgREST.RangeQuery (allRange, rangeLimit, rangeOffset)
import PostgREST.Types
import Protolude hiding (cast, intercalate, replace)
column :: HD.Value a -> HD.Row a
column = HD.column . HD.nonNullable
nullableColumn :: HD.Value a -> HD.Row (Maybe a)
nullableColumn = HD.column . HD.nullable
element :: HD.Value a -> HD.Array a
element = HD.element . HD.nonNullable
param :: HE.Value a -> HE.Params a
param = HE.param . HE.nonNullable
{-| The generic query result format used by API responses. The location header
is represented as a list of strings containing variable bindings like
@"k1=eq.42"@, or the empty list if there is no location header.
@@ -58,10 +70,10 @@ import Protolude hiding (cast, intercalate, replace)
type ResultsWithCount = (Maybe Int64, Int64, [BS.ByteString], BS.ByteString)
standardRow :: HD.Row ResultsWithCount
standardRow = (,,,) <$> HD.nullableColumn HD.int8 <*> HD.column HD.int8
<*> HD.column header <*> HD.column HD.bytea
standardRow = (,,,) <$> nullableColumn HD.int8 <*> column HD.int8
<*> column header <*> column HD.bytea
where
header = HD.array $ HD.dimension replicateM $ HD.element HD.bytea
header = HD.array $ HD.dimension replicateM $ element HD.bytea
noLocationF :: Text
noLocationF = "array[]::text[]"
@@ -81,7 +93,7 @@ decodeStandardMay =
createReadStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool -> Maybe FieldName ->
H.Statement () ResultsWithCount
createReadStatement selectQuery countQuery isSingle countTotal asCsv binaryField =
unicodeStatement sql HE.unit decodeStandard False
unicodeStatement sql HE.noParams decodeStandard False
where
sql = [qc|
WITH {sourceCTEName} AS ({selectQuery}) SELECT {cols}
@@ -104,7 +116,7 @@ createWriteStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool ->
PreferRepresentation -> [Text] ->
H.Statement ByteString (Maybe ResultsWithCount)
createWriteStatement selectQuery mutateQuery wantSingle isInsert asCsv rep pKeys =
unicodeStatement sql (HE.param HE.unknown) decodeStandardMay True
unicodeStatement sql (param HE.unknown) decodeStandardMay True
where
sql = case rep of
@@ -146,7 +158,7 @@ callProc :: QualifiedIdentifier -> [PgArg] -> Bool -> SqlQuery -> SqlQuery -> Bo
Bool -> Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion ->
H.Statement ByteString (Maybe ProcResults)
callProc qi pgArgs returnsScalar selectQuery countQuery countTotal isSingle paramsAsSingleObject asCsv asBinary binaryField pgVer =
unicodeStatement sql (HE.param HE.unknown) decodeProc True
unicodeStatement sql (param HE.unknown) decodeProc True
where
sql =[qc|
WITH
@@ -210,8 +222,8 @@ callProc qi pgArgs returnsScalar selectQuery countQuery countTotal isSingle para
else "'[]'" :: Text
decodeProc = HD.rowMaybe procRow
procRow = (,,,) <$> HD.nullableColumn HD.int8 <*> HD.column HD.int8
<*> HD.column HD.bytea <*> HD.column HD.bytea
procRow = (,,,) <$> nullableColumn HD.int8 <*> column HD.int8
<*> column HD.bytea <*> column HD.bytea
pgFmtIdent :: SqlFragment -> SqlFragment
pgFmtIdent x = "\"" <> replace "\"" "\"\"" (trimNullChars $ toS x) <> "\""
stack.yaml
+6
View File
@@ -6,6 +6,12 @@ extra-deps:
- Ranged-sets-0.4.0
- configurator-pg-0.1.0.3
- http-types-0.12.3
- hasql-1.4
- hasql-pool-0.5.1
- hasql-transaction-0.7.2
- text-builder-0.6.5.1
- deferred-folds-0.9.10.1
- primitive-0.6.4.0
ghc-options:
postgrest: -O2 -Werror -Wall -fwarn-identities -fno-warn-redundant-constraints
nix: