Types reference each other

2015-11-11 09:09:53 -05:00
parent 3a682360f3
commit e1e4fe6d5c
5 changed files with 178 additions and 194 deletions
@@ -3,13 +3,17 @@
 {-# LANGUAGE QuasiQuotes           #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE TypeSynonymInstances  #-}
-module PostgREST.DbStructure where
+module PostgREST.DbStructure (
+  createDbStructure
+, doesProcExist
+, doesProcReturnJWT
+) where

 import           Control.Applicative
 import           Control.Monad         (join)
 import           Data.Functor.Identity
 import           Data.List             (elemIndex, find, subsequences)
-import           Data.Maybe            (fromMaybe, isJust, mapMaybe)
+import           Data.Maybe            (fromMaybe, fromJust, isJust, mapMaybe)
 import           Data.Monoid
 import           Data.Text             (Text, split)
 import qualified Hasql                 as H
@@ -24,13 +28,13 @@ import           Prelude
 createDbStructure :: H.Tx P.Postgres s DbStructure
 createDbStructure = do
  tabs <- allTables
-  rels <- allRelations
-  cols <- allColumns rels
-  keys <- allPrimaryKeys
+  cols <- allColumns tabs
+  rels <- allRelations tabs cols
+  keys <- allPrimaryKeys tabs

  return DbStructure {
      tables = tabs
-    , columns = cols
+    , columns = addForeignKeys rels cols
    , relations = rels
    , primaryKeys = keys
    }
@@ -62,135 +66,79 @@ doesProcReturnJWT = doesProc [H.stmt|
      AND    pg_catalog.pg_get_function_result(p.oid) like '%jwt_claims'
    |]

-tableFromRow :: (Text, Text, Bool) -> Table
-tableFromRow (s, n, i) = Table s n i
+addForeignKeys :: [Relation] -> [Column] -> [Column]
+addForeignKeys rels = map addFk
+  where
+    addFk col = col { colFK = fk col }
+    fk col = join $ relToFk col <$> find (lookupFn col) rels
+    lookupFn :: Column -> Relation -> Bool
+    lookupFn c (Relation{relColumns=cs, relType=rty}) = c `elem` cs && rty==Child
+    -- lookupFn _ _ = False
+    relToFk col (Relation{relColumns=cols, relFColumns=colsF}) = ForeignKey <$> colF
+      where
+        pos = elemIndex col cols
+        colF = (colsF !!) <$> pos

-columnFromRow :: (Text,       Text,      Text,
+columnFromRow :: [Table] ->
+                 (Text,       Text,      Text,
                  Int,        Bool,      Text,
                  Bool,       Maybe Int, Maybe Int,
                  Maybe Text, Maybe Text)
-              -> Column
-columnFromRow (s, t, n, pos, nul, typ, u, l, p, d, e) =
-  Column s t n pos nul typ u l p d (parseEnum e) Nothing
-
+                 -> Column
+columnFromRow tabs (s, t, n, pos, nul, typ, u, l, p, d, e) =
+  Column table n pos nul typ u l p d (parseEnum e) Nothing
  where
+    table = fromJust $ find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
    parseEnum :: Maybe Text -> [Text]
    parseEnum str = fromMaybe [] $ split (==',') <$> str


-relationFromRow :: (Text, Text, [Text], Text, Text, [Text]) -> Relation
-relationFromRow (s, t, cs, fs, ft, fcs) = Relation s t cs fs ft fcs Child Nothing Nothing Nothing Nothing
+relationFromRow :: [Table] -> [Column] -> (Text, Text, [Text], Text, Text, [Text]) -> Relation
+relationFromRow allTabs allCols (rs, rt, rcs, frs, frt, frcs) = Relation table cols tableF colsF Child Nothing Nothing Nothing
+  where
+    findTable s t = fromJust $ find (\tbl -> tableSchema tbl == s && tableName tbl == t) allTabs
+    findCols s t cs = filter (\col -> tableSchema (colTable col) == s && tableName (colTable col) == t && colName col `elem` cs) allCols
+    table  = findTable rs rt
+    tableF = findTable frs frt
+    cols  = findCols rs rt rcs
+    colsF = findCols frs frt frcs

-pkFromRow :: (Text, Text, Text) -> PrimaryKey
-pkFromRow (s, t, n) = PrimaryKey s t n
+pkFromRow :: [Table] -> (Schema, Text, Text) -> PrimaryKey
+pkFromRow tabs (s, t, n) = PrimaryKey table n
+  where
+    table = fromJust $ find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs


 addParentRelation :: Relation -> [Relation] -> [Relation]
-addParentRelation rel@(Relation s t c fs ft fc _ _ _ _ _) rels = Relation fs ft fc s t c Parent Nothing Nothing Nothing Nothing:rel:rels
+addParentRelation rel@(Relation t c ft fc _ _ _ _) rels = Relation ft fc t c Parent Nothing Nothing Nothing : rel : rels

-- allTables :: H.Tx P.Postgres s [Table]
-- allTables = do
--     rows <- H.listEx $ [H.stmt|
--       SELECT
--         n.nspname AS table_schema,
--         c.relname AS table_name,
--         c.relkind = 'r' OR (c.relkind IN ('v','f'))
--         AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 8) = 8
--         OR (EXISTS
--           ( SELECT 1
--             FROM pg_trigger
--             WHERE pg_trigger.tgrelid = c.oid
--             AND (pg_trigger.tgtype::integer & 69) = 69) ) AS insertable,
--         array_to_string(array_agg(r.rolname), ',') AS acl
--       FROM pg_class c
--       CROSS JOIN pg_roles r
--       JOIN pg_namespace n ON n.oid = c.relnamespace
--       WHERE c.relkind IN ('v','r','m')
--         AND n.nspname NOT IN ('pg_catalog', 'information_schema')
--         AND (
--           pg_has_role(r.rolname, c.relowner, 'USAGE'::text) OR
--           has_table_privilege(r.rolname, c.oid, 'SELECT, INSERT, UPDATE, DELETE, TRUNCATE, REFERENCES, TRIGGER'::text) OR
--           has_any_column_privilege(r.rolname, c.oid, 'SELECT, INSERT, UPDATE, REFERENCES'::text) )
--
--       GROUP BY table_schema, table_name, insertable
--       ORDER BY table_schema, table_name
--     |]
--     return $ map tableFromRow rows
+allTables :: H.Tx P.Postgres s [Table]
+allTables = do
+    rows <- H.listEx $ [H.stmt|
+      SELECT
+        n.nspname AS table_schema,
+        c.relname AS table_name,
+        c.relkind = 'r' OR (c.relkind IN ('v','f'))
+        AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 8) = 8
+        OR (EXISTS
+          ( SELECT 1
+            FROM pg_trigger
+            WHERE pg_trigger.tgrelid = c.oid
+            AND (pg_trigger.tgtype::integer & 69) = 69) ) AS insertable
+      FROM pg_class c
+      JOIN pg_namespace n ON n.oid = c.relnamespace
+      WHERE c.relkind IN ('v','r','m')
+        AND n.nspname NOT IN ('pg_catalog', 'information_schema')
+      GROUP BY table_schema, table_name, insertable
+      ORDER BY table_schema, table_name;
+    |]
+    return $ map tableFromRow rows

