Types reference each other
This commit is contained in:
calebmer
@@ -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)
|
||||
|
||||
+112
-133
@@ -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
|
||||
|
||||
@@ -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 <> ".*"
|
||||
|
||||
@@ -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
|
||||
|
||||
+43
-39
@@ -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 [
|
||||
|
||||
Reference in New Issue
Block a user