{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedLists #-}

-- | This module provides an API for suggesting relationships so that
--   the console (or client) does not need to construct and submit relationship queries itself.
--
--   This suggests reciprocal object relationships A -> object -> B -> object -> A if there is a unique
--   constraint on the column(s) in A mapping A->B, and if not then a reciprocal array relationship
--   A -> object -> B -> array -> A is suggested.
--
--   All JSON fields to the main exported function `runSuggestRels` are optional and behave as follows:
--
--   * _srsSource: The source to suggest relationships for - Defaults to `defaultSource`
--   * _srsTables: The tables to suggest relationships between - Defaults to all tables
--   * _srsOmitTracked: Only suggest untracked relationships - Defaults to False
--
--   Autodocodec Codecs instances are implemented for these datatypes.
module Hasura.RQL.DDL.Relationship.Suggest
  ( SuggestRels,
    runSuggestRels,
  )
where

import Autodocodec
import Autodocodec.OpenAPI ()
import Control.Lens (preview)
import Data.Aeson qualified as J
import Data.HashMap.Strict qualified as HashMap
import Data.HashMap.Strict.NonEmpty qualified as MapNE
import Data.HashSet qualified as H
import Data.OpenApi (ToSchema (..))
import Data.Tuple (swap)
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.Prelude
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Metadata.Backend
import Hasura.RQL.Types.Relationships.Local (RelInfo (riMapping, riTarget), RelTarget (..))
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.SchemaCache.Build
import Hasura.Table.Cache (ForeignKey, UniqueConstraint, _cName, _fkColumnMapping, _fkConstraint, _fkForeignTable, _ucColumns)

-- | Datatype used by Metadata API to represent Request for Suggested Relationships
data SuggestRels b = SuggestRels
  { forall (b :: BackendType). SuggestRels b -> SourceName
_srsSource :: SourceName,
    forall (b :: BackendType). SuggestRels b -> Maybe [TableName b]
_srsTables :: Maybe [TableName b],
    forall (b :: BackendType). SuggestRels b -> Bool
_srsOmitTracked :: Bool
  }
  deriving ((forall x. SuggestRels b -> Rep (SuggestRels b) x)
-> (forall x. Rep (SuggestRels b) x -> SuggestRels b)
-> Generic (SuggestRels b)
forall x. Rep (SuggestRels b) x -> SuggestRels b
forall x. SuggestRels b -> Rep (SuggestRels b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x. Rep (SuggestRels b) x -> SuggestRels b
forall (b :: BackendType) x. SuggestRels b -> Rep (SuggestRels b) x
$cfrom :: forall (b :: BackendType) x. SuggestRels b -> Rep (SuggestRels b) x
from :: forall x. SuggestRels b -> Rep (SuggestRels b) x
$cto :: forall (b :: BackendType) x. Rep (SuggestRels b) x -> SuggestRels b
to :: forall x. Rep (SuggestRels b) x -> SuggestRels b
Generic)
  deriving (Value -> Parser [SuggestRels b]
Value -> Parser (SuggestRels b)
(Value -> Parser (SuggestRels b))
-> (Value -> Parser [SuggestRels b]) -> FromJSON (SuggestRels b)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
forall (b :: BackendType).
Backend b =>
Value -> Parser [SuggestRels b]
forall (b :: BackendType).
Backend b =>
Value -> Parser (SuggestRels b)
$cparseJSON :: forall (b :: BackendType).
Backend b =>
Value -> Parser (SuggestRels b)
parseJSON :: Value -> Parser (SuggestRels b)
$cparseJSONList :: forall (b :: BackendType).
Backend b =>
Value -> Parser [SuggestRels b]
parseJSONList :: Value -> Parser [SuggestRels b]
J.FromJSON, [SuggestRels b] -> Value
[SuggestRels b] -> Encoding
SuggestRels b -> Value
SuggestRels b -> Encoding
(SuggestRels b -> Value)
-> (SuggestRels b -> Encoding)
-> ([SuggestRels b] -> Value)
-> ([SuggestRels b] -> Encoding)
-> ToJSON (SuggestRels b)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall (b :: BackendType). Backend b => [SuggestRels b] -> Value
forall (b :: BackendType). Backend b => [SuggestRels b] -> Encoding
forall (b :: BackendType). Backend b => SuggestRels b -> Value
forall (b :: BackendType). Backend b => SuggestRels b -> Encoding
$ctoJSON :: forall (b :: BackendType). Backend b => SuggestRels b -> Value
toJSON :: SuggestRels b -> Value
$ctoEncoding :: forall (b :: BackendType). Backend b => SuggestRels b -> Encoding
toEncoding :: SuggestRels b -> Encoding
$ctoJSONList :: forall (b :: BackendType). Backend b => [SuggestRels b] -> Value
toJSONList :: [SuggestRels b] -> Value
$ctoEncodingList :: forall (b :: BackendType). Backend b => [SuggestRels b] -> Encoding
toEncodingList :: [SuggestRels b] -> Encoding
J.ToJSON, Typeable (SuggestRels b)
Typeable (SuggestRels b)
-> (Proxy (SuggestRels b)
    -> Declare (Definitions Schema) NamedSchema)
-> ToSchema (SuggestRels b)
Proxy (SuggestRels b) -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a
-> (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> ToSchema a
forall {b :: BackendType}. Backend b => Typeable (SuggestRels b)
forall (b :: BackendType).
Backend b =>
Proxy (SuggestRels b) -> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: forall (b :: BackendType).
Backend b =>
Proxy (SuggestRels b) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy (SuggestRels b) -> Declare (Definitions Schema) NamedSchema
ToSchema) via Autodocodec (SuggestRels b)

instance (Backend b) => HasCodec (SuggestRels b) where
  codec :: JSONCodec (SuggestRels b)
codec =
    Text
-> ObjectCodec (SuggestRels b) (SuggestRels b)
-> JSONCodec (SuggestRels b)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object
      Text
"SuggestRels"
      ( SourceName -> Maybe [TableName b] -> Bool -> SuggestRels b
forall (b :: BackendType).
SourceName -> Maybe [TableName b] -> Bool -> SuggestRels b
SuggestRels
          (SourceName -> Maybe [TableName b] -> Bool -> SuggestRels b)
-> Codec Object (SuggestRels b) SourceName
-> Codec
     Object
     (SuggestRels b)
     (Maybe [TableName b] -> Bool -> SuggestRels b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> SourceName -> Text -> ObjectCodec SourceName SourceName
forall output.
(Eq output, HasCodec output) =>
Text -> output -> Text -> ObjectCodec output output
optionalFieldWithOmittedDefault Text
"source" SourceName
defaultSource Text
"The source to suggest relationships for - Defaults to 'default'."
          ObjectCodec SourceName SourceName
-> (SuggestRels b -> SourceName)
-> Codec Object (SuggestRels b) SourceName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= SuggestRels b -> SourceName
forall (b :: BackendType). SuggestRels b -> SourceName
_srsSource
            Codec
  Object
  (SuggestRels b)
  (Maybe [TableName b] -> Bool -> SuggestRels b)
-> Codec Object (SuggestRels b) (Maybe [TableName b])
-> Codec Object (SuggestRels b) (Bool -> SuggestRels b)
forall a b.
Codec Object (SuggestRels b) (a -> b)
-> Codec Object (SuggestRels b) a -> Codec Object (SuggestRels b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Text -> ObjectCodec (Maybe [TableName b]) (Maybe [TableName b])
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalFieldOrNull Text
"tables" Text
"The list of tables to suggest relationships for - Defaults to all tracked tables."
          ObjectCodec (Maybe [TableName b]) (Maybe [TableName b])
-> (SuggestRels b -> Maybe [TableName b])
-> Codec Object (SuggestRels b) (Maybe [TableName b])
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= SuggestRels b -> Maybe [TableName b]
forall (b :: BackendType). SuggestRels b -> Maybe [TableName b]
_srsTables
            Codec Object (SuggestRels b) (Bool -> SuggestRels b)
-> Codec Object (SuggestRels b) Bool
-> ObjectCodec (SuggestRels b) (SuggestRels b)
forall a b.
Codec Object (SuggestRels b) (a -> b)
-> Codec Object (SuggestRels b) a -> Codec Object (SuggestRels b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Bool -> Text -> ObjectCodec Bool Bool
forall output.
(Eq output, HasCodec output) =>
Text -> output -> Text -> ObjectCodec output output
optionalFieldWithOmittedDefault Text
"omit_tracked" Bool
False Text
"Determines if currently tracked relationships should be ommited from suggestions - Defaults to false."
          ObjectCodec Bool Bool
-> (SuggestRels b -> Bool) -> Codec Object (SuggestRels b) Bool
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= SuggestRels b -> Bool
forall (b :: BackendType). SuggestRels b -> Bool
_srsOmitTracked
      )
      JSONCodec (SuggestRels b) -> [Text] -> JSONCodec (SuggestRels b)
forall input output.
ValueCodec input output -> [Text] -> ValueCodec input output
<??> [Text
Item [Text]
"API call to request suggestions for relationships"]

newtype SuggestedRelationships b = Relationships
  { forall (b :: BackendType).
SuggestedRelationships b -> [Relationship b]
sRelationships :: [Relationship b]
  }
  deriving ((forall x.
 SuggestedRelationships b -> Rep (SuggestedRelationships b) x)
-> (forall x.
    Rep (SuggestedRelationships b) x -> SuggestedRelationships b)
-> Generic (SuggestedRelationships b)
forall x.
Rep (SuggestedRelationships b) x -> SuggestedRelationships b
forall x.
SuggestedRelationships b -> Rep (SuggestedRelationships b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (SuggestedRelationships b) x -> SuggestedRelationships b
forall (b :: BackendType) x.
SuggestedRelationships b -> Rep (SuggestedRelationships b) x
$cfrom :: forall (b :: BackendType) x.
SuggestedRelationships b -> Rep (SuggestedRelationships b) x
from :: forall x.
SuggestedRelationships b -> Rep (SuggestedRelationships b) x
$cto :: forall (b :: BackendType) x.
Rep (SuggestedRelationships b) x -> SuggestedRelationships b
to :: forall x.
Rep (SuggestedRelationships b) x -> SuggestedRelationships b
Generic)
  deriving (Value -> Parser [SuggestedRelationships b]
Value -> Parser (SuggestedRelationships b)
(Value -> Parser (SuggestedRelationships b))
-> (Value -> Parser [SuggestedRelationships b])
-> FromJSON (SuggestedRelationships b)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
forall (b :: BackendType).
Backend b =>
Value -> Parser [SuggestedRelationships b]
forall (b :: BackendType).
Backend b =>
Value -> Parser (SuggestedRelationships b)
$cparseJSON :: forall (b :: BackendType).
Backend b =>
Value -> Parser (SuggestedRelationships b)
parseJSON :: Value -> Parser (SuggestedRelationships b)
$cparseJSONList :: forall (b :: BackendType).
Backend b =>
Value -> Parser [SuggestedRelationships b]
parseJSONList :: Value -> Parser [SuggestedRelationships b]
J.FromJSON, [SuggestedRelationships b] -> Value
[SuggestedRelationships b] -> Encoding
SuggestedRelationships b -> Value
SuggestedRelationships b -> Encoding
(SuggestedRelationships b -> Value)
-> (SuggestedRelationships b -> Encoding)
-> ([SuggestedRelationships b] -> Value)
-> ([SuggestedRelationships b] -> Encoding)
-> ToJSON (SuggestedRelationships b)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall (b :: BackendType).
Backend b =>
[SuggestedRelationships b] -> Value
forall (b :: BackendType).
Backend b =>
[SuggestedRelationships b] -> Encoding
forall (b :: BackendType).
Backend b =>
SuggestedRelationships b -> Value
forall (b :: BackendType).
Backend b =>
SuggestedRelationships b -> Encoding
$ctoJSON :: forall (b :: BackendType).
Backend b =>
SuggestedRelationships b -> Value
toJSON :: SuggestedRelationships b -> Value
$ctoEncoding :: forall (b :: BackendType).
Backend b =>
SuggestedRelationships b -> Encoding
toEncoding :: SuggestedRelationships b -> Encoding
$ctoJSONList :: forall (b :: BackendType).
Backend b =>
[SuggestedRelationships b] -> Value
toJSONList :: [SuggestedRelationships b] -> Value
$ctoEncodingList :: forall (b :: BackendType).
Backend b =>
[SuggestedRelationships b] -> Encoding
toEncodingList :: [SuggestedRelationships b] -> Encoding
J.ToJSON, Typeable (SuggestedRelationships b)
Typeable (SuggestedRelationships b)
-> (Proxy (SuggestedRelationships b)
    -> Declare (Definitions Schema) NamedSchema)
-> ToSchema (SuggestedRelationships b)
Proxy (SuggestedRelationships b)
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a
-> (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> ToSchema a
forall {b :: BackendType}.
Backend b =>
Typeable (SuggestedRelationships b)
forall (b :: BackendType).
Backend b =>
Proxy (SuggestedRelationships b)
-> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: forall (b :: BackendType).
Backend b =>
Proxy (SuggestedRelationships b)
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy (SuggestedRelationships b)
-> Declare (Definitions Schema) NamedSchema
ToSchema) via Autodocodec (SuggestedRelationships b)

instance (Backend b) => HasCodec (SuggestedRelationships b) where
  codec :: JSONCodec (SuggestedRelationships b)
codec =
    Text
-> ObjectCodec
     (SuggestedRelationships b) (SuggestedRelationships b)
-> JSONCodec (SuggestedRelationships b)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object
      Text
"SuggestedRelationships"
      ( [Relationship b] -> SuggestedRelationships b
forall (b :: BackendType).
[Relationship b] -> SuggestedRelationships b
Relationships
          ([Relationship b] -> SuggestedRelationships b)
-> Codec Object (SuggestedRelationships b) [Relationship b]
-> ObjectCodec
     (SuggestedRelationships b) (SuggestedRelationships b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec [Relationship b] [Relationship b]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"relationships"
          ObjectCodec [Relationship b] [Relationship b]
-> (SuggestedRelationships b -> [Relationship b])
-> Codec Object (SuggestedRelationships b) [Relationship b]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= SuggestedRelationships b -> [Relationship b]
forall (b :: BackendType).
SuggestedRelationships b -> [Relationship b]
sRelationships
      )

data Relationship b = Relationship
  { forall (b :: BackendType). Relationship b -> RelType
rType :: RelType,
    forall (b :: BackendType). Relationship b -> Mapping b
rFrom :: Mapping b,
    forall (b :: BackendType). Relationship b -> Mapping b
rTo :: Mapping b
  }
  deriving ((forall x. Relationship b -> Rep (Relationship b) x)
-> (forall x. Rep (Relationship b) x -> Relationship b)
-> Generic (Relationship b)
forall x. Rep (Relationship b) x -> Relationship b
forall x. Relationship b -> Rep (Relationship b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (Relationship b) x -> Relationship b
forall (b :: BackendType) x.
Relationship b -> Rep (Relationship b) x
$cfrom :: forall (b :: BackendType) x.
Relationship b -> Rep (Relationship b) x
from :: forall x. Relationship b -> Rep (Relationship b) x
$cto :: forall (b :: BackendType) x.
Rep (Relationship b) x -> Relationship b
to :: forall x. Rep (Relationship b) x -> Relationship b
Generic)
  deriving (Value -> Parser [Relationship b]
Value -> Parser (Relationship b)
(Value -> Parser (Relationship b))
-> (Value -> Parser [Relationship b]) -> FromJSON (Relationship b)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
forall (b :: BackendType).
Backend b =>
Value -> Parser [Relationship b]
forall (b :: BackendType).
Backend b =>
Value -> Parser (Relationship b)
$cparseJSON :: forall (b :: BackendType).
Backend b =>
Value -> Parser (Relationship b)
parseJSON :: Value -> Parser (Relationship b)
$cparseJSONList :: forall (b :: BackendType).
Backend b =>
Value -> Parser [Relationship b]
parseJSONList :: Value -> Parser [Relationship b]
J.FromJSON, [Relationship b] -> Value
[Relationship b] -> Encoding
Relationship b -> Value
Relationship b -> Encoding
(Relationship b -> Value)
-> (Relationship b -> Encoding)
-> ([Relationship b] -> Value)
-> ([Relationship b] -> Encoding)
-> ToJSON (Relationship b)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall (b :: BackendType). Backend b => [Relationship b] -> Value
forall (b :: BackendType).
Backend b =>
[Relationship b] -> Encoding
forall (b :: BackendType). Backend b => Relationship b -> Value
forall (b :: BackendType). Backend b => Relationship b -> Encoding
$ctoJSON :: forall (b :: BackendType). Backend b => Relationship b -> Value
toJSON :: Relationship b -> Value
$ctoEncoding :: forall (b :: BackendType). Backend b => Relationship b -> Encoding
toEncoding :: Relationship b -> Encoding
$ctoJSONList :: forall (b :: BackendType). Backend b => [Relationship b] -> Value
toJSONList :: [Relationship b] -> Value
$ctoEncodingList :: forall (b :: BackendType).
Backend b =>
[Relationship b] -> Encoding
toEncodingList :: [Relationship b] -> Encoding
J.ToJSON, Typeable (Relationship b)
Typeable (Relationship b)
-> (Proxy (Relationship b)
    -> Declare (Definitions Schema) NamedSchema)
-> ToSchema (Relationship b)
Proxy (Relationship b) -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a
-> (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> ToSchema a
forall {b :: BackendType}. Backend b => Typeable (Relationship b)
forall (b :: BackendType).
Backend b =>
Proxy (Relationship b) -> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: forall (b :: BackendType).
Backend b =>
Proxy (Relationship b) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy (Relationship b) -> Declare (Definitions Schema) NamedSchema
ToSchema) via Autodocodec (Relationship b)

instance (Backend b) => HasCodec (Relationship b) where
  codec :: JSONCodec (Relationship b)
codec =
    Text
-> ObjectCodec (Relationship b) (Relationship b)
-> JSONCodec (Relationship b)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object
      Text
"Relationship"
      ( RelType -> Mapping b -> Mapping b -> Relationship b
forall (b :: BackendType).
RelType -> Mapping b -> Mapping b -> Relationship b
Relationship
          (RelType -> Mapping b -> Mapping b -> Relationship b)
-> Codec Object (Relationship b) RelType
-> Codec
     Object (Relationship b) (Mapping b -> Mapping b -> Relationship b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec RelType RelType
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"type"
          ObjectCodec RelType RelType
-> (Relationship b -> RelType)
-> Codec Object (Relationship b) RelType
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Relationship b -> RelType
forall (b :: BackendType). Relationship b -> RelType
rType
            Codec
  Object (Relationship b) (Mapping b -> Mapping b -> Relationship b)
-> Codec Object (Relationship b) (Mapping b)
-> Codec Object (Relationship b) (Mapping b -> Relationship b)
forall a b.
Codec Object (Relationship b) (a -> b)
-> Codec Object (Relationship b) a
-> Codec Object (Relationship b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec (Mapping b) (Mapping b)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"from"
          ObjectCodec (Mapping b) (Mapping b)
-> (Relationship b -> Mapping b)
-> Codec Object (Relationship b) (Mapping b)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Relationship b -> Mapping b
forall (b :: BackendType). Relationship b -> Mapping b
rFrom
            Codec Object (Relationship b) (Mapping b -> Relationship b)
-> Codec Object (Relationship b) (Mapping b)
-> ObjectCodec (Relationship b) (Relationship b)
forall a b.
Codec Object (Relationship b) (a -> b)
-> Codec Object (Relationship b) a
-> Codec Object (Relationship b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec (Mapping b) (Mapping b)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"to"
          ObjectCodec (Mapping b) (Mapping b)
-> (Relationship b -> Mapping b)
-> Codec Object (Relationship b) (Mapping b)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Relationship b -> Mapping b
forall (b :: BackendType). Relationship b -> Mapping b
rTo
      )

data Mapping b = Mapping
  { forall (b :: BackendType). Mapping b -> TableName b
mTable :: TableName b,
    forall (b :: BackendType). Mapping b -> [Column b]
mColumns :: [Column b],
    forall (b :: BackendType). Mapping b -> Maybe Value
mConstraintName :: Maybe J.Value
  }
  deriving ((forall x. Mapping b -> Rep (Mapping b) x)
-> (forall x. Rep (Mapping b) x -> Mapping b)
-> Generic (Mapping b)
forall x. Rep (Mapping b) x -> Mapping b
forall x. Mapping b -> Rep (Mapping b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x. Rep (Mapping b) x -> Mapping b
forall (b :: BackendType) x. Mapping b -> Rep (Mapping b) x
$cfrom :: forall (b :: BackendType) x. Mapping b -> Rep (Mapping b) x
from :: forall x. Mapping b -> Rep (Mapping b) x
$cto :: forall (b :: BackendType) x. Rep (Mapping b) x -> Mapping b
to :: forall x. Rep (Mapping b) x -> Mapping b
Generic)
  deriving (Value -> Parser [Mapping b]
Value -> Parser (Mapping b)
(Value -> Parser (Mapping b))
-> (Value -> Parser [Mapping b]) -> FromJSON (Mapping b)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
forall (b :: BackendType). Backend b => Value -> Parser [Mapping b]
forall (b :: BackendType). Backend b => Value -> Parser (Mapping b)
$cparseJSON :: forall (b :: BackendType). Backend b => Value -> Parser (Mapping b)
parseJSON :: Value -> Parser (Mapping b)
$cparseJSONList :: forall (b :: BackendType). Backend b => Value -> Parser [Mapping b]
parseJSONList :: Value -> Parser [Mapping b]
J.FromJSON, [Mapping b] -> Value
[Mapping b] -> Encoding
Mapping b -> Value
Mapping b -> Encoding
(Mapping b -> Value)
-> (Mapping b -> Encoding)
-> ([Mapping b] -> Value)
-> ([Mapping b] -> Encoding)
-> ToJSON (Mapping b)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall (b :: BackendType). Backend b => [Mapping b] -> Value
forall (b :: BackendType). Backend b => [Mapping b] -> Encoding
forall (b :: BackendType). Backend b => Mapping b -> Value
forall (b :: BackendType). Backend b => Mapping b -> Encoding
$ctoJSON :: forall (b :: BackendType). Backend b => Mapping b -> Value
toJSON :: Mapping b -> Value
$ctoEncoding :: forall (b :: BackendType). Backend b => Mapping b -> Encoding
toEncoding :: Mapping b -> Encoding
$ctoJSONList :: forall (b :: BackendType). Backend b => [Mapping b] -> Value
toJSONList :: [Mapping b] -> Value
$ctoEncodingList :: forall (b :: BackendType). Backend b => [Mapping b] -> Encoding
toEncodingList :: [Mapping b] -> Encoding
J.ToJSON, Typeable (Mapping b)
Typeable (Mapping b)
-> (Proxy (Mapping b) -> Declare (Definitions Schema) NamedSchema)
-> ToSchema (Mapping b)
Proxy (Mapping b) -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a
-> (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> ToSchema a
forall {b :: BackendType}. Backend b => Typeable (Mapping b)
forall (b :: BackendType).
Backend b =>
Proxy (Mapping b) -> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: forall (b :: BackendType).
Backend b =>
Proxy (Mapping b) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy (Mapping b) -> Declare (Definitions Schema) NamedSchema
ToSchema) via Autodocodec (Mapping b)

instance (Backend b) => HasCodec (Mapping b) where
  codec :: JSONCodec (Mapping b)
codec =
    Text
-> ObjectCodec (Mapping b) (Mapping b) -> JSONCodec (Mapping b)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object
      Text
"Mapping"
      ( TableName b -> [Column b] -> Maybe Value -> Mapping b
forall (b :: BackendType).
TableName b -> [Column b] -> Maybe Value -> Mapping b
Mapping
          (TableName b -> [Column b] -> Maybe Value -> Mapping b)
-> Codec Object (Mapping b) (TableName b)
-> Codec
     Object (Mapping b) ([Column b] -> Maybe Value -> Mapping b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec (TableName b) (TableName b)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"table"
          ObjectCodec (TableName b) (TableName b)
-> (Mapping b -> TableName b)
-> Codec Object (Mapping b) (TableName b)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Mapping b -> TableName b
forall (b :: BackendType). Mapping b -> TableName b
mTable
            Codec Object (Mapping b) ([Column b] -> Maybe Value -> Mapping b)
-> Codec Object (Mapping b) [Column b]
-> Codec Object (Mapping b) (Maybe Value -> Mapping b)
forall a b.
Codec Object (Mapping b) (a -> b)
-> Codec Object (Mapping b) a -> Codec Object (Mapping b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec [Column b] [Column b]
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"columns"
          ObjectCodec [Column b] [Column b]
-> (Mapping b -> [Column b]) -> Codec Object (Mapping b) [Column b]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Mapping b -> [Column b]
forall (b :: BackendType). Mapping b -> [Column b]
mColumns
            Codec Object (Mapping b) (Maybe Value -> Mapping b)
-> Codec Object (Mapping b) (Maybe Value)
-> ObjectCodec (Mapping b) (Mapping b)
forall a b.
Codec Object (Mapping b) (a -> b)
-> Codec Object (Mapping b) a -> Codec Object (Mapping b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec (Maybe Value) (Maybe Value)
forall output.
HasCodec output =>
Text -> ObjectCodec (Maybe output) (Maybe output)
optionalFieldOrNull' Text
"constraint_name"
          ObjectCodec (Maybe Value) (Maybe Value)
-> (Mapping b -> Maybe Value)
-> Codec Object (Mapping b) (Maybe Value)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Mapping b -> Maybe Value
forall (b :: BackendType). Mapping b -> Maybe Value
mConstraintName
      )

--  | Most of the heavy lifting for this module occurs in this function.
--    Suggests reciprocal relationships for foreign keys.
--    Incorporates logic to omit previously-tracked relationships
--    and only considers required tables.
suggestRelsFK ::
  forall b.
  (Backend b) =>
  -- | Omits currently tracked relationships from recommendations if True.
  Bool ->
  HashMap (TableName b) (TableCoreInfo b) ->
  TableName b ->
  HashSet (UniqueConstraint b) ->
  H.HashSet (TableName b, HashMap (Column b) (Column b)) ->
  (TableName b -> Bool) ->
  ForeignKey b ->
  [Relationship b]
suggestRelsFK :: forall (b :: BackendType).
Backend b =>
Bool
-> HashMap (TableName b) (TableCoreInfo b)
-> TableName b
-> HashSet (UniqueConstraint b)
-> HashSet (TableName b, HashMap (Column b) (Column b))
-> (TableName b -> Bool)
-> ForeignKey b
-> [Relationship b]
suggestRelsFK Bool
omitTracked HashMap (TableName b) (TableCoreInfo b)
tables TableName b
name HashSet (UniqueConstraint b)
uniqueConstraints HashSet (TableName b, HashMap (Column b) (Column b))
tracked TableName b -> Bool
predicate ForeignKey b
foreignKey
  | Bool -> Bool
not (TableName b -> Bool
predicate TableName b
name Bool -> Bool -> Bool
|| TableName b -> Bool
predicate TableName b
relatedTableName) = [] -- Neither table appears in tables list
  | Maybe (TableCoreInfo b) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (TableCoreInfo b)
relatedTable = [] -- There is no information for the related table
  | Bool
omitTracked = [Maybe (Relationship b)] -> [Relationship b]
forall a. [Maybe a] -> [a]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes [Bool -> Relationship b -> Maybe (Relationship b)
forall {a}. Bool -> a -> Maybe a
discard Bool
toTracked Relationship b
toRelationship, Bool -> Relationship b -> Maybe (Relationship b)
forall {a}. Bool -> a -> Maybe a
discard Bool
fromTracked Relationship b
fromRelationship] -- Discard tracked relationships if that's requested
  | Bool
otherwise = [Item [Relationship b]
Relationship b
toRelationship, Item [Relationship b]
Relationship b
fromRelationship] -- Otherwise, return the reciprocal relationships
  where
    toTracked :: Bool
toTracked = (TableName b, HashMap (Column b) (Column b))
-> HashSet (TableName b, HashMap (Column b) (Column b)) -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
H.member (TableName b
relatedTableName, HashMap (Column b) (Column b)
columnRelationships) HashSet (TableName b, HashMap (Column b) (Column b))
tracked
    fromTracked :: Bool
fromTracked = (TableName b, HashMap (Column b) (Column b))
-> HashSet (TableName b, HashMap (Column b) (Column b)) -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
H.member (TableName b
name, HashMap (Column b) (Column b) -> HashMap (Column b) (Column b)
forall {v}. HashMap v (Column b) -> HashMap (Column b) v
invert HashMap (Column b) (Column b)
columnRelationships) HashSet (TableName b, HashMap (Column b) (Column b))
trackedBack
    toRelationship :: Relationship b
toRelationship =
      Relationship
        { rType :: RelType
rType = RelType
ObjRel,
          rFrom :: Mapping b
rFrom = Mapping {mTable :: TableName b
mTable = TableName b
name, mColumns :: [Column b]
mColumns = [Column b]
localColumns, mConstraintName :: Maybe Value
mConstraintName = Value -> Maybe Value
forall a. a -> Maybe a
Just Value
constraintName},
          rTo :: Mapping b
rTo = Mapping {mTable :: TableName b
mTable = TableName b
relatedTableName, mColumns :: [Column b]
mColumns = [Column b]
relatedColumns, mConstraintName :: Maybe Value
mConstraintName = Maybe Value
forall a. Maybe a
Nothing}
        }
    fromRelationship :: Relationship b
fromRelationship =
      Relationship
        { rType :: RelType
rType = if [Column b] -> HashSet (Column b)
forall a. (Eq a, Hashable a) => [a] -> HashSet a
H.fromList [Column b]
localColumns HashSet (Column b) -> HashSet (HashSet (Column b)) -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`H.member` HashSet (HashSet (Column b))
uniqueConstraintColumns then RelType
ObjRel else RelType
ArrRel,
          rTo :: Mapping b
rTo = Mapping {mTable :: TableName b
mTable = TableName b
name, mColumns :: [Column b]
mColumns = [Column b]
localColumns, mConstraintName :: Maybe Value
mConstraintName = Value -> Maybe Value
forall a. a -> Maybe a
Just Value
constraintName},
          rFrom :: Mapping b
rFrom = Mapping {mTable :: TableName b
mTable = TableName b
relatedTableName, mColumns :: [Column b]
mColumns = [Column b]
relatedColumns, mConstraintName :: Maybe Value
mConstraintName = Maybe Value
forall a. Maybe a
Nothing}
        }
    columnRelationships :: HashMap (Column b) (Column b)
columnRelationships = NEHashMap (Column b) (Column b) -> HashMap (Column b) (Column b)
forall k v. NEHashMap k v -> HashMap k v
MapNE.toHashMap (ForeignKey b -> NEHashMap (Column b) (Column b)
forall (b :: BackendType).
ForeignKey b -> NEHashMap (Column b) (Column b)
_fkColumnMapping ForeignKey b
foreignKey)
    localColumns :: [Column b]
localColumns = HashMap (Column b) (Column b) -> [Column b]
forall k v. HashMap k v -> [k]
HashMap.keys HashMap (Column b) (Column b)
columnRelationships
    relatedColumns :: [Column b]
relatedColumns = HashMap (Column b) (Column b) -> [Column b]
forall k v. HashMap k v -> [v]
HashMap.elems HashMap (Column b) (Column b)
columnRelationships
    uniqueConstraintColumns :: HashSet (HashSet (Column b))
uniqueConstraintColumns = (UniqueConstraint b -> HashSet (Column b))
-> HashSet (UniqueConstraint b) -> HashSet (HashSet (Column b))
forall b a.
(Hashable b, Eq b) =>
(a -> b) -> HashSet a -> HashSet b
H.map UniqueConstraint b -> HashSet (Column b)
forall (b :: BackendType). UniqueConstraint b -> HashSet (Column b)
_ucColumns HashSet (UniqueConstraint b)
uniqueConstraints
    relatedTableName :: TableName b
relatedTableName = ForeignKey b -> TableName b
forall (b :: BackendType). ForeignKey b -> TableName b
_fkForeignTable ForeignKey b
foreignKey
    relatedTable :: Maybe (TableCoreInfo b)
relatedTable = TableName b
-> HashMap (TableName b) (TableCoreInfo b)
-> Maybe (TableCoreInfo b)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup TableName b
relatedTableName HashMap (TableName b) (TableCoreInfo b)
tables
    constraintName :: Value
constraintName = ConstraintName b -> Value
forall a. ToJSON a => a -> Value
J.toJSON (Constraint b -> ConstraintName b
forall (b :: BackendType). Constraint b -> ConstraintName b
_cName (ForeignKey b -> Constraint b
forall (b :: BackendType). ForeignKey b -> Constraint b
_fkConstraint ForeignKey b
foreignKey))
    discard :: Bool -> a -> Maybe a
discard Bool
b a
x = Maybe a -> Maybe a -> Bool -> Maybe a
forall a. a -> a -> Bool -> a
bool Maybe a
forall a. Maybe a
Nothing (a -> Maybe a
forall a. a -> Maybe a
Just a
x) (Bool -> Bool
not Bool
b)
    invert :: HashMap v (Column b) -> HashMap (Column b) v
invert = [(Column b, v)] -> HashMap (Column b) v
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Column b, v)] -> HashMap (Column b) v)
-> (HashMap v (Column b) -> [(Column b, v)])
-> HashMap v (Column b)
-> HashMap (Column b) v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((v, Column b) -> (Column b, v))
-> [(v, Column b)] -> [(Column b, v)]
forall a b. (a -> b) -> [a] -> [b]
map (v, Column b) -> (Column b, v)
forall a b. (a, b) -> (b, a)
swap ([(v, Column b)] -> [(Column b, v)])
-> (HashMap v (Column b) -> [(v, Column b)])
-> HashMap v (Column b)
-> [(Column b, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap v (Column b) -> [(v, Column b)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList
    trackedBack :: HashSet (TableName b, HashMap (Column b) (Column b))
trackedBack =
      [(TableName b, HashMap (Column b) (Column b))]
-> HashSet (TableName b, HashMap (Column b) (Column b))
forall a. (Eq a, Hashable a) => [a] -> HashSet a
H.fromList
        ([(TableName b, HashMap (Column b) (Column b))]
 -> HashSet (TableName b, HashMap (Column b) (Column b)))
-> [(TableName b, HashMap (Column b) (Column b))]
-> HashSet (TableName b, HashMap (Column b) (Column b))
forall a b. (a -> b) -> a -> b
$ (FieldInfo b -> Maybe (TableName b, HashMap (Column b) (Column b)))
-> [FieldInfo b] -> [(TableName b, HashMap (Column b) (Column b))]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe ((RelInfo b -> Maybe (TableName b, HashMap (Column b) (Column b)))
-> FieldInfo b
-> Maybe (TableName b, HashMap (Column b) (Column b))
forall (b1 :: BackendType) b2.
(RelInfo b1 -> Maybe b2) -> FieldInfo b1 -> Maybe b2
relationships (forall (b :: BackendType).
RelInfo b -> Maybe (TableName b, HashMap (Column b) (Column b))
getRelationshipsInputs @b))
        ([FieldInfo b] -> [(TableName b, HashMap (Column b) (Column b))])
-> [FieldInfo b] -> [(TableName b, HashMap (Column b) (Column b))]
forall a b. (a -> b) -> a -> b
$ [FieldInfo b]
-> (TableCoreInfo b -> [FieldInfo b])
-> Maybe (TableCoreInfo b)
-> [FieldInfo b]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (HashMap FieldName (FieldInfo b) -> [FieldInfo b]
forall k v. HashMap k v -> [v]
HashMap.elems (HashMap FieldName (FieldInfo b) -> [FieldInfo b])
-> (TableCoreInfo b -> HashMap FieldName (FieldInfo b))
-> TableCoreInfo b
-> [FieldInfo b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableCoreInfo b -> HashMap FieldName (FieldInfo b)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> FieldInfoMap field
_tciFieldInfoMap) Maybe (TableCoreInfo b)
relatedTable

-- we're only interested in suggesting table-based relationships for now
getRelationshipsInputs ::
  RelInfo b ->
  Maybe (TableName b, HashMap (Column b) (Column b))
getRelationshipsInputs :: forall (b :: BackendType).
RelInfo b -> Maybe (TableName b, HashMap (Column b) (Column b))
getRelationshipsInputs RelInfo b
ri =
  case RelInfo b -> RelTarget b
forall (b :: BackendType). RelInfo b -> RelTarget b
riTarget RelInfo b
ri of
    RelTargetTable TableName b
tn -> (TableName b, HashMap (Column b) (Column b))
-> Maybe (TableName b, HashMap (Column b) (Column b))
forall a. a -> Maybe a
Just (TableName b
tn, RelInfo b -> HashMap (Column b) (Column b)
forall (b :: BackendType).
RelInfo b -> HashMap (Column b) (Column b)
riMapping RelInfo b
ri)
    RelTarget b
_ -> Maybe (TableName b, HashMap (Column b) (Column b))
forall a. Maybe a
Nothing

suggestRelsTable ::
  forall b.
  (Backend b) =>
  Bool ->
  HashMap (TableName b) (TableCoreInfo b) ->
  (TableName b -> Bool) ->
  (TableName b, TableCoreInfo b) ->
  [Relationship b]
suggestRelsTable :: forall (b :: BackendType).
Backend b =>
Bool
-> HashMap (TableName b) (TableCoreInfo b)
-> (TableName b -> Bool)
-> (TableName b, TableCoreInfo b)
-> [Relationship b]
suggestRelsTable Bool
omitTracked HashMap (TableName b) (TableCoreInfo b)
tables TableName b -> Bool
predicate (TableName b
name, TableCoreInfo b
table) =
  Bool
-> HashMap (TableName b) (TableCoreInfo b)
-> TableName b
-> HashSet (UniqueConstraint b)
-> HashSet (TableName b, HashMap (Column b) (Column b))
-> (TableName b -> Bool)
-> ForeignKey b
-> [Relationship b]
forall (b :: BackendType).
Backend b =>
Bool
-> HashMap (TableName b) (TableCoreInfo b)
-> TableName b
-> HashSet (UniqueConstraint b)
-> HashSet (TableName b, HashMap (Column b) (Column b))
-> (TableName b -> Bool)
-> ForeignKey b
-> [Relationship b]
suggestRelsFK Bool
omitTracked HashMap (TableName b) (TableCoreInfo b)
tables TableName b
name HashSet (UniqueConstraint b)
constraints HashSet (TableName b, HashMap (Column b) (Column b))
tracked TableName b -> Bool
predicate (ForeignKey b -> [Relationship b])
-> [ForeignKey b] -> [Relationship b]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HashSet (ForeignKey b) -> [ForeignKey b]
forall a. HashSet a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList HashSet (ForeignKey b)
foreignKeys
  where
    foreignKeys :: HashSet (ForeignKey b)
foreignKeys = TableCoreInfo b -> HashSet (ForeignKey b)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> HashSet (ForeignKey b)
_tciForeignKeys TableCoreInfo b
table
    constraints :: HashSet (UniqueConstraint b)
constraints = TableCoreInfo b -> HashSet (UniqueConstraint b)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn
-> HashSet (UniqueConstraint b)
_tciUniqueConstraints TableCoreInfo b
table
    tracked :: HashSet (TableName b, HashMap (Column b) (Column b))
tracked =
      [(TableName b, HashMap (Column b) (Column b))]
-> HashSet (TableName b, HashMap (Column b) (Column b))
forall a. (Eq a, Hashable a) => [a] -> HashSet a
H.fromList
        ([(TableName b, HashMap (Column b) (Column b))]
 -> HashSet (TableName b, HashMap (Column b) (Column b)))
-> [(TableName b, HashMap (Column b) (Column b))]
-> HashSet (TableName b, HashMap (Column b) (Column b))
forall a b. (a -> b) -> a -> b
$ (FieldInfo b -> Maybe (TableName b, HashMap (Column b) (Column b)))
-> [FieldInfo b] -> [(TableName b, HashMap (Column b) (Column b))]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe ((RelInfo b -> Maybe (TableName b, HashMap (Column b) (Column b)))
-> FieldInfo b
-> Maybe (TableName b, HashMap (Column b) (Column b))
forall (b1 :: BackendType) b2.
(RelInfo b1 -> Maybe b2) -> FieldInfo b1 -> Maybe b2
relationships (forall (b :: BackendType).
RelInfo b -> Maybe (TableName b, HashMap (Column b) (Column b))
getRelationshipsInputs @b))
        ([FieldInfo b] -> [(TableName b, HashMap (Column b) (Column b))])
-> [FieldInfo b] -> [(TableName b, HashMap (Column b) (Column b))]
forall a b. (a -> b) -> a -> b
$ HashMap FieldName (FieldInfo b) -> [FieldInfo b]
forall k v. HashMap k v -> [v]
HashMap.elems
        (HashMap FieldName (FieldInfo b) -> [FieldInfo b])
-> HashMap FieldName (FieldInfo b) -> [FieldInfo b]
forall a b. (a -> b) -> a -> b
$ TableCoreInfo b -> HashMap FieldName (FieldInfo b)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> FieldInfoMap field
_tciFieldInfoMap TableCoreInfo b
table

relationships :: (RelInfo b1 -> Maybe b2) -> FieldInfo b1 -> Maybe b2
relationships :: forall (b1 :: BackendType) b2.
(RelInfo b1 -> Maybe b2) -> FieldInfo b1 -> Maybe b2
relationships RelInfo b1 -> Maybe b2
f = (RelInfo b1 -> Maybe b2) -> Maybe (RelInfo b1) -> Maybe b2
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) RelInfo b1 -> Maybe b2
f (Maybe (RelInfo b1) -> Maybe b2)
-> (FieldInfo b1 -> Maybe (RelInfo b1)) -> FieldInfo b1 -> Maybe b2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First (RelInfo b1)) (FieldInfo b1) (RelInfo b1)
-> FieldInfo b1 -> Maybe (RelInfo b1)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First (RelInfo b1)) (FieldInfo b1) (RelInfo b1)
forall (b :: BackendType) (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (RelInfo b) (f (RelInfo b)) -> p (FieldInfo b) (f (FieldInfo b))
_FIRelationship

-- NOTE: This could be grouped by table instead of a list, console stakeholders are happy with this being a list.
suggestRelsResponse ::
  forall b.
  (Backend b) =>
  Bool ->
  HashMap (TableName b) (TableCoreInfo b) ->
  (TableName b -> Bool) ->
  SuggestedRelationships b
suggestRelsResponse :: forall (b :: BackendType).
Backend b =>
Bool
-> HashMap (TableName b) (TableCoreInfo b)
-> (TableName b -> Bool)
-> SuggestedRelationships b
suggestRelsResponse Bool
omitTracked HashMap (TableName b) (TableCoreInfo b)
tables TableName b -> Bool
predicate =
  [Relationship b] -> SuggestedRelationships b
forall (b :: BackendType).
[Relationship b] -> SuggestedRelationships b
Relationships
    ([Relationship b] -> SuggestedRelationships b)
-> [Relationship b] -> SuggestedRelationships b
forall a b. (a -> b) -> a -> b
$ Bool
-> HashMap (TableName b) (TableCoreInfo b)
-> (TableName b -> Bool)
-> (TableName b, TableCoreInfo b)
-> [Relationship b]
forall (b :: BackendType).
Backend b =>
Bool
-> HashMap (TableName b) (TableCoreInfo b)
-> (TableName b -> Bool)
-> (TableName b, TableCoreInfo b)
-> [Relationship b]
suggestRelsTable Bool
omitTracked HashMap (TableName b) (TableCoreInfo b)
tables TableName b -> Bool
predicate
    ((TableName b, TableCoreInfo b) -> [Relationship b])
-> [(TableName b, TableCoreInfo b)] -> [Relationship b]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HashMap (TableName b) (TableCoreInfo b)
-> [(TableName b, TableCoreInfo b)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap (TableName b) (TableCoreInfo b)
tables

tablePredicate :: (Hashable a) => Maybe [a] -> a -> Bool
tablePredicate :: forall a. Hashable a => Maybe [a] -> a -> Bool
tablePredicate Maybe [a]
Nothing a
_ = Bool
True
tablePredicate (Just [a]
ns) a
n = a
n a -> HashSet a -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`H.member` HashSet a
hash
  where
    hash :: HashSet a
hash = [a] -> HashSet a
forall a. (Eq a, Hashable a) => [a] -> HashSet a
H.fromList [a]
ns

-- | The method invoked when dispatching on metadata calls in POST /v1/metadata
runSuggestRels ::
  forall b m.
  (MonadError QErr m, CacheRWM m, BackendMetadata b) =>
  SuggestRels b ->
  m EncJSON
runSuggestRels :: forall (b :: BackendType) (m :: * -> *).
(MonadError QErr m, CacheRWM m, BackendMetadata b) =>
SuggestRels b -> m EncJSON
runSuggestRels (SuggestRels SourceName
source Maybe [TableName b]
tablesM Bool
omitExistingB) = do
  Maybe (HashMap (TableName b) (TableCoreInfo b))
tableCacheM <- (HashMap (TableName b) (TableInfo b)
 -> HashMap (TableName b) (TableCoreInfo b))
-> Maybe (HashMap (TableName b) (TableInfo b))
-> Maybe (HashMap (TableName b) (TableCoreInfo b))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TableInfo b -> TableCoreInfo b)
-> HashMap (TableName b) (TableInfo b)
-> HashMap (TableName b) (TableCoreInfo b)
forall a b.
(a -> b) -> HashMap (TableName b) a -> HashMap (TableName b) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TableInfo b -> TableCoreInfo b
forall (b :: BackendType). TableInfo b -> TableCoreInfo b
_tiCoreInfo)) (Maybe (HashMap (TableName b) (TableInfo b))
 -> Maybe (HashMap (TableName b) (TableCoreInfo b)))
-> m (Maybe (HashMap (TableName b) (TableInfo b)))
-> m (Maybe (HashMap (TableName b) (TableCoreInfo b)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (b :: BackendType) (m :: * -> *).
(Backend b, CacheRM m) =>
SourceName -> m (Maybe (TableCache b))
askTableCache @b SourceName
source
  case Maybe (HashMap (TableName b) (TableCoreInfo b))
tableCacheM of
    Maybe (HashMap (TableName b) (TableCoreInfo b))
Nothing -> Text -> m EncJSON
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 Text
"Couldn't find any schema source information"
    Just HashMap (TableName b) (TableCoreInfo b)
tableCache -> EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EncJSON -> m EncJSON) -> EncJSON -> m EncJSON
forall a b. (a -> b) -> a -> b
$ SuggestedRelationships b -> EncJSON
forall a. ToJSON a => a -> EncJSON
encJFromJValue (SuggestedRelationships b -> EncJSON)
-> SuggestedRelationships b -> EncJSON
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
Backend b =>
Bool
-> HashMap (TableName b) (TableCoreInfo b)
-> (TableName b -> Bool)
-> SuggestedRelationships b
suggestRelsResponse @b Bool
omitExistingB HashMap (TableName b) (TableCoreInfo b)
tableCache (Maybe [TableName b] -> TableName b -> Bool
forall a. Hashable a => Maybe [a] -> a -> Bool
tablePredicate Maybe [TableName b]
tablesM)