{-# LANGUAGE CPP #-}

{- |
Copyright : Flipstone Technology Partners 2023
License   : MIT
Stability : Stable

@since 1.0.0.0
-}
module Orville.PostgreSQL.PgCatalog.DatabaseDescription
  ( DatabaseDescription (..)
  , RelationDescription (..)
  , ConstraintDescription (..)
  , ForeignRelationDescription (..)
  , IndexDescription (..)
  , IndexMember (..)
  , lookupRelation
  , lookupRelationOfKind
  , lookupAttribute
  , lookupAttributeDefault
  , describeDatabaseRelations
  )
where

#if MIN_VERSION_base(4,18,0)
#else
import Control.Applicative (liftA2)
#endif
import qualified Data.Map.Strict as Map
import qualified Database.PostgreSQL.LibPQ as LibPQ

import qualified Orville.PostgreSQL as Orville
import Orville.PostgreSQL.PgCatalog.OidField (oidField)
import Orville.PostgreSQL.PgCatalog.PgAttribute (AttributeName, AttributeNumber, PgAttribute (pgAttributeName, pgAttributeNumber), attributeIsDroppedField, attributeNumberToInt16, attributeRelationOidField, pgAttributeTable)
import Orville.PostgreSQL.PgCatalog.PgAttributeDefault (PgAttributeDefault (pgAttributeDefaultAttributeNumber), attributeDefaultRelationOidField, pgAttributeDefaultTable)
import Orville.PostgreSQL.PgCatalog.PgClass (PgClass (pgClassNamespaceOid, pgClassOid, pgClassRelationName), RelationKind, RelationName, namespaceOidField, pgClassRelationKind, pgClassTable, relationNameField, relationNameToString)
import Orville.PostgreSQL.PgCatalog.PgConstraint (PgConstraint (pgConstraintForeignKey, pgConstraintForeignRelationOid, pgConstraintKey), constraintRelationOidField, pgConstraintTable)
import Orville.PostgreSQL.PgCatalog.PgIndex (PgIndex (pgIndexAttributeNumbers, pgIndexPgClassOid), indexIsLiveField, indexRelationOidField, pgIndexTable)
import Orville.PostgreSQL.PgCatalog.PgNamespace (NamespaceName, PgNamespace (pgNamespaceOid), namespaceNameField, pgNamespaceTable)
import Orville.PostgreSQL.PgCatalog.PgSequence (PgSequence, pgSequenceTable, sequencePgClassOidField)
import qualified Orville.PostgreSQL.Plan as Plan
import qualified Orville.PostgreSQL.Plan.Many as Many
import qualified Orville.PostgreSQL.Plan.Operation as Op

{- |
  A description of selected items from a single PostgreSQL database.
  'describeDatabaseRelations' can be used to load the descriptions of request
  items.

@since 1.0.0.0
-}
data DatabaseDescription = DatabaseDescription
  { DatabaseDescription
-> Map (NamespaceName, RelationName) RelationDescription
databaseRelations :: Map.Map (NamespaceName, RelationName) RelationDescription
  }

{- |
  Lookup a relation by its qualified name in the @pg_catalog@ schema.

@since 1.0.0.0
-}
lookupRelation ::
  (NamespaceName, RelationName) ->
  DatabaseDescription ->
  Maybe RelationDescription
lookupRelation :: (NamespaceName, RelationName)
-> DatabaseDescription -> Maybe RelationDescription
lookupRelation (NamespaceName, RelationName)
key =
  (NamespaceName, RelationName)
-> Map (NamespaceName, RelationName) RelationDescription
-> Maybe RelationDescription
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (NamespaceName, RelationName)
key (Map (NamespaceName, RelationName) RelationDescription
 -> Maybe RelationDescription)
-> (DatabaseDescription
    -> Map (NamespaceName, RelationName) RelationDescription)
-> DatabaseDescription
-> Maybe RelationDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatabaseDescription
-> Map (NamespaceName, RelationName) RelationDescription
databaseRelations

{- |
  Lookup a relation by its qualified name in the @pg_catalog@ schema. If the
  relation is not of the expected kind, 'Nothing' is returned.

@since 1.0.0.0
-}
lookupRelationOfKind ::
  RelationKind ->
  (NamespaceName, RelationName) ->
  DatabaseDescription ->
  Maybe RelationDescription
lookupRelationOfKind :: RelationKind
-> (NamespaceName, RelationName)
-> DatabaseDescription
-> Maybe RelationDescription
lookupRelationOfKind RelationKind
kind (NamespaceName, RelationName)
key DatabaseDescription
dbDesc =
  case (NamespaceName, RelationName)
-> Map (NamespaceName, RelationName) RelationDescription
-> Maybe RelationDescription
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (NamespaceName, RelationName)
key (DatabaseDescription
-> Map (NamespaceName, RelationName) RelationDescription
databaseRelations DatabaseDescription
dbDesc) of
    Just RelationDescription
relation ->
      if PgClass -> RelationKind
pgClassRelationKind (RelationDescription -> PgClass
relationRecord RelationDescription
relation) RelationKind -> RelationKind -> Bool
forall a. Eq a => a -> a -> Bool
== RelationKind
kind
        then RelationDescription -> Maybe RelationDescription
forall a. a -> Maybe a
Just RelationDescription
relation
        else Maybe RelationDescription
forall a. Maybe a
Nothing
    Maybe RelationDescription
Nothing ->
      Maybe RelationDescription
forall a. Maybe a
Nothing

{- |
  A description of a particular relation in the PostgreSQL database, including
  the attributes of the relation.

@since 1.0.0.0
-}
data RelationDescription = RelationDescription
  { RelationDescription -> PgClass
relationRecord :: PgClass
  , RelationDescription -> Map AttributeName PgAttribute
relationAttributes :: Map.Map AttributeName PgAttribute
  , RelationDescription -> Map AttributeNumber PgAttributeDefault
relationAttributeDefaults :: Map.Map AttributeNumber PgAttributeDefault
  , RelationDescription -> [ConstraintDescription]
relationConstraints :: [ConstraintDescription]
  , RelationDescription -> [IndexDescription]
relationIndexes :: [IndexDescription]
  , RelationDescription -> Maybe PgSequence
relationSequence :: Maybe PgSequence
  }

{- |
  Find an attribute by name from the 'RelationDescription'.

@since 1.0.0.0
-}
lookupAttribute ::
  AttributeName ->
  RelationDescription ->
  Maybe PgAttribute
lookupAttribute :: AttributeName -> RelationDescription -> Maybe PgAttribute
lookupAttribute AttributeName
key =
  AttributeName -> Map AttributeName PgAttribute -> Maybe PgAttribute
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AttributeName
key (Map AttributeName PgAttribute -> Maybe PgAttribute)
-> (RelationDescription -> Map AttributeName PgAttribute)
-> RelationDescription
-> Maybe PgAttribute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelationDescription -> Map AttributeName PgAttribute
relationAttributes

{- |
  Find an attribute default from the 'RelationDescription'.

@since 1.0.0.0
-}
lookupAttributeDefault ::
  PgAttribute ->
  RelationDescription ->
  Maybe PgAttributeDefault
lookupAttributeDefault :: PgAttribute -> RelationDescription -> Maybe PgAttributeDefault
lookupAttributeDefault PgAttribute
attr =
  AttributeNumber
-> Map AttributeNumber PgAttributeDefault
-> Maybe PgAttributeDefault
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (PgAttribute -> AttributeNumber
pgAttributeNumber PgAttribute
attr) (Map AttributeNumber PgAttributeDefault
 -> Maybe PgAttributeDefault)
-> (RelationDescription -> Map AttributeNumber PgAttributeDefault)
-> RelationDescription
-> Maybe PgAttributeDefault
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelationDescription -> Map AttributeNumber PgAttributeDefault
relationAttributeDefaults

{- |
  A description of a particular constraint in the PostgreSQL database, including
  the attributes and relations that it references.

@since 1.0.0.0
-}
data ConstraintDescription = ConstraintDescription
  { ConstraintDescription -> PgConstraint
constraintRecord :: PgConstraint
  , ConstraintDescription -> Maybe [PgAttribute]
constraintKey :: Maybe [PgAttribute]
  , ConstraintDescription -> Maybe ForeignRelationDescription
constraintForeignRelation :: Maybe ForeignRelationDescription
  , ConstraintDescription -> Maybe [PgAttribute]
constraintForeignKey :: Maybe [PgAttribute]
  }

{- |
  A description of a relation in the PostgreSQL database that is referenced by
  a foreign key constraint, including the namespace that the relation belongs to.

@since 1.0.0.0
-}
data ForeignRelationDescription = ForeignRelationDescription
  { ForeignRelationDescription -> PgClass
foreignRelationClass :: PgClass
  , ForeignRelationDescription -> PgNamespace
foreignRelationNamespace :: PgNamespace
  }

{- |
  A description of an index in the PostgreSQL database, including the names of
  the attributes included in the index and the 'PgClass' record of the index
  itself (NOT the 'PgClass' of the table that the index is for).

@since 1.0.0.0
-}
data IndexDescription = IndexDescription
  { IndexDescription -> PgIndex
indexRecord :: PgIndex
  , IndexDescription -> PgClass
indexPgClass :: PgClass
  , IndexDescription -> [IndexMember]
indexMembers :: [IndexMember]
  }

{- |
  A description of an index member in the PostgreSQL database. If the member
  is a simple attribute, the 'PgAttribute' for that is provided. If it is an
  index over an expression, no further description is currently provided.

@since 1.0.0.0
-}
data IndexMember
  = IndexAttribute PgAttribute
  | IndexExpression

{- |
  Describes the requested relations in the current database. If any of the
  relations do not exist, they will not have an entry in the returned
  description.

  Each 'RelationDescription' will contain all the attributes that currently
  exist for that relation, according to the @pg_catalog@ tables.

@since 1.0.0.0
-}
describeDatabaseRelations ::
  Orville.MonadOrville m =>
  [(NamespaceName, RelationName)] ->
  m DatabaseDescription
describeDatabaseRelations :: forall (m :: * -> *).
MonadOrville m =>
[(NamespaceName, RelationName)] -> m DatabaseDescription
describeDatabaseRelations [(NamespaceName, RelationName)]
relations = do
  Many (NamespaceName, RelationName) (Maybe RelationDescription)
manyRelations <-
    Plan
  Execute
  [(NamespaceName, RelationName)]
  (Many (NamespaceName, RelationName) (Maybe RelationDescription))
-> [(NamespaceName, RelationName)]
-> m (Many
        (NamespaceName, RelationName) (Maybe RelationDescription))
forall (m :: * -> *) param result.
MonadOrville m =>
Plan Execute param result -> param -> m result
Plan.execute
      ((forall manyScope.
 Plan
   manyScope
   (NamespaceName, RelationName)
   (Maybe RelationDescription))
-> Plan
     Execute
     [(NamespaceName, RelationName)]
     (Many (NamespaceName, RelationName) (Maybe RelationDescription))
forall param result scope.
(forall manyScope. Plan manyScope param result)
-> Plan scope [param] (Many param result)
Plan.planMany Plan
  manyScope (NamespaceName, RelationName) (Maybe RelationDescription)
forall manyScope.
Plan
  manyScope (NamespaceName, RelationName) (Maybe RelationDescription)
describeRelationByName)
      [(NamespaceName, RelationName)]
relations

  let
    relationsMap :: Map (NamespaceName, RelationName) RelationDescription
relationsMap =
      (Maybe RelationDescription -> Maybe RelationDescription)
-> Map (NamespaceName, RelationName) (Maybe RelationDescription)
-> Map (NamespaceName, RelationName) RelationDescription
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe Maybe RelationDescription -> Maybe RelationDescription
forall a. a -> a
id
        (Map (NamespaceName, RelationName) (Maybe RelationDescription)
 -> Map (NamespaceName, RelationName) RelationDescription)
-> (Many (NamespaceName, RelationName) (Maybe RelationDescription)
    -> Map (NamespaceName, RelationName) (Maybe RelationDescription))
-> Many (NamespaceName, RelationName) (Maybe RelationDescription)
-> Map (NamespaceName, RelationName) RelationDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many (NamespaceName, RelationName) (Maybe RelationDescription)
-> Map (NamespaceName, RelationName) (Maybe RelationDescription)
forall k a. Ord k => Many k a -> Map k a
Many.toMap
        (Many (NamespaceName, RelationName) (Maybe RelationDescription)
 -> Map (NamespaceName, RelationName) RelationDescription)
-> Many (NamespaceName, RelationName) (Maybe RelationDescription)
-> Map (NamespaceName, RelationName) RelationDescription
forall a b. (a -> b) -> a -> b
$ Many (NamespaceName, RelationName) (Maybe RelationDescription)
manyRelations

  DatabaseDescription -> m DatabaseDescription
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DatabaseDescription -> m DatabaseDescription)
-> DatabaseDescription -> m DatabaseDescription
forall a b. (a -> b) -> a -> b
$
    DatabaseDescription
      { databaseRelations :: Map (NamespaceName, RelationName) RelationDescription
databaseRelations = Map (NamespaceName, RelationName) RelationDescription
relationsMap
      }

