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

WIP: converting DbStructure

Browse Source
This commit is contained in:
Joe Nelson
2016-01-24 18:09:18 -08:00
parent 2d5210464a
commit 4b515c5df4
1 changed files with 298 additions and 258 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/PostgREST/DbStructure.hs
+67 -27
View File
@@ -27,9 +27,10 @@ import qualified Hasql.Session as H
import PostgREST.Types
import GHC.Exts (groupWith)
import GHC.Int (Int32)
import Prelude
getDbStructure :: Schema -> H.Session DbStructure
getDbStructure :: Schema -> H.Query () DbStructure
getDbStructure schema = do
tabs <- allTables
cols <- allColumns tabs
@@ -60,6 +61,48 @@ decodeTables =
tblRow = Table <$> HD.value HD.text <*> HD.value HD.text
<*> HD.value HD.bool
decodeColumns :: [Table] -> HD.Result [Column]
decodeColumns tables =
mapMaybe (columnFromRow tables) <$> HD.rowsList colRow
where
colRow =
(,,,,,,,,,,)
<$> HD.value HD.text <*> HD.value HD.text
<*> HD.value HD.text <*> HD.value HD.int4
<*> HD.value HD.bool <*> HD.value HD.text
<*> HD.value HD.bool
<*> HD.nullableValue HD.int4
<*> HD.nullableValue HD.int4
<*> HD.nullableValue HD.text
<*> HD.nullableValue HD.text
decodeRelations :: [Table] -> [Column] -> HD.Result [Relation]
decodeRelations tables cols =
mapMaybe (relationFromRow tables cols) <$> HD.rowsList relRow
where
relRow = (,,,,,)
<$> HD.value HD.text
<*> HD.value HD.text
<*> HD.value (HD.array $ HD.arrayValue HD.text)
<*> HD.value HD.text
<*> HD.value HD.text
<*> HD.value (HD.array $ HD.arrayValue HD.text)
decodePks :: [Table] -> HD.Result [PrimaryKey]
decodePks tables =
mapMaybe (pkFromRow tables) <$> HD.rowsList pkRow
where
pkRow = (,,) <$> HD.value HD.text <*> HD.value HD.text <*> HD.value HD.text
decodeSynonyms :: [Column] -> HD.Result [(Column,Column)]
decodeSynonyms cols =
mapMaybe (synonymFromRow cols) <$> HD.rowsList synRow
where
synRow = (,,,,,)
<$> HD.value HD.text <*> HD.value HD.text
<*> HD.value HD.text <*> HD.value HD.text
<*> HD.value HD.text <*> HD.value HD.text
doesProcExist :: H.Query QualifiedIdentifier Bool
doesProcExist =
H.statement sql encodeQi (HD.singleRow (HD.value HD.bool)) True
@@ -209,12 +252,11 @@ allTables =
GROUP BY table_schema, table_name, insertable
ORDER BY table_schema, table_name |]
tableFromRow :: (Text, Text, Bool) -> Table
tableFromRow (s, n, i) = Table s n i
allColumns :: [Table] -> H.Session [Column]
allColumns :: [Table] -> H.Query () [Column]
allColumns tabs = do
cols <- H.listEx $ [H.stmt|
H.statement sql HE.unit (decodeColumns tabs) True
where
sql = [q|
SELECT DISTINCT
info.table_schema AS schema,
info.table_name AS table_name,
@@ -346,14 +388,12 @@ allColumns tabs = do
JOIN pg_catalog.pg_namespace n ON n.oid = t.typnamespace
GROUP BY s,n
) AS enum_info ON (info.udt_name = enum_info.n)
ORDER BY schema, position
|]
return $ mapMaybe (columnFromRow tabs) cols
ORDER BY schema, position |]
columnFromRow :: [Table] ->
(Text, Text, Text,
Int, Bool, Text,
Bool, Maybe Int, Maybe Int,
Int32, Bool, Text,
Bool, Maybe Int32, Maybe Int32,
Maybe Text, Maybe Text)
-> Maybe Column
columnFromRow tabs (s, t, n, pos, nul, typ, u, l, p, d, e) = buildColumn <$> table
@@ -363,9 +403,11 @@ columnFromRow tabs (s, t, n, pos, nul, typ, u, l, p, d, e) = buildColumn <$> tab
parseEnum :: Maybe Text -> [Text]
parseEnum str = fromMaybe [] $ split (==',') <$> str
allRelations :: [Table] -> [Column] -> H.Session [Relation]
allRelations :: [Table] -> [Column] -> H.Query () [Relation]
allRelations tabs cols = do
rels <- H.listEx $ [H.stmt|
H.statement sql HE.unit (decodeRelations tabs cols) True
where
sql = [q|
SELECT ns1.nspname AS table_schema,
tab.relname AS table_name,
column_info.cols AS columns,
@@ -389,9 +431,7 @@ allRelations tabs cols = do
LATERAL (SELECT * FROM pg_class WHERE pg_class.oid = confrelid) AS other,
LATERAL (SELECT * FROM pg_namespace WHERE pg_namespace.oid = other.relnamespace) AS ns2
WHERE confrelid != 0
ORDER BY (conrelid, column_info.nums)
|]
return $ mapMaybe (relationFromRow tabs cols) rels
ORDER BY (conrelid, column_info.nums) |]
relationFromRow :: [Table] -> [Column] -> (Text, Text, [Text], Text, Text, [Text]) -> Maybe Relation
relationFromRow allTabs allCols (rs, rt, rcs, frs, frt, frcs) =
@@ -404,9 +444,11 @@ relationFromRow allTabs allCols (rs, rt, rcs, frs, frt, frcs) =
cols = mapM (findCol rs rt) rcs
colsF = mapM (findCol frs frt) frcs
allPrimaryKeys :: [Table] -> H.Session [PrimaryKey]
allPrimaryKeys :: [Table] -> H.Query () [PrimaryKey]
allPrimaryKeys tabs = do
pks <- H.listEx $ [H.stmt|
H.statement sql HE.unit (decodePks tabs) True
where
sql = [q|
/*
-- CTE to replace information_schema.table_constraints to remove owner limit
*/
@@ -506,17 +548,17 @@ allPrimaryKeys tabs = do
kc.table_name = tc.table_name AND
kc.table_schema = tc.table_schema AND
kc.constraint_name = tc.constraint_name AND
kc.table_schema NOT IN ('pg_catalog', 'information_schema')
|]
return $ mapMaybe (pkFromRow tabs) pks
kc.table_schema NOT IN ('pg_catalog', 'information_schema') |]
pkFromRow :: [Table] -> (Schema, Text, Text) -> Maybe PrimaryKey
pkFromRow tabs (s, t, n) = PrimaryKey <$> table <*> pure n
where table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
allSynonyms :: [Column] -> H.Session [(Column,Column)]
allSynonyms allCols = do
syns <- H.listEx $ [H.stmt|
allSynonyms :: [Column] -> H.Query () [(Column,Column)]
allSynonyms cols = do
H.statement sql HE.unit (decodeSynonyms cols) True
where
sql = [q|
WITH synonyms AS (
/*
-- CTE to replace the view from information_schema because the information in it depended on the logged in role
@@ -578,9 +620,7 @@ allSynonyms allCols = do
syn_table_schema, syn_table_name,
(regexp_matches(view_definition, CONCAT('\.', src_column_name, '\sAS\s("?)(.+?)\1(,|$)'), 'gn'))[2] AS syn_column_name /* " <- for syntax highlighting */
FROM synonyms
)
|]
return $ mapMaybe (synonymFromRow allCols) syns
) |]
synonymFromRow :: [Column] -> (Text,Text,Text,Text,Text,Text) -> Maybe (Column,Column)
synonymFromRow allCols (s1,t1,c1,s2,t2,c2) = (,) <$> col1 <*> col2