-tables :: Text -> H.Tx P.Postgres s [Table]
-tables schema = do
-  rows <- H.listEx $
-    [H.stmt|
-      select
-        n.nspname as table_schema,
-        relname as table_name,
-        c.relkind = 'r' or (c.relkind IN ('v', 'f')) and (pg_relation_is_updatable(c.oid::regclass, false) & 8) = 8
-        or (exists (
-           select 1
-           from pg_trigger
-           where pg_trigger.tgrelid = c.oid and (pg_trigger.tgtype::integer & 69) = 69)
-        ) as insertable
-      from
-        pg_class c
-        join pg_namespace n on n.oid = c.relnamespace
-      where
-        c.relkind in ('v', 'r', 'm')
-        and n.nspname = ?
-        and (
-          pg_has_role(c.relowner, 'USAGE'::text)
-          or has_table_privilege(c.oid, 'SELECT, INSERT, UPDATE, DELETE, TRUNCATE, REFERENCES, TRIGGER'::text)
-          or has_any_column_privilege(c.oid, 'SELECT, INSERT, UPDATE, REFERENCES'::text)
-        )
-      order by relname
-    |] schema
-  return $ map tableFromRow rows
+tableFromRow :: (Text, Text, Bool) -> Table
+tableFromRow (s, n, i) = Table s n i

-allRelations :: H.Tx P.Postgres s [Relation]
-allRelations = do
-  rels <- H.listEx $ [H.stmt|
-    SELECT ns1.nspname AS table_schema,
-           tab.relname AS table_name,
-           column_info.cols AS columns,
-           ns2.nspname AS foreign_table_schema,
-           other.relname AS foreign_table_name,
-           column_info.refs AS foreign_columns
-    FROM pg_constraint,
-       LATERAL (SELECT array_agg(cols.attname) AS cols,
-                       array_agg(cols.attnum)  AS nums,
-                       array_agg(refs.attname) AS refs
-                  FROM ( SELECT unnest(conkey) AS col, unnest(confkey) AS ref) k,
-                       LATERAL (SELECT * FROM pg_attribute
-                                 WHERE attrelid = conrelid AND attnum = col)
-                            AS cols,
-                       LATERAL (SELECT * FROM pg_attribute
-                                 WHERE attrelid = confrelid AND attnum = ref)
-                            AS refs)
-            AS column_info,
-       LATERAL (SELECT * FROM pg_namespace WHERE pg_namespace.oid = connamespace) AS ns1,
-       LATERAL (SELECT * FROM pg_class WHERE pg_class.oid = conrelid) AS tab,
-       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)
-  |]
-  let simpleRelations = foldr (addParentRelation.relationFromRow) [] rels
-      links = join $ map (combinations 2) $ filter (not . null) $ groupWith groupFn $ filter ( (==Child). relType) simpleRelations
-  return $ simpleRelations ++ mapMaybe link2Relation links
-  where
-    groupFn :: Relation -> Text
-    groupFn (Relation{relSchema=s, relTable=t}) = s<>"_"<>t
-    combinations k ns = filter ((k==).length) (subsequences ns)
-    link2Relation [
-      Relation{relSchema=ls, relTable=lt, relColumns=lc1, relFSchema=s,  relFTable=t,  relFColumns=c},
-      Relation{                           relColumns=lc2, relFSchema=fs, relFTable=ft, relFColumns=fc}
-      ]
-      | lc1 /= lc2 && length lc1 == 1 && length lc2 == 1 = Just $ Relation s t c fs ft fc Many (Just ls) (Just lt) (Just lc1) (Just lc2)
-      | otherwise = Nothing
-    link2Relation _ = Nothing
-
-
-allColumns :: [Relation] -> H.Tx P.Postgres s [Column]
-allColumns rels = do
+allColumns :: [Table] -> H.Tx P.Postgres s [Column]
+allColumns tabs = do
  cols <- H.listEx $ [H.stmt|
      SELECT DISTINCT
          info.table_schema AS schema,
@@ -232,22 +180,53 @@ allColumns rels = do
      ) AS enum_info ON (info.udt_name = enum_info.n)
      ORDER BY schema, position
  |]
