-- | Postgres DDL Table
--
-- Used to fill up the enum values field of 'Hasura.RQL.Types.Table.TableCoreInfoG'.
--
-- See 'Hasura.Eventing.Backend'.
module Hasura.Backends.Postgres.DDL.Table
  ( fetchAndValidateEnumValues,
  )
where

import Control.Monad.Trans.Control (MonadBaseControl)
import Control.Monad.Validate
import Data.HashMap.Strict qualified as HashMap
import Data.List (delete)
import Data.List.NonEmpty qualified as NE
import Data.Sequence qualified as Seq
import Data.Sequence.NonEmpty qualified as NESeq
import Data.Text.Extended
import Database.PG.Query qualified as PG
import Hasura.Backends.Postgres.Connection
import Hasura.Backends.Postgres.SQL.DML
import Hasura.Backends.Postgres.SQL.Types
import Hasura.Base.Error
import Hasura.Prelude
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Column
import Hasura.SQL.Types
import Hasura.Server.Utils
import Hasura.Table.Cache
import Language.GraphQL.Draft.Syntax qualified as G

data EnumTableIntegrityError (b :: BackendType)
  = EnumTablePostgresError Text
  | EnumTableMissingPrimaryKey
  | EnumTableMultiColumnPrimaryKey [PGCol]
  | EnumTableNonTextualPrimaryKey (RawColumnInfo b)
  | EnumTableNoEnumValues
  | EnumTableInvalidEnumValueNames (NE.NonEmpty Text)
  | EnumTableNonTextualCommentColumn (RawColumnInfo b)
  | EnumTableTooManyColumns [PGCol]