describeRelationByName :: Plan.Plan scope (NamespaceName, RelationName) (Maybe RelationDescription)
describeRelationByName :: forall manyScope.
Plan
  manyScope (NamespaceName, RelationName) (Maybe RelationDescription)
describeRelationByName =
  Plan scope (NamespaceName, RelationName) NamespaceName
-> (Planned scope (NamespaceName, RelationName) NamespaceName
    -> Plan
         scope (NamespaceName, RelationName) (Maybe RelationDescription))
-> Plan
     scope (NamespaceName, RelationName) (Maybe RelationDescription)
forall scope param a result.
Plan scope param a
-> (Planned scope param a -> Plan scope param result)
-> Plan scope param result
Plan.bind ((NamespaceName, RelationName) -> NamespaceName
forall a b. (a, b) -> a
fst ((NamespaceName, RelationName) -> NamespaceName)
-> Plan
     scope (NamespaceName, RelationName) (NamespaceName, RelationName)
-> Plan scope (NamespaceName, RelationName) NamespaceName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Plan
  scope (NamespaceName, RelationName) (NamespaceName, RelationName)
forall scope param. Plan scope param param
Plan.askParam) ((Planned scope (NamespaceName, RelationName) NamespaceName
  -> Plan
       scope (NamespaceName, RelationName) (Maybe RelationDescription))
 -> Plan
      scope (NamespaceName, RelationName) (Maybe RelationDescription))
-> (Planned scope (NamespaceName, RelationName) NamespaceName
    -> Plan
         scope (NamespaceName, RelationName) (Maybe RelationDescription))
-> Plan
     scope (NamespaceName, RelationName) (Maybe RelationDescription)
forall a b. (a -> b) -> a -> b
$ \Planned scope (NamespaceName, RelationName) NamespaceName
namespaceName ->
    Plan scope (NamespaceName, RelationName) RelationName
-> (Planned scope (NamespaceName, RelationName) RelationName
    -> Plan
         scope (NamespaceName, RelationName) (Maybe RelationDescription))
-> Plan
     scope (NamespaceName, RelationName) (Maybe RelationDescription)
forall scope param a result.
Plan scope param a
-> (Planned scope param a -> Plan scope param result)
-> Plan scope param result
Plan.bind ((NamespaceName, RelationName) -> RelationName
forall a b. (a, b) -> b
snd ((NamespaceName, RelationName) -> RelationName)
-> Plan
     scope (NamespaceName, RelationName) (NamespaceName, RelationName)
-> Plan scope (NamespaceName, RelationName) RelationName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Plan
  scope (NamespaceName, RelationName) (NamespaceName, RelationName)
forall scope param. Plan scope param param
Plan.askParam) ((Planned scope (NamespaceName, RelationName) RelationName
  -> Plan
       scope (NamespaceName, RelationName) (Maybe RelationDescription))
 -> Plan
      scope (NamespaceName, RelationName) (Maybe RelationDescription))
-> (Planned scope (NamespaceName, RelationName) RelationName
    -> Plan
         scope (NamespaceName, RelationName) (Maybe RelationDescription))
-> Plan
     scope (NamespaceName, RelationName) (Maybe RelationDescription)
forall a b. (a -> b) -> a -> b
$ \Planned scope (NamespaceName, RelationName) RelationName
relationName ->
      Plan scope (NamespaceName, RelationName) PgNamespace
-> (Planned scope (NamespaceName, RelationName) PgNamespace
    -> Plan
         scope (NamespaceName, RelationName) (Maybe RelationDescription))
-> Plan
     scope (NamespaceName, RelationName) (Maybe RelationDescription)
forall scope param a result.
Plan scope param a
-> (Planned scope param a -> Plan scope param result)
-> Plan scope param result
Plan.bind (Planned scope (NamespaceName, RelationName) NamespaceName
-> Plan scope NamespaceName PgNamespace
-> Plan scope (NamespaceName, RelationName) PgNamespace
forall scope param a b.
Planned scope param a -> Plan scope a b -> Plan scope param b
Plan.using Planned scope (NamespaceName, RelationName) NamespaceName
namespaceName Plan scope NamespaceName PgNamespace
forall scope. Plan scope NamespaceName PgNamespace
findNamespace) ((Planned scope (NamespaceName, RelationName) PgNamespace
  -> Plan
       scope (NamespaceName, RelationName) (Maybe RelationDescription))
 -> Plan
      scope (NamespaceName, RelationName) (Maybe RelationDescription))
-> (Planned scope (NamespaceName, RelationName) PgNamespace
    -> Plan
         scope (NamespaceName, RelationName) (Maybe RelationDescription))
-> Plan
     scope (NamespaceName, RelationName) (Maybe RelationDescription)
forall a b. (a -> b) -> a -> b
$ \Planned scope (NamespaceName, RelationName) PgNamespace
namespace ->
        let
          namespaceAndRelName :: Plan
  scope (NamespaceName, RelationName) (PgNamespace, RelationName)
namespaceAndRelName =
            (,) (PgNamespace -> RelationName -> (PgNamespace, RelationName))
-> Plan scope (NamespaceName, RelationName) PgNamespace
-> Plan
     scope
     (NamespaceName, RelationName)
     (RelationName -> (PgNamespace, RelationName))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Planned scope (NamespaceName, RelationName) PgNamespace
-> Plan scope (NamespaceName, RelationName) PgNamespace
forall scope param a. Planned scope param a -> Plan scope param a
Plan.use Planned scope (NamespaceName, RelationName) PgNamespace
namespace Plan
  scope
  (NamespaceName, RelationName)
  (RelationName -> (PgNamespace, RelationName))
-> Plan scope (NamespaceName, RelationName) RelationName
-> Plan
     scope (NamespaceName, RelationName) (PgNamespace, RelationName)
forall a b.
Plan scope (NamespaceName, RelationName) (a -> b)
-> Plan scope (NamespaceName, RelationName) a
-> Plan scope (NamespaceName, RelationName) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Planned scope (NamespaceName, RelationName) RelationName
-> Plan scope (NamespaceName, RelationName) RelationName
forall scope param a. Planned scope param a -> Plan scope param a
Plan.use Planned scope (NamespaceName, RelationName) RelationName
relationName
        in
          Plan scope (NamespaceName, RelationName) (Maybe PgClass)
-> (Planned scope (NamespaceName, RelationName) (Maybe PgClass)
    -> Plan
         scope (NamespaceName, RelationName) (Maybe RelationDescription))
-> Plan
     scope (NamespaceName, RelationName) (Maybe RelationDescription)
forall scope param a result.
Plan scope param a
-> (Planned scope param a -> Plan scope param result)
-> Plan scope param result
Plan.bind (Plan
  scope (NamespaceName, RelationName) (PgNamespace, RelationName)
-> Plan scope (PgNamespace, RelationName) (Maybe PgClass)
-> Plan scope (NamespaceName, RelationName) (Maybe PgClass)
forall scope a b c.
Plan scope a b -> Plan scope b c -> Plan scope a c
Plan.chain Plan
  scope (NamespaceName, RelationName) (PgNamespace, RelationName)
namespaceAndRelName Plan scope (PgNamespace, RelationName) (Maybe PgClass)
forall scope.
Plan scope (PgNamespace, RelationName) (Maybe PgClass)
findRelation) ((Planned scope (NamespaceName, RelationName) (Maybe PgClass)
  -> Plan
       scope (NamespaceName, RelationName) (Maybe RelationDescription))
 -> Plan
      scope (NamespaceName, RelationName) (Maybe RelationDescription))
-> (Planned scope (NamespaceName, RelationName) (Maybe PgClass)
    -> Plan
         scope (NamespaceName, RelationName) (Maybe RelationDescription))
-> Plan
     scope (NamespaceName, RelationName) (Maybe RelationDescription)
forall a b. (a -> b) -> a -> b
$ \Planned scope (NamespaceName, RelationName) (Maybe PgClass)
maybePgClass ->
            Planned scope (NamespaceName, RelationName) (Maybe PgClass)
-> Plan scope (Maybe PgClass) (Maybe RelationDescription)
-> Plan
     scope (NamespaceName, RelationName) (Maybe RelationDescription)
forall scope param a b.
Planned scope param a -> Plan scope a b -> Plan scope param b
Plan.using Planned scope (NamespaceName, RelationName) (Maybe PgClass)
maybePgClass (Plan scope PgClass RelationDescription
-> Plan scope (Maybe PgClass) (Maybe RelationDescription)
forall scope a b. Plan scope a b -> Plan scope (Maybe a) (Maybe b)
Plan.planMaybe Plan scope PgClass RelationDescription
forall scope. Plan scope PgClass RelationDescription
describeRelationByClass)

describeRelationByClass :: Plan.Plan scope PgClass RelationDescription
describeRelationByClass :: forall scope. Plan scope PgClass RelationDescription
describeRelationByClass =
  Plan scope PgClass PgClass
-> (Planned scope PgClass PgClass
    -> Plan scope PgClass RelationDescription)
-> Plan scope PgClass RelationDescription
forall scope param a result.
Plan scope param a
-> (Planned scope param a -> Plan scope param result)
-> Plan scope param result
Plan.bind Plan scope PgClass PgClass
forall scope param. Plan scope param param
Plan.askParam ((Planned scope PgClass PgClass
  -> Plan scope PgClass RelationDescription)
 -> Plan scope PgClass RelationDescription)
-> (Planned scope PgClass PgClass
    -> Plan scope PgClass RelationDescription)
-> Plan scope PgClass RelationDescription
forall a b. (a -> b) -> a -> b
$ \Planned scope PgClass PgClass
pgClass ->
    Plan scope PgClass [PgAttribute]
-> (Planned scope PgClass [PgAttribute]
    -> Plan scope PgClass RelationDescription)
-> Plan scope PgClass RelationDescription
forall scope param a result.
Plan scope param a
-> (Planned scope param a -> Plan scope param result)
-> Plan scope param result
Plan.bind Plan scope PgClass [PgAttribute]
forall scope. Plan scope PgClass [PgAttribute]
findClassAttributes ((Planned scope PgClass [PgAttribute]
  -> Plan scope PgClass RelationDescription)
 -> Plan scope PgClass RelationDescription)
-> (Planned scope PgClass [PgAttribute]
    -> Plan scope PgClass RelationDescription)
-> Plan scope PgClass RelationDescription
forall a b. (a -> b) -> a -> b
$ \Planned scope PgClass [PgAttribute]
attributes ->
      let
        classAndAttributes :: Plan scope PgClass PgClassAndAttributes
classAndAttributes =
          PgClass -> [PgAttribute] -> PgClassAndAttributes
mkPgClassAndAttributes
            (PgClass -> [PgAttribute] -> PgClassAndAttributes)
-> Plan scope PgClass PgClass
-> Plan scope PgClass ([PgAttribute] -> PgClassAndAttributes)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Planned scope PgClass PgClass -> Plan scope PgClass PgClass
forall scope param a. Planned scope param a -> Plan scope param a
Plan.use Planned scope PgClass PgClass
pgClass
            Plan scope PgClass ([PgAttribute] -> PgClassAndAttributes)
-> Plan scope PgClass [PgAttribute]
-> Plan scope PgClass PgClassAndAttributes
forall a b.
Plan scope PgClass (a -> b)
-> Plan scope PgClass a -> Plan scope PgClass b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Planned scope PgClass [PgAttribute]
-> Plan scope PgClass [PgAttribute]
forall scope param a. Planned scope param a -> Plan scope param a
Plan.use Planned scope PgClass [PgAttribute]
attributes
      in
        PgClass