-  return $ map (addFK . columnFromRow) cols
+  return $ map (columnFromRow tabs) cols

+allRelations :: [Table] -> [Column] -> H.Tx P.Postgres s [Relation]
+allRelations tabs cols = do
+  rels <- H.listEx $ [H.stmt|
+    SELECT ns1.nspname AS table_schema,
+           tab.relname AS table_name,
+           column_info.cols AS columns,
+           ns2.nspname AS foreign_table_schema,
+           other.relname AS foreign_table_name,
+           column_info.refs AS foreign_columns
+    FROM pg_constraint,
+       LATERAL (SELECT array_agg(cols.attname) AS cols,
+                       array_agg(cols.attnum)  AS nums,
+                       array_agg(refs.attname) AS refs
+                  FROM ( SELECT unnest(conkey) AS col, unnest(confkey) AS ref) k,
+                       LATERAL (SELECT * FROM pg_attribute
+                                 WHERE attrelid = conrelid AND attnum = col)
+                            AS cols,
+                       LATERAL (SELECT * FROM pg_attribute
+                                 WHERE attrelid = confrelid AND attnum = ref)
+                            AS refs)
+            AS column_info,
+       LATERAL (SELECT * FROM pg_namespace WHERE pg_namespace.oid = connamespace) AS ns1,
+       LATERAL (SELECT * FROM pg_class WHERE pg_class.oid = conrelid) AS tab,
+       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)
+  |]
+  let simpleRelations = foldr (addParentRelation . relationFromRow tabs cols) [] rels
+      links = join $ map (combinations 2) $ filter (not . null) $ groupWith groupFn $ filter ( (==Child). relType) simpleRelations
+  return $ simpleRelations ++ mapMaybe link2Relation links
  where
-    addFK col = col { colFK = fk col }
-    fk col = join $ relToFk (colName col) <$> find (lookupFn col) rels
-    lookupFn :: Column -> Relation -> Bool
-    lookupFn (Column{colSchema=cs, colTable=ct, colName=cn})  (Relation{relSchema=rs, relTable=rt, relColumns=rc, relType=rty}) =
-      cs==rs && ct==rt && cn `elem` rc && rty==Child
-    lookupFn _ _ = False
-    relToFk cName (Relation{relSchema=s, relFTable=t, relColumns=cs, relFColumns=fcs}) = ForeignKey s t <$> c
-      where
-        pos = elemIndex cName cs
-        c = (fcs !!) <$> pos
+    groupFn :: Relation -> Text
+    groupFn (Relation{relTable=Table{tableSchema=s, tableName=t}}) = s<>"_"<>t
+    combinations k ns = filter ((k==).length) (subsequences ns)
+    link2Relation [
+      Relation{relTable=lt, relColumns=lc1, relFTable=t,  relFColumns=c},
+      Relation{             relColumns=lc2, relFTable=ft, relFColumns=fc}
+      ]
+      | lc1 /= lc2 && length lc1 == 1 && length lc2 == 1 = Just $ Relation t c ft fc Many (Just lt) (Just lc1) (Just lc2)
+      | otherwise = Nothing
+    link2Relation _ = Nothing

-allPrimaryKeys :: H.Tx P.Postgres s [PrimaryKey]
-allPrimaryKeys = do
+allPrimaryKeys :: [Table] -> H.Tx P.Postgres s [PrimaryKey]
+allPrimaryKeys tabs = do
  pks <- H.listEx $ [H.stmt|
    SELECT
        kc.table_schema,
@@ -263,4 +242,4 @@ allPrimaryKeys = do
        kc.constraint_name = tc.constraint_name AND
        kc.table_schema NOT IN ('pg_catalog', 'information_schema')
    |]
-  return $ map pkFromRow pks
+  return $ map (pkFromRow tabs) pks