fetchAndValidateEnumValues ::
  forall pgKind m.
  (Backend ('Postgres pgKind), MonadIO m, MonadBaseControl IO m) =>
  PGSourceConfig ->
  QualifiedTable ->
  Maybe (PrimaryKey ('Postgres pgKind) (RawColumnInfo ('Postgres pgKind))) ->
  [RawColumnInfo ('Postgres pgKind)] ->
  m (Either QErr EnumValues)
fetchAndValidateEnumValues :: forall (pgKind :: PostgresKind) (m :: * -> *).
(Backend ('Postgres pgKind), MonadIO m, MonadBaseControl IO m) =>
PGSourceConfig
-> QualifiedTable
-> Maybe
     (PrimaryKey ('Postgres pgKind) (RawColumnInfo ('Postgres pgKind)))
-> [RawColumnInfo ('Postgres pgKind)]
-> m (Either QErr EnumValues)
fetchAndValidateEnumValues PGSourceConfig
pgSourceConfig QualifiedTable
tableName Maybe
  (PrimaryKey ('Postgres pgKind) (RawColumnInfo ('Postgres pgKind)))
maybePrimaryKey [RawColumnInfo ('Postgres pgKind)]
columnInfos =
  ExceptT QErr m EnumValues -> m (Either QErr EnumValues)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
    (ExceptT QErr m EnumValues -> m (Either QErr EnumValues))
-> ExceptT QErr m EnumValues -> m (Either QErr EnumValues)
forall a b. (a -> b) -> a -> b
$ ([EnumTableIntegrityError ('Postgres pgKind)]
 -> ExceptT QErr m EnumValues)
-> (EnumValues -> ExceptT QErr m EnumValues)
-> Either [EnumTableIntegrityError ('Postgres pgKind)] EnumValues
-> ExceptT QErr m EnumValues
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Code -> Text -> ExceptT QErr m EnumValues
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
ConstraintViolation (Text -> ExceptT QErr m EnumValues)
-> ([EnumTableIntegrityError ('Postgres pgKind)] -> Text)
-> [EnumTableIntegrityError ('Postgres pgKind)]
-> ExceptT QErr m EnumValues
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EnumTableIntegrityError ('Postgres pgKind)] -> Text
showErrors) EnumValues -> ExceptT QErr m EnumValues
forall a. a -> ExceptT QErr m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Either [EnumTableIntegrityError ('Postgres pgKind)] EnumValues
 -> ExceptT QErr m EnumValues)
-> ExceptT
     QErr
     m
     (Either [EnumTableIntegrityError ('Postgres pgKind)] EnumValues)
-> ExceptT QErr m EnumValues
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ValidateT
  [EnumTableIntegrityError ('Postgres pgKind)]
  (ExceptT QErr m)
  EnumValues
-> ExceptT
     QErr
     m
     (Either [EnumTableIntegrityError ('Postgres pgKind)] EnumValues)
forall e (m :: * -> *) a.
Functor m =>
ValidateT e m a -> m (Either e a)
runValidateT ValidateT
  [EnumTableIntegrityError ('Postgres pgKind)]
  (ExceptT QErr m)
  EnumValues
forall (n :: * -> *).
(MonadIO n, MonadBaseControl IO n,
 MonadValidate [EnumTableIntegrityError ('Postgres pgKind)] n) =>
n EnumValues
fetchAndValidate
  where
    fetchAndValidate ::
      (MonadIO n, MonadBaseControl IO n, MonadValidate [EnumTableIntegrityError ('Postgres pgKind)] n) =>
      n EnumValues
    fetchAndValidate :: forall (n :: * -> *).
(MonadIO n, MonadBaseControl IO n,
 MonadValidate [EnumTableIntegrityError ('Postgres pgKind)] n) =>
n EnumValues
fetchAndValidate = do
      Maybe (RawColumnInfo ('Postgres pgKind))
maybePrimaryKeyColumn <- n (RawColumnInfo ('Postgres pgKind))
-> n (Maybe (RawColumnInfo ('Postgres pgKind)))
forall a. n a -> n (Maybe a)
forall e (m :: * -> *) a. MonadValidate e m => m a -> m (Maybe a)
tolerate n (RawColumnInfo ('Postgres pgKind))
validatePrimaryKey
      Maybe (RawColumnInfo ('Postgres pgKind))
maybeCommentColumn <- Maybe (RawColumnInfo ('Postgres pgKind))
-> n (Maybe (RawColumnInfo ('Postgres pgKind)))
validateColumns Maybe (RawColumnInfo ('Postgres pgKind))
maybePrimaryKeyColumn
      case Maybe (RawColumnInfo ('Postgres pgKind))
maybePrimaryKeyColumn of
        Maybe (RawColumnInfo ('Postgres pgKind))
Nothing -> [EnumTableIntegrityError ('Postgres pgKind)] -> n EnumValues
forall a. [EnumTableIntegrityError ('Postgres pgKind)] -> n a
forall e (m :: * -> *) a. MonadValidate e m => e -> m a
refute [EnumTableIntegrityError ('Postgres pgKind)]
forall a. Monoid a => a
mempty
        Just RawColumnInfo ('Postgres pgKind)
primaryKeyColumn -> do
          Either
  QErr
  (Either [EnumTableIntegrityError ('Postgres pgKind)] EnumValues)
result <-
            PGSourceConfig
-> TxET
     QErr
     n
     (Either [EnumTableIntegrityError ('Postgres pgKind)] EnumValues)
-> n (Either
        QErr
        (Either [EnumTableIntegrityError ('Postgres pgKind)] EnumValues))
forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
PGSourceConfig -> TxET QErr m a -> m (Either QErr a)
runPgSourceReadTx PGSourceConfig
pgSourceConfig
              (TxET
   QErr
   n
   (Either [EnumTableIntegrityError ('Postgres pgKind)] EnumValues)
 -> n (Either
         QErr
         (Either [EnumTableIntegrityError ('Postgres pgKind)] EnumValues)))
-> TxET
     QErr
     n
     (Either [EnumTableIntegrityError ('Postgres pgKind)] EnumValues)
-> n (Either
        QErr
        (Either [EnumTableIntegrityError ('Postgres pgKind)] EnumValues))
forall a b. (a -> b) -> a -> b
$ ValidateT
  [EnumTableIntegrityError ('Postgres pgKind)]
  (TxET QErr n)
  EnumValues
-> TxET
     QErr
     n
     (Either [EnumTableIntegrityError ('Postgres pgKind)] EnumValues)
forall e (m :: * -> *) a.
Functor m =>
ValidateT e m a -> m (Either e a)
runValidateT
              (ValidateT
   [EnumTableIntegrityError ('Postgres pgKind)]
   (TxET QErr n)
   EnumValues
 -> TxET
      QErr
      n
      (Either [EnumTableIntegrityError ('Postgres pgKind)] EnumValues))
-> ValidateT
     [EnumTableIntegrityError ('Postgres pgKind)]
     (TxET QErr n)
     EnumValues
-> TxET
     QErr
     n
     (Either [EnumTableIntegrityError ('Postgres pgKind)] EnumValues)
forall a b. (a -> b) -> a -> b
$ QualifiedTable
-> RawColumnInfo ('Postgres pgKind)
-> Maybe (RawColumnInfo ('Postgres pgKind))
-> ValidateT
     [EnumTableIntegrityError ('Postgres pgKind)]
     (TxET QErr n)
     EnumValues
forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadTx m,
 MonadValidate [EnumTableIntegrityError ('Postgres pgKind)] m) =>
QualifiedTable
-> RawColumnInfo ('Postgres pgKind)
-> Maybe (RawColumnInfo ('Postgres pgKind))
-> m EnumValues
fetchEnumValuesFromDb QualifiedTable
tableName RawColumnInfo ('Postgres pgKind)
primaryKeyColumn Maybe (RawColumnInfo ('Postgres pgKind))
maybeCommentColumn
          case Either
  QErr
  (Either [EnumTableIntegrityError ('Postgres pgKind)] EnumValues)
result of
            Left QErr
e -> ([EnumTableIntegrityError ('Postgres pgKind)] -> n EnumValues
forall a. [EnumTableIntegrityError ('Postgres pgKind)] -> n a
forall e (m :: * -> *) a. MonadValidate e m => e -> m a
refute ([EnumTableIntegrityError ('Postgres pgKind)] -> n EnumValues)
-> (QErr -> [EnumTableIntegrityError ('Postgres pgKind)])
-> QErr
-> n EnumValues
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumTableIntegrityError ('Postgres pgKind)
-> [EnumTableIntegrityError ('Postgres pgKind)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EnumTableIntegrityError ('Postgres pgKind)
 -> [EnumTableIntegrityError ('Postgres pgKind)])
-> (QErr -> EnumTableIntegrityError ('Postgres pgKind))
-> QErr
-> [EnumTableIntegrityError ('Postgres pgKind)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> EnumTableIntegrityError ('Postgres pgKind)
forall (b :: BackendType). Text -> EnumTableIntegrityError b
EnumTablePostgresError (Text -> EnumTableIntegrityError ('Postgres pgKind))
-> (QErr -> Text)
-> QErr
-> EnumTableIntegrityError ('Postgres pgKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QErr -> Text
qeError) QErr
e
            Right (Left [EnumTableIntegrityError ('Postgres pgKind)]
vErrs) -> [EnumTableIntegrityError ('Postgres pgKind)] -> n EnumValues
forall a. [EnumTableIntegrityError ('Postgres pgKind)] -> n a
forall e (m :: * -> *) a. MonadValidate e m => e -> m a
refute [EnumTableIntegrityError ('Postgres pgKind)]
vErrs
            Right (Right EnumValues
r) -> EnumValues -> n EnumValues
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EnumValues
r
      where
        validatePrimaryKey :: n (RawColumnInfo ('Postgres pgKind))
validatePrimaryKey = case Maybe
  (PrimaryKey ('Postgres pgKind) (RawColumnInfo ('Postgres pgKind)))
maybePrimaryKey of
          Maybe
  (PrimaryKey ('Postgres pgKind) (RawColumnInfo ('Postgres pgKind)))
Nothing -> [EnumTableIntegrityError ('Postgres pgKind)]
-> n (RawColumnInfo ('Postgres pgKind))
forall a. [EnumTableIntegrityError ('Postgres pgKind)] -> n a
forall e (m :: * -> *) a. MonadValidate e m => e -> m a
refute [EnumTableIntegrityError ('Postgres pgKind)
forall (b :: BackendType). EnumTableIntegrityError b
EnumTableMissingPrimaryKey]
          Just PrimaryKey ('Postgres pgKind) (RawColumnInfo ('Postgres pgKind))
primaryKey -> case PrimaryKey ('Postgres pgKind) (RawColumnInfo ('Postgres pgKind))
-> NESeq (RawColumnInfo ('Postgres pgKind))
forall (b :: BackendType) a. PrimaryKey b a -> NESeq a
_pkColumns PrimaryKey ('Postgres pgKind) (RawColumnInfo ('Postgres pgKind))
primaryKey of
            RawColumnInfo ('Postgres pgKind)
column NESeq.:<|| Seq (RawColumnInfo ('Postgres pgKind))
Seq.Empty -> case RawColumnInfo ('Postgres pgKind)
-> RawColumnType ('Postgres pgKind)
forall (b :: BackendType). RawColumnInfo b -> RawColumnType b
rciType RawColumnInfo ('Postgres pgKind)
column of
              RawColumnTypeScalar ScalarType ('Postgres pgKind)
PGScalarType
PGText -> RawColumnInfo ('Postgres pgKind)
-> n (RawColumnInfo ('Postgres pgKind))
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RawColumnInfo ('Postgres pgKind)
column
              RawColumnType ('Postgres pgKind)
_ -> [EnumTableIntegrityError ('Postgres pgKind)]
-> n (RawColumnInfo ('Postgres pgKind))
forall a. [EnumTableIntegrityError ('Postgres pgKind)] -> n a
forall e (m :: * -> *) a. MonadValidate e m => e -> m a
refute [RawColumnInfo ('Postgres pgKind)
-> EnumTableIntegrityError ('Postgres pgKind)
forall (b :: BackendType).
RawColumnInfo b -> EnumTableIntegrityError b
EnumTableNonTextualPrimaryKey RawColumnInfo ('Postgres pgKind)
column]
            NESeq (RawColumnInfo ('Postgres pgKind))
columns -> [EnumTableIntegrityError ('Postgres pgKind)]
-> n (RawColumnInfo ('Postgres pgKind))
forall a. [EnumTableIntegrityError ('Postgres pgKind)] -> n a
forall e (m :: * -> *) a. MonadValidate e m => e -> m a
refute [[PGCol] -> EnumTableIntegrityError ('Postgres pgKind)
forall (b :: BackendType). [PGCol] -> EnumTableIntegrityError b
EnumTableMultiColumnPrimaryKey ([PGCol] -> EnumTableIntegrityError ('Postgres pgKind))
-> [PGCol] -> EnumTableIntegrityError ('Postgres pgKind)
forall a b. (a -> b) -> a -> b
$ (RawColumnInfo ('Postgres pgKind) -> PGCol)
-> [RawColumnInfo ('Postgres pgKind)] -> [PGCol]
forall a b. (a -> b) -> [a] -> [b]
map RawColumnInfo ('Postgres pgKind) -> Column ('Postgres pgKind)
RawColumnInfo ('Postgres pgKind) -> PGCol
forall (b :: BackendType). RawColumnInfo b -> Column b
rciName (NESeq (RawColumnInfo ('Postgres pgKind))
-> [RawColumnInfo ('Postgres pgKind)]
forall a. NESeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NESeq (RawColumnInfo ('Postgres pgKind))
columns)]

        validateColumns :: Maybe (RawColumnInfo ('Postgres pgKind))
-> n (Maybe (RawColumnInfo ('Postgres pgKind)))
validateColumns Maybe (RawColumnInfo ('Postgres pgKind))
primaryKeyColumn = do
          let nonPrimaryKeyColumns :: [RawColumnInfo ('Postgres pgKind)]
nonPrimaryKeyColumns = [RawColumnInfo ('Postgres pgKind)]
-> (RawColumnInfo ('Postgres pgKind)
    -> [RawColumnInfo ('Postgres pgKind)])
-> Maybe (RawColumnInfo ('Postgres pgKind))
-> [RawColumnInfo ('Postgres pgKind)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [RawColumnInfo ('Postgres pgKind)]
columnInfos (RawColumnInfo ('Postgres pgKind)
-> [RawColumnInfo ('Postgres pgKind)]
-> [RawColumnInfo ('Postgres pgKind)]
forall a. Eq a => a -> [a] -> [a]
`delete` [RawColumnInfo ('Postgres pgKind)]
columnInfos) Maybe (RawColumnInfo ('Postgres pgKind))
primaryKeyColumn
          case [RawColumnInfo ('Postgres pgKind)]
nonPrimaryKeyColumns of
            [] -> Maybe (RawColumnInfo ('Postgres pgKind))
-> n (Maybe (RawColumnInfo ('Postgres pgKind)))
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (RawColumnInfo ('Postgres pgKind))
forall a. Maybe a
Nothing
            [RawColumnInfo ('Postgres pgKind)
column] -> case RawColumnInfo ('Postgres pgKind)
-> RawColumnType ('Postgres pgKind)
forall (b :: BackendType). RawColumnInfo b -> RawColumnType b
rciType RawColumnInfo ('Postgres pgKind)
column of
              RawColumnTypeScalar ScalarType ('Postgres pgKind)
PGScalarType
PGText -> Maybe (RawColumnInfo ('Postgres pgKind))
-> n (Maybe (RawColumnInfo ('Postgres pgKind)))
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (RawColumnInfo ('Postgres pgKind))
 -> n (Maybe (RawColumnInfo ('Postgres pgKind))))
-> Maybe (RawColumnInfo ('Postgres pgKind))
-> n (Maybe (RawColumnInfo ('Postgres pgKind)))
forall a b. (a -> b) -> a -> b
$ RawColumnInfo ('Postgres pgKind)
-> Maybe (RawColumnInfo ('Postgres pgKind))
forall a. a -> Maybe a
Just RawColumnInfo ('Postgres pgKind)
column
              RawColumnType ('Postgres pgKind)
_ -> [EnumTableIntegrityError ('Postgres pgKind)] -> n ()
forall e (m :: * -> *). MonadValidate e m => e -> m ()
dispute [RawColumnInfo ('Postgres pgKind)
-> EnumTableIntegrityError ('Postgres pgKind)
forall (b :: BackendType).
RawColumnInfo b -> EnumTableIntegrityError b
EnumTableNonTextualCommentColumn RawColumnInfo ('Postgres pgKind)
column] n ()
-> Maybe (RawColumnInfo ('Postgres pgKind))
-> n (Maybe (RawColumnInfo ('Postgres pgKind)))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe (RawColumnInfo ('Postgres pgKind))
forall a. Maybe a
Nothing
            [RawColumnInfo ('Postgres pgKind)]
columns -> [EnumTableIntegrityError ('Postgres pgKind)] -> n ()
forall e (m :: * -> *). MonadValidate e m => e -> m ()
dispute [[PGCol] -> EnumTableIntegrityError ('Postgres pgKind)
forall (b :: BackendType). [PGCol] -> EnumTableIntegrityError b
EnumTableTooManyColumns ([PGCol] -> EnumTableIntegrityError ('Postgres pgKind))
-> [PGCol] -> EnumTableIntegrityError ('Postgres pgKind)
forall a b. (a -> b) -> a -> b
$ (RawColumnInfo ('Postgres pgKind) -> PGCol)
-> [RawColumnInfo ('Postgres pgKind)] -> [PGCol]
forall a b. (a -> b) -> [a] -> [b]
map RawColumnInfo ('Postgres pgKind) -> Column ('Postgres pgKind)
RawColumnInfo ('Postgres pgKind) -> PGCol
forall (b :: BackendType). RawColumnInfo b -> Column b
rciName [RawColumnInfo ('Postgres pgKind)]
columns] n ()
-> Maybe (RawColumnInfo ('Postgres pgKind))
-> n (Maybe (RawColumnInfo ('Postgres pgKind)))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe (RawColumnInfo ('Postgres pgKind))
forall a. Maybe a
Nothing

    showErrors :: [EnumTableIntegrityError ('Postgres pgKind)] -> Text
    showErrors :: [EnumTableIntegrityError ('Postgres pgKind)] -> Text
showErrors [EnumTableIntegrityError ('Postgres pgKind)]
allErrors =
      Text
"the table " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> QualifiedTable
tableName QualifiedTable -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" cannot be used as an enum " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
reasonsMessage
      where
        reasonsMessage :: Text
reasonsMessage = [EnumTableIntegrityError ('Postgres pgKind)]
-> (EnumTableIntegrityError ('Postgres pgKind) -> Text) -> Text
forall a. [a] -> (a -> Text) -> Text
makeReasonMessage [EnumTableIntegrityError ('Postgres pgKind)]
allErrors EnumTableIntegrityError ('Postgres pgKind) -> Text
showOne

        showOne :: EnumTableIntegrityError ('Postgres pgKind) -> Text
        showOne :: EnumTableIntegrityError ('Postgres pgKind) -> Text
showOne = \case
          EnumTablePostgresError Text
err -> Text
"postgres error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err
          EnumTableIntegrityError ('Postgres pgKind)
EnumTableMissingPrimaryKey -> Text
"the table must have a primary key"
          EnumTableMultiColumnPrimaryKey [PGCol]
cols ->
            Text
"the table’s primary key must not span multiple columns ("
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [PGCol] -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
commaSeparated ([PGCol] -> [PGCol]
forall a. Ord a => [a] -> [a]
sort [PGCol]
cols)
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
          EnumTableNonTextualPrimaryKey RawColumnInfo ('Postgres pgKind)
colInfo -> Text -> RawColumnInfo ('Postgres pgKind) -> PGScalarType -> Text
typeMismatch Text
"primary key" RawColumnInfo ('Postgres pgKind)
colInfo PGScalarType
PGText
          EnumTableIntegrityError ('Postgres pgKind)
EnumTableNoEnumValues -> Text
"the table must have at least one row"
          EnumTableInvalidEnumValueNames NonEmpty Text
values ->
            let pluralString :: Text
pluralString = Text
" are not valid GraphQL enum value names"
                valuesString :: Text
valuesString = case NonEmpty Text -> NonEmpty Text
forall a. NonEmpty a -> NonEmpty a
NE.reverse (NonEmpty Text -> NonEmpty Text
forall a. Ord a => NonEmpty a -> NonEmpty a
NE.sort NonEmpty Text
values) of
                  Text
value NE.:| [] -> Text
"value " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
value Text -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is not a valid GraphQL enum value name"
                  Text
value2 NE.:| [Text
value1] -> Text
"values " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
value1 Text -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" and " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
value2 Text -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
pluralString
                  Text
lastValue NE.:| [Text]
otherValues ->
                    Text
"values "
                      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
commaSeparated ([Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
otherValues)
                      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", and "
                      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
lastValue
                      Text -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
pluralString
             in Text
"the " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
valuesString
          EnumTableNonTextualCommentColumn RawColumnInfo ('Postgres pgKind)
colInfo -> Text -> RawColumnInfo ('Postgres pgKind) -> PGScalarType -> Text
typeMismatch Text
"comment column" RawColumnInfo ('Postgres pgKind)
colInfo PGScalarType
PGText
          EnumTableTooManyColumns [PGCol]
cols ->
            Text
"the table must have exactly one primary key and optionally one comment column, not "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow ([PGCol] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PGCol]
cols)
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" columns ("
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [PGCol] -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
commaSeparated ([PGCol] -> [PGCol]
forall a. Ord a => [a] -> [a]
sort [PGCol]
cols)
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
          where
            typeMismatch :: Text -> RawColumnInfo ('Postgres pgKind) -> PGScalarType -> Text
typeMismatch Text
description RawColumnInfo ('Postgres pgKind)
colInfo PGScalarType
expected =
              let RawColumnTypeScalar ScalarType ('Postgres pgKind)
scalarType = forall (b :: BackendType). RawColumnInfo b -> RawColumnType b
rciType @('Postgres pgKind) RawColumnInfo ('Postgres pgKind)
colInfo
               in Text
"the table’s "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
description
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ("
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RawColumnInfo ('Postgres pgKind) -> Column ('Postgres pgKind)
forall (b :: BackendType). RawColumnInfo b -> Column b
rciName RawColumnInfo ('Postgres pgKind)
colInfo
                    PGCol -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
") must have type "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PGScalarType
expected
                    PGScalarType -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
", not type "
                    Text -> PGScalarType -> Text
forall t. ToTxt t => Text -> t -> Text
<>> ScalarType ('Postgres pgKind)
PGScalarType
scalarType

fetchEnumValuesFromDb ::
  forall pgKind m.
  (MonadTx m, MonadValidate [EnumTableIntegrityError ('Postgres pgKind)] m) =>
  QualifiedTable ->
  RawColumnInfo ('Postgres pgKind) ->
  Maybe (RawColumnInfo ('Postgres pgKind)) ->
  m EnumValues
fetchEnumValuesFromDb :: forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadTx m,
 MonadValidate [EnumTableIntegrityError ('Postgres pgKind)] m) =>
QualifiedTable
-> RawColumnInfo ('Postgres pgKind)
-> Maybe (RawColumnInfo ('Postgres pgKind))
-> m EnumValues
fetchEnumValuesFromDb QualifiedTable
tableName RawColumnInfo ('Postgres pgKind)
primaryKeyColumn Maybe (RawColumnInfo ('Postgres pgKind))
maybeCommentColumn = do
  let nullExtr :: Extractor
nullExtr = SQLExp -> Maybe ColumnAlias -> Extractor
Extractor SQLExp
SENull Maybe ColumnAlias
forall a. Maybe a
Nothing
      commentExtr :: Extractor
commentExtr = Extractor
-> (RawColumnInfo ('Postgres pgKind) -> Extractor)
-> Maybe (RawColumnInfo ('Postgres pgKind))
-> Extractor
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Extractor
nullExtr (PGCol -> Extractor
forall a. IsIdentifier a => a -> Extractor
mkExtr (PGCol -> Extractor)
-> (RawColumnInfo ('Postgres pgKind) -> PGCol)
-> RawColumnInfo ('Postgres pgKind)
-> Extractor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawColumnInfo ('Postgres pgKind) -> Column ('Postgres pgKind)
RawColumnInfo ('Postgres pgKind) -> PGCol
forall (b :: BackendType). RawColumnInfo b -> Column b
rciName) Maybe (RawColumnInfo ('Postgres pgKind))
maybeCommentColumn
      query :: Query
query =
        Builder -> Query
PG.fromBuilder
          (Builder -> Query) -> Builder -> Query
forall a b. (a -> b) -> a -> b
$ Select -> Builder
forall a. ToSQL a => a -> Builder
toSQL
            Select
mkSelect
              { selFrom :: Maybe FromExp
selFrom = FromExp -> Maybe FromExp
forall a. a -> Maybe a
Just (FromExp -> Maybe FromExp) -> FromExp -> Maybe FromExp
forall a b. (a -> b) -> a -> b
$ QualifiedTable -> FromExp
mkSimpleFromExp QualifiedTable
tableName,
                selExtr :: [Extractor]
selExtr = [PGCol -> Extractor
forall a. IsIdentifier a => a -> Extractor
mkExtr (RawColumnInfo ('Postgres pgKind) -> Column ('Postgres pgKind)
forall (b :: BackendType). RawColumnInfo b -> Column b
rciName RawColumnInfo ('Postgres pgKind)
primaryKeyColumn), Extractor
commentExtr]
              }
  [(Text, Maybe Text)]
rawEnumValues <- TxE QErr [(Text, Maybe Text)] -> m [(Text, Maybe Text)]
forall a. TxE QErr a -> m a
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx (TxE QErr [(Text, Maybe Text)] -> m [(Text, Maybe Text)])
-> TxE QErr [(Text, Maybe Text)] -> m [(Text, Maybe Text)]
forall a b. (a -> b) -> a -> b
$ (PGTxErr -> QErr)
-> Query -> () -> Bool -> TxE QErr [(Text, Maybe Text)]
forall (m :: * -> *) a r e.
(MonadIO m, FromRes a, ToPrepArgs r) =>
(PGTxErr -> e) -> Query -> r -> Bool -> TxET e m a
PG.withQE PGTxErr -> QErr
defaultTxErrorHandler Query
query () Bool
True
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([(Text, Maybe Text)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, Maybe Text)]
rawEnumValues) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [EnumTableIntegrityError ('Postgres pgKind)] -> m ()
forall e (m :: * -> *). MonadValidate e m => e -> m ()
dispute [EnumTableIntegrityError ('Postgres pgKind)
forall (b :: BackendType). EnumTableIntegrityError b
EnumTableNoEnumValues]
  let enumValues :: [Either Text (EnumValue, EnumValueInfo)]
enumValues = (((Text, Maybe Text) -> Either Text (EnumValue, EnumValueInfo))
 -> [(Text, Maybe Text)]
 -> [Either Text (EnumValue, EnumValueInfo)])
-> [(Text, Maybe Text)]
-> ((Text, Maybe Text) -> Either Text (EnumValue, EnumValueInfo))
-> [Either Text (EnumValue, EnumValueInfo)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Text, Maybe Text) -> Either Text (EnumValue, EnumValueInfo))
-> [(Text, Maybe Text)] -> [Either Text (EnumValue, EnumValueInfo)]
forall a b. (a -> b) -> [a] -> [b]
map [(Text, Maybe Text)]
rawEnumValues
        (((Text, Maybe Text) -> Either Text (EnumValue, EnumValueInfo))
 -> [Either Text (EnumValue, EnumValueInfo)])
-> ((Text, Maybe Text) -> Either Text (EnumValue, EnumValueInfo))
-> [Either Text (EnumValue, EnumValueInfo)]
forall a b. (a -> b) -> a -> b
$ \(Text
enumValueText, Maybe Text
comment) ->
          case Text -> Maybe Name
mkValidEnumValueName Text
enumValueText of
            Maybe Name
Nothing -> Text -> Either Text (EnumValue, EnumValueInfo)
forall a b. a -> Either a b
Left Text
enumValueText
            Just Name
enumValue -> (EnumValue, EnumValueInfo)
-> Either Text (EnumValue, EnumValueInfo)
forall a b. b -> Either a b
Right (Name -> EnumValue
EnumValue Name
enumValue, Maybe Text -> EnumValueInfo
EnumValueInfo Maybe Text
comment)
      badNames :: [Text]
badNames = [Either Text (EnumValue, EnumValueInfo)] -> [Text]
forall a b. [Either a b] -> [a]
lefts [Either Text (EnumValue, EnumValueInfo)]
enumValues
      validEnums :: [(EnumValue, EnumValueInfo)]
validEnums = [Either Text (EnumValue, EnumValueInfo)]
-> [(EnumValue, EnumValueInfo)]
forall a b. [Either a b] -> [b]
rights [Either Text (EnumValue, EnumValueInfo)]
enumValues
  case [Text] -> Maybe (NonEmpty Text)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [Text]
badNames of
    Just NonEmpty Text
someBadNames -> [EnumTableIntegrityError ('Postgres pgKind)] -> m EnumValues
forall a. [EnumTableIntegrityError ('Postgres pgKind)] -> m a
forall e (m :: * -> *) a. MonadValidate e m => e -> m a
refute [NonEmpty Text -> EnumTableIntegrityError ('Postgres pgKind)
forall (b :: BackendType).
NonEmpty Text -> EnumTableIntegrityError b
EnumTableInvalidEnumValueNames NonEmpty Text
someBadNames]
    Maybe (NonEmpty Text)
Nothing -> EnumValues -> m EnumValues
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EnumValues -> m EnumValues) -> EnumValues -> m EnumValues
forall a b. (a -> b) -> a -> b
$ [(EnumValue, EnumValueInfo)] -> EnumValues
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(EnumValue, EnumValueInfo)]
validEnums
  where
    -- https://graphql.github.io/graphql-spec/June2018/#EnumValue
    mkValidEnumValueName :: Text -> Maybe Name
mkValidEnumValueName Text
name =
      if Text
name Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"true", Text
"false", Text
"null"]
        then Maybe Name
forall a. Maybe a
Nothing
        else Text -> Maybe Name
G.mkName Text
name