-> Map AttributeName PgAttribute
-> Map AttributeNumber PgAttributeDefault
-> [ConstraintDescription]
-> [IndexDescription]
-> Maybe PgSequence
-> RelationDescription
RelationDescription
          (PgClass
 -> Map AttributeName PgAttribute
 -> Map AttributeNumber PgAttributeDefault
 -> [ConstraintDescription]
 -> [IndexDescription]
 -> Maybe PgSequence
 -> RelationDescription)
-> Plan scope PgClass PgClass
-> Plan
     scope
     PgClass
     (Map AttributeName PgAttribute
      -> Map AttributeNumber PgAttributeDefault
      -> [ConstraintDescription]
      -> [IndexDescription]
      -> Maybe PgSequence
      -> RelationDescription)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Planned scope PgClass PgClass -> Plan scope PgClass PgClass
forall scope param a. Planned scope param a -> Plan scope param a
Plan.use Planned scope PgClass PgClass
pgClass
          Plan
  scope
  PgClass
  (Map AttributeName PgAttribute
   -> Map AttributeNumber PgAttributeDefault
   -> [ConstraintDescription]
   -> [IndexDescription]
   -> Maybe PgSequence
   -> RelationDescription)
-> Plan scope PgClass (Map AttributeName PgAttribute)
-> Plan
     scope
     PgClass
     (Map AttributeNumber PgAttributeDefault
      -> [ConstraintDescription]
      -> [IndexDescription]
      -> Maybe PgSequence
      -> RelationDescription)
forall a b.
Plan scope PgClass (a -> b)
-> Plan scope PgClass a -> Plan scope PgClass b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Planned scope PgClass (Map AttributeName PgAttribute)
-> Plan scope PgClass (Map AttributeName PgAttribute)
forall scope param a. Planned scope param a -> Plan scope param a
Plan.use (([PgAttribute] -> Map AttributeName PgAttribute)
-> Planned scope PgClass [PgAttribute]
-> Planned scope PgClass (Map AttributeName PgAttribute)
forall a b.
(a -> b) -> Planned scope PgClass a -> Planned scope PgClass b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((PgAttribute -> AttributeName)
-> [PgAttribute] -> Map AttributeName PgAttribute
forall key row. Ord key => (row -> key) -> [row] -> Map key row
indexBy PgAttribute -> AttributeName
pgAttributeName) Planned scope PgClass [PgAttribute]
attributes)
          Plan
  scope
  PgClass
  (Map AttributeNumber PgAttributeDefault
   -> [ConstraintDescription]
   -> [IndexDescription]
   -> Maybe PgSequence
   -> RelationDescription)
-> Plan scope PgClass (Map AttributeNumber PgAttributeDefault)
-> Plan
     scope
     PgClass
     ([ConstraintDescription]
      -> [IndexDescription] -> Maybe PgSequence -> RelationDescription)
forall a b.
Plan scope PgClass (a -> b)
-> Plan scope PgClass a -> Plan scope PgClass b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([PgAttributeDefault] -> Map AttributeNumber PgAttributeDefault)
-> Plan scope PgClass [PgAttributeDefault]
-> Plan scope PgClass (Map AttributeNumber PgAttributeDefault)
forall a b.
(a -> b) -> Plan scope PgClass a -> Plan scope PgClass b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((PgAttributeDefault -> AttributeNumber)
-> [PgAttributeDefault] -> Map AttributeNumber PgAttributeDefault
forall key row. Ord key => (row -> key) -> [row] -> Map key row
indexBy PgAttributeDefault -> AttributeNumber
pgAttributeDefaultAttributeNumber) Plan scope PgClass [PgAttributeDefault]
forall scope. Plan scope PgClass [PgAttributeDefault]
findClassAttributeDefaults
          Plan
  scope
  PgClass
  ([ConstraintDescription]
   -> [IndexDescription] -> Maybe PgSequence -> RelationDescription)
-> Plan scope PgClass [ConstraintDescription]
-> Plan
     scope
     PgClass
     ([IndexDescription] -> Maybe PgSequence -> RelationDescription)
forall a b.
Plan scope PgClass (a -> b)
-> Plan scope PgClass a -> Plan scope PgClass b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Plan scope PgClass PgClassAndAttributes
-> Plan scope PgClassAndAttributes [ConstraintDescription]
-> Plan scope PgClass [ConstraintDescription]
forall scope a b c.
Plan scope a b -> Plan scope b c -> Plan scope a c
Plan.chain Plan scope PgClass PgClassAndAttributes
classAndAttributes Plan scope PgClassAndAttributes [ConstraintDescription]
forall scope.
Plan scope PgClassAndAttributes [ConstraintDescription]
findClassConstraints
          Plan
  scope
  PgClass
  ([IndexDescription] -> Maybe PgSequence -> RelationDescription)
-> Plan scope PgClass [IndexDescription]
-> Plan scope PgClass (Maybe PgSequence -> RelationDescription)
forall a b.
Plan scope PgClass (a -> b)
-> Plan scope PgClass a -> Plan scope PgClass b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Plan scope PgClass PgClassAndAttributes
-> Plan scope PgClassAndAttributes [IndexDescription]
-> Plan scope PgClass [IndexDescription]
forall scope a b c.
Plan scope a b -> Plan scope b c -> Plan scope a c
Plan.chain Plan scope PgClass PgClassAndAttributes
classAndAttributes Plan scope PgClassAndAttributes [IndexDescription]
forall scope. Plan scope PgClassAndAttributes [IndexDescription]
findClassIndexes
          Plan scope PgClass (Maybe PgSequence -> RelationDescription)
-> Plan scope PgClass (Maybe PgSequence)
-> Plan scope PgClass RelationDescription
forall a b.
Plan scope PgClass (a -> b)
-> Plan scope PgClass a -> Plan scope PgClass b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Planned scope PgClass PgClass
-> Plan scope PgClass (Maybe PgSequence)
-> Plan scope PgClass (Maybe PgSequence)
forall scope param a b.
Planned scope param a -> Plan scope a b -> Plan scope param b
Plan.using Planned scope PgClass PgClass
pgClass Plan scope PgClass (Maybe PgSequence)
forall scope. Plan scope PgClass (Maybe PgSequence)
findClassSequence

findRelation :: Plan.Plan scope (PgNamespace, RelationName) (Maybe PgClass)
findRelation :: forall scope.
Plan scope (PgNamespace, RelationName) (Maybe PgClass)
findRelation =
  ((PgNamespace, RelationName) -> (Oid, RelationName))
-> Plan scope (Oid, RelationName) (Maybe PgClass)
-> Plan scope (PgNamespace, RelationName) (Maybe PgClass)
forall a b scope result.
(a -> b) -> Plan scope b result -> Plan scope a result
Plan.focusParam (\(PgNamespace
ns, RelationName
relname) -> (PgNamespace -> Oid
pgNamespaceOid PgNamespace
ns, RelationName
relname)) (Plan scope (Oid, RelationName) (Maybe PgClass)
 -> Plan scope (PgNamespace, RelationName) (Maybe PgClass))
-> Plan scope (Oid, RelationName) (Maybe PgClass)
-> Plan scope (PgNamespace, RelationName) (Maybe PgClass)
forall a b. (a -> b) -> a -> b
$
    Operation (Oid, RelationName) (Maybe PgClass)
-> Plan scope (Oid, RelationName) (Maybe PgClass)
forall param result scope.
Operation param result -> Plan scope param result
Plan.planOperation (Operation (Oid, RelationName) (Maybe PgClass)
 -> Plan scope (Oid, RelationName) (Maybe PgClass))
-> Operation (Oid, RelationName) (Maybe PgClass)
-> Plan scope (Oid, RelationName) (Maybe PgClass)
forall a b. (a -> b) -> a -> b
$
      TableDefinition (HasKey Oid) PgClass PgClass
-> WherePlanner (Oid, RelationName)
-> Operation (Oid, RelationName) (Maybe PgClass)
forall param key writeEntity readEntity.
Ord param =>
TableDefinition key writeEntity readEntity
-> WherePlanner param -> Operation param (Maybe readEntity)
Op.findOne TableDefinition (HasKey Oid) PgClass PgClass
pgClassTable WherePlanner (Oid, RelationName)
byNamespaceOidAndRelationName

byNamespaceOidAndRelationName :: Op.WherePlanner (LibPQ.Oid, RelationName)
byNamespaceOidAndRelationName :: WherePlanner (Oid, RelationName)
byNamespaceOidAndRelationName =
  FieldDefinition NotNull Oid
-> FieldDefinition NotNull RelationName
-> WherePlanner (Oid, RelationName)
forall nullabilityA fieldValueA nullabilityB fieldValueB.
(Ord fieldValueA, Ord fieldValueB) =>
FieldDefinition nullabilityA fieldValueA
-> FieldDefinition nullabilityB fieldValueB
-> WherePlanner (fieldValueA, fieldValueB)
Op.byFieldTuple FieldDefinition NotNull Oid
namespaceOidField FieldDefinition NotNull RelationName
relationNameField

findNamespace :: Plan.Plan scope NamespaceName PgNamespace
findNamespace :: forall scope. Plan scope NamespaceName PgNamespace
findNamespace =
  TableDefinition (HasKey Oid) PgNamespace PgNamespace
-> FieldDefinition NotNull NamespaceName
-> Plan scope NamespaceName PgNamespace
forall fieldValue key writeEntity readEntity nullability scope.
(Show fieldValue, Ord fieldValue) =>
TableDefinition key writeEntity readEntity
-> FieldDefinition nullability fieldValue
-> Plan scope fieldValue readEntity
Plan.findOne TableDefinition (HasKey Oid) PgNamespace PgNamespace
pgNamespaceTable FieldDefinition NotNull NamespaceName
namespaceNameField

findClassAttributes :: Plan.Plan scope PgClass [PgAttribute]
findClassAttributes :: forall scope. Plan scope PgClass [PgAttribute]
findClassAttributes =
  (PgClass -> Oid)
-> Plan scope Oid [PgAttribute] -> Plan scope PgClass [PgAttribute]
forall a b scope result.
(a -> b) -> Plan scope b result -> Plan scope a result
Plan.focusParam PgClass -> Oid
pgClassOid (Plan scope Oid [PgAttribute] -> Plan scope PgClass [PgAttribute])
-> Plan scope Oid [PgAttribute] -> Plan scope PgClass [PgAttribute]
forall a b. (a -> b) -> a -> b
$
    TableDefinition NoKey PgAttribute PgAttribute
-> FieldDefinition NotNull Oid
-> BooleanExpr
-> Plan scope Oid [PgAttribute]
forall fieldValue key writeEntity readEntity nullability scope.
Ord fieldValue =>
TableDefinition key writeEntity readEntity
-> FieldDefinition nullability fieldValue
-> BooleanExpr
-> Plan scope fieldValue [readEntity]
Plan.findAllWhere
      TableDefinition NoKey PgAttribute PgAttribute
pgAttributeTable
      FieldDefinition NotNull Oid
attributeRelationOidField
      (FieldDefinition NotNull Bool -> Bool -> BooleanExpr
forall nullability a.
FieldDefinition nullability a -> a -> BooleanExpr
Orville.fieldEquals FieldDefinition NotNull Bool
attributeIsDroppedField Bool
False)

findClassAttributeDefaults :: Plan.Plan scope PgClass [PgAttributeDefault]
findClassAttributeDefaults :: forall scope. Plan scope PgClass [PgAttributeDefault]
findClassAttributeDefaults =
  (PgClass -> Oid)
-> Plan scope Oid [PgAttributeDefault]
-> Plan scope PgClass [PgAttributeDefault]
forall a b scope result.
(a -> b) -> Plan scope b result -> Plan scope a result
Plan.focusParam PgClass -> Oid
pgClassOid (Plan scope Oid [PgAttributeDefault]
 -> Plan scope PgClass [PgAttributeDefault])
-> Plan scope Oid [PgAttributeDefault]
-> Plan scope PgClass [PgAttributeDefault]
forall a b. (a -> b) -> a -> b
$
    TableDefinition NoKey PgAttributeDefault PgAttributeDefault
-> FieldDefinition NotNull Oid
-> Plan scope Oid [PgAttributeDefault]
forall fieldValue key writeEntity readEntity nullability scope.
Ord fieldValue =>
TableDefinition key writeEntity readEntity
-> FieldDefinition nullability fieldValue
-> Plan scope fieldValue [readEntity]
Plan.findAll
      TableDefinition NoKey PgAttributeDefault PgAttributeDefault
pgAttributeDefaultTable
      FieldDefinition NotNull Oid
attributeDefaultRelationOidField

findClassConstraints :: Plan.Plan scope PgClassAndAttributes [ConstraintDescription]
findClassConstraints :: forall scope.
Plan scope PgClassAndAttributes [ConstraintDescription]
findClassConstraints =
  let
    relationOid :: PgClassAndAttributes -> Oid
relationOid =
      PgClass -> Oid
pgClassOid (PgClass -> Oid)
-> (PgClassAndAttributes -> PgClass) -> PgClassAndAttributes -> Oid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PgClassAndAttributes -> PgClass
pgClassRecord
  in
    Plan scope PgClassAndAttributes [PgConstraint]
-> (Planned scope PgClassAndAttributes [PgConstraint]
    -> Plan scope PgClassAndAttributes [ConstraintDescription])
-> Plan scope PgClassAndAttributes [ConstraintDescription]
forall scope param a result.
Plan scope param a
-> (Planned scope param a -> Plan scope param result)
-> Plan scope param result
Plan.bind ((PgClassAndAttributes -> Oid)
-> Plan scope Oid [PgConstraint]
-> Plan scope PgClassAndAttributes [PgConstraint]
forall a b scope result.
(a -> b) -> Plan scope b result -> Plan scope a result
Plan.focusParam PgClassAndAttributes -> Oid
relationOid (Plan scope Oid [PgConstraint]
 -> Plan scope PgClassAndAttributes [PgConstraint])
-> Plan scope Oid [PgConstraint]
-> Plan scope PgClassAndAttributes [PgConstraint]
forall a b. (a -> b) -> a -> b
$ TableDefinition (HasKey Oid) PgConstraint PgConstraint
-> FieldDefinition NotNull Oid -> Plan scope Oid [PgConstraint]
forall fieldValue key writeEntity readEntity nullability scope.
Ord fieldValue =>
TableDefinition key writeEntity readEntity
-> FieldDefinition nullability fieldValue
-> Plan scope fieldValue [readEntity]
Plan.findAll TableDefinition (HasKey Oid) PgConstraint PgConstraint
pgConstraintTable FieldDefinition NotNull Oid
constraintRelationOidField) ((Planned scope PgClassAndAttributes [PgConstraint]
  -> Plan scope PgClassAndAttributes [ConstraintDescription])
 -> Plan scope PgClassAndAttributes [ConstraintDescription])
-> (Planned scope PgClassAndAttributes [PgConstraint]
    -> Plan scope PgClassAndAttributes [ConstraintDescription])
-> Plan scope PgClassAndAttributes [ConstraintDescription]
forall a b. (a -> b) -> a -> b
$ \Planned scope PgClassAndAttributes [PgConstraint]
constraints ->
      Plan scope PgClassAndAttributes PgClassAndAttributes
-> (Planned scope PgClassAndAttributes PgClassAndAttributes
    -> Plan scope PgClassAndAttributes [ConstraintDescription])
-> Plan scope PgClassAndAttributes [ConstraintDescription]
forall scope param a result.
Plan scope param a
-> (Planned scope param a -> Plan scope param result)
-> Plan scope param result
Plan.bind Plan scope PgClassAndAttributes PgClassAndAttributes
forall scope param. Plan scope param param
Plan.askParam ((Planned scope PgClassAndAttributes PgClassAndAttributes
  -> Plan scope PgClassAndAttributes [ConstraintDescription])
 -> Plan scope PgClassAndAttributes [ConstraintDescription])
-> (Planned scope PgClassAndAttributes PgClassAndAttributes
    -> Plan scope PgClassAndAttributes [ConstraintDescription])
-> Plan scope PgClassAndAttributes [ConstraintDescription]
forall a b. (a -> b) -> a -> b
$ \Planned scope PgClassAndAttributes PgClassAndAttributes
pgClassAndAttrs ->
        Plan
  scope PgClassAndAttributes [(PgClassAndAttributes, PgConstraint)]
-> Plan
     scope
     [(PgClassAndAttributes, PgConstraint)]
     [ConstraintDescription]
