WIP: converting DbStructure

src/PostgREST/DbStructure.hs

@@ -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
+allColumns :: [Table] -> H.Query () [Column]
-tableFromRow (s, n, i) = Table s n i
-
-allColumns :: [Table] -> H.Session [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
+    ORDER BY schema, position |]
-  |]
-  return $ mapMaybe (columnFromRow tabs) cols
 
 columnFromRow :: [Table] ->
                  (Text,       Text,        Text,
-                  Int,        Bool,      Text,
+                  Int32,      Bool,        Text,
-                  Bool,       Maybe Int, Maybe Int,
+                  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)
+    ORDER BY (conrelid, column_info.nums) |]
-  |]
-  return $ mapMaybe (relationFromRow tabs cols) rels
 
 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')
+        kc.table_schema NOT IN ('pg_catalog', 'information_schema') |]
-    |]
-  return $ mapMaybe (pkFromRow tabs) pks
 
 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 :: [Column] -> H.Query () [(Column,Column)]
-allSynonyms allCols = do
+allSynonyms cols = do
-  syns <- H.listEx $ [H.stmt|
+  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