From e1e4fe6d5c0f4a889678566574c5fecb990b0d5f Mon Sep 17 00:00:00 2001 From: calebmer Date: Tue, 10 Nov 2015 18:49:30 -0500 Subject: [PATCH] Types reference each other --- src/PostgREST/App.hs | 16 +-- src/PostgREST/DbStructure.hs | 245 ++++++++++++++++------------------ src/PostgREST/PgQuery.hs | 3 +- src/PostgREST/QueryBuilder.hs | 26 ++-- src/PostgREST/Types.hs | 82 ++++++------ 5 files changed, 178 insertions(+), 194 deletions(-) diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index 2779c016d..f3f914109 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -163,9 +163,9 @@ app db conf reqBody req = allRels = relations db allCols = columns db allPrKeys = primaryKeys db - filterCol sc table (Column{colSchema=s, colTable=t}) = s==sc && table==t + filterCol sc table (Column{colTable=Table{tableSchema=s, tableName=t}}) = s==sc && table==t filterCol _ _ _ = False - filterPk sc table pk = sc == pkSchema pk && table == pkTable pk + filterPk sc table pk = sc == (tableSchema . pkTable) pk && table == (tableName . pkTable) pk path = pathInfo req verb = requestMethod req hdrs = requestHeaders req @@ -289,7 +289,7 @@ convertJson v = (,) <$> (header <$> normalized) <*> (vals <$> normalized) a@(Array _) -> Right a _ -> Left invalidMsg -augumentRequestWithJoin :: Text -> [Relation] -> ApiRequest -> Either Text ApiRequest +augumentRequestWithJoin :: Schema -> [Relation] -> ApiRequest -> Either Text ApiRequest augumentRequestWithJoin schema allRels request = (first formatRelationError . addRelations schema allRels Nothing) request >>= addJoinConditions schema @@ -332,10 +332,10 @@ addFilter (path, flt) (Node rn forest) = where maybeNode = find ((name==).fst.snd.rootLabel) forst toSourceRelation :: Text -> Relation -> Maybe Relation -toSourceRelation mt r@(Relation _ t _ _ ft _ _ _ rt _ _) - | mt == t = Just $ r {relTable=sourceSubqueryName} - | mt == ft = Just $ r {relFTable=sourceSubqueryName} - | Just mt == rt = Just $ r {relLTable=Just sourceSubqueryName} +toSourceRelation mt r@(Relation t _ ft _ _ rt _ _) + | mt == tableName t = Just $ r {relTable=t {tableName=sourceSubqueryName}} + | mt == tableName ft = Just $ r {relFTable=t {tableName=sourceSubqueryName}} + | Just mt == (tableName <$> rt) = Just $ r {relLTable=(\tbl -> tbl {tableName=sourceSubqueryName}) <$> rt} | otherwise = Nothing data TableOptions = TableOptions { @@ -348,7 +348,7 @@ instance ToJSON TableOptions where "columns" .= tblOptcolumns t , "pkey" .= tblOptpkey t ] -parseRequest :: Text -> [Relation] -> NodeName -> Request -> BL.ByteString -> Either Text (Text, Text, Bool) +parseRequest :: Schema -> [Relation] -> NodeName -> Request -> BL.ByteString -> Either Text (Text, Text, Bool) parseRequest schema allRels rootTableName httpRequest reqBody = (,,) <$> selectQuery <*> (if method == "GET" then pure "" else mutateQuery) diff --git a/src/PostgREST/DbStructure.hs b/src/PostgREST/DbStructure.hs index 3a8a36e48..6949a9412 100644 --- a/src/PostgREST/DbStructure.hs +++ b/src/PostgREST/DbStructure.hs @@ -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 diff --git a/src/PostgREST/PgQuery.hs b/src/PostgREST/PgQuery.hs index 62cf96df7..ebf68adea 100644 --- a/src/PostgREST/PgQuery.hs +++ b/src/PostgREST/PgQuery.hs @@ -281,8 +281,9 @@ pgFmtCondition table (Filter (col,jp) ops val) = _ -> "" valToStr v = case v of VText s -> pgFmtValue opCode s - VForeignKey (QualifiedIdentifier s _) (ForeignKey _ ft fc) -> pgFmtColumn qi fc + VForeignKey (QualifiedIdentifier s _) (ForeignKey Column{colTable=Table{tableName=ft}, colName=fc}) -> pgFmtColumn qi fc where qi = QualifiedIdentifier (if ft == sourceSubqueryName then "" else s) ft + _ -> "" pgFmtColumn :: QualifiedIdentifier -> T.Text -> T.Text pgFmtColumn table "*" = fromQi table <> ".*" diff --git a/src/PostgREST/QueryBuilder.hs b/src/PostgREST/QueryBuilder.hs index 27799ac99..679524e3e 100644 --- a/src/PostgREST/QueryBuilder.hs +++ b/src/PostgREST/QueryBuilder.hs @@ -7,7 +7,7 @@ import Control.Error import Data.List (find) import Data.Monoid import Data.Text hiding (filter, find, foldr, head, last, map, - null, zipWith) + null, zipWith, concatMap) import Control.Applicative import Data.Tree import PostgREST.PgQuery (fromQi, pgFmtCondition, pgFmtSelectItem, @@ -16,11 +16,11 @@ import PostgREST.PgQuery (fromQi, pgFmtCondition, pgFmtSelectItem, import PostgREST.Types import qualified Data.Map as M -findRelation :: [Relation] -> Text -> Text -> Text -> Maybe Relation +findRelation :: [Relation] -> Schema -> Text -> Text -> Maybe Relation findRelation allRelations s t1 t2 = - find (\r -> s == relSchema r && t1 == relTable r && t2 == relFTable r) allRelations + find (\r -> s == (tableSchema . relTable) r && t1 == (tableName . relTable) r && t2 == (tableName . relFTable) r) allRelations -addRelations :: Text -> [Relation] -> Maybe ApiRequest -> ApiRequest -> Either Text ApiRequest +addRelations :: Schema -> [Relation] -> Maybe ApiRequest -> ApiRequest -> Either Text ApiRequest addRelations schema allRelations parentNode node@(Node n@(query, (table, _)) forest) = case parentNode of Nothing -> Node (query, (table, Nothing)) <$> updatedForest @@ -35,14 +35,14 @@ addRelations schema allRelations parentNode node@(Node n@(query, (table, _)) for updatedForest = mapM (addRelations schema allRelations (Just node)) forest getJoinConditions :: Relation -> [Filter] -getJoinConditions (Relation s t cs fs ft fcs typ ls lt lc1 lc2) = +getJoinConditions (Relation t cs ft fcs typ _ lc1 lc2) = case typ of - Child -> zipWith (toFilter t fs ft) cs fcs - Parent -> zipWith (toFilter t fs ft) cs fcs - Many -> zipWith (toFilter t (fromMaybe "" ls) (fromMaybe "" lt)) cs (fromMaybe [] lc1) ++ zipWith (toFilter ft (fromMaybe "" ls) (fromMaybe "" lt)) fcs (fromMaybe [] lc2) + Child -> zipWith (toFilter t) cs fcs + Parent -> zipWith (toFilter t) cs fcs + Many -> zipWith (toFilter t) cs (fromMaybe [] lc1) ++ zipWith (toFilter ft) fcs (fromMaybe [] lc2) where - toFilter :: Text -> Text -> Text -> FieldName -> FieldName -> Filter - toFilter tb fsc ftb c fc = Filter (c, Nothing) "=" (VForeignKey (QualifiedIdentifier s tb) (ForeignKey fsc ftb fc)) + toFilter :: Table -> Column -> Column -> Filter + toFilter tb c fc = Filter (colName c, Nothing) "=" (VForeignKey (QualifiedIdentifier (tableSchema tb) (tableName tb)) (ForeignKey fc)) addJoinConditions :: Text -> ApiRequest -> Either Text ApiRequest addJoinConditions schema (Node (query, (t, r)) forest) = @@ -54,15 +54,15 @@ addJoinConditions schema (Node (query, (t, r)) forest) = Node (qq, (t, r)) <$> updatedForest where q = addCond updatedQuery (getJoinConditions rel) - qq = q{from=linkTable:from q} + qq = q{from=tableName linkTable : from q} _ -> Left "unknown relation" where -- add parentTable and parentJoinConditions to the query updatedQuery = foldr (flip addCond) (query{from = parentTables ++ from query}) parentJoinConditions where - parentJoinConditions = map (getJoinConditions.snd) parents + parentJoinConditions = map (getJoinConditions . snd) parents parentTables = map fst parents - parents = mapMaybe (getParents.rootLabel) forest + parents = mapMaybe (getParents . rootLabel) forest getParents (_, (tbl, Just rel@(Relation{relType=Parent}))) = Just (tbl, rel) getParents _ = Nothing updatedForest = mapM (addJoinConditions schema) forest diff --git a/src/PostgREST/Types.hs b/src/PostgREST/Types.hs index a65835473..b7f60606f 100644 --- a/src/PostgREST/Types.hs +++ b/src/PostgREST/Types.hs @@ -9,66 +9,62 @@ data DbStructure = DbStructure { columns :: [Column] , relations :: [Relation] , primaryKeys :: [PrimaryKey] -} +} deriving (Show, Eq) +type Schema = Text data Table = Table { - tableSchema :: Text -, tableName :: Text + tableSchema :: Schema +, tableName :: Text , tableInsertable :: Bool } deriving (Show) -data ForeignKey = ForeignKey { - fkSchema :: Text, - fkTable :: Text, - fkCol :: Text -} deriving (Show, Eq) +data ForeignKey = ForeignKey { fkCol :: Column } deriving (Show, Eq) - -data Column = Column { - colSchema :: Text -, colTable :: Text -, colName :: Text -, colPosition :: Int -, colNullable :: Bool -, colType :: Text -, colUpdatable :: Bool -, colMaxLen :: Maybe Int -, colPrecision :: Maybe Int -, colDefault :: Maybe Text -, colEnum :: [Text] -, colFK :: Maybe ForeignKey -} | Star { colSchema :: Text, colTable :: Text } deriving (Show) +data Column = + Column { + colTable :: Table + , colName :: Text + , colPosition :: Int + , colNullable :: Bool + , colType :: Text + , colUpdatable :: Bool + , colMaxLen :: Maybe Int + , colPrecision :: Maybe Int + , colDefault :: Maybe Text + , colEnum :: [Text] + , colFK :: Maybe ForeignKey + } + | Star { colTable :: Table } + deriving (Show, Eq) data PrimaryKey = PrimaryKey { - pkSchema::Text, pkTable::Text, pkName::Text -} + pkTable :: Table + , pkName :: Text +} deriving (Show, Eq) data OrderTerm = OrderTerm { - otTerm :: Text + otTerm :: Text , otDirection :: BS.ByteString , otNullOrder :: Maybe BS.ByteString } deriving (Show, Eq) data QualifiedIdentifier = QualifiedIdentifier { - qiSchema :: Text + qiSchema :: Schema , qiName :: Text } deriving (Show, Eq) data RelationType = Child | Parent | Many deriving (Show, Eq) data Relation = Relation { - relSchema :: Text -, relTable :: Text -, relColumns :: [Text] -, relFSchema :: Text -, relFTable :: Text -, relFColumns :: [Text] + relTable :: Table +, relColumns :: [Column] +, relFTable :: Table +, relFColumns :: [Column] , relType :: RelationType -, relLSchema :: Maybe Text -, relLTable :: Maybe Text -, relLCols1 :: Maybe [Text] -, relLCols2 :: Maybe [Text] +, relLTable :: Maybe Table +, relLCols1 :: Maybe [Column] +, relLCols2 :: Maybe [Column] } deriving (Show, Eq) @@ -92,7 +88,7 @@ type ApiRequest = Tree ApiNode instance ToJSON Column where toJSON c = object [ - "schema" .= colSchema c + "schema" .= tableSchema t , "name" .= colName c , "position" .= colPosition c , "nullable" .= colNullable c @@ -103,9 +99,17 @@ instance ToJSON Column where , "references".= colFK c , "default" .= colDefault c , "enum" .= colEnum c ] + where + t = colTable c instance ToJSON ForeignKey where - toJSON fk = object ["schema".=fkSchema fk, "table".=fkTable fk, "column".=fkCol fk] + toJSON fk = object [ + "schema" .= tableSchema t + , "table" .= tableName t + , "column" .= colName c ] + where + c = fkCol fk + t = colTable c instance ToJSON Table where toJSON v = object [