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

refactor: remove colFK from Column

Browse Source
This commit is contained in:
steve-chavez
2021-04-30 10:06:07 -05:00
committed by Steve Chavez
parent 6670a3214b
commit 0f6a13191c
4 changed files with 32 additions and 42 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/PostgREST/DbStructure.hs
+2 -18
View File
@@ -51,7 +51,6 @@ import PostgREST.DbStructure.Proc (PgArg (..), PgType (..),
ProcVolatility (..),
ProcsMap, RetType (..))
import PostgREST.DbStructure.Relationship (Cardinality (..),
ForeignKey (..),
Junction (..),
PrimaryKey (..),
Relationship (..))
@@ -98,12 +97,11 @@ getDbStructure schemas extraSearchPath pgVer prepared = do
procs <- HT.statement schemas $ allProcs prepared
let rels = addO2MRels . addM2MRels $ addViewM2ORels srcCols m2oRels
cols' = addForeignKeys rels cols
keys' = addViewPrimaryKeys srcCols keys
return $ removeInternal schemas $ DbStructure {
dbTables = tabs
, dbColumns = cols'
, dbColumns = cols
, dbRelationships = rels
, dbPrimaryKeys = keys'
, dbProcs = procs
@@ -379,20 +377,6 @@ accessibleTables =
)
order by relname |]
addForeignKeys :: [Relationship] -> [Column] -> [Column]
addForeignKeys rels = map addFk
where
addFk col = col { colFK = fk col }
fk col = find (lookupFn col) rels >>= relToFk col
lookupFn :: Column -> Relationship -> Bool
lookupFn c rel = case rel of
Relationship{relColumns=cs, relCardinality=M2O _} -> c `elem` cs
_ -> False
relToFk col Relationship{relColumns=cols, relForeignColumns=colsF} = do
pos <- L.elemIndex col cols
colF <- atMay colsF pos
return $ ForeignKey colF
{-
Adds Views M2O Relationships based on SourceColumns found, the logic is as follows:
@@ -675,7 +659,7 @@ columnFromRow :: [Table] ->
-> Maybe Column
columnFromRow tabs (s, t, n, desc, nul, typ, l, d, e) = buildColumn <$> table
where
buildColumn tbl = Column tbl n desc nul typ l d (parseEnum e) Nothing
buildColumn tbl = Column tbl n desc nul typ l d (parseEnum e)
table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs
parseEnum :: Maybe Text -> [Text]
parseEnum = maybe [] (split (==','))
src/PostgREST/DbStructure/Relationship.hs
+1 -3
View File
@@ -3,7 +3,6 @@
module PostgREST.DbStructure.Relationship
( Cardinality(..)
, ForeignKey(..)
, PrimaryKey(..)
, Relationship(..)
, Junction(..)
@@ -12,8 +11,7 @@ module PostgREST.DbStructure.Relationship
import qualified Data.Aeson as JSON
import PostgREST.DbStructure.Table (Column (..), ForeignKey (..),
Table (..))
import PostgREST.DbStructure.Table (Column (..), Table (..))
import Protolude
src/PostgREST/DbStructure/Table.hs
-6
View File
@@ -3,7 +3,6 @@
module PostgREST.DbStructure.Table
( Column(..)
, ForeignKey(..)
, Table(..)
, tableQi
) where
@@ -34,10 +33,6 @@ instance Eq Table where
tableQi :: Table -> QualifiedIdentifier
tableQi Table{tableSchema=s, tableName=n} = QualifiedIdentifier s n
newtype ForeignKey = ForeignKey
{ fkCol :: Column }
deriving (Eq, Ord, Generic, JSON.ToJSON)
data Column = Column
{ colTable :: Table
, colName :: FieldName
@@ -47,7 +42,6 @@ data Column = Column
, colMaxLen :: Maybe Int32
, colDefault :: Maybe Text
, colEnum :: [Text]
, colFK :: Maybe ForeignKey
}
deriving (Ord, Generic, JSON.ToJSON)
src/PostgREST/OpenAPI.hs
+29 -15
View File
@@ -2,6 +2,8 @@
Module : PostgREST.OpenAPI
Description : Generates the OpenAPI output
-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
module PostgREST.OpenAPI (encode) where
@@ -27,10 +29,10 @@ import PostgREST.DbStructure (DbStructure (..),
tableCols, tablePKCols)
import PostgREST.DbStructure.Proc (PgArg (..),
ProcDescription (..))
import PostgREST.DbStructure.Relationship (PrimaryKey (..))
import PostgREST.DbStructure.Table (Column (..),
ForeignKey (..),
Table (..))
import PostgREST.DbStructure.Relationship (Cardinality (..),
PrimaryKey (..),
Relationship (..))
import PostgREST.DbStructure.Table (Column (..), Table (..))
import PostgREST.Version (docsVersion, prettyVersion)
import PostgREST.ContentType
@@ -42,6 +44,7 @@ encode :: AppConfig -> DbStructure -> [Table] -> Maybe Text -> HashMap.HashMap k
encode conf dbStructure tables schemaDescription procs =
JSON.encode $
postgrestSpec
(dbRelationships dbStructure)
(concat $ HashMap.elems procs)
(openApiTableInfo dbStructure <$> tables)
(proxyUri conf)
@@ -64,27 +67,38 @@ toSwaggerType "real" = SwaggerNumber
toSwaggerType "double precision" = SwaggerNumber
toSwaggerType _ = SwaggerString
makeTableDef :: [PrimaryKey] -> (Table, [Column], [Text]) -> (Text, Schema)
makeTableDef pks (t, cs, _) =
makeTableDef :: [Relationship] -> [PrimaryKey] -> (Table, [Column], [Text]) -> (Text, Schema)
makeTableDef rels pks (t, cs, _) =
let tn = tableName t in
(tn, (mempty :: Schema)
& description .~ tableDescription t
& type_ ?~ SwaggerObject
& properties .~ fromList (fmap (makeProperty pks) cs)
& properties .~ fromList (fmap (makeProperty rels pks) cs)
& required .~ fmap colName (filter (not . colNullable) cs))
makeProperty :: [PrimaryKey] -> Column -> (Text, Referenced Schema)
makeProperty pks c = (colName c, Inline s)
makeProperty :: [Relationship] -> [PrimaryKey] -> Column -> (Text, Referenced Schema)
makeProperty rels pks c = (colName c, Inline s)
where
e = if null $ colEnum c then Nothing else JSON.decode $ JSON.encode $ colEnum c
fk ForeignKey{fkCol=Column{colTable=Table{tableName=a}, colName=b}} =
T.intercalate "" ["This is a Foreign Key to `", a, ".", b, "`.<fk table='", a, "' column='", b, "'/>"]
fk :: Maybe Text
fk =
let
-- Finds the relationship that has a single column foreign key
rel = find (\case
Relationship{relColumns, relCardinality=M2O _} -> [c] == relColumns
_ -> False
) rels
fCol = colName <$> (headMay =<< (relForeignColumns <$> rel))
fTbl = tableName . relForeignTable <$> rel
fTblCol = (,) <$> fTbl <*> fCol
in
(\(a, b) -> T.intercalate "" ["This is a Foreign Key to `", a, ".", b, "`.<fk table='", a, "' column='", b, "'/>"]) <$> fTblCol
pk :: Bool
pk = any (\p -> pkTable p == colTable c && pkName p == colName c) pks
n = catMaybes
[ Just "Note:"
, if pk then Just "This is a Primary Key.<pk/>" else Nothing
, fk <$> colFK c
, fk
]
d =
if length n > 1 then
@@ -294,8 +308,8 @@ escapeHostName "*6" = "0.0.0.0"
escapeHostName "!6" = "0.0.0.0"
escapeHostName h = h
postgrestSpec :: [ProcDescription] -> [(Table, [Column], [Text])] -> (Text, Text, Integer, Text) -> Maybe Text -> [PrimaryKey] -> Swagger
postgrestSpec pds ti (s, h, p, b) sd pks = (mempty :: Swagger)
postgrestSpec :: [Relationship] -> [ProcDescription] -> [(Table, [Column], [Text])] -> (Text, Text, Integer, Text) -> Maybe Text -> [PrimaryKey] -> Swagger
postgrestSpec rels pds ti (s, h, p, b) sd pks = (mempty :: Swagger)
& basePath ?~ T.unpack b
& schemes ?~ [s']
& info .~ ((mempty :: Info)
@@ -306,7 +320,7 @@ postgrestSpec pds ti (s, h, p, b) sd pks = (mempty :: Swagger)
& description ?~ "PostgREST Documentation"
& url .~ URL ("https://postgrest.org/en/" <> docsVersion <> "/api.html"))
& host .~ h'
& definitions .~ fromList (makeTableDef pks <$> ti)
& definitions .~ fromList (makeTableDef rels pks <$> ti)
& parameters .~ fromList (makeParamDefs ti)
& paths .~ makePathItems pds ti
& produces .~ makeMimeList [CTApplicationJSON, CTSingularJSON, CTTextCSV]