{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}
module PostgREST.DbStructure
( DbStructure(..)
, queryDbStructure
, accessibleTables
, accessibleProcs
, schemaDescription
, tableCols
, tablePKCols
) where
import qualified Data.Aeson as JSON
import qualified Data.HashMap.Strict as M
import qualified Data.List as L
import qualified Hasql.Decoders as HD
import qualified Hasql.Encoders as HE
import qualified Hasql.Statement as H
import qualified Hasql.Transaction as HT
import Contravariant.Extras (contrazip2)
import Data.Set as S (fromList)
import Data.Text (split)
import Text.InterpolatedString.Perl6 (q)
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..),
Schema, TableName)
import PostgREST.DbStructure.Proc (PgArg (..), PgType (..),
ProcDescription (..),
ProcVolatility (..),
ProcsMap, RetType (..))
import PostgREST.DbStructure.Relationship (Cardinality (..),
Junction (..),
PrimaryKey (..),
Relationship (..))
import PostgREST.DbStructure.Table (Column (..), Table (..))
import Protolude hiding (toS)
import Protolude.Conv (toS)
import Protolude.Unsafe (unsafeHead)
data DbStructure = DbStructure
{ DbStructure -> [Table]
dbTables :: [Table]
, DbStructure -> [Column]
dbColumns :: [Column]
, DbStructure -> [Relationship]
dbRelationships :: [Relationship]
, DbStructure -> [PrimaryKey]
dbPrimaryKeys :: [PrimaryKey]
, DbStructure -> ProcsMap
dbProcs :: ProcsMap
}
deriving ((forall x. DbStructure -> Rep DbStructure x)
-> (forall x. Rep DbStructure x -> DbStructure)
-> Generic DbStructure
forall x. Rep DbStructure x -> DbStructure
forall x. DbStructure -> Rep DbStructure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DbStructure x -> DbStructure
$cfrom :: forall x. DbStructure -> Rep DbStructure x
Generic, [DbStructure] -> Encoding
[DbStructure] -> Value
DbStructure -> Encoding
DbStructure -> Value
(DbStructure -> Value)
-> (DbStructure -> Encoding)
-> ([DbStructure] -> Value)
-> ([DbStructure] -> Encoding)
-> ToJSON DbStructure
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [DbStructure] -> Encoding
$ctoEncodingList :: [DbStructure] -> Encoding
toJSONList :: [DbStructure] -> Value
$ctoJSONList :: [DbStructure] -> Value
toEncoding :: DbStructure -> Encoding
$ctoEncoding :: DbStructure -> Encoding
toJSON :: DbStructure -> Value
$ctoJSON :: DbStructure -> Value
JSON.ToJSON)
tableCols :: DbStructure -> Schema -> TableName -> [Column]
tableCols :: DbStructure -> Schema -> Schema -> [Column]
tableCols DbStructure
dbs Schema
tSchema Schema
tName = (Column -> Bool) -> [Column] -> [Column]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Column{colTable :: Column -> Table
colTable=Table{tableSchema :: Table -> Schema
tableSchema=Schema
s, tableName :: Table -> Schema
tableName=Schema
t}} -> Schema
sSchema -> Schema -> Bool
forall a. Eq a => a -> a -> Bool
==Schema
tSchema Bool -> Bool -> Bool
&& Schema
tSchema -> Schema -> Bool
forall a. Eq a => a -> a -> Bool
==Schema
tName) ([Column] -> [Column]) -> [Column] -> [Column]
forall a b. (a -> b) -> a -> b
$ DbStructure -> [Column]
dbColumns DbStructure
dbs
tablePKCols :: DbStructure -> Schema -> TableName -> [Text]
tablePKCols :: DbStructure -> Schema -> Schema -> [Schema]
tablePKCols DbStructure
dbs Schema
tSchema Schema
tName = PrimaryKey -> Schema
pkName (PrimaryKey -> Schema) -> [PrimaryKey] -> [Schema]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PrimaryKey -> Bool) -> [PrimaryKey] -> [PrimaryKey]
forall a. (a -> Bool) -> [a] -> [a]
filter (\PrimaryKey
pk -> Schema
tSchema Schema -> Schema -> Bool
forall a. Eq a => a -> a -> Bool
== (Table -> Schema
tableSchema (Table -> Schema) -> (PrimaryKey -> Table) -> PrimaryKey -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimaryKey -> Table
pkTable) PrimaryKey
pk Bool -> Bool -> Bool
&& Schema
tName Schema -> Schema -> Bool
forall a. Eq a => a -> a -> Bool
== (Table -> Schema
tableName (Table -> Schema) -> (PrimaryKey -> Table) -> PrimaryKey -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimaryKey -> Table
pkTable) PrimaryKey
pk) (DbStructure -> [PrimaryKey]
dbPrimaryKeys DbStructure
dbs)
type SourceColumn = (Column, ViewColumn)
type ViewColumn = Column
type SqlQuery = ByteString
queryDbStructure :: [Schema] -> [Schema] -> Bool -> HT.Transaction DbStructure
queryDbStructure :: [Schema] -> [Schema] -> Bool -> Transaction DbStructure
queryDbStructure [Schema]
schemas [Schema]
extraSearchPath Bool
prepared = do
ByteString -> Transaction ()
HT.sql ByteString
"set local schema ''"
[Table]
tabs <- () -> Statement () [Table] -> Transaction [Table]
forall a b. a -> Statement a b -> Transaction b
HT.statement ()
forall a. Monoid a => a
mempty (Statement () [Table] -> Transaction [Table])
-> Statement () [Table] -> Transaction [Table]
forall a b. (a -> b) -> a -> b
$ Bool -> Statement () [Table]
allTables Bool
prepared
[Column]
cols <- [Schema] -> Statement [Schema] [Column] -> Transaction [Column]
forall a b. a -> Statement a b -> Transaction b
HT.statement [Schema]
schemas (Statement [Schema] [Column] -> Transaction [Column])
-> Statement [Schema] [Column] -> Transaction [Column]
forall a b. (a -> b) -> a -> b
$ [Table] -> Bool -> Statement [Schema] [Column]
allColumns [Table]
tabs Bool
prepared
[SourceColumn]
srcCols <- ([Schema], [Schema])
-> Statement ([Schema], [Schema]) [SourceColumn]
-> Transaction [SourceColumn]
forall a b. a -> Statement a b -> Transaction b
HT.statement ([Schema]
schemas, [Schema]
extraSearchPath) (Statement ([Schema], [Schema]) [SourceColumn]
-> Transaction [SourceColumn])
-> Statement ([Schema], [Schema]) [SourceColumn]
-> Transaction [SourceColumn]
forall a b. (a -> b) -> a -> b
$ [Column] -> Bool -> Statement ([Schema], [Schema]) [SourceColumn]
pfkSourceColumns [Column]
cols Bool
prepared
[Relationship]
m2oRels <- () -> Statement () [Relationship] -> Transaction [Relationship]
forall a b. a -> Statement a b -> Transaction b
HT.statement ()
forall a. Monoid a => a
mempty (Statement () [Relationship] -> Transaction [Relationship])
-> Statement () [Relationship] -> Transaction [Relationship]
forall a b. (a -> b) -> a -> b
$ [Table] -> [Column] -> Bool -> Statement () [Relationship]
allM2ORels [Table]
tabs [Column]
cols Bool
prepared
[PrimaryKey]
keys <- () -> Statement () [PrimaryKey] -> Transaction [PrimaryKey]
forall a b. a -> Statement a b -> Transaction b
HT.statement ()
forall a. Monoid a => a
mempty (Statement () [PrimaryKey] -> Transaction [PrimaryKey])
-> Statement () [PrimaryKey] -> Transaction [PrimaryKey]
forall a b. (a -> b) -> a -> b
$ [Table] -> Bool -> Statement () [PrimaryKey]
allPrimaryKeys [Table]
tabs Bool
prepared
ProcsMap
procs <- [Schema] -> Statement [Schema] ProcsMap -> Transaction ProcsMap
forall a b. a -> Statement a b -> Transaction b
HT.statement [Schema]
schemas (Statement [Schema] ProcsMap -> Transaction ProcsMap)
-> Statement [Schema] ProcsMap -> Transaction ProcsMap
forall a b. (a -> b) -> a -> b
$ Bool -> Statement [Schema] ProcsMap
allProcs Bool
prepared
let rels :: [Relationship]
rels = [Relationship] -> [Relationship]
addO2MRels ([Relationship] -> [Relationship])
-> ([Relationship] -> [Relationship])
-> [Relationship]
-> [Relationship]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Relationship] -> [Relationship]
addM2MRels ([Relationship] -> [Relationship])
-> [Relationship] -> [Relationship]
forall a b. (a -> b) -> a -> b
$ [SourceColumn] -> [Relationship] -> [Relationship]
addViewM2ORels [SourceColumn]
srcCols [Relationship]
m2oRels
keys' :: [PrimaryKey]
keys' = [SourceColumn] -> [PrimaryKey] -> [PrimaryKey]
addViewPrimaryKeys [SourceColumn]
srcCols [PrimaryKey]
keys
DbStructure -> Transaction DbStructure
forall (m :: * -> *) a. Monad m => a -> m a
return (DbStructure -> Transaction DbStructure)
-> DbStructure -> Transaction DbStructure
forall a b. (a -> b) -> a -> b
$ [Schema] -> DbStructure -> DbStructure
removeInternal [Schema]
schemas (DbStructure -> DbStructure) -> DbStructure -> DbStructure
forall a b. (a -> b) -> a -> b
$ DbStructure :: [Table]
-> [Column]
-> [Relationship]
-> [PrimaryKey]
-> ProcsMap
-> DbStructure
DbStructure {
dbTables :: [Table]
dbTables = [Table]
tabs
, dbColumns :: [Column]
dbColumns = [Column]
cols
, dbRelationships :: [Relationship]
dbRelationships = [Relationship]
rels
, dbPrimaryKeys :: [PrimaryKey]
dbPrimaryKeys = [PrimaryKey]
keys'
, dbProcs :: ProcsMap
dbProcs = ProcsMap
procs
}
removeInternal :: [Schema] -> DbStructure -> DbStructure
removeInternal :: [Schema] -> DbStructure -> DbStructure
removeInternal [Schema]
schemas DbStructure
dbStruct =
DbStructure :: [Table]
-> [Column]
-> [Relationship]
-> [PrimaryKey]
-> ProcsMap
-> DbStructure
DbStructure {
dbTables :: [Table]
dbTables = (Table -> Bool) -> [Table] -> [Table]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Table
x -> Table -> Schema
tableSchema Table
x Schema -> [Schema] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Schema]
schemas) ([Table] -> [Table]) -> [Table] -> [Table]
forall a b. (a -> b) -> a -> b
$ DbStructure -> [Table]
dbTables DbStructure
dbStruct
, dbColumns :: [Column]
dbColumns = (Column -> Bool) -> [Column] -> [Column]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Column
x -> Table -> Schema
tableSchema (Column -> Table
colTable Column
x) Schema -> [Schema] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Schema]
schemas) (DbStructure -> [Column]
dbColumns DbStructure
dbStruct)
, dbRelationships :: [Relationship]
dbRelationships = (Relationship -> Bool) -> [Relationship] -> [Relationship]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Relationship
x -> Table -> Schema
tableSchema (Relationship -> Table
relTable Relationship
x) Schema -> [Schema] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Schema]
schemas Bool -> Bool -> Bool
&&
Table -> Schema
tableSchema (Relationship -> Table
relForeignTable Relationship
x) Schema -> [Schema] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Schema]
schemas Bool -> Bool -> Bool
&&
Bool -> Bool
not (Relationship -> Bool
hasInternalJunction Relationship
x)) ([Relationship] -> [Relationship])
-> [Relationship] -> [Relationship]
forall a b. (a -> b) -> a -> b
$ DbStructure -> [Relationship]
dbRelationships DbStructure
dbStruct
, dbPrimaryKeys :: [PrimaryKey]
dbPrimaryKeys = (PrimaryKey -> Bool) -> [PrimaryKey] -> [PrimaryKey]
forall a. (a -> Bool) -> [a] -> [a]
filter (\PrimaryKey
x -> Table -> Schema
tableSchema (PrimaryKey -> Table
pkTable PrimaryKey
x) Schema -> [Schema] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Schema]
schemas) ([PrimaryKey] -> [PrimaryKey]) -> [PrimaryKey] -> [PrimaryKey]
forall a b. (a -> b) -> a -> b
$ DbStructure -> [PrimaryKey]
dbPrimaryKeys DbStructure
dbStruct
, dbProcs :: ProcsMap
dbProcs = DbStructure -> ProcsMap
dbProcs DbStructure
dbStruct
}
where
hasInternalJunction :: Relationship -> Bool
hasInternalJunction Relationship
rel = case Relationship -> Cardinality
relCardinality Relationship
rel of
M2M Junction{Table
junTable :: Junction -> Table
junTable :: Table
junTable} -> Table -> Schema
tableSchema Table
junTable Schema -> [Schema] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Schema]
schemas
Cardinality
_ -> Bool
False
decodeTables :: HD.Result [Table]
decodeTables :: Result [Table]
decodeTables =
Row Table -> Result [Table]
forall a. Row a -> Result [a]
HD.rowList Row Table
tblRow
where
tblRow :: Row Table
tblRow = Schema -> Schema -> Maybe Schema -> Bool -> Bool -> Bool -> Table
Table (Schema -> Schema -> Maybe Schema -> Bool -> Bool -> Bool -> Table)
-> Row Schema
-> Row (Schema -> Maybe Schema -> Bool -> Bool -> Bool -> Table)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value Schema -> Row Schema
forall a. Value a -> Row a
column Value Schema
HD.text
Row (Schema -> Maybe Schema -> Bool -> Bool -> Bool -> Table)
-> Row Schema
-> Row (Maybe Schema -> Bool -> Bool -> Bool -> Table)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value Schema -> Row Schema
forall a. Value a -> Row a
column Value Schema
HD.text
Row (Maybe Schema -> Bool -> Bool -> Bool -> Table)
-> Row (Maybe Schema) -> Row (Bool -> Bool -> Bool -> Table)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value Schema -> Row (Maybe Schema)
forall a. Value a -> Row (Maybe a)
nullableColumn Value Schema
HD.text
Row (Bool -> Bool -> Bool -> Table)
-> Row Bool -> Row (Bool -> Bool -> Table)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value Bool -> Row Bool
forall a. Value a -> Row a
column Value Bool
HD.bool
Row (Bool -> Bool -> Table) -> Row Bool -> Row (Bool -> Table)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value Bool -> Row Bool
forall a. Value a -> Row a
column Value Bool
HD.bool
Row (Bool -> Table) -> Row Bool -> Row Table
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value Bool -> Row Bool
forall a. Value a -> Row a
column Value Bool
HD.bool
decodeColumns :: [Table] -> HD.Result [Column]
decodeColumns :: [Table] -> Result [Column]
decodeColumns [Table]
tables =
((Schema, Schema, Schema, Maybe Schema, Bool, Schema, Maybe Int32,
Maybe Schema, Maybe Schema)
-> Maybe Column)
-> [(Schema, Schema, Schema, Maybe Schema, Bool, Schema,
Maybe Int32, Maybe Schema, Maybe Schema)]
-> [Column]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([Table]
-> (Schema, Schema, Schema, Maybe Schema, Bool, Schema,
Maybe Int32, Maybe Schema, Maybe Schema)
-> Maybe Column
columnFromRow [Table]
tables) ([(Schema, Schema, Schema, Maybe Schema, Bool, Schema, Maybe Int32,
Maybe Schema, Maybe Schema)]
-> [Column])
-> Result
[(Schema, Schema, Schema, Maybe Schema, Bool, Schema, Maybe Int32,
Maybe Schema, Maybe Schema)]
-> Result [Column]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Row
(Schema, Schema, Schema, Maybe Schema, Bool, Schema, Maybe Int32,
Maybe Schema, Maybe Schema)
-> Result
[(Schema, Schema, Schema, Maybe Schema, Bool, Schema, Maybe Int32,
Maybe Schema, Maybe Schema)]
forall a. Row a -> Result [a]
HD.rowList Row
(Schema, Schema, Schema, Maybe Schema, Bool, Schema, Maybe Int32,
Maybe Schema, Maybe Schema)
colRow
where
colRow :: Row
(Schema, Schema, Schema, Maybe Schema, Bool, Schema, Maybe Int32,
Maybe Schema, Maybe Schema)
colRow =
(,,,,,,,,)
(Schema
-> Schema
-> Schema
-> Maybe Schema
-> Bool
-> Schema
-> Maybe Int32
-> Maybe Schema
-> Maybe Schema
-> (Schema, Schema, Schema, Maybe Schema, Bool, Schema,
Maybe Int32, Maybe Schema, Maybe Schema))
-> Row Schema
-> Row
(Schema
-> Schema
-> Maybe Schema
-> Bool
-> Schema
-> Maybe Int32
-> Maybe Schema
-> Maybe Schema
-> (Schema, Schema, Schema, Maybe Schema, Bool, Schema,
Maybe Int32, Maybe Schema, Maybe Schema))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value Schema -> Row Schema
forall a. Value a -> Row a
column Value Schema
HD.text
Row
(Schema
-> Schema
-> Maybe Schema
-> Bool
-> Schema
-> Maybe Int32
-> Maybe Schema
-> Maybe Schema
-> (Schema, Schema, Schema, Maybe Schema, Bool, Schema,
Maybe Int32, Maybe Schema, Maybe Schema))
-> Row Schema
-> Row
(Schema
-> Maybe Schema
-> Bool
-> Schema
-> Maybe Int32
-> Maybe Schema
-> Maybe Schema
-> (Schema, Schema, Schema, Maybe Schema, Bool, Schema,
Maybe Int32, Maybe Schema, Maybe Schema))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value Schema -> Row Schema
forall a. Value a -> Row a
column Value Schema
HD.text
Row
(Schema
-> Maybe Schema
-> Bool
-> Schema
-> Maybe Int32
-> Maybe Schema
-> Maybe Schema
-> (Schema, Schema, Schema, Maybe Schema, Bool, Schema,
Maybe Int32, Maybe Schema, Maybe Schema))
-> Row Schema
-> Row
(Maybe Schema
-> Bool
-> Schema
-> Maybe Int32
-> Maybe Schema
-> Maybe Schema
-> (Schema, Schema, Schema, Maybe Schema, Bool, Schema,
Maybe Int32, Maybe Schema, Maybe Schema))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value Schema -> Row Schema
forall a. Value a -> Row a
column Value Schema
HD.text
Row
(Maybe Schema
-> Bool
-> Schema
-> Maybe Int32
-> Maybe Schema
-> Maybe Schema
-> (Schema, Schema, Schema, Maybe Schema, Bool, Schema,
Maybe Int32, Maybe Schema, Maybe Schema))
-> Row (Maybe Schema)
-> Row
(Bool
-> Schema
-> Maybe Int32
-> Maybe Schema
-> Maybe Schema
-> (Schema, Schema, Schema, Maybe Schema, Bool, Schema,
Maybe Int32, Maybe Schema, Maybe Schema))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value Schema -> Row (Maybe Schema)
forall a. Value a -> Row (Maybe a)
nullableColumn Value Schema
HD.text
Row
(Bool
-> Schema
-> Maybe Int32
-> Maybe Schema
-> Maybe Schema
-> (Schema, Schema, Schema, Maybe Schema, Bool, Schema,
Maybe Int32, Maybe Schema, Maybe Schema))
-> Row Bool
-> Row
(Schema
-> Maybe Int32
-> Maybe Schema
-> Maybe Schema
-> (Schema, Schema, Schema, Maybe Schema, Bool, Schema,
Maybe Int32, Maybe Schema, Maybe Schema))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value Bool -> Row Bool
forall a. Value a -> Row a
column Value Bool
HD.bool
Row
(Schema
-> Maybe Int32
-> Maybe Schema
-> Maybe Schema
-> (Schema, Schema, Schema, Maybe Schema, Bool, Schema,
Maybe Int32, Maybe Schema, Maybe Schema))
-> Row Schema
-> Row
(Maybe Int32
-> Maybe Schema
-> Maybe Schema
-> (Schema, Schema, Schema, Maybe Schema, Bool, Schema,
Maybe Int32, Maybe Schema, Maybe Schema))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value Schema -> Row Schema
forall a. Value a -> Row a
column Value Schema
HD.text
Row
(Maybe Int32
-> Maybe Schema
-> Maybe Schema
-> (Schema, Schema, Schema, Maybe Schema, Bool, Schema,
Maybe Int32, Maybe Schema, Maybe Schema))
-> Row (Maybe Int32)
-> Row
(Maybe Schema
-> Maybe Schema
-> (Schema, Schema, Schema, Maybe Schema, Bool, Schema,
Maybe Int32, Maybe Schema, Maybe Schema))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value Int32 -> Row (Maybe Int32)
forall a. Value a -> Row (Maybe a)
nullableColumn Value Int32
HD.int4
Row
(Maybe Schema
-> Maybe Schema
-> (Schema, Schema, Schema, Maybe Schema, Bool, Schema,
Maybe Int32, Maybe Schema, Maybe Schema))
-> Row (Maybe Schema)
-> Row
(Maybe Schema
-> (Schema, Schema, Schema, Maybe Schema, Bool, Schema,
Maybe Int32, Maybe Schema, Maybe Schema))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value Schema -> Row (Maybe Schema)
forall a. Value a -> Row (Maybe a)
nullableColumn Value Schema
HD.text
Row
(Maybe Schema
-> (Schema, Schema, Schema, Maybe Schema, Bool, Schema,
Maybe Int32, Maybe Schema, Maybe Schema))
-> Row (Maybe Schema)
-> Row
(Schema, Schema, Schema, Maybe Schema, Bool, Schema, Maybe Int32,
Maybe Schema, Maybe Schema)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value Schema -> Row (Maybe Schema)
forall a. Value a -> Row (Maybe a)
nullableColumn Value Schema
HD.text
decodeRels :: [Table] -> [Column] -> HD.Result [Relationship]
decodeRels :: [Table] -> [Column] -> Result [Relationship]
decodeRels [Table]
tables [Column]
cols =
((Schema, Schema, Schema, [Schema], Schema, Schema, [Schema])
-> Maybe Relationship)
-> [(Schema, Schema, Schema, [Schema], Schema, Schema, [Schema])]
-> [Relationship]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([Table]
-> [Column]
-> (Schema, Schema, Schema, [Schema], Schema, Schema, [Schema])
-> Maybe Relationship
relFromRow [Table]
tables [Column]
cols) ([(Schema, Schema, Schema, [Schema], Schema, Schema, [Schema])]
-> [Relationship])
-> Result
[(Schema, Schema, Schema, [Schema], Schema, Schema, [Schema])]
-> Result [Relationship]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Row (Schema, Schema, Schema, [Schema], Schema, Schema, [Schema])
-> Result
[(Schema, Schema, Schema, [Schema], Schema, Schema, [Schema])]
forall a. Row a -> Result [a]
HD.rowList Row (Schema, Schema, Schema, [Schema], Schema, Schema, [Schema])
relRow
where
relRow :: Row (Schema, Schema, Schema, [Schema], Schema, Schema, [Schema])
relRow = (,,,,,,)
(Schema
-> Schema
-> Schema
-> [Schema]
-> Schema
-> Schema
-> [Schema]
-> (Schema, Schema, Schema, [Schema], Schema, Schema, [Schema]))
-> Row Schema
-> Row
(Schema
-> Schema
-> [Schema]
-> Schema
-> Schema
-> [Schema]
-> (Schema, Schema, Schema, [Schema], Schema, Schema, [Schema]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value Schema -> Row Schema
forall a. Value a -> Row a
column Value Schema
HD.text
Row
(Schema
-> Schema
-> [Schema]
-> Schema
-> Schema
-> [Schema]
-> (Schema, Schema, Schema, [Schema], Schema, Schema, [Schema]))
-> Row Schema
-> Row
(Schema
-> [Schema]
-> Schema
-> Schema
-> [Schema]
-> (Schema, Schema, Schema, [Schema], Schema, Schema, [Schema]))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value Schema -> Row Schema
forall a. Value a -> Row a
column Value Schema
HD.text
Row
(Schema
-> [Schema]
-> Schema
-> Schema
-> [Schema]
-> (Schema, Schema, Schema, [Schema], Schema, Schema, [Schema]))
-> Row Schema
-> Row
([Schema]
-> Schema
-> Schema
-> [Schema]
-> (Schema, Schema, Schema, [Schema], Schema, Schema, [Schema]))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value Schema -> Row Schema
forall a. Value a -> Row a
column Value Schema
HD.text
Row
([Schema]
-> Schema
-> Schema
-> [Schema]
-> (Schema, Schema, Schema, [Schema], Schema, Schema, [Schema]))
-> Row [Schema]
-> Row
(Schema
-> Schema
-> [Schema]
-> (Schema, Schema, Schema, [Schema], Schema, Schema, [Schema]))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value Schema -> Row [Schema]
forall a. Value a -> Row [a]
arrayColumn Value Schema
HD.text
Row
(Schema
-> Schema
-> [Schema]
-> (Schema, Schema, Schema, [Schema], Schema, Schema, [Schema]))
-> Row Schema
-> Row
(Schema
-> [Schema]
-> (Schema, Schema, Schema, [Schema], Schema, Schema, [Schema]))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value Schema -> Row Schema
forall a. Value a -> Row a
column Value Schema
HD.text
Row
(Schema
-> [Schema]
-> (Schema, Schema, Schema, [Schema], Schema, Schema, [Schema]))
-> Row Schema
-> Row
([Schema]
-> (Schema, Schema, Schema, [Schema], Schema, Schema, [Schema]))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value Schema -> Row Schema
forall a. Value a -> Row a
column Value Schema
HD.text
Row
([Schema]
-> (Schema, Schema, Schema, [Schema], Schema, Schema, [Schema]))
-> Row [Schema]
-> Row (Schema, Schema, Schema, [Schema], Schema, Schema, [Schema])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value Schema -> Row [Schema]
forall a. Value a -> Row [a]
arrayColumn Value Schema
HD.text
decodePks :: [Table] -> HD.Result [PrimaryKey]
decodePks :: [Table] -> Result [PrimaryKey]
decodePks [Table]
tables =
((Schema, Schema, Schema) -> Maybe PrimaryKey)
-> [(Schema, Schema, Schema)] -> [PrimaryKey]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([Table] -> (Schema, Schema, Schema) -> Maybe PrimaryKey
pkFromRow [Table]
tables) ([(Schema, Schema, Schema)] -> [PrimaryKey])
-> Result [(Schema, Schema, Schema)] -> Result [PrimaryKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Row (Schema, Schema, Schema) -> Result [(Schema, Schema, Schema)]
forall a. Row a -> Result [a]
HD.rowList Row (Schema, Schema, Schema)
pkRow
where
pkRow :: Row (Schema, Schema, Schema)
pkRow = (,,) (Schema -> Schema -> Schema -> (Schema, Schema, Schema))
-> Row Schema -> Row (Schema -> Schema -> (Schema, Schema, Schema))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value Schema -> Row Schema
forall a. Value a -> Row a
column Value Schema
HD.text Row (Schema -> Schema -> (Schema, Schema, Schema))
-> Row Schema -> Row (Schema -> (Schema, Schema, Schema))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value Schema -> Row Schema
forall a. Value a -> Row a
column Value Schema
HD.text Row (Schema -> (Schema, Schema, Schema))
-> Row Schema -> Row (Schema, Schema, Schema)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value Schema -> Row Schema
forall a. Value a -> Row a
column Value Schema
HD.text
decodeSourceColumns :: [Column] -> HD.Result [SourceColumn]
decodeSourceColumns :: [Column] -> Result [SourceColumn]
decodeSourceColumns [Column]
cols =
((Schema, Schema, Schema, Schema, Schema, Schema)
-> Maybe SourceColumn)
-> [(Schema, Schema, Schema, Schema, Schema, Schema)]
-> [SourceColumn]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([Column]
-> (Schema, Schema, Schema, Schema, Schema, Schema)
-> Maybe SourceColumn
sourceColumnFromRow [Column]
cols) ([(Schema, Schema, Schema, Schema, Schema, Schema)]
-> [SourceColumn])
-> Result [(Schema, Schema, Schema, Schema, Schema, Schema)]
-> Result [SourceColumn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Row (Schema, Schema, Schema, Schema, Schema, Schema)
-> Result [(Schema, Schema, Schema, Schema, Schema, Schema)]
forall a. Row a -> Result [a]
HD.rowList Row (Schema, Schema, Schema, Schema, Schema, Schema)
srcColRow
where
srcColRow :: Row (Schema, Schema, Schema, Schema, Schema, Schema)
srcColRow = (,,,,,)
(Schema
-> Schema
-> Schema
-> Schema
-> Schema
-> Schema
-> (Schema, Schema, Schema, Schema, Schema, Schema))
-> Row Schema
-> Row
(Schema
-> Schema
-> Schema
-> Schema
-> Schema
-> (Schema, Schema, Schema, Schema, Schema, Schema))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value Schema -> Row Schema
forall a. Value a -> Row a
column Value Schema
HD.text Row
(Schema
-> Schema
-> Schema
-> Schema
-> Schema
-> (Schema, Schema, Schema, Schema, Schema, Schema))
-> Row Schema
-> Row
(Schema
-> Schema
-> Schema
-> Schema
-> (Schema, Schema, Schema, Schema, Schema, Schema))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value Schema -> Row Schema
forall a. Value a -> Row a
column Value Schema
HD.text
Row
(Schema
-> Schema
-> Schema
-> Schema
-> (Schema, Schema, Schema, Schema, Schema, Schema))
-> Row Schema
-> Row
(Schema
-> Schema
-> Schema
-> (Schema, Schema, Schema, Schema, Schema, Schema))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value Schema -> Row Schema
forall a. Value a -> Row a
column Value Schema
HD.text Row
(Schema
-> Schema
-> Schema
-> (Schema, Schema, Schema, Schema, Schema, Schema))
-> Row Schema
-> Row
(Schema
-> Schema -> (Schema, Schema, Schema, Schema, Schema, Schema))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value Schema -> Row Schema
forall a. Value a -> Row a
column Value Schema
HD.text
Row
(Schema
-> Schema -> (Schema, Schema, Schema, Schema, Schema, Schema))
-> Row Schema
-> Row (Schema -> (Schema, Schema, Schema, Schema, Schema, Schema))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value Schema -> Row Schema
forall a. Value a -> Row a
column Value Schema
HD.text Row (Schema -> (Schema, Schema, Schema, Schema, Schema, Schema))
-> Row Schema
-> Row (Schema, Schema, Schema, Schema, Schema, Schema)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value Schema -> Row Schema
forall a. Value a -> Row a
column Value Schema
HD.text
sourceColumnFromRow :: [Column] -> (Text,Text,Text,Text,Text,Text) -> Maybe SourceColumn
sourceColumnFromRow :: [Column]
-> (Schema, Schema, Schema, Schema, Schema, Schema)
-> Maybe SourceColumn
sourceColumnFromRow [Column]
allCols (Schema
s1,Schema
t1,Schema
c1,Schema
s2,Schema
t2,Schema
c2) = (,) (Column -> Column -> SourceColumn)
-> Maybe Column -> Maybe (Column -> SourceColumn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Column
col1 Maybe (Column -> SourceColumn)
-> Maybe Column -> Maybe SourceColumn
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Column
col2
where
col1 :: Maybe Column
col1 = Schema -> Schema -> Schema -> Maybe Column
findCol Schema
s1 Schema
t1 Schema
c1
col2 :: Maybe Column
col2 = Schema -> Schema -> Schema -> Maybe Column
findCol Schema
s2 Schema
t2 Schema
c2
findCol :: Schema -> Schema -> Schema -> Maybe Column
findCol Schema
s Schema
t Schema
c = (Column -> Bool) -> [Column] -> Maybe Column
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Column
col -> (Table -> Schema
tableSchema (Table -> Schema) -> (Column -> Table) -> Column -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Column -> Table
colTable) Column
col Schema -> Schema -> Bool
forall a. Eq a => a -> a -> Bool
== Schema
s Bool -> Bool -> Bool
&& (Table -> Schema
tableName (Table -> Schema) -> (Column -> Table) -> Column -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Column -> Table
colTable) Column
col Schema -> Schema -> Bool
forall a. Eq a => a -> a -> Bool
== Schema
t Bool -> Bool -> Bool
&& Column -> Schema
colName Column
col Schema -> Schema -> Bool
forall a. Eq a => a -> a -> Bool
== Schema
c) [Column]
allCols
decodeProcs :: HD.Result ProcsMap
decodeProcs :: Result ProcsMap
decodeProcs =
([ProcDescription] -> [ProcDescription]) -> ProcsMap -> ProcsMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map [ProcDescription] -> [ProcDescription]
forall a. Ord a => [a] -> [a]
sort (ProcsMap -> ProcsMap)
-> ([ProcDescription] -> ProcsMap) -> [ProcDescription] -> ProcsMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ProcDescription] -> [ProcDescription] -> [ProcDescription])
-> [(QualifiedIdentifier, [ProcDescription])] -> ProcsMap
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
M.fromListWith [ProcDescription] -> [ProcDescription] -> [ProcDescription]
forall a. [a] -> [a] -> [a]
(++) ([(QualifiedIdentifier, [ProcDescription])] -> ProcsMap)
-> ([ProcDescription]
-> [(QualifiedIdentifier, [ProcDescription])])
-> [ProcDescription]
-> ProcsMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProcDescription -> (QualifiedIdentifier, [ProcDescription]))
-> [ProcDescription] -> [(QualifiedIdentifier, [ProcDescription])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((\(QualifiedIdentifier
x,ProcDescription
y) -> (QualifiedIdentifier
x, [ProcDescription
y])) ((QualifiedIdentifier, ProcDescription)
-> (QualifiedIdentifier, [ProcDescription]))
-> (ProcDescription -> (QualifiedIdentifier, ProcDescription))
-> ProcDescription
-> (QualifiedIdentifier, [ProcDescription])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcDescription -> (QualifiedIdentifier, ProcDescription)
addKey) ([ProcDescription] -> ProcsMap)
-> Result [ProcDescription] -> Result ProcsMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Row ProcDescription -> Result [ProcDescription]
forall a. Row a -> Result [a]
HD.rowList Row ProcDescription
procRow
where
procRow :: Row ProcDescription
procRow = Schema
-> Schema
-> Maybe Schema
-> [PgArg]
-> RetType
-> ProcVolatility
-> Bool
-> ProcDescription
ProcDescription
(Schema
-> Schema
-> Maybe Schema
-> [PgArg]
-> RetType
-> ProcVolatility
-> Bool
-> ProcDescription)
-> Row Schema
-> Row
(Schema
-> Maybe Schema
-> [PgArg]
-> RetType
-> ProcVolatility
-> Bool
-> ProcDescription)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value Schema -> Row Schema
forall a. Value a -> Row a
column Value Schema
HD.text
Row
(Schema
-> Maybe Schema
-> [PgArg]
-> RetType
-> ProcVolatility
-> Bool
-> ProcDescription)
-> Row Schema
-> Row
(Maybe Schema
-> [PgArg] -> RetType -> ProcVolatility -> Bool -> ProcDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value Schema -> Row Schema
forall a. Value a -> Row a
column Value Schema
HD.text
Row
(Maybe Schema
-> [PgArg] -> RetType -> ProcVolatility -> Bool -> ProcDescription)
-> Row (Maybe Schema)
-> Row
([PgArg] -> RetType -> ProcVolatility -> Bool -> ProcDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value Schema -> Row (Maybe Schema)
forall a. Value a -> Row (Maybe a)
nullableColumn Value Schema
HD.text
Row
([PgArg] -> RetType -> ProcVolatility -> Bool -> ProcDescription)
-> Row [PgArg]
-> Row (RetType -> ProcVolatility -> Bool -> ProcDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Composite PgArg -> Row [PgArg]
forall a. Composite a -> Row [a]
compositeArrayColumn
(Schema -> Schema -> Bool -> Bool -> PgArg
PgArg
(Schema -> Schema -> Bool -> Bool -> PgArg)
-> Composite Schema -> Composite (Schema -> Bool -> Bool -> PgArg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value Schema -> Composite Schema
forall a. Value a -> Composite a
compositeField Value Schema
HD.text
Composite (Schema -> Bool -> Bool -> PgArg)
-> Composite Schema -> Composite (Bool -> Bool -> PgArg)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value Schema -> Composite Schema
forall a. Value a -> Composite a
compositeField Value Schema
HD.text
Composite (Bool -> Bool -> PgArg)
-> Composite Bool -> Composite (Bool -> PgArg)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value Bool -> Composite Bool
forall a. Value a -> Composite a
compositeField Value Bool
HD.bool
Composite (Bool -> PgArg) -> Composite Bool -> Composite PgArg
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value Bool -> Composite Bool
forall a. Value a -> Composite a
compositeField Value Bool
HD.bool)
Row (RetType -> ProcVolatility -> Bool -> ProcDescription)
-> Row RetType -> Row (ProcVolatility -> Bool -> ProcDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Schema -> Schema -> Bool -> Bool -> RetType
parseRetType
(Schema -> Schema -> Bool -> Bool -> RetType)
-> Row Schema -> Row (Schema -> Bool -> Bool -> RetType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value Schema -> Row Schema
forall a. Value a -> Row a
column Value Schema
HD.text
Row (Schema -> Bool -> Bool -> RetType)
-> Row Schema -> Row (Bool -> Bool -> RetType)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value Schema -> Row Schema
forall a. Value a -> Row a
column Value Schema
HD.text
Row (Bool -> Bool -> RetType) -> Row Bool -> Row (Bool -> RetType)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value Bool -> Row Bool
forall a. Value a -> Row a
column Value Bool
HD.bool
Row (Bool -> RetType) -> Row Bool -> Row RetType
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value Bool -> Row Bool
forall a. Value a -> Row a
column Value Bool
HD.bool)
Row (ProcVolatility -> Bool -> ProcDescription)
-> Row ProcVolatility -> Row (Bool -> ProcDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> ProcVolatility
parseVolatility (Char -> ProcVolatility) -> Row Char -> Row ProcVolatility
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value Char -> Row Char
forall a. Value a -> Row a
column Value Char
HD.char)
Row (Bool -> ProcDescription) -> Row Bool -> Row ProcDescription
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value Bool -> Row Bool
forall a. Value a -> Row a
column Value Bool
HD.bool
addKey :: ProcDescription -> (QualifiedIdentifier, ProcDescription)
addKey :: ProcDescription -> (QualifiedIdentifier, ProcDescription)
addKey ProcDescription
pd = (Schema -> Schema -> QualifiedIdentifier
QualifiedIdentifier (ProcDescription -> Schema
pdSchema ProcDescription
pd) (ProcDescription -> Schema
pdName ProcDescription
pd), ProcDescription
pd)
parseRetType :: Text -> Text -> Bool -> Bool -> RetType
parseRetType :: Schema -> Schema -> Bool -> Bool -> RetType
parseRetType Schema
schema Schema
name Bool
isSetOf Bool
isComposite
| Bool
isSetOf = PgType -> RetType
SetOf PgType
pgType
| Bool
otherwise = PgType -> RetType
Single PgType
pgType
where
qi :: QualifiedIdentifier
qi = Schema -> Schema -> QualifiedIdentifier
QualifiedIdentifier Schema
schema Schema
name
pgType :: PgType
pgType
| Bool
isComposite = QualifiedIdentifier -> PgType
Composite QualifiedIdentifier
qi
| Bool
otherwise = PgType
Scalar
parseVolatility :: Char -> ProcVolatility
parseVolatility :: Char -> ProcVolatility
parseVolatility Char
v | Char
v Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'i' = ProcVolatility
Immutable
| Char
v Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
's' = ProcVolatility
Stable
| Bool
otherwise = ProcVolatility
Volatile
allProcs :: Bool -> H.Statement [Schema] ProcsMap
allProcs :: Bool -> Statement [Schema] ProcsMap
allProcs = ByteString
-> Params [Schema]
-> Result ProcsMap
-> Bool
-> Statement [Schema] ProcsMap
forall a b.
ByteString -> Params a -> Result b -> Bool -> Statement a b
H.Statement (ByteString -> ByteString
forall a b. StringConv a b => a -> b
toS ByteString
sql) (Value Schema -> Params [Schema]
forall a. Value a -> Params [a]
arrayParam Value Schema
HE.text) Result ProcsMap
decodeProcs
where
sql :: ByteString
sql = ByteString
procsSqlQuery ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" WHERE pn.nspname = ANY($1)"
accessibleProcs :: Bool -> H.Statement Schema ProcsMap
accessibleProcs :: Bool -> Statement Schema ProcsMap
accessibleProcs = ByteString
-> Params Schema
-> Result ProcsMap
-> Bool
-> Statement Schema ProcsMap
forall a b.
ByteString -> Params a -> Result b -> Bool -> Statement a b
H.Statement (ByteString -> ByteString
forall a b. StringConv a b => a -> b
toS ByteString
sql) (Value Schema -> Params Schema
forall a. Value a -> Params a
param Value Schema
HE.text) Result ProcsMap
decodeProcs
where
sql :: ByteString
sql = ByteString
procsSqlQuery ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" WHERE pn.nspname = $1 AND has_function_privilege(p.oid, 'execute')"
procsSqlQuery :: SqlQuery
procsSqlQuery :: ByteString
procsSqlQuery = [q|
-- Recursively get the base types of domains
WITH
base_types AS (
WITH RECURSIVE
recurse AS (
SELECT
oid,
typbasetype,
COALESCE(NULLIF(typbasetype, 0), oid) AS base
FROM pg_type
UNION
SELECT
t.oid,
b.typbasetype,
COALESCE(NULLIF(b.typbasetype, 0), b.oid) AS base
FROM recurse t
JOIN pg_type b ON t.typbasetype = b.oid
)
SELECT
oid,
base
FROM recurse
WHERE typbasetype = 0
),
arguments AS (
SELECT
oid,
array_agg((
COALESCE(name, ''), -- name
type::regtype::text, -- type
idx <= (pronargs - pronargdefaults), -- is_required
COALESCE(mode = 'v', FALSE) -- is_variadic
) ORDER BY idx) AS args
FROM pg_proc,
unnest(proargnames, proargtypes, proargmodes)
WITH ORDINALITY AS _ (name, type, mode, idx)
WHERE type IS NOT NULL -- only input arguments
GROUP BY oid
)
SELECT
pn.nspname AS proc_schema,
p.proname AS proc_name,
d.description AS proc_description,
COALESCE(a.args, '{}') AS args,
tn.nspname AS schema,
COALESCE(comp.relname, t.typname) AS name,
p.proretset AS rettype_is_setof,
(t.typtype = 'c'
-- Only pg pseudo type that is a row type is 'record'
or t.typtype = 'p' and t.typname = 'record'
-- if any INOUT or OUT arguments present, treat as composite
or COALESCE(proargmodes::text[] && '{b,o}', false)
) AS rettype_is_composite,
p.provolatile,
p.provariadic > 0 as hasvariadic
FROM pg_proc p
LEFT JOIN arguments a ON a.oid = p.oid
JOIN pg_namespace pn ON pn.oid = p.pronamespace
JOIN base_types bt ON bt.oid = p.prorettype
JOIN pg_type t ON t.oid = bt.base
JOIN pg_namespace tn ON tn.oid = t.typnamespace
LEFT JOIN pg_class comp ON comp.oid = t.typrelid
LEFT JOIN pg_catalog.pg_description as d ON d.objoid = p.oid
|]
schemaDescription :: Bool -> H.Statement Schema (Maybe Text)
schemaDescription :: Bool -> Statement Schema (Maybe Schema)
schemaDescription =
ByteString
-> Params Schema
-> Result (Maybe Schema)
-> Bool
-> Statement Schema (Maybe Schema)
forall a b.
ByteString -> Params a -> Result b -> Bool -> Statement a b
H.Statement ByteString
sql (Value Schema -> Params Schema
forall a. Value a -> Params a
param Value Schema
HE.text) (Maybe (Maybe Schema) -> Maybe Schema
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe Schema) -> Maybe Schema)
-> Result (Maybe (Maybe Schema)) -> Result (Maybe Schema)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Row (Maybe Schema) -> Result (Maybe (Maybe Schema))
forall a. Row a -> Result (Maybe a)
HD.rowMaybe (Value Schema -> Row (Maybe Schema)
forall a. Value a -> Row (Maybe a)
nullableColumn Value Schema
HD.text))
where
sql :: ByteString
sql = [q|
select
description
from
pg_catalog.pg_namespace n
left join pg_catalog.pg_description d on d.objoid = n.oid
where
n.nspname = $1 |]
accessibleTables :: Bool -> H.Statement Schema [Table]
accessibleTables :: Bool -> Statement Schema [Table]
accessibleTables =
ByteString
-> Params Schema
-> Result [Table]
-> Bool
-> Statement Schema [Table]
forall a b.
ByteString -> Params a -> Result b -> Bool -> Statement a b
H.Statement ByteString
sql (Value Schema -> Params Schema
forall a. Value a -> Params a
param Value Schema
HE.text) Result [Table]
decodeTables
where
sql :: ByteString
sql = [q|
select
n.nspname as table_schema,
relname as table_name,
d.description as table_description,
(
c.relkind IN ('r', '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,
(
c.relkind IN ('r', 'v','f')
AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 4) = 4
-- CMD_UPDATE
OR EXISTS (
SELECT 1
FROM pg_trigger
WHERE
pg_trigger.tgrelid = c.oid
and (pg_trigger.tgtype::integer & 81) = 81
)
) as updatable,
(
c.relkind IN ('r', 'v','f')
AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 16) = 16
-- CMD_DELETE
OR EXISTS (
SELECT 1
FROM pg_trigger
WHERE
pg_trigger.tgrelid = c.oid
and (pg_trigger.tgtype::integer & 73) = 73
)
) as deletable
from
pg_class c
join pg_namespace n on n.oid = c.relnamespace
left join pg_catalog.pg_description as d on d.objoid = c.oid and d.objsubid = 0
where
c.relkind in ('v', 'r', 'm', 'f')
and n.nspname = $1
and (
pg_has_role(c.relowner, 'USAGE')
or has_table_privilege(c.oid, 'SELECT, INSERT, UPDATE, DELETE, TRUNCATE, REFERENCES, TRIGGER')
or has_any_column_privilege(c.oid, 'SELECT, INSERT, UPDATE, REFERENCES')
)
order by relname |]
addViewM2ORels :: [SourceColumn] -> [Relationship] -> [Relationship]
addViewM2ORels :: [SourceColumn] -> [Relationship] -> [Relationship]
addViewM2ORels [SourceColumn]
allSrcCols = (Relationship -> [Relationship])
-> [Relationship] -> [Relationship]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\rel :: Relationship
rel@Relationship{[Column]
Table
Cardinality
relForeignColumns :: Relationship -> [Column]
relColumns :: Relationship -> [Column]
relCardinality :: Cardinality
relForeignColumns :: [Column]
relForeignTable :: Table
relColumns :: [Column]
relTable :: Table
relCardinality :: Relationship -> Cardinality
relForeignTable :: Relationship -> Table
relTable :: Relationship -> Table
..} -> Relationship
rel Relationship -> [Relationship] -> [Relationship]
forall a. a -> [a] -> [a]
:
let
srcColsGroupedByView :: [Column] -> [[SourceColumn]]
srcColsGroupedByView :: [Column] -> [[SourceColumn]]
srcColsGroupedByView [Column]
relCols = (SourceColumn -> SourceColumn -> Bool)
-> [SourceColumn] -> [[SourceColumn]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy (\(Column
_, Column
viewCol1) (Column
_, Column
viewCol2) -> Column -> Table
colTable Column
viewCol1 Table -> Table -> Bool
forall a. Eq a => a -> a -> Bool
== Column -> Table
colTable Column
viewCol2) ([SourceColumn] -> [[SourceColumn]])
-> [SourceColumn] -> [[SourceColumn]]
forall a b. (a -> b) -> a -> b
$
(SourceColumn -> Bool) -> [SourceColumn] -> [SourceColumn]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Column
c, Column
_) -> Column
c Column -> [Column] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Column]
relCols) [SourceColumn]
allSrcCols
relSrcCols :: [[SourceColumn]]
relSrcCols = [Column] -> [[SourceColumn]]
srcColsGroupedByView [Column]
relColumns
relFSrcCols :: [[SourceColumn]]
relFSrcCols = [Column] -> [[SourceColumn]]
srcColsGroupedByView [Column]
relForeignColumns
getView :: [SourceColumn] -> Table
getView :: [SourceColumn] -> Table
getView = Column -> Table
colTable (Column -> Table)
-> ([SourceColumn] -> Column) -> [SourceColumn] -> Table
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceColumn -> Column
forall a b. (a, b) -> b
snd (SourceColumn -> Column)
-> ([SourceColumn] -> SourceColumn) -> [SourceColumn] -> Column
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SourceColumn] -> SourceColumn
forall a. [a] -> a
unsafeHead
[(a, b)]
srcCols allSrcColsOf :: [(a, b)] -> [a] -> Bool
`allSrcColsOf` [a]
cols = [a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList ((a, b) -> a
forall a b. (a, b) -> a
fst ((a, b) -> a) -> [(a, b)] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, b)]
srcCols) Set a -> Set a -> Bool
forall a. Eq a => a -> a -> Bool
== [a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList [a]
cols
[(a, b)]
srcCols sortAccordingTo :: [(a, b)] -> [a] -> [(a, b)]
`sortAccordingTo` [a]
cols = ((a, b) -> Maybe Int) -> [(a, b)] -> [(a, b)]
forall o a. Ord o => (a -> o) -> [a] -> [a]
sortOn (\(a
k, b
_) -> a -> [(a, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup a
k ([(a, Int)] -> Maybe Int) -> [(a, Int)] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ [a] -> [Int] -> [(a, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
cols [Int
0::Int ..]) [(a, b)]
srcCols
viewTableM2O :: [Relationship]
viewTableM2O =
[ Table
-> [Column] -> Table -> [Column] -> Cardinality -> Relationship
Relationship
([SourceColumn] -> Table
getView [SourceColumn]
srcCols) (SourceColumn -> Column
forall a b. (a, b) -> b
snd (SourceColumn -> Column) -> [SourceColumn] -> [Column]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SourceColumn]
srcCols [SourceColumn] -> [Column] -> [SourceColumn]
forall a b. Eq a => [(a, b)] -> [a] -> [(a, b)]
`sortAccordingTo` [Column]
relColumns)
Table
relForeignTable [Column]
relForeignColumns Cardinality
relCardinality
| [SourceColumn]
srcCols <- [[SourceColumn]]
relSrcCols, [SourceColumn]
srcCols [SourceColumn] -> [Column] -> Bool
forall a b. Ord a => [(a, b)] -> [a] -> Bool
`allSrcColsOf` [Column]
relColumns ]
tableViewM2O :: [Relationship]
tableViewM2O =
[ Table
-> [Column] -> Table -> [Column] -> Cardinality -> Relationship
Relationship
Table
relTable [Column]
relColumns
([SourceColumn] -> Table
getView [SourceColumn]
fSrcCols) (SourceColumn -> Column
forall a b. (a, b) -> b
snd (SourceColumn -> Column) -> [SourceColumn] -> [Column]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SourceColumn]
fSrcCols [SourceColumn] -> [Column] -> [SourceColumn]
forall a b. Eq a => [(a, b)] -> [a] -> [(a, b)]
`sortAccordingTo` [Column]
relForeignColumns)
Cardinality
relCardinality
| [SourceColumn]
fSrcCols <- [[SourceColumn]]
relFSrcCols, [SourceColumn]
fSrcCols [SourceColumn] -> [Column] -> Bool
forall a b. Ord a => [(a, b)] -> [a] -> Bool
`allSrcColsOf` [Column]
relForeignColumns ]
viewViewM2O :: [Relationship]
viewViewM2O =
[ Table
-> [Column] -> Table -> [Column] -> Cardinality -> Relationship
Relationship
([SourceColumn] -> Table
getView [SourceColumn]
srcCols) (SourceColumn -> Column
forall a b. (a, b) -> b
snd (SourceColumn -> Column) -> [SourceColumn] -> [Column]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SourceColumn]
srcCols [SourceColumn] -> [Column] -> [SourceColumn]
forall a b. Eq a => [(a, b)] -> [a] -> [(a, b)]
`sortAccordingTo` [Column]
relColumns)
([SourceColumn] -> Table
getView [SourceColumn]
fSrcCols) (SourceColumn -> Column
forall a b. (a, b) -> b
snd (SourceColumn -> Column) -> [SourceColumn] -> [Column]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SourceColumn]
fSrcCols [SourceColumn] -> [Column] -> [SourceColumn]
forall a b. Eq a => [(a, b)] -> [a] -> [(a, b)]
`sortAccordingTo` [Column]
relForeignColumns)
Cardinality
relCardinality
| [SourceColumn]
srcCols <- [[SourceColumn]]
relSrcCols, [SourceColumn]
srcCols [SourceColumn] -> [Column] -> Bool
forall a b. Ord a => [(a, b)] -> [a] -> Bool
`allSrcColsOf` [Column]
relColumns
, [SourceColumn]
fSrcCols <- [[SourceColumn]]
relFSrcCols, [SourceColumn]
fSrcCols [SourceColumn] -> [Column] -> Bool
forall a b. Ord a => [(a, b)] -> [a] -> Bool
`allSrcColsOf` [Column]
relForeignColumns ]
in [Relationship]
viewTableM2O [Relationship] -> [Relationship] -> [Relationship]
forall a. [a] -> [a] -> [a]
++ [Relationship]
tableViewM2O [Relationship] -> [Relationship] -> [Relationship]
forall a. [a] -> [a] -> [a]
++ [Relationship]
viewViewM2O)
addO2MRels :: [Relationship] -> [Relationship]
addO2MRels :: [Relationship] -> [Relationship]
addO2MRels [Relationship]
rels = [Relationship]
rels [Relationship] -> [Relationship] -> [Relationship]
forall a. [a] -> [a] -> [a]
++ [ Table
-> [Column] -> Table -> [Column] -> Cardinality -> Relationship
Relationship Table
ft [Column]
fc Table
t [Column]
c (Schema -> Cardinality
O2M Schema
cons)
| Relationship Table
t [Column]
c Table
ft [Column]
fc (M2O Schema
cons) <- [Relationship]
rels ]
addM2MRels :: [Relationship] -> [Relationship]
addM2MRels :: [Relationship] -> [Relationship]
addM2MRels [Relationship]
rels = [Relationship]
rels [Relationship] -> [Relationship] -> [Relationship]
forall a. [a] -> [a] -> [a]
++ [ Table
-> [Column] -> Table -> [Column] -> Cardinality -> Relationship
Relationship Table
t [Column]
c Table
ft [Column]
fc (Junction -> Cardinality
M2M (Junction -> Cardinality) -> Junction -> Cardinality
forall a b. (a -> b) -> a -> b
$ Table -> Schema -> [Column] -> Schema -> [Column] -> Junction
Junction Table
jt1 Schema
cons1 [Column]
jc1 Schema
cons2 [Column]
jc2)
| Relationship Table
jt1 [Column]
jc1 Table
t [Column]
c (M2O Schema
cons1) <- [Relationship]
rels
, Relationship Table
jt2 [Column]
jc2 Table
ft [Column]
fc (M2O Schema
cons2) <- [Relationship]
rels
, Table
jt1 Table -> Table -> Bool
forall a. Eq a => a -> a -> Bool
== Table
jt2
, Schema
cons1 Schema -> Schema -> Bool
forall a. Eq a => a -> a -> Bool
/= Schema
cons2]
addViewPrimaryKeys :: [SourceColumn] -> [PrimaryKey] -> [PrimaryKey]
addViewPrimaryKeys :: [SourceColumn] -> [PrimaryKey] -> [PrimaryKey]
addViewPrimaryKeys [SourceColumn]
srcCols = (PrimaryKey -> [PrimaryKey]) -> [PrimaryKey] -> [PrimaryKey]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\PrimaryKey
pk ->
let viewPks :: [PrimaryKey]
viewPks = (\(Column
_, Column
viewCol) -> PrimaryKey :: Table -> Schema -> PrimaryKey
PrimaryKey{pkTable :: Table
pkTable=Column -> Table
colTable Column
viewCol, pkName :: Schema
pkName=Column -> Schema
colName Column
viewCol}) (SourceColumn -> PrimaryKey) -> [SourceColumn] -> [PrimaryKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(SourceColumn -> Bool) -> [SourceColumn] -> [SourceColumn]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Column
col, Column
_) -> Column -> Table
colTable Column
col Table -> Table -> Bool
forall a. Eq a => a -> a -> Bool
== PrimaryKey -> Table
pkTable PrimaryKey
pk Bool -> Bool -> Bool
&& Column -> Schema
colName Column
col Schema -> Schema -> Bool
forall a. Eq a => a -> a -> Bool
== PrimaryKey -> Schema
pkName PrimaryKey
pk) [SourceColumn]
srcCols in
PrimaryKey
pk PrimaryKey -> [PrimaryKey] -> [PrimaryKey]
forall a. a -> [a] -> [a]
: [PrimaryKey]
viewPks)
allTables :: Bool -> H.Statement () [Table]
allTables :: Bool -> Statement () [Table]
allTables =
ByteString
-> Params () -> Result [Table] -> Bool -> Statement () [Table]
forall a b.
ByteString -> Params a -> Result b -> Bool -> Statement a b
H.Statement ByteString
sql Params ()
HE.noParams Result [Table]
decodeTables
where
sql :: ByteString
sql = [q|
SELECT
n.nspname AS table_schema,
c.relname AS table_name,
d.description AS table_description,
(
c.relkind = 'r'
OR (
c.relkind in ('v','f')
AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 8) = 8
-- The function `pg_relation_is_updateable` returns a bitmask where 8
-- corresponds to `1 << CMD_INSERT` in the PostgreSQL source code, i.e.
-- it's possible to insert into the relation.
OR EXISTS (
SELECT 1
FROM pg_trigger
WHERE
pg_trigger.tgrelid = c.oid
AND (pg_trigger.tgtype::integer & 69) = 69
-- The trigger type `tgtype` is a bitmask where 69 corresponds to
-- TRIGGER_TYPE_ROW + TRIGGER_TYPE_INSTEAD + TRIGGER_TYPE_INSERT
-- in the PostgreSQL source code.
)
)
) AS insertable,
(
c.relkind = 'r'
OR (
c.relkind in ('v','f')
AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 4) = 4
-- CMD_UPDATE
OR EXISTS (
SELECT 1
FROM pg_trigger
WHERE
pg_trigger.tgrelid = c.oid
and (pg_trigger.tgtype::integer & 81) = 81
-- TRIGGER_TYPE_ROW + TRIGGER_TYPE_INSTEAD + TRIGGER_TYPE_UPDATE
)
)
) AS updatable,
(
c.relkind = 'r'
OR (
c.relkind in ('v','f')
AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 16) = 16
-- CMD_DELETE
OR EXISTS (
SELECT 1
FROM pg_trigger
WHERE
pg_trigger.tgrelid = c.oid
and (pg_trigger.tgtype::integer & 73) = 73
-- TRIGGER_TYPE_ROW + TRIGGER_TYPE_INSTEAD + TRIGGER_TYPE_DELETE
)
)
) AS deletable
FROM pg_class c
JOIN pg_namespace n ON n.oid = c.relnamespace
LEFT JOIN pg_catalog.pg_description as d on d.objoid = c.oid and d.objsubid = 0
WHERE c.relkind IN ('v','r','m','f')
AND n.nspname NOT IN ('pg_catalog', 'information_schema')
ORDER BY table_schema, table_name |]
allColumns :: [Table] -> Bool -> H.Statement [Schema] [Column]
allColumns :: [Table] -> Bool -> Statement [Schema] [Column]
allColumns [Table]
tabs =
ByteString
-> Params [Schema]
-> Result [Column]
-> Bool
-> Statement [Schema] [Column]
forall a b.
ByteString -> Params a -> Result b -> Bool -> Statement a b
H.Statement ByteString
sql (Value Schema -> Params [Schema]
forall a. Value a -> Params [a]
arrayParam Value Schema
HE.text) ([Table] -> Result [Column]
decodeColumns [Table]
tabs)
where
sql :: ByteString
sql = [q|
SELECT DISTINCT
info.table_schema AS schema,
info.table_name AS table_name,
info.column_name AS name,
info.description AS description,
info.is_nullable::boolean AS nullable,
info.data_type AS col_type,
info.character_maximum_length AS max_len,
info.column_default AS default_value,
array_to_string(enum_info.vals, ',') AS enum,
info.position
FROM (
-- CTE based on pg_catalog to get PRIMARY/FOREIGN key and UNIQUE columns outside api schema
WITH key_columns AS (
SELECT
r.oid AS r_oid,
c.oid AS c_oid,
n.nspname,
c.relname,
r.conname,
r.contype,
unnest(r.conkey) AS conkey
FROM
pg_catalog.pg_constraint r,
pg_catalog.pg_class c,
pg_catalog.pg_namespace n
WHERE
r.contype IN ('f', 'p', 'u')
AND c.relkind IN ('r', 'v', 'f', 'm')
AND r.conrelid = c.oid
AND c.relnamespace = n.oid
AND n.nspname <> ANY (ARRAY['pg_catalog', 'information_schema'] || $1)
),
/*
-- CTE based on information_schema.columns
-- changed:
-- remove the owner filter
-- limit columns to the ones in the api schema or PK/FK columns
*/
columns AS (
SELECT
nc.nspname::name AS table_schema,
c.relname::name AS table_name,
a.attname::name AS column_name,
d.description AS description,
pg_get_expr(ad.adbin, ad.adrelid)::text AS column_default,
not (a.attnotnull OR t.typtype = 'd' AND t.typnotnull) AS is_nullable,
CASE
WHEN t.typtype = 'd' THEN
CASE
WHEN bt.typelem <> 0::oid AND bt.typlen = (-1) THEN 'ARRAY'::text
WHEN nbt.nspname = 'pg_catalog'::name THEN format_type(t.typbasetype, NULL::integer)
ELSE format_type(a.atttypid, a.atttypmod)
END
ELSE
CASE
WHEN t.typelem <> 0::oid AND t.typlen = (-1) THEN 'ARRAY'::text
WHEN nt.nspname = 'pg_catalog'::name THEN format_type(a.atttypid, NULL::integer)
ELSE format_type(a.atttypid, a.atttypmod)
END
END::text AS data_type,
information_schema._pg_char_max_length(
information_schema._pg_truetypid(a.*, t.*),
information_schema._pg_truetypmod(a.*, t.*)
)::integer AS character_maximum_length,
COALESCE(bt.typname, t.typname)::name AS udt_name,
a.attnum::integer AS position
FROM pg_attribute a
LEFT JOIN key_columns kc
ON kc.conkey = a.attnum AND kc.c_oid = a.attrelid
LEFT JOIN pg_catalog.pg_description AS d
ON d.objoid = a.attrelid and d.objsubid = a.attnum
LEFT JOIN pg_attrdef ad
ON a.attrelid = ad.adrelid AND a.attnum = ad.adnum
JOIN (pg_class c JOIN pg_namespace nc ON c.relnamespace = nc.oid)
ON a.attrelid = c.oid
JOIN (pg_type t JOIN pg_namespace nt ON t.typnamespace = nt.oid)
ON a.atttypid = t.oid
LEFT JOIN (pg_type bt JOIN pg_namespace nbt ON bt.typnamespace = nbt.oid)
ON t.typtype = 'd' AND t.typbasetype = bt.oid
LEFT JOIN (pg_collation co JOIN pg_namespace nco ON co.collnamespace = nco.oid)
ON a.attcollation = co.oid AND (nco.nspname <> 'pg_catalog'::name OR co.collname <> 'default'::name)
WHERE
NOT pg_is_other_temp_schema(nc.oid)
AND a.attnum > 0
AND NOT a.attisdropped
AND c.relkind in ('r', 'v', 'f', 'm')
-- Filter only columns that are FK/PK or in the api schema:
AND (nc.nspname = ANY ($1) OR kc.r_oid IS NOT NULL)
)
SELECT
table_schema,
table_name,
column_name,
description,
is_nullable,
data_type,
character_maximum_length,
column_default,
udt_name,
position
FROM columns
WHERE table_schema NOT IN ('pg_catalog', 'information_schema')
) AS info
LEFT OUTER JOIN (
SELECT
n.nspname AS s,
t.typname AS n,
array_agg(e.enumlabel ORDER BY e.enumsortorder) AS vals
FROM pg_type t
JOIN pg_enum e ON t.oid = e.enumtypid
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 |]
columnFromRow :: [Table] ->
(Text, Text, Text,
Maybe Text, Bool, Text,
Maybe Int32, Maybe Text, Maybe Text)
-> Maybe Column
columnFromRow :: [Table]
-> (Schema, Schema, Schema, Maybe Schema, Bool, Schema,
Maybe Int32, Maybe Schema, Maybe Schema)
-> Maybe Column
columnFromRow [Table]
tabs (Schema
s, Schema
t, Schema
n, Maybe Schema
desc, Bool
nul, Schema
typ, Maybe Int32
l, Maybe Schema
d, Maybe Schema
e) = Table -> Column
buildColumn (Table -> Column) -> Maybe Table -> Maybe Column
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Table
table
where
buildColumn :: Table -> Column
buildColumn Table
tbl = Table
-> Schema
-> Maybe Schema
-> Bool
-> Schema
-> Maybe Int32
-> Maybe Schema
-> [Schema]
-> Column
Column Table
tbl Schema
n Maybe Schema
desc Bool
nul Schema
typ Maybe Int32
l Maybe Schema
d (Maybe Schema -> [Schema]
parseEnum Maybe Schema
e)
table :: Maybe Table
table = (Table -> Bool) -> [Table] -> Maybe Table
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Table
tbl -> Table -> Schema
tableSchema Table
tbl Schema -> Schema -> Bool
forall a. Eq a => a -> a -> Bool
== Schema
s Bool -> Bool -> Bool
&& Table -> Schema
tableName Table
tbl Schema -> Schema -> Bool
forall a. Eq a => a -> a -> Bool
== Schema
t) [Table]
tabs
parseEnum :: Maybe Text -> [Text]
parseEnum :: Maybe Schema -> [Schema]
parseEnum = [Schema] -> (Schema -> [Schema]) -> Maybe Schema -> [Schema]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Char -> Bool) -> Schema -> [Schema]
split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
','))
allM2ORels :: [Table] -> [Column] -> Bool -> H.Statement () [Relationship]
allM2ORels :: [Table] -> [Column] -> Bool -> Statement () [Relationship]
allM2ORels [Table]
tabs [Column]
cols =
ByteString
-> Params ()
-> Result [Relationship]
-> Bool
-> Statement () [Relationship]
forall a b.
ByteString -> Params a -> Result b -> Bool -> Statement a b
H.Statement ByteString
sql Params ()
HE.noParams ([Table] -> [Column] -> Result [Relationship]
decodeRels [Table]
tabs [Column]
cols)
where
sql :: ByteString
sql = [q|
SELECT ns1.nspname AS table_schema,
tab.relname AS table_name,
conname AS constraint_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) |]
relFromRow :: [Table] -> [Column] -> (Text, Text, Text, [Text], Text, Text, [Text]) -> Maybe Relationship
relFromRow :: [Table]
-> [Column]
-> (Schema, Schema, Schema, [Schema], Schema, Schema, [Schema])
-> Maybe Relationship
relFromRow [Table]
allTabs [Column]
allCols (Schema
rs, Schema
rt, Schema
cn, [Schema]
rcs, Schema
frs, Schema
frt, [Schema]
frcs) =
Table
-> [Column] -> Table -> [Column] -> Cardinality -> Relationship
Relationship (Table
-> [Column] -> Table -> [Column] -> Cardinality -> Relationship)
-> Maybe Table
-> Maybe
([Column] -> Table -> [Column] -> Cardinality -> Relationship)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Table
table Maybe
([Column] -> Table -> [Column] -> Cardinality -> Relationship)
-> Maybe [Column]
-> Maybe (Table -> [Column] -> Cardinality -> Relationship)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe [Column]
cols Maybe (Table -> [Column] -> Cardinality -> Relationship)
-> Maybe Table -> Maybe ([Column] -> Cardinality -> Relationship)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Table
tableF Maybe ([Column] -> Cardinality -> Relationship)
-> Maybe [Column] -> Maybe (Cardinality -> Relationship)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe [Column]
colsF Maybe (Cardinality -> Relationship)
-> Maybe Cardinality -> Maybe Relationship
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Cardinality -> Maybe Cardinality
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Schema -> Cardinality
M2O Schema
cn)
where
findTable :: Schema -> Schema -> Maybe Table
findTable Schema
s Schema
t = (Table -> Bool) -> [Table] -> Maybe Table
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Table
tbl -> Table -> Schema
tableSchema Table
tbl Schema -> Schema -> Bool
forall a. Eq a => a -> a -> Bool
== Schema
s Bool -> Bool -> Bool
&& Table -> Schema
tableName Table
tbl Schema -> Schema -> Bool
forall a. Eq a => a -> a -> Bool
== Schema
t) [Table]
allTabs
findCol :: Schema -> Schema -> Schema -> Maybe Column
findCol Schema
s Schema
t Schema
c = (Column -> Bool) -> [Column] -> Maybe Column
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Column
col -> Table -> Schema
tableSchema (Column -> Table
colTable Column
col) Schema -> Schema -> Bool
forall a. Eq a => a -> a -> Bool
== Schema
s Bool -> Bool -> Bool
&& Table -> Schema
tableName (Column -> Table
colTable Column
col) Schema -> Schema -> Bool
forall a. Eq a => a -> a -> Bool
== Schema
t Bool -> Bool -> Bool
&& Column -> Schema
colName Column
col Schema -> Schema -> Bool
forall a. Eq a => a -> a -> Bool
== Schema
c) [Column]
allCols
table :: Maybe Table
table = Schema -> Schema -> Maybe Table
findTable Schema
rs Schema
rt
tableF :: Maybe Table
tableF = Schema -> Schema -> Maybe Table
findTable Schema
frs Schema
frt
cols :: Maybe [Column]
cols = (Schema -> Maybe Column) -> [Schema] -> Maybe [Column]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Schema -> Schema -> Schema -> Maybe Column
findCol Schema
rs Schema
rt) [Schema]
rcs
colsF :: Maybe [Column]
colsF = (Schema -> Maybe Column) -> [Schema] -> Maybe [Column]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Schema -> Schema -> Schema -> Maybe Column
findCol Schema
frs Schema
frt) [Schema]
frcs
allPrimaryKeys :: [Table] -> Bool -> H.Statement () [PrimaryKey]
allPrimaryKeys :: [Table] -> Bool -> Statement () [PrimaryKey]
allPrimaryKeys [Table]
tabs =
ByteString
-> Params ()
-> Result [PrimaryKey]
-> Bool
-> Statement () [PrimaryKey]
forall a b.
ByteString -> Params a -> Result b -> Bool -> Statement a b
H.Statement ByteString
sql Params ()
HE.noParams ([Table] -> Result [PrimaryKey]
decodePks [Table]
tabs)
where
sql :: ByteString
sql = [q|
-- CTE to replace information_schema.table_constraints to remove owner limit
WITH tc AS (
SELECT
c.conname::name AS constraint_name,
nr.nspname::name AS table_schema,
r.relname::name AS table_name
FROM pg_namespace nc,
pg_namespace nr,
pg_constraint c,
pg_class r
WHERE
nc.oid = c.connamespace
AND nr.oid = r.relnamespace
AND c.conrelid = r.oid
AND r.relkind = 'r'
AND NOT pg_is_other_temp_schema(nr.oid)
AND c.contype = 'p'
),
-- CTE to replace information_schema.key_column_usage to remove owner limit
kc AS (
SELECT
ss.conname::name AS constraint_name,
ss.nr_nspname::name AS table_schema,
ss.relname::name AS table_name,
a.attname::name AS column_name,
(ss.x).n::integer AS ordinal_position,
CASE
WHEN ss.contype = 'f' THEN information_schema._pg_index_position(ss.conindid, ss.confkey[(ss.x).n])
ELSE NULL::integer
END::integer AS position_in_unique_constraint
FROM pg_attribute a,
( SELECT r.oid AS roid,
r.relname,
r.relowner,
nc.nspname AS nc_nspname,
nr.nspname AS nr_nspname,
c.oid AS coid,
c.conname,
c.contype,
c.conindid,
c.confkey,
information_schema._pg_expandarray(c.conkey) AS x
FROM pg_namespace nr,
pg_class r,
pg_namespace nc,
pg_constraint c
WHERE
nr.oid = r.relnamespace
AND r.oid = c.conrelid
AND nc.oid = c.connamespace
AND c.contype in ('p', 'u', 'f')
AND r.relkind = 'r'
AND NOT pg_is_other_temp_schema(nr.oid)
) ss
WHERE
ss.roid = a.attrelid
AND a.attnum = (ss.x).x
AND NOT a.attisdropped
)
SELECT
kc.table_schema,
kc.table_name,
kc.column_name
FROM
tc, kc
WHERE
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') |]
pkFromRow :: [Table] -> (Schema, Text, Text) -> Maybe PrimaryKey
pkFromRow :: [Table] -> (Schema, Schema, Schema) -> Maybe PrimaryKey
pkFromRow [Table]
tabs (Schema
s, Schema
t, Schema
n) = Table -> Schema -> PrimaryKey
PrimaryKey (Table -> Schema -> PrimaryKey)
-> Maybe Table -> Maybe (Schema -> PrimaryKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Table
table Maybe (Schema -> PrimaryKey) -> Maybe Schema -> Maybe PrimaryKey
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Schema -> Maybe Schema
forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema
n
where table :: Maybe Table
table = (Table -> Bool) -> [Table] -> Maybe Table
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Table
tbl -> Table -> Schema
tableSchema Table
tbl Schema -> Schema -> Bool
forall a. Eq a => a -> a -> Bool
== Schema
s Bool -> Bool -> Bool
&& Table -> Schema
tableName Table
tbl Schema -> Schema -> Bool
forall a. Eq a => a -> a -> Bool
== Schema
t) [Table]
tabs
pfkSourceColumns :: [Column] -> Bool -> H.Statement ([Schema], [Schema]) [SourceColumn]
pfkSourceColumns :: [Column] -> Bool -> Statement ([Schema], [Schema]) [SourceColumn]
pfkSourceColumns [Column]
cols =
ByteString
-> Params ([Schema], [Schema])
-> Result [SourceColumn]
-> Bool
-> Statement ([Schema], [Schema]) [SourceColumn]
forall a b.
ByteString -> Params a -> Result b -> Bool -> Statement a b
H.Statement ByteString
sql (Params [Schema] -> Params [Schema] -> Params ([Schema], [Schema])
forall (f :: * -> *) a1 a2.
Divisible f =>
f a1 -> f a2 -> f (a1, a2)
contrazip2 (Value Schema -> Params [Schema]
forall a. Value a -> Params [a]
arrayParam Value Schema
HE.text) (Value Schema -> Params [Schema]
forall a. Value a -> Params [a]
arrayParam Value Schema
HE.text)) ([Column] -> Result [SourceColumn]
decodeSourceColumns [Column]
cols)
where
sql :: ByteString
sql = [q|
with recursive
pks_fks as (
-- pk + fk referencing col
select
conrelid as resorigtbl,
unnest(conkey) as resorigcol
from pg_constraint
where contype IN ('p', 'f')
union
-- fk referenced col
select
confrelid,
unnest(confkey)
from pg_constraint
where contype='f'
),
views as (
select
c.oid as view_id,
n.nspname as view_schema,
c.relname as view_name,
r.ev_action as view_definition
from pg_class c
join pg_namespace n on n.oid = c.relnamespace
join pg_rewrite r on r.ev_class = c.oid
where c.relkind in ('v', 'm') and n.nspname = ANY($1 || $2)
),
transform_json as (
select
view_id, view_schema, view_name,
-- the following formatting is without indentation on purpose
-- to allow simple diffs, with less whitespace noise
replace(
replace(
replace(
replace(
replace(
replace(
replace(
replace(
regexp_replace(
replace(
replace(
replace(
replace(
replace(
replace(
replace(
replace(
replace(
replace(
view_definition::text,
-- This conversion to json is heavily optimized for performance.
-- The general idea is to use as few regexp_replace() calls as possible.
-- Simple replace() is a lot faster, so we jump through some hoops
-- to be able to use regexp_replace() only once.
-- This has been tested against a huge schema with 250+ different views.
-- The unit tests do NOT reflect all possible inputs. Be careful when changing this!
-- -----------------------------------------------
-- pattern | replacement | flags
-- -----------------------------------------------
-- `,` is not part of the pg_node_tree format, but used in the regex.
-- This removes all `,` that might be part of column names.
',' , ''
-- The same applies for `{` and `}`, although those are used a lot in pg_node_tree.
-- We remove the escaped ones, which might be part of column names again.
), '\{' , ''
), '\}' , ''
-- The fields we need are formatted as json manually to protect them from the regex.
), ' :targetList ' , ',"targetList":'
), ' :resno ' , ',"resno":'
), ' :resorigtbl ' , ',"resorigtbl":'
), ' :resorigcol ' , ',"resorigcol":'
-- Make the regex also match the node type, e.g. `{QUERY ...`, to remove it in one pass.
), '{' , '{ :'
-- Protect node lists, which start with `({` or `((` from the greedy regex.
-- The extra `{` is removed again later.
), '((' , '{(('
), '({' , '{({'
-- This regex removes all unused fields to avoid the need to format all of them correctly.
-- This leads to a smaller json result as well.
-- Removal stops at `,` for used fields (see above) and `}` for the end of the current node.
-- Nesting can't be parsed correctly with a regex, so we stop at `{` as well and
-- add an empty key for the followig node.
), ' :[^}{,]+' , ',"":' , 'g'
-- For performance, the regex also added those empty keys when hitting a `,` or `}`.
-- Those are removed next.
), ',"":}' , '}'
), ',"":,' , ','
-- This reverses the "node list protection" from above.
), '{(' , '('
-- Every key above has been added with a `,` so far. The first key in an object doesn't need it.
), '{,' , '{'
-- pg_node_tree has `()` around lists, but JSON uses `[]`
), '(' , '['
), ')' , ']'
-- pg_node_tree has ` ` between list items, but JSON uses `,`
), ' ' , ','
-- `<>` in pg_node_tree is the same as `null` in JSON, but due to very poor performance of json_typeof
-- we need to make this an empty array here to prevent json_array_elements from throwing an error
-- when the targetList is null.
), '<>' , '[]'
)::json as view_definition
from views
),
target_entries as(
select
view_id, view_schema, view_name,
json_array_elements(view_definition->0->'targetList') as entry
from transform_json
),
results as(
select
view_id, view_schema, view_name,
(entry->>'resno')::int as view_column,
(entry->>'resorigtbl')::oid as resorigtbl,
(entry->>'resorigcol')::int as resorigcol
from target_entries
),
recursion as(
select r.*
from results r
where view_schema = ANY ($1)
union all
select
view.view_id,
view.view_schema,
view.view_name,
view.view_column,
tab.resorigtbl,
tab.resorigcol
from recursion view
join results tab on view.resorigtbl=tab.view_id and view.resorigcol=tab.view_column
)
select
sch.nspname as table_schema,
tbl.relname as table_name,
col.attname as table_column_name,
rec.view_schema,
rec.view_name,
vcol.attname as view_column_name
from recursion rec
join pg_class tbl on tbl.oid = rec.resorigtbl
join pg_attribute col on col.attrelid = tbl.oid and col.attnum = rec.resorigcol
join pg_attribute vcol on vcol.attrelid = rec.view_id and vcol.attnum = rec.view_column
join pg_namespace sch on sch.oid = tbl.relnamespace
join pks_fks using (resorigtbl, resorigcol)
order by view_schema, view_name, view_column_name; |]
param :: HE.Value a -> HE.Params a
param :: Value a -> Params a
param = NullableOrNot Value a -> Params a
forall a. NullableOrNot Value a -> Params a
HE.param (NullableOrNot Value a -> Params a)
-> (Value a -> NullableOrNot Value a) -> Value a -> Params a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value a -> NullableOrNot Value a
forall (encoder :: * -> *) a. encoder a -> NullableOrNot encoder a
HE.nonNullable
arrayParam :: HE.Value a -> HE.Params [a]
arrayParam :: Value a -> Params [a]
arrayParam = Value [a] -> Params [a]
forall a. Value a -> Params a
param (Value [a] -> Params [a])
-> (Value a -> Value [a]) -> Value a -> Params [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NullableOrNot Value a -> Value [a]
forall (foldable :: * -> *) element.
Foldable foldable =>
NullableOrNot Value element -> Value (foldable element)
HE.foldableArray (NullableOrNot Value a -> Value [a])
-> (Value a -> NullableOrNot Value a) -> Value a -> Value [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value a -> NullableOrNot Value a
forall (encoder :: * -> *) a. encoder a -> NullableOrNot encoder a
HE.nonNullable
compositeArrayColumn :: HD.Composite a -> HD.Row [a]
compositeArrayColumn :: Composite a -> Row [a]
compositeArrayColumn = Value a -> Row [a]
forall a. Value a -> Row [a]
arrayColumn (Value a -> Row [a])
-> (Composite a -> Value a) -> Composite a -> Row [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Composite a -> Value a
forall a. Composite a -> Value a
HD.composite
compositeField :: HD.Value a -> HD.Composite a
compositeField :: Value a -> Composite a
compositeField = NullableOrNot Value a -> Composite a
forall a. NullableOrNot Value a -> Composite a
HD.field (NullableOrNot Value a -> Composite a)
-> (Value a -> NullableOrNot Value a) -> Value a -> Composite a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value a -> NullableOrNot Value a
forall (decoder :: * -> *) a. decoder a -> NullableOrNot decoder a
HD.nonNullable
column :: HD.Value a -> HD.Row a
column :: Value a -> Row a
column = NullableOrNot Value a -> Row a
forall a. NullableOrNot Value a -> Row a
HD.column (NullableOrNot Value a -> Row a)
-> (Value a -> NullableOrNot Value a) -> Value a -> Row a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value a -> NullableOrNot Value a
forall (decoder :: * -> *) a. decoder a -> NullableOrNot decoder a
HD.nonNullable
nullableColumn :: HD.Value a -> HD.Row (Maybe a)
nullableColumn :: Value a -> Row (Maybe a)
nullableColumn = NullableOrNot Value (Maybe a) -> Row (Maybe a)
forall a. NullableOrNot Value a -> Row a
HD.column (NullableOrNot Value (Maybe a) -> Row (Maybe a))
-> (Value a -> NullableOrNot Value (Maybe a))
-> Value a
-> Row (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value a -> NullableOrNot Value (Maybe a)
forall (decoder :: * -> *) a.
decoder a -> NullableOrNot decoder (Maybe a)
HD.nullable
arrayColumn :: HD.Value a -> HD.Row [a]
arrayColumn :: Value a -> Row [a]
arrayColumn = Value [a] -> Row [a]
forall a. Value a -> Row a
column (Value [a] -> Row [a])
-> (Value a -> Value [a]) -> Value a -> Row [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NullableOrNot Value a -> Value [a]
forall element. NullableOrNot Value element -> Value [element]
HD.listArray (NullableOrNot Value a -> Value [a])
-> (Value a -> NullableOrNot Value a) -> Value a -> Value [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value a -> NullableOrNot Value a
forall (decoder :: * -> *) a. decoder a -> NullableOrNot decoder a
HD.nonNullable