-> Plan scope PgClassAndAttributes [ConstraintDescription]
forall scope a b c.
Plan scope a b -> Plan scope b c -> Plan scope a c
Plan.chain
          ([PgClassAndAttributes]
-> [PgConstraint] -> [(PgClassAndAttributes, PgConstraint)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([PgClassAndAttributes]
 -> [PgConstraint] -> [(PgClassAndAttributes, PgConstraint)])
-> Plan scope PgClassAndAttributes [PgClassAndAttributes]
-> Plan
     scope
     PgClassAndAttributes
     ([PgConstraint] -> [(PgClassAndAttributes, PgConstraint)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Planned scope PgClassAndAttributes [PgClassAndAttributes]
-> Plan scope PgClassAndAttributes [PgClassAndAttributes]
forall scope param a. Planned scope param a -> Plan scope param a
Plan.use ((PgClassAndAttributes -> [PgClassAndAttributes])
-> Planned scope PgClassAndAttributes PgClassAndAttributes
-> Planned scope PgClassAndAttributes [PgClassAndAttributes]
forall a b.
(a -> b)
-> Planned scope PgClassAndAttributes a
-> Planned scope PgClassAndAttributes b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PgClassAndAttributes -> [PgClassAndAttributes]
forall a. a -> [a]
repeat Planned scope PgClassAndAttributes PgClassAndAttributes
pgClassAndAttrs) Plan
  scope
  PgClassAndAttributes
  ([PgConstraint] -> [(PgClassAndAttributes, PgConstraint)])
-> Plan scope PgClassAndAttributes [PgConstraint]
-> Plan
     scope PgClassAndAttributes [(PgClassAndAttributes, PgConstraint)]
forall a b.
Plan scope PgClassAndAttributes (a -> b)
-> Plan scope PgClassAndAttributes a
-> Plan scope PgClassAndAttributes b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Planned scope PgClassAndAttributes [PgConstraint]
-> Plan scope PgClassAndAttributes [PgConstraint]
forall scope param a. Planned scope param a -> Plan scope param a
Plan.use Planned scope PgClassAndAttributes [PgConstraint]
constraints)
          ((forall scope.
 Plan
   scope (PgClassAndAttributes, PgConstraint) ConstraintDescription)
-> Plan
     scope
     [(PgClassAndAttributes, PgConstraint)]
     [ConstraintDescription]
forall param result listScope.
(forall scope. Plan scope param result)
-> Plan listScope [param] [result]
Plan.planList Plan
  scope (PgClassAndAttributes, PgConstraint) ConstraintDescription
forall scope.
Plan
  scope (PgClassAndAttributes, PgConstraint) ConstraintDescription
describeConstraint)

describeConstraint :: Plan.Plan scope (PgClassAndAttributes, PgConstraint) ConstraintDescription
describeConstraint :: forall scope.
Plan
  scope (PgClassAndAttributes, PgConstraint) ConstraintDescription
describeConstraint =
  let
    prepareAttributeLookups :: (PgClassAndAttributes, PgConstraint) -> Maybe [(PgClassAndAttributes, AttributeNumber)]
    prepareAttributeLookups :: (PgClassAndAttributes, PgConstraint)
-> Maybe [(PgClassAndAttributes, AttributeNumber)]
prepareAttributeLookups (PgClassAndAttributes
pgClassAndAttrs, PgConstraint
pgConstraint) =
      case PgConstraint -> Maybe [AttributeNumber]
pgConstraintKey PgConstraint
pgConstraint of
        Maybe [AttributeNumber]
Nothing -> Maybe [(PgClassAndAttributes, AttributeNumber)]
forall a. Maybe a
Nothing
        Just [AttributeNumber]
key -> [(PgClassAndAttributes, AttributeNumber)]
-> Maybe [(PgClassAndAttributes, AttributeNumber)]
forall a. a -> Maybe a
Just ((AttributeNumber -> (PgClassAndAttributes, AttributeNumber))
-> [AttributeNumber] -> [(PgClassAndAttributes, AttributeNumber)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\AttributeNumber
attNum -> (PgClassAndAttributes
pgClassAndAttrs, AttributeNumber
attNum)) [AttributeNumber]
key)
  in
    Plan scope (PgClassAndAttributes, PgConstraint) PgConstraint
-> (Planned scope (PgClassAndAttributes, PgConstraint) PgConstraint
    -> Plan
         scope (PgClassAndAttributes, PgConstraint) ConstraintDescription)
-> Plan
     scope (PgClassAndAttributes, PgConstraint) ConstraintDescription
forall scope param a result.
Plan scope param a
-> (Planned scope param a -> Plan scope param result)
-> Plan scope param result
Plan.bind ((PgClassAndAttributes, PgConstraint) -> PgConstraint
forall a b. (a, b) -> b
snd ((PgClassAndAttributes, PgConstraint) -> PgConstraint)
-> Plan
     scope
     (PgClassAndAttributes, PgConstraint)
     (PgClassAndAttributes, PgConstraint)
-> Plan scope (PgClassAndAttributes, PgConstraint) PgConstraint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Plan
  scope
  (PgClassAndAttributes, PgConstraint)
  (PgClassAndAttributes, PgConstraint)
forall scope param. Plan scope param param
Plan.askParam) ((Planned scope (PgClassAndAttributes, PgConstraint) PgConstraint
  -> Plan
       scope (PgClassAndAttributes, PgConstraint) ConstraintDescription)
 -> Plan
      scope (PgClassAndAttributes, PgConstraint) ConstraintDescription)
-> (Planned scope (PgClassAndAttributes, PgConstraint) PgConstraint
    -> Plan
         scope (PgClassAndAttributes, PgConstraint) ConstraintDescription)
-> Plan
     scope (PgClassAndAttributes, PgConstraint) ConstraintDescription
forall a b. (a -> b) -> a -> b
$ \Planned scope (PgClassAndAttributes, PgConstraint) PgConstraint
constraint ->
      Plan scope (PgClassAndAttributes, PgConstraint) (Maybe PgClass)
-> (Planned
      scope (PgClassAndAttributes, PgConstraint) (Maybe PgClass)
    -> Plan
         scope (PgClassAndAttributes, PgConstraint) ConstraintDescription)
-> Plan
     scope (PgClassAndAttributes, PgConstraint) ConstraintDescription
forall scope param a result.
Plan scope param a
-> (Planned scope param a -> Plan scope param result)
-> Plan scope param result
Plan.bind (Planned scope (PgClassAndAttributes, PgConstraint) PgConstraint
-> Plan scope PgConstraint (Maybe PgClass)
-> Plan scope (PgClassAndAttributes, PgConstraint) (Maybe PgClass)
forall scope param a b.
Planned scope param a -> Plan scope a b -> Plan scope param b
Plan.using Planned scope (PgClassAndAttributes, PgConstraint) PgConstraint
constraint Plan scope PgConstraint (Maybe PgClass)
forall scope. Plan scope PgConstraint (Maybe PgClass)
findConstraintForeignRelationClass) ((Planned
    scope (PgClassAndAttributes, PgConstraint) (Maybe PgClass)
  -> Plan
       scope (PgClassAndAttributes, PgConstraint) ConstraintDescription)
 -> Plan
      scope (PgClassAndAttributes, PgConstraint) ConstraintDescription)
-> (Planned
      scope (PgClassAndAttributes, PgConstraint) (Maybe PgClass)
    -> Plan
         scope (PgClassAndAttributes, PgConstraint) ConstraintDescription)
-> Plan
     scope (PgClassAndAttributes, PgConstraint) ConstraintDescription
forall a b. (a -> b) -> a -> b
$ \Planned scope (PgClassAndAttributes, PgConstraint) (Maybe PgClass)
maybeForeignPgClass ->
        let
          maybeForeignClassAndAttrNums :: Plan
  scope
  (PgClassAndAttributes, PgConstraint)
  (Maybe (PgClass, [AttributeNumber]))
maybeForeignClassAndAttrNums =
            (Maybe PgClass
 -> Maybe [AttributeNumber] -> Maybe (PgClass, [AttributeNumber]))
-> Plan scope (PgClassAndAttributes, PgConstraint) (Maybe PgClass)
-> Plan
     scope
     (PgClassAndAttributes, PgConstraint)
     (Maybe [AttributeNumber])
-> Plan
     scope
     (PgClassAndAttributes, PgConstraint)
     (Maybe (PgClass, [AttributeNumber]))
forall a b c.
(a -> b -> c)
-> Plan scope (PgClassAndAttributes, PgConstraint) a
-> Plan scope (PgClassAndAttributes, PgConstraint) b
-> Plan scope (PgClassAndAttributes, PgConstraint) c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
              ((PgClass -> [AttributeNumber] -> (PgClass, [AttributeNumber]))
-> Maybe PgClass
-> Maybe [AttributeNumber]
-> Maybe (PgClass, [AttributeNumber])
forall a b c. (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,))
              (Planned scope (PgClassAndAttributes, PgConstraint) (Maybe PgClass)
-> Plan scope (PgClassAndAttributes, PgConstraint) (Maybe PgClass)
forall scope param a. Planned scope param a -> Plan scope param a
Plan.use Planned scope (PgClassAndAttributes, PgConstraint) (Maybe PgClass)
maybeForeignPgClass)
              (((PgClassAndAttributes, PgConstraint) -> Maybe [AttributeNumber])
-> Plan
     scope
     (PgClassAndAttributes, PgConstraint)
     (PgClassAndAttributes, PgConstraint)
-> Plan
     scope
     (PgClassAndAttributes, PgConstraint)
     (Maybe [AttributeNumber])
forall a b.
(a -> b)
-> Plan scope (PgClassAndAttributes, PgConstraint) a
-> Plan scope (PgClassAndAttributes, PgConstraint) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PgConstraint -> Maybe [AttributeNumber]
pgConstraintForeignKey (PgConstraint -> Maybe [AttributeNumber])
-> ((PgClassAndAttributes, PgConstraint) -> PgConstraint)
-> (PgClassAndAttributes, PgConstraint)
-> Maybe [AttributeNumber]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PgClassAndAttributes, PgConstraint) -> PgConstraint
forall a b. (a, b) -> b
snd) Plan
  scope
  (PgClassAndAttributes, PgConstraint)
  (PgClassAndAttributes, PgConstraint)
forall scope param. Plan scope param param
Plan.askParam)
        in
          PgConstraint
-> Maybe [PgAttribute]
-> Maybe ForeignRelationDescription
-> Maybe [PgAttribute]
-> ConstraintDescription
ConstraintDescription
            (PgConstraint
 -> Maybe [PgAttribute]
 -> Maybe ForeignRelationDescription
 -> Maybe [PgAttribute]
 -> ConstraintDescription)
-> Plan scope (PgClassAndAttributes, PgConstraint) PgConstraint
-> Plan
     scope
     (PgClassAndAttributes, PgConstraint)
     (Maybe [PgAttribute]
      -> Maybe ForeignRelationDescription
      -> Maybe [PgAttribute]
      -> ConstraintDescription)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Planned scope (PgClassAndAttributes, PgConstraint) PgConstraint
-> Plan scope (PgClassAndAttributes, PgConstraint) PgConstraint
forall scope param a. Planned scope param a -> Plan scope param a
Plan.use Planned scope (PgClassAndAttributes, PgConstraint) PgConstraint
constraint
            Plan
  scope
  (PgClassAndAttributes, PgConstraint)
  (Maybe [PgAttribute]
   -> Maybe ForeignRelationDescription
   -> Maybe [PgAttribute]
   -> ConstraintDescription)
-> Plan
     scope (PgClassAndAttributes, PgConstraint) (Maybe [PgAttribute])
-> Plan
     scope
     (PgClassAndAttributes, PgConstraint)
     (Maybe ForeignRelationDescription
      -> Maybe [PgAttribute] -> ConstraintDescription)
forall a b.
Plan scope (PgClassAndAttributes, PgConstraint) (a -> b)
-> Plan scope (PgClassAndAttributes, PgConstraint) a
-> Plan scope (PgClassAndAttributes, PgConstraint) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((PgClassAndAttributes, PgConstraint)
 -> Maybe [(PgClassAndAttributes, AttributeNumber)])
-> Plan
     scope
     (Maybe [(PgClassAndAttributes, AttributeNumber)])
     (Maybe [PgAttribute])
-> Plan
     scope (PgClassAndAttributes, PgConstraint) (Maybe [PgAttribute])
forall a b scope result.
(a -> b) -> Plan scope b result -> Plan scope a result
Plan.focusParam (PgClassAndAttributes, PgConstraint)
-> Maybe [(PgClassAndAttributes, AttributeNumber)]
prepareAttributeLookups (Plan scope [(PgClassAndAttributes, AttributeNumber)] [PgAttribute]
-> Plan
     scope
     (Maybe [(PgClassAndAttributes, AttributeNumber)])
     (Maybe [PgAttribute])
forall scope a b. Plan scope a b -> Plan scope (Maybe a) (Maybe b)
Plan.planMaybe (Plan scope [(PgClassAndAttributes, AttributeNumber)] [PgAttribute]
 -> Plan
      scope
      (Maybe [(PgClassAndAttributes, AttributeNumber)])
      (Maybe [PgAttribute]))
-> Plan
     scope [(PgClassAndAttributes, AttributeNumber)] [PgAttribute]
-> Plan
     scope
     (Maybe [(PgClassAndAttributes, AttributeNumber)])
     (Maybe [PgAttribute])
forall a b. (a -> b) -> a -> b
$ (forall scope.
 Plan scope (PgClassAndAttributes, AttributeNumber) PgAttribute)
-> Plan
     scope [(PgClassAndAttributes, AttributeNumber)] [PgAttribute]
forall param result listScope.
(forall scope. Plan scope param result)
-> Plan listScope [param] [result]
Plan.planList Plan scope (PgClassAndAttributes, AttributeNumber) PgAttribute
forall scope.
Plan scope (PgClassAndAttributes, AttributeNumber) PgAttribute
findAttributeByNumber)
            Plan
  scope
  (PgClassAndAttributes, PgConstraint)
  (Maybe ForeignRelationDescription
   -> Maybe [PgAttribute] -> ConstraintDescription)
-> Plan
     scope
     (PgClassAndAttributes, PgConstraint)
     (Maybe ForeignRelationDescription)
-> Plan
     scope
     (PgClassAndAttributes, PgConstraint)
     (Maybe [PgAttribute] -> ConstraintDescription)
forall a b.
Plan scope (PgClassAndAttributes, PgConstraint) (a -> b)
-> Plan scope (PgClassAndAttributes, PgConstraint) a
-> Plan scope (PgClassAndAttributes, PgConstraint) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Planned scope (PgClassAndAttributes, PgConstraint) (Maybe PgClass)
-> Plan scope (Maybe PgClass) (Maybe ForeignRelationDescription)
-> Plan
     scope
     (PgClassAndAttributes, PgConstraint)
     (Maybe ForeignRelationDescription)
forall scope param a b.
Planned scope param a -> Plan scope a b -> Plan scope param b
Plan.using Planned scope (PgClassAndAttributes, PgConstraint) (Maybe PgClass)
maybeForeignPgClass (Plan scope PgClass ForeignRelationDescription
-> Plan scope (Maybe PgClass) (Maybe ForeignRelationDescription)
forall scope a b. Plan scope a b -> Plan scope (Maybe a) (Maybe b)
Plan.planMaybe Plan scope PgClass ForeignRelationDescription
forall scope. Plan scope PgClass ForeignRelationDescription
describeForeignRelation)
            Plan
  scope
  (PgClassAndAttributes, PgConstraint)
  (Maybe [PgAttribute] -> ConstraintDescription)
-> Plan
     scope (PgClassAndAttributes, PgConstraint) (Maybe [PgAttribute])
-> Plan
     scope (PgClassAndAttributes, PgConstraint) ConstraintDescription
forall a b.
Plan scope (PgClassAndAttributes, PgConstraint) (a -> b)
-> Plan scope (PgClassAndAttributes, PgConstraint) a
-> Plan scope (PgClassAndAttributes, PgConstraint) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Plan
  scope
  (PgClassAndAttributes, PgConstraint)
  (Maybe (PgClass, [AttributeNumber]))
-> Plan
     scope (Maybe (PgClass, [AttributeNumber])) (Maybe [PgAttribute])
-> Plan
     scope (PgClassAndAttributes, PgConstraint) (Maybe [PgAttribute])
forall scope a b c.
Plan scope a b -> Plan scope b c -> Plan scope a c
Plan.chain Plan
  scope
  (PgClassAndAttributes, PgConstraint)
  (Maybe (PgClass, [AttributeNumber]))
maybeForeignClassAndAttrNums (Plan scope (PgClass, [AttributeNumber]) [PgAttribute]
-> Plan
     scope (Maybe (PgClass, [AttributeNumber])) (Maybe [PgAttribute])
forall scope a b. Plan scope a b -> Plan scope (Maybe a) (Maybe b)
Plan.planMaybe Plan scope (PgClass, [AttributeNumber]) [PgAttribute]
forall scope. Plan scope (PgClass, [AttributeNumber]) [PgAttribute]
findForeignKeyAttributes)

describeForeignRelation :: Plan.Plan scope PgClass ForeignRelationDescription
describeForeignRelation :: forall scope. Plan scope PgClass ForeignRelationDescription
describeForeignRelation =
  PgClass -> PgNamespace -> ForeignRelationDescription
ForeignRelationDescription
    (PgClass -> PgNamespace -> ForeignRelationDescription)
-> Plan scope PgClass PgClass
-> Plan scope PgClass (PgNamespace -> ForeignRelationDescription)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Plan scope PgClass PgClass
forall scope param. Plan scope param param
Plan.askParam
    Plan scope PgClass (PgNamespace -> ForeignRelationDescription)
-> Plan scope PgClass PgNamespace
-> Plan scope PgClass ForeignRelationDescription
forall a b.
Plan scope PgClass (a -> b)
-> Plan scope PgClass a -> Plan scope PgClass b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (PgClass -> Oid)
-> Plan scope Oid PgNamespace -> Plan scope PgClass PgNamespace
forall a b scope result.
(a -> b) -> Plan scope b result -> Plan scope a result
Plan.focusParam PgClass -> Oid
pgClassNamespaceOid (TableDefinition (HasKey Oid) PgNamespace PgNamespace
-> FieldDefinition NotNull Oid -> Plan scope Oid PgNamespace
forall fieldValue key writeEntity readEntity nullability scope.
(Show fieldValue, Ord fieldValue) =>
TableDefinition key writeEntity readEntity
-> FieldDefinition nullability fieldValue
-> Plan scope fieldValue readEntity
Plan.findOne TableDefinition (HasKey Oid) PgNamespace PgNamespace
pgNamespaceTable FieldDefinition NotNull Oid
oidField)

findForeignKeyAttributes :: Plan.Plan scope (PgClass, [AttributeNumber]) [PgAttribute]
findForeignKeyAttributes :: forall scope. Plan scope (PgClass, [AttributeNumber]) [PgAttribute]
findForeignKeyAttributes =
  Plan scope (PgClass, [AttributeNumber]) PgClass
-> (Planned scope (PgClass, [AttributeNumber]) PgClass
    -> Plan scope (PgClass, [AttributeNumber]) [PgAttribute])
-> Plan scope (PgClass, [AttributeNumber]) [PgAttribute]
forall scope param a result.
Plan scope param a
-> (Planned scope param a -> Plan scope param result)
-> Plan scope param result
Plan.bind ((PgClass, [AttributeNumber]) -> PgClass
forall a b. (a, b) -> a
fst ((PgClass, [AttributeNumber]) -> PgClass)
-> Plan
     scope (PgClass, [AttributeNumber]) (PgClass, [AttributeNumber])
-> Plan scope (PgClass, [AttributeNumber]) PgClass
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Plan
  scope (PgClass, [AttributeNumber]) (PgClass, [AttributeNumber])
forall scope param. Plan scope param param
Plan.askParam) ((Planned scope (PgClass, [AttributeNumber]) PgClass
  -> Plan scope (PgClass, [AttributeNumber]) [PgAttribute])
 -> Plan scope (PgClass, [AttributeNumber]) [PgAttribute])
-> (Planned scope (PgClass, [AttributeNumber]) PgClass
    -> Plan scope (PgClass, [AttributeNumber]) [PgAttribute])
-> Plan scope (PgClass, [AttributeNumber]) [PgAttribute]
forall a b. (a -> b) -> a -> b
$ \Planned scope (PgClass, [AttributeNumber]) PgClass
pgClass ->
    Plan scope (PgClass, [AttributeNumber]) [AttributeNumber]
-> (Planned scope (PgClass, [AttributeNumber]) [AttributeNumber]
    -> Plan scope (PgClass, [AttributeNumber]) [PgAttribute])
-> Plan scope (PgClass, [AttributeNumber]) [PgAttribute]
forall scope param a result.
Plan scope param a
-> (Planned scope param a -> Plan scope param result)
-> Plan scope param result
Plan.bind ((PgClass, [AttributeNumber]) -> [AttributeNumber]
forall a b. (a, b) -> b
snd ((PgClass, [AttributeNumber]) -> [AttributeNumber])
-> Plan
     scope (PgClass, [AttributeNumber]) (PgClass, [AttributeNumber])
-> Plan scope (PgClass, [AttributeNumber]) [AttributeNumber]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Plan
  scope (PgClass, [AttributeNumber]) (PgClass, [AttributeNumber])
forall scope param. Plan scope param param
Plan.askParam) ((Planned scope (PgClass, [AttributeNumber]) [AttributeNumber]
  -> Plan scope (PgClass, [AttributeNumber]) [PgAttribute])
 -> Plan scope (PgClass, [AttributeNumber]) [PgAttribute])
-> (Planned scope (PgClass, [AttributeNumber]) [AttributeNumber]
    -> Plan scope (PgClass, [AttributeNumber]) [PgAttribute])
-> Plan scope (PgClass, [AttributeNumber]) [PgAttribute]
forall a b. (a -> b) -> a -> b
$ \Planned scope (PgClass, [AttributeNumber]) [AttributeNumber]
attrNums ->
      Plan scope (PgClass, [AttributeNumber]) [PgAttribute]
-> (Planned scope (PgClass, [AttributeNumber]) [PgAttribute]
    -> Plan scope (PgClass, [AttributeNumber]) [PgAttribute])
-> Plan scope (PgClass, [AttributeNumber]) [PgAttribute]
forall scope param a result.
Plan scope param a
-> (Planned scope param a -> Plan scope param result)
-> Plan scope param result
Plan.bind (((PgClass, [AttributeNumber]) -> PgClass)
-> Plan scope PgClass [PgAttribute]
-> Plan scope (PgClass, [AttributeNumber]) [PgAttribute]
forall a b scope result.
(a -> b) -> Plan scope b result -> Plan scope a result
Plan.focusParam (PgClass, [AttributeNumber]) -> PgClass
forall a b. (a, b) -> a
fst Plan scope PgClass [PgAttribute]
forall scope. Plan scope PgClass [PgAttribute]
findClassAttributes) ((Planned scope (PgClass, [AttributeNumber]) [PgAttribute]
  -> Plan scope (PgClass, [AttributeNumber]) [PgAttribute])
 -> Plan scope (PgClass, [AttributeNumber]) [PgAttribute])
-> (Planned scope (PgClass, [AttributeNumber]) [PgAttribute]
    -> Plan scope (PgClass, [AttributeNumber]) [PgAttribute])
-> Plan scope (PgClass, [AttributeNumber]) [PgAttribute]
forall a b. (a -> b) -> a -> b
$ \Planned scope (PgClass, [AttributeNumber]) [PgAttribute]
attributes ->
        let
          attrSource :: Plan scope (PgClass, [AttributeNumber]) PgClassAndAttributes
attrSource =
            PgClass -> [PgAttribute] -> PgClassAndAttributes
mkPgClassAndAttributes
              (PgClass -> [PgAttribute] -> PgClassAndAttributes)
-> Plan scope (PgClass, [AttributeNumber]) PgClass
-> Plan
     scope
     (PgClass, [AttributeNumber])
     ([PgAttribute] -> PgClassAndAttributes)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Planned scope (PgClass, [AttributeNumber]) PgClass
-> Plan scope (PgClass, [AttributeNumber]) PgClass
forall scope param a. Planned scope param a -> Plan scope param a
Plan.use Planned scope (PgClass, [AttributeNumber]) PgClass
pgClass
              Plan
  scope
  (PgClass, [AttributeNumber])
  ([PgAttribute] -> PgClassAndAttributes)
-> Plan scope (PgClass, [AttributeNumber]) [PgAttribute]
-> Plan scope (PgClass, [AttributeNumber]) PgClassAndAttributes
forall a b.
Plan scope (PgClass, [AttributeNumber]) (a -> b)
-> Plan scope (PgClass, [AttributeNumber]) a
-> Plan scope (PgClass, [AttributeNumber]) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Planned scope (PgClass, [AttributeNumber]) [PgAttribute]
-> Plan scope (PgClass, [AttributeNumber]) [PgAttribute]
forall scope param a. Planned scope param a -> Plan scope param a
Plan.use Planned scope (PgClass, [AttributeNumber]) [PgAttribute]
attributes
        in
          Plan
  scope
  (PgClass, [AttributeNumber])
  [(PgClassAndAttributes, AttributeNumber)]
-> Plan
     scope [(PgClassAndAttributes, AttributeNumber)] [PgAttribute]
-> Plan scope (PgClass, [AttributeNumber]) [PgAttribute]
forall scope a b c.
Plan scope a b -> Plan scope b c -> Plan scope a c
Plan.chain
            ([PgClassAndAttributes]
-> [AttributeNumber] -> [(PgClassAndAttributes, AttributeNumber)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([PgClassAndAttributes]
 -> [AttributeNumber] -> [(PgClassAndAttributes, AttributeNumber)])
-> Plan scope (PgClass, [AttributeNumber]) [PgClassAndAttributes]
-> Plan
     scope
     (PgClass, [AttributeNumber])
     ([AttributeNumber] -> [(PgClassAndAttributes, AttributeNumber)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PgClassAndAttributes -> [PgClassAndAttributes])
-> Plan scope (PgClass, [AttributeNumber]) PgClassAndAttributes
-> Plan scope (PgClass, [AttributeNumber]) [PgClassAndAttributes]
forall a b.
(a -> b)
-> Plan scope (PgClass, [AttributeNumber]) a
-> Plan scope (PgClass, [AttributeNumber]) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PgClassAndAttributes -> [PgClassAndAttributes]
forall a. a -> [a]
repeat Plan scope (PgClass, [AttributeNumber]) PgClassAndAttributes
attrSource Plan
  scope
  (PgClass, [AttributeNumber])
  ([AttributeNumber] -> [(PgClassAndAttributes, AttributeNumber)])
-> Plan scope (PgClass, [AttributeNumber]) [AttributeNumber]
-> Plan
     scope
     (PgClass, [AttributeNumber])
     [(PgClassAndAttributes, AttributeNumber)]
forall a b.
Plan scope (PgClass, [AttributeNumber]) (a -> b)
-> Plan scope (PgClass, [AttributeNumber]) a
-> Plan scope (PgClass, [AttributeNumber]) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Planned scope (PgClass, [AttributeNumber]) [AttributeNumber]
-> Plan scope (PgClass, [AttributeNumber]) [AttributeNumber]
forall scope param a. Planned scope param a -> Plan scope param a
Plan.use Planned scope (PgClass, [AttributeNumber]) [AttributeNumber]
attrNums)
            ((forall scope.
 Plan scope (PgClassAndAttributes, AttributeNumber) PgAttribute)
-> Plan
     scope [(PgClassAndAttributes, AttributeNumber)] [PgAttribute]
forall param result listScope.
(forall scope. Plan scope param result)
-> Plan listScope [param] [result]
Plan.planList Plan scope (PgClassAndAttributes, AttributeNumber) PgAttribute
forall scope.
Plan scope (PgClassAndAttributes, AttributeNumber) PgAttribute
findAttributeByNumber)

findConstraintForeignRelationClass :: Plan.Plan scope PgConstraint (Maybe PgClass)
findConstraintForeignRelationClass :: forall scope. Plan scope PgConstraint (Maybe PgClass)
findConstraintForeignRelationClass =
  let
    relationId :: PgConstraint -> Maybe Oid
relationId PgConstraint
constraint =
      case PgConstraint -> Oid
pgConstraintForeignRelationOid PgConstraint
constraint of
        LibPQ.Oid CUInt
0 -> Maybe Oid
forall a. Maybe a
Nothing
        Oid
nonZero -> Oid -> Maybe Oid
forall a. a -> Maybe a
Just Oid
nonZero
  in
    (PgConstraint -> Maybe Oid)
-> Plan scope (Maybe Oid) (Maybe PgClass)
-> Plan scope PgConstraint (Maybe PgClass)
forall a b scope result.
(a -> b) -> Plan scope b result -> Plan scope a result
Plan.focusParam PgConstraint -> Maybe Oid
relationId (Plan scope (Maybe Oid) (Maybe PgClass)
 -> Plan scope PgConstraint (Maybe PgClass))
-> Plan scope (Maybe Oid) (Maybe PgClass)
-> Plan scope PgConstraint (Maybe PgClass)
forall a b. (a -> b) -> a -> b
$
      Plan scope Oid PgClass -> Plan scope (Maybe Oid) (Maybe PgClass)
forall scope a b. Plan scope a b -> Plan scope (Maybe a) (Maybe b)
Plan.planMaybe (Plan scope Oid PgClass -> Plan scope (Maybe Oid) (Maybe PgClass))
-> Plan scope Oid PgClass -> Plan scope (Maybe Oid) (Maybe PgClass)
forall a b. (a -> b) -> a -> b
$
        TableDefinition (HasKey Oid) PgClass PgClass
-> FieldDefinition NotNull Oid -> Plan scope Oid PgClass
forall fieldValue key writeEntity readEntity nullability scope.
(Show fieldValue, Ord fieldValue) =>
TableDefinition key writeEntity readEntity
-> FieldDefinition nullability fieldValue
-> Plan scope fieldValue readEntity
Plan.findOne TableDefinition (HasKey Oid) PgClass PgClass
pgClassTable FieldDefinition NotNull Oid
oidField

findClassIndexes :: Plan.Plan scope PgClassAndAttributes [IndexDescription]
findClassIndexes :: forall scope. Plan scope PgClassAndAttributes [IndexDescription]
findClassIndexes =
  let
    findIndexes :: Plan.Plan scope PgClassAndAttributes [PgIndex]
    findIndexes :: forall scope. Plan scope PgClassAndAttributes [PgIndex]
findIndexes =
      (PgClassAndAttributes -> Oid)
-> Plan scope Oid [PgIndex]
-> Plan scope PgClassAndAttributes [PgIndex]
forall a b scope result.
(a -> b) -> Plan scope b result -> Plan scope a result
Plan.focusParam (PgClass -> Oid
pgClassOid (PgClass -> Oid)
-> (PgClassAndAttributes -> PgClass) -> PgClassAndAttributes -> Oid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PgClassAndAttributes -> PgClass
pgClassRecord) (Plan scope Oid [PgIndex]
 -> Plan scope PgClassAndAttributes [PgIndex])
-> Plan scope Oid [PgIndex]
-> Plan scope PgClassAndAttributes [PgIndex]
forall a b. (a -> b) -> a -> b
$
        TableDefinition NoKey PgIndex PgIndex
-> FieldDefinition NotNull Oid
-> BooleanExpr
-> Plan scope Oid [PgIndex]
forall fieldValue key writeEntity readEntity nullability scope.
Ord fieldValue =>
TableDefinition key writeEntity readEntity
-> FieldDefinition nullability fieldValue
-> BooleanExpr
-> Plan scope fieldValue [readEntity]
Plan.findAllWhere
          TableDefinition NoKey PgIndex PgIndex
pgIndexTable
          FieldDefinition NotNull Oid
indexRelationOidField
          (FieldDefinition NotNull Bool -> Bool -> BooleanExpr
forall nullability a.
FieldDefinition nullability a -> a -> BooleanExpr
Orville.fieldEquals FieldDefinition NotNull Bool
indexIsLiveField Bool
True)

    indexesWithClassAndAttrs :: Plan.Plan scope PgClassAndAttributes [(PgClassAndAttributes, PgIndex)]
    indexesWithClassAndAttrs :: forall scope.
Plan scope PgClassAndAttributes [(PgClassAndAttributes, PgIndex)]
indexesWithClassAndAttrs =
      [PgClassAndAttributes]
-> [PgIndex] -> [(PgClassAndAttributes, PgIndex)]
forall a b. [a] -> [b] -> [(a, b)]
zip
        ([PgClassAndAttributes]
 -> [PgIndex] -> [(PgClassAndAttributes, PgIndex)])
-> Plan scope PgClassAndAttributes [PgClassAndAttributes]
-> Plan
     scope
     PgClassAndAttributes
     ([PgIndex] -> [(PgClassAndAttributes, PgIndex)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PgClassAndAttributes -> [PgClassAndAttributes])
-> Plan scope PgClassAndAttributes PgClassAndAttributes
-> Plan scope PgClassAndAttributes [PgClassAndAttributes]
forall a b.
(a -> b)
-> Plan scope PgClassAndAttributes a
-> Plan scope PgClassAndAttributes b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PgClassAndAttributes -> [PgClassAndAttributes]
forall a. a -> [a]
repeat Plan scope PgClassAndAttributes PgClassAndAttributes
forall scope param. Plan scope param param
Plan.askParam
        Plan
  scope
  PgClassAndAttributes
  ([PgIndex] -> [(PgClassAndAttributes, PgIndex)])
-> Plan scope PgClassAndAttributes [PgIndex]
-> Plan
     scope PgClassAndAttributes [(PgClassAndAttributes, PgIndex)]
forall a b.
Plan scope PgClassAndAttributes (a -> b)
-> Plan scope PgClassAndAttributes a
-> Plan scope PgClassAndAttributes b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Plan scope PgClassAndAttributes [PgIndex]
forall scope. Plan scope PgClassAndAttributes [PgIndex]
findIndexes
  in
    Plan scope PgClassAndAttributes [(PgClassAndAttributes, PgIndex)]
-> Plan scope [(PgClassAndAttributes, PgIndex)] [IndexDescription]
-> Plan scope PgClassAndAttributes [IndexDescription]
forall scope a b c.
Plan scope a b -> Plan scope b c -> Plan scope a c
Plan.chain Plan scope PgClassAndAttributes [(PgClassAndAttributes, PgIndex)]
forall scope.
Plan scope PgClassAndAttributes [(PgClassAndAttributes, PgIndex)]
indexesWithClassAndAttrs ((forall scope.
 Plan scope (PgClassAndAttributes, PgIndex) IndexDescription)
-> Plan scope [(PgClassAndAttributes, PgIndex)] [IndexDescription]
forall param result listScope.
(forall scope. Plan scope param result)
-> Plan listScope [param] [result]
Plan.planList Plan scope (PgClassAndAttributes, PgIndex) IndexDescription
forall scope.
Plan scope (PgClassAndAttributes, PgIndex) IndexDescription
describeIndex)

describeIndex :: Plan.Plan scope (PgClassAndAttributes, PgIndex) IndexDescription
describeIndex :: forall scope.
Plan scope (PgClassAndAttributes, PgIndex) IndexDescription
describeIndex =
  let
    expressionsOrAttributeLookups ::
      PgClassAndAttributes ->
      [AttributeNumber] ->
      [Either IndexMember (PgClassAndAttributes, AttributeNumber)]
    expressionsOrAttributeLookups :: PgClassAndAttributes
-> [AttributeNumber]
-> [Either IndexMember (PgClassAndAttributes, AttributeNumber)]
expressionsOrAttributeLookups PgClassAndAttributes
pgClassAndAttrs [AttributeNumber]
attNumList = do
      AttributeNumber
attNum <- [AttributeNumber]
attNumList
      Either IndexMember (PgClassAndAttributes, AttributeNumber)
-> [Either IndexMember (PgClassAndAttributes, AttributeNumber)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either IndexMember (PgClassAndAttributes, AttributeNumber)
 -> [Either IndexMember (PgClassAndAttributes, AttributeNumber)])
-> Either IndexMember (PgClassAndAttributes, AttributeNumber)
-> [Either IndexMember (PgClassAndAttributes, AttributeNumber)]
forall a b. (a -> b) -> a -> b
$
        if AttributeNumber
attNum AttributeNumber -> AttributeNumber -> Bool
forall a. Eq a => a -> a -> Bool
== AttributeNumber
0
          then IndexMember
-> Either IndexMember (PgClassAndAttributes, AttributeNumber)
forall a b. a -> Either a b
Left IndexMember
IndexExpression
          else (PgClassAndAttributes, AttributeNumber)
-> Either IndexMember (PgClassAndAttributes, AttributeNumber)
forall a b. b -> Either a b
Right (PgClassAndAttributes
pgClassAndAttrs, AttributeNumber
attNum)

    indexMemberLookups ::
      Plan.Plan
        scope
        (PgClassAndAttributes, PgIndex)
        [Either IndexMember (PgClassAndAttributes, AttributeNumber)]
    indexMemberLookups :: forall scope.
Plan
  scope
  (PgClassAndAttributes, PgIndex)
  [Either IndexMember (PgClassAndAttributes, AttributeNumber)]
indexMemberLookups =
      Plan scope (PgClassAndAttributes, PgIndex) PgClassAndAttributes
-> (Planned
      scope (PgClassAndAttributes, PgIndex) PgClassAndAttributes
    -> Plan
         scope
         (PgClassAndAttributes, PgIndex)
         [Either IndexMember (PgClassAndAttributes, AttributeNumber)])
-> Plan
     scope
     (PgClassAndAttributes, PgIndex)
     [Either IndexMember (PgClassAndAttributes, AttributeNumber)]
forall scope param a result.
Plan scope param a
-> (Planned scope param a -> Plan scope param result)
-> Plan scope param result
Plan.bind ((PgClassAndAttributes, PgIndex) -> PgClassAndAttributes
forall a b. (a, b) -> a
fst ((PgClassAndAttributes, PgIndex) -> PgClassAndAttributes)
-> Plan
     scope
     (PgClassAndAttributes, PgIndex)
     (PgClassAndAttributes, PgIndex)
-> Plan scope (PgClassAndAttributes, PgIndex) PgClassAndAttributes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Plan
  scope
  (PgClassAndAttributes, PgIndex)
  (PgClassAndAttributes, PgIndex)
forall scope param. Plan scope param param
Plan.askParam) ((Planned
    scope (PgClassAndAttributes, PgIndex) PgClassAndAttributes
  -> Plan
       scope
       (PgClassAndAttributes, PgIndex)
       [Either IndexMember (PgClassAndAttributes, AttributeNumber)])
 -> Plan
      scope
      (PgClassAndAttributes, PgIndex)
      [Either IndexMember (PgClassAndAttributes, AttributeNumber)])
-> (Planned
      scope (PgClassAndAttributes, PgIndex) PgClassAndAttributes
    -> Plan
         scope
         (PgClassAndAttributes, PgIndex)
         [Either IndexMember (PgClassAndAttributes, AttributeNumber)])
-> Plan
     scope
     (PgClassAndAttributes, PgIndex)
     [Either IndexMember (PgClassAndAttributes, AttributeNumber)]
forall a b. (a -> b) -> a -> b
$ \Planned scope (PgClassAndAttributes, PgIndex) PgClassAndAttributes
pgClassAndAttrs ->
        Plan scope (PgClassAndAttributes, PgIndex) [AttributeNumber]
-> (Planned scope (PgClassAndAttributes, PgIndex) [AttributeNumber]
    -> Plan
         scope
         (PgClassAndAttributes, PgIndex)
         [Either IndexMember (PgClassAndAttributes, AttributeNumber)])
-> Plan
     scope
     (PgClassAndAttributes, PgIndex)
     [Either IndexMember (PgClassAndAttributes, AttributeNumber)]
forall scope param a result.
Plan scope param a
-> (Planned scope param a -> Plan scope param result)
-> Plan scope param result
Plan.bind (PgIndex -> [AttributeNumber]
pgIndexAttributeNumbers (PgIndex -> [AttributeNumber])
-> ((PgClassAndAttributes, PgIndex) -> PgIndex)
-> (PgClassAndAttributes, PgIndex)
-> [AttributeNumber]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PgClassAndAttributes, PgIndex) -> PgIndex
forall a b. (a, b) -> b
snd ((PgClassAndAttributes, PgIndex) -> [AttributeNumber])
-> Plan
     scope
     (PgClassAndAttributes, PgIndex)
     (PgClassAndAttributes, PgIndex)
-> Plan scope (PgClassAndAttributes, PgIndex) [AttributeNumber]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Plan
  scope
  (PgClassAndAttributes, PgIndex)
  (PgClassAndAttributes, PgIndex)
forall scope param. Plan scope param param
Plan.askParam) ((Planned scope (PgClassAndAttributes, PgIndex) [AttributeNumber]
  -> Plan
       scope
       (PgClassAndAttributes, PgIndex)
       [Either IndexMember (PgClassAndAttributes, AttributeNumber)])
 -> Plan
      scope
      (PgClassAndAttributes, PgIndex)
      [Either IndexMember (PgClassAndAttributes, AttributeNumber)])
-> (Planned scope (PgClassAndAttributes, PgIndex) [AttributeNumber]
    -> Plan
         scope
         (PgClassAndAttributes, PgIndex)
         [Either IndexMember (PgClassAndAttributes, AttributeNumber)])
-> Plan
     scope
     (PgClassAndAttributes, PgIndex)
     [Either IndexMember (PgClassAndAttributes, AttributeNumber)]
forall a b. (a -> b) -> a -> b
$ \Planned scope (PgClassAndAttributes, PgIndex) [AttributeNumber]
attNums ->
          PgClassAndAttributes
-> [AttributeNumber]
-> [Either IndexMember (PgClassAndAttributes, AttributeNumber)]
expressionsOrAttributeLookups
            (PgClassAndAttributes
 -> [AttributeNumber]
 -> [Either IndexMember (PgClassAndAttributes, AttributeNumber)])
-> Plan scope (PgClassAndAttributes, PgIndex) PgClassAndAttributes
-> Plan
     scope
     (PgClassAndAttributes, PgIndex)
     ([AttributeNumber]
      -> [Either IndexMember (PgClassAndAttributes, AttributeNumber)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Planned scope (PgClassAndAttributes, PgIndex) PgClassAndAttributes
-> Plan scope (PgClassAndAttributes, PgIndex) PgClassAndAttributes
forall scope param a. Planned scope param a -> Plan scope param a
Plan.use Planned scope (PgClassAndAttributes, PgIndex) PgClassAndAttributes
pgClassAndAttrs
            Plan
  scope
  (PgClassAndAttributes, PgIndex)
  ([AttributeNumber]
   -> [Either IndexMember (PgClassAndAttributes, AttributeNumber)])
-> Plan scope (PgClassAndAttributes, PgIndex) [AttributeNumber]
-> Plan
     scope
     (PgClassAndAttributes, PgIndex)
     [Either IndexMember (PgClassAndAttributes, AttributeNumber)]
forall a b.
Plan scope (PgClassAndAttributes, PgIndex) (a -> b)
-> Plan scope (PgClassAndAttributes, PgIndex) a
-> Plan scope (PgClassAndAttributes, PgIndex) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Planned scope (PgClassAndAttributes, PgIndex) [AttributeNumber]
-> Plan scope (PgClassAndAttributes, PgIndex) [AttributeNumber]
forall scope param a. Planned scope param a -> Plan scope param a
Plan.use Planned scope (PgClassAndAttributes, PgIndex) [AttributeNumber]
attNums

    resolveIndexMemberLookup ::
      Plan.Plan
        scope
        (Either IndexMember (PgClassAndAttributes, AttributeNumber))
        IndexMember
    resolveIndexMemberLookup :: forall scope.
Plan
  scope
  (Either IndexMember (PgClassAndAttributes, AttributeNumber))
  IndexMember
resolveIndexMemberLookup =
      (IndexMember -> IndexMember)
-> (PgAttribute -> IndexMember)
-> Either IndexMember PgAttribute
-> IndexMember
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either IndexMember -> IndexMember
forall a. a -> a
id PgAttribute -> IndexMember
IndexAttribute
        (Either IndexMember PgAttribute -> IndexMember)
-> Plan
     scope
     (Either IndexMember (PgClassAndAttributes, AttributeNumber))
     (Either IndexMember PgAttribute)
-> Plan
     scope
     (Either IndexMember (PgClassAndAttributes, AttributeNumber))
     IndexMember
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Plan scope IndexMember IndexMember
-> Plan scope (PgClassAndAttributes, AttributeNumber) PgAttribute
-> Plan
     scope
     (Either IndexMember (PgClassAndAttributes, AttributeNumber))
     (Either IndexMember PgAttribute)
forall scope leftParam leftResult rightParam rightResult.
Plan scope leftParam leftResult
-> Plan scope rightParam rightResult
-> Plan
     scope (Either leftParam rightParam) (Either leftResult rightResult)
Plan.planEither Plan scope IndexMember IndexMember
forall scope param. Plan scope param param
Plan.askParam Plan scope (PgClassAndAttributes, AttributeNumber) PgAttribute
forall scope.
Plan scope (PgClassAndAttributes, AttributeNumber) PgAttribute
findAttributeByNumber
  in
    PgIndex -> PgClass -> [IndexMember] -> IndexDescription
IndexDescription
      (PgIndex -> PgClass -> [IndexMember] -> IndexDescription)
-> Plan scope (PgClassAndAttributes, PgIndex) PgIndex
-> Plan
     scope
     (PgClassAndAttributes, PgIndex)
     (PgClass -> [IndexMember] -> IndexDescription)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((PgClassAndAttributes, PgIndex) -> PgIndex)
-> Plan
     scope
     (PgClassAndAttributes, PgIndex)
     (PgClassAndAttributes, PgIndex)
-> Plan scope (PgClassAndAttributes, PgIndex) PgIndex
forall a b.
(a -> b)
-> Plan scope (PgClassAndAttributes, PgIndex) a
-> Plan scope (PgClassAndAttributes, PgIndex) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PgClassAndAttributes, PgIndex) -> PgIndex
forall a b. (a, b) -> b
snd Plan
  scope
  (PgClassAndAttributes, PgIndex)
  (PgClassAndAttributes, PgIndex)
forall scope param. Plan scope param param
Plan.askParam
      Plan
  scope
  (PgClassAndAttributes, PgIndex)
  (PgClass -> [IndexMember] -> IndexDescription)
-> Plan scope (PgClassAndAttributes, PgIndex) PgClass
-> Plan
     scope
     (PgClassAndAttributes, PgIndex)
     ([IndexMember] -> IndexDescription)
forall a b.
Plan scope (PgClassAndAttributes, PgIndex) (a -> b)
-> Plan scope (PgClassAndAttributes, PgIndex) a
-> Plan scope (PgClassAndAttributes, PgIndex) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((PgClassAndAttributes, PgIndex) -> Oid)
-> Plan scope Oid PgClass
-> Plan scope (PgClassAndAttributes, PgIndex) PgClass
forall a b scope result.
(a -> b) -> Plan scope b result -> Plan scope a result
Plan.focusParam (PgIndex -> Oid
pgIndexPgClassOid (PgIndex -> Oid)
-> ((PgClassAndAttributes, PgIndex) -> PgIndex)
-> (PgClassAndAttributes, PgIndex)
-> Oid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PgClassAndAttributes, PgIndex) -> PgIndex
forall a b. (a, b) -> b
snd) (TableDefinition (HasKey Oid) PgClass PgClass
-> FieldDefinition NotNull Oid -> Plan scope Oid PgClass
forall fieldValue key writeEntity readEntity nullability scope.
(Show fieldValue, Ord fieldValue) =>
TableDefinition key writeEntity readEntity
-> FieldDefinition nullability fieldValue
-> Plan scope fieldValue readEntity
Plan.findOne TableDefinition (HasKey Oid) PgClass PgClass
pgClassTable FieldDefinition NotNull Oid
oidField)
      Plan
  scope
  (PgClassAndAttributes, PgIndex)
  ([IndexMember] -> IndexDescription)
-> Plan scope (PgClassAndAttributes, PgIndex) [IndexMember]
-> Plan scope (PgClassAndAttributes, PgIndex) IndexDescription
forall a b.
Plan scope (PgClassAndAttributes, PgIndex) (a -> b)
-> Plan scope (PgClassAndAttributes, PgIndex) a
-> Plan scope (PgClassAndAttributes, PgIndex) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Plan
  scope
  (PgClassAndAttributes, PgIndex)
  [Either IndexMember (PgClassAndAttributes, AttributeNumber)]
-> Plan
     scope
     [Either IndexMember (PgClassAndAttributes, AttributeNumber)]
     [IndexMember]
-> Plan scope (PgClassAndAttributes, PgIndex) [IndexMember]
forall scope a b c.
Plan scope a b -> Plan scope b c -> Plan scope a c
Plan.chain Plan
  scope
  (PgClassAndAttributes, PgIndex)
  [Either IndexMember (PgClassAndAttributes, AttributeNumber)]
forall scope.
Plan
  scope
  (PgClassAndAttributes, PgIndex)
  [Either IndexMember (PgClassAndAttributes, AttributeNumber)]
indexMemberLookups ((forall scope.
 Plan
   scope
   (Either IndexMember (PgClassAndAttributes, AttributeNumber))
   IndexMember)
-> Plan
     scope
     [Either IndexMember (PgClassAndAttributes, AttributeNumber)]
     [IndexMember]
forall param result listScope.
(forall scope. Plan scope param result)
-> Plan listScope [param] [result]
Plan.planList Plan
  scope
  (Either IndexMember (PgClassAndAttributes, AttributeNumber))
  IndexMember
forall scope.
Plan
  scope
  (Either IndexMember (PgClassAndAttributes, AttributeNumber))
  IndexMember
resolveIndexMemberLookup)

data PgClassAndAttributes = PgClassAndAttributes
  { PgClassAndAttributes -> PgClass
pgClassRecord :: PgClass
  , PgClassAndAttributes -> Map AttributeNumber PgAttribute
pgClassAttributes :: Map.Map AttributeNumber PgAttribute
  }

mkPgClassAndAttributes :: PgClass -> [PgAttribute] -> PgClassAndAttributes
mkPgClassAndAttributes :: PgClass -> [PgAttribute] -> PgClassAndAttributes
mkPgClassAndAttributes PgClass
pgClass [PgAttribute]
attributes =
  PgClassAndAttributes
    { pgClassRecord :: PgClass
pgClassRecord = PgClass
pgClass
    , pgClassAttributes :: Map AttributeNumber PgAttribute
pgClassAttributes = (PgAttribute -> AttributeNumber)
-> [PgAttribute] -> Map AttributeNumber PgAttribute
forall key row. Ord key => (row -> key) -> [row] -> Map key row
indexBy PgAttribute -> AttributeNumber
pgAttributeNumber [PgAttribute]
attributes
    }

findAttributeByNumber :: Plan.Plan scope (PgClassAndAttributes, AttributeNumber) PgAttribute
findAttributeByNumber :: forall scope.
Plan scope (PgClassAndAttributes, AttributeNumber) PgAttribute
findAttributeByNumber =
  let
    lookupAttr :: (PgClassAndAttributes, AttributeNumber) -> Maybe PgAttribute
lookupAttr (PgClassAndAttributes
pgClassAndAttrs, AttributeNumber
attrNum) =
      AttributeNumber
-> Map AttributeNumber PgAttribute -> Maybe PgAttribute
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AttributeNumber
attrNum (PgClassAndAttributes -> Map AttributeNumber PgAttribute
pgClassAttributes PgClassAndAttributes
pgClassAndAttrs)

    assertFound ::
      (PgClassAndAttributes, AttributeNumber) ->
      Maybe PgAttribute ->
      Either String PgAttribute
    assertFound :: (PgClassAndAttributes, AttributeNumber)
-> Maybe PgAttribute -> Either String PgAttribute
assertFound (PgClassAndAttributes
pgClassAndAttrs, AttributeNumber
attrNum) Maybe PgAttribute
maybeAttr =
      case Maybe PgAttribute
maybeAttr of
        Maybe PgAttribute
Nothing ->
          String -> Either String PgAttribute
forall a b. a -> Either a b
Left (String -> Either String PgAttribute)
-> String -> Either String PgAttribute
forall a b. (a -> b) -> a -> b
$
            String
"Unable to find attribute number "
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int16 -> String
forall a. Show a => a -> String
show (AttributeNumber -> Int16
attributeNumberToInt16 AttributeNumber
attrNum)
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" of relation "
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (RelationName -> String
relationNameToString (RelationName -> String)
-> (PgClassAndAttributes -> RelationName)
-> PgClassAndAttributes
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PgClass -> RelationName
pgClassRelationName (PgClass -> RelationName)
-> (PgClassAndAttributes -> PgClass)
-> PgClassAndAttributes
-> RelationName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PgClassAndAttributes -> PgClass
pgClassRecord (PgClassAndAttributes -> String) -> PgClassAndAttributes -> String
forall a b. (a -> b) -> a -> b
$ PgClassAndAttributes
pgClassAndAttrs)
        Just PgAttribute
attr ->
          PgAttribute -> Either String PgAttribute
forall a b. b -> Either a b
Right PgAttribute
attr
  in
    ((PgClassAndAttributes, AttributeNumber)
 -> Maybe PgAttribute -> Either String PgAttribute)
-> Plan
     scope (PgClassAndAttributes, AttributeNumber) (Maybe PgAttribute)
-> Plan scope (PgClassAndAttributes, AttributeNumber) PgAttribute
forall param a b scope.
(param -> a -> Either String b)
-> Plan scope param a -> Plan scope param b
Plan.assert (PgClassAndAttributes, AttributeNumber)
-> Maybe PgAttribute -> Either String PgAttribute
assertFound (Plan
   scope (PgClassAndAttributes, AttributeNumber) (Maybe PgAttribute)
 -> Plan scope (PgClassAndAttributes, AttributeNumber) PgAttribute)
-> Plan
     scope (PgClassAndAttributes, AttributeNumber) (Maybe PgAttribute)
-> Plan scope (PgClassAndAttributes, AttributeNumber) PgAttribute
forall a b. (a -> b) -> a -> b
$ ((PgClassAndAttributes, AttributeNumber) -> Maybe PgAttribute)
-> Plan
     scope
     (PgClassAndAttributes, AttributeNumber)
     (PgClassAndAttributes, AttributeNumber)
-> Plan
     scope (PgClassAndAttributes, AttributeNumber) (Maybe PgAttribute)
forall a b.
(a -> b)
-> Plan scope (PgClassAndAttributes, AttributeNumber) a
-> Plan scope (PgClassAndAttributes, AttributeNumber) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PgClassAndAttributes, AttributeNumber) -> Maybe PgAttribute
lookupAttr Plan
  scope
  (PgClassAndAttributes, AttributeNumber)
  (PgClassAndAttributes, AttributeNumber)
forall scope param. Plan scope param param
Plan.askParam

findClassSequence :: Plan.Plan scope PgClass (Maybe PgSequence)
findClassSequence :: forall scope. Plan scope PgClass (Maybe PgSequence)
findClassSequence =
  (PgClass -> Oid)
-> Plan scope Oid (Maybe PgSequence)
-> Plan scope PgClass (Maybe PgSequence)
forall a b scope result.
(a -> b) -> Plan scope b result -> Plan scope a result
Plan.focusParam PgClass -> Oid
pgClassOid (Plan scope Oid (Maybe PgSequence)
 -> Plan scope PgClass (Maybe PgSequence))
-> Plan scope Oid (Maybe PgSequence)
-> Plan scope PgClass (Maybe PgSequence)
forall a b. (a -> b) -> a -> b
$
    TableDefinition (HasKey Oid) PgSequence PgSequence
-> FieldDefinition NotNull Oid -> Plan scope Oid (Maybe PgSequence)
forall fieldValue key writeEntity readEntity nullability scope.
Ord fieldValue =>
TableDefinition key writeEntity readEntity
-> FieldDefinition nullability fieldValue
-> Plan scope fieldValue (Maybe readEntity)
Plan.findMaybeOne TableDefinition (HasKey Oid) PgSequence PgSequence
pgSequenceTable FieldDefinition NotNull Oid
sequencePgClassOidField

indexBy :: Ord key => (row -> key) -> [row] -> Map.Map key row
indexBy :: forall key row. Ord key => (row -> key) -> [row] -> Map key row
indexBy row -> key
rowKey =
  [(key, row)] -> Map key row
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(key, row)] -> Map key row)
-> ([row] -> [(key, row)]) -> [row] -> Map key row
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (row -> (key, row)) -> [row] -> [(key, row)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\row
row -> (row -> key
rowKey row
row, row
row))