-- | Postgres DDL ComputedField
--
-- How to build the 'ComputedFieldInfo' for a field.
--
-- See 'Hasura.RQL.Types.Metadata.Backend'.
module Hasura.Backends.Postgres.DDL.ComputedField
  ( buildComputedFieldInfo,
  )
where

import Control.Monad.Validate qualified as MV
import Data.HashSet qualified as S
import Data.Sequence qualified as Seq
import Data.Text.Extended
import Hasura.Backends.Postgres.DDL.Function
import Hasura.Backends.Postgres.SQL.Types
import Hasura.Backends.Postgres.Types.ComputedField qualified as PG
import Hasura.Backends.Postgres.Types.Function qualified as PG
import Hasura.Base.Error
import Hasura.Function.Cache
import Hasura.Prelude
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Common (Comment (..))
import Hasura.RQL.Types.ComputedField
import Hasura.Server.Utils
import Language.GraphQL.Draft.Syntax qualified as G

data ComputedFieldValidateError
  = CFVENotValidGraphQLName ComputedFieldName
  | CFVEInvalidTableArgument InvalidTableArgument
  | CFVEInvalidSessionArgument InvalidSessionArgument
  | CFVENotBaseReturnType PGScalarType
  | CFVEReturnTableNotFound QualifiedTable
  | CFVENoInputArguments
  | CFVEFunctionVolatile
  deriving (Int -> ComputedFieldValidateError -> ShowS
[ComputedFieldValidateError] -> ShowS
ComputedFieldValidateError -> String
(Int -> ComputedFieldValidateError -> ShowS)
-> (ComputedFieldValidateError -> String)
-> ([ComputedFieldValidateError] -> ShowS)
-> Show ComputedFieldValidateError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ComputedFieldValidateError -> ShowS
showsPrec :: Int -> ComputedFieldValidateError -> ShowS
$cshow :: ComputedFieldValidateError -> String
show :: ComputedFieldValidateError -> String
$cshowList :: [ComputedFieldValidateError] -> ShowS
showList :: [ComputedFieldValidateError] -> ShowS
Show, ComputedFieldValidateError -> ComputedFieldValidateError -> Bool
(ComputedFieldValidateError -> ComputedFieldValidateError -> Bool)
-> (ComputedFieldValidateError
    -> ComputedFieldValidateError -> Bool)
-> Eq ComputedFieldValidateError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ComputedFieldValidateError -> ComputedFieldValidateError -> Bool
== :: ComputedFieldValidateError -> ComputedFieldValidateError -> Bool
$c/= :: ComputedFieldValidateError -> ComputedFieldValidateError -> Bool
/= :: ComputedFieldValidateError -> ComputedFieldValidateError -> Bool
Eq)

data InvalidTableArgument
  = ITANotFound FunctionArgName
  | ITANotComposite PG.FunctionTableArgument
  | ITANotTable QualifiedTable PG.FunctionTableArgument
  deriving (Int -> InvalidTableArgument -> ShowS
[InvalidTableArgument] -> ShowS
InvalidTableArgument -> String
(Int -> InvalidTableArgument -> ShowS)
-> (InvalidTableArgument -> String)
-> ([InvalidTableArgument] -> ShowS)
-> Show InvalidTableArgument
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InvalidTableArgument -> ShowS
showsPrec :: Int -> InvalidTableArgument -> ShowS
$cshow :: InvalidTableArgument -> String
show :: InvalidTableArgument -> String
$cshowList :: [InvalidTableArgument] -> ShowS
showList :: [InvalidTableArgument] -> ShowS
Show, InvalidTableArgument -> InvalidTableArgument -> Bool
(InvalidTableArgument -> InvalidTableArgument -> Bool)
-> (InvalidTableArgument -> InvalidTableArgument -> Bool)
-> Eq InvalidTableArgument
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InvalidTableArgument -> InvalidTableArgument -> Bool
== :: InvalidTableArgument -> InvalidTableArgument -> Bool
$c/= :: InvalidTableArgument -> InvalidTableArgument -> Bool
/= :: InvalidTableArgument -> InvalidTableArgument -> Bool
Eq)

data InvalidSessionArgument
  = ISANotFound FunctionArgName
  | ISANotJSON PG.FunctionSessionArgument
  deriving (Int -> InvalidSessionArgument -> ShowS
[InvalidSessionArgument] -> ShowS
InvalidSessionArgument -> String
(Int -> InvalidSessionArgument -> ShowS)
-> (InvalidSessionArgument -> String)
-> ([InvalidSessionArgument] -> ShowS)
-> Show InvalidSessionArgument
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InvalidSessionArgument -> ShowS
showsPrec :: Int -> InvalidSessionArgument -> ShowS
$cshow :: InvalidSessionArgument -> String
show :: InvalidSessionArgument -> String
$cshowList :: [InvalidSessionArgument] -> ShowS
showList :: [InvalidSessionArgument] -> ShowS
Show, InvalidSessionArgument -> InvalidSessionArgument -> Bool
(InvalidSessionArgument -> InvalidSessionArgument -> Bool)
-> (InvalidSessionArgument -> InvalidSessionArgument -> Bool)
-> Eq InvalidSessionArgument
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InvalidSessionArgument -> InvalidSessionArgument -> Bool
== :: InvalidSessionArgument -> InvalidSessionArgument -> Bool
$c/= :: InvalidSessionArgument -> InvalidSessionArgument -> Bool
/= :: InvalidSessionArgument -> InvalidSessionArgument -> Bool
Eq)

showError :: QualifiedFunction -> ComputedFieldValidateError -> Text
showError :: QualifiedFunction -> ComputedFieldValidateError -> Text
showError QualifiedFunction
qf = \case
  CFVENotValidGraphQLName ComputedFieldName
computedField ->
    ComputedFieldName
computedField ComputedFieldName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is not valid GraphQL name"
  CFVEInvalidTableArgument (ITANotFound FunctionArgName
argName) ->
    FunctionArgName
argName FunctionArgName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is not an input argument of the function " Text -> QualifiedFunction -> Text
forall t. ToTxt t => Text -> t -> Text
<>> QualifiedFunction
qf
  CFVEInvalidTableArgument (ITANotComposite FunctionTableArgument
functionArg) ->
    FunctionTableArgument -> Text
showFunctionTableArgument FunctionTableArgument
functionArg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not COMPOSITE type"
  CFVEInvalidTableArgument (ITANotTable QualifiedTable
ty FunctionTableArgument
functionArg) ->
    FunctionTableArgument -> Text
showFunctionTableArgument FunctionTableArgument
functionArg
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" of type "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> QualifiedTable
ty
      QualifiedTable -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is not the table to which the computed field is being added"
  CFVEInvalidSessionArgument (ISANotFound FunctionArgName
argName) ->
    FunctionArgName
argName FunctionArgName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is not an input argument of the function " Text -> QualifiedFunction -> Text
forall t. ToTxt t => Text -> t -> Text
<>> QualifiedFunction
qf
  CFVEInvalidSessionArgument (ISANotJSON FunctionSessionArgument
functionArg) ->
    FunctionSessionArgument -> Text
showFunctionSessionArgument FunctionSessionArgument
functionArg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not of type JSON"
  CFVENotBaseReturnType PGScalarType
scalarType ->
    Text
"the function "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> QualifiedFunction
qf
      QualifiedFunction -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" returning type "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PGScalarType -> Text
pgScalarTypeToText PGScalarType
scalarType
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not a BASE type"
  CFVEReturnTableNotFound QualifiedTable
table ->
    Text
"the function "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> QualifiedFunction
qf
      QualifiedFunction -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" returning set of table "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> QualifiedTable
table
      QualifiedTable -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is not tracked or not found in database"
  ComputedFieldValidateError
CFVENoInputArguments ->
    Text
"the function " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> QualifiedFunction
qf QualifiedFunction -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" has no input arguments"
  ComputedFieldValidateError
CFVEFunctionVolatile ->
    Text
"the function " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> QualifiedFunction
qf QualifiedFunction -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is of type VOLATILE; cannot be added as a computed field"
  where
    showFunctionTableArgument :: FunctionTableArgument -> Text
showFunctionTableArgument = \case
      FunctionTableArgument
PG.FTAFirst -> Text
"first argument of the function " Text -> QualifiedFunction -> Text
forall t. ToTxt t => Text -> t -> Text
<>> QualifiedFunction
qf
      PG.FTANamed FunctionArgName
argName Int
_ -> FunctionArgName
argName FunctionArgName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" argument of the function " Text -> QualifiedFunction -> Text
forall t. ToTxt t => Text -> t -> Text
<>> QualifiedFunction
qf
    showFunctionSessionArgument :: FunctionSessionArgument -> Text
showFunctionSessionArgument = \case
      PG.FunctionSessionArgument FunctionArgName
argName Int
_ -> FunctionArgName
argName FunctionArgName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" argument of the function " Text -> QualifiedFunction -> Text
forall t. ToTxt t => Text -> t -> Text
<>> QualifiedFunction
qf

buildComputedFieldInfo ::
  forall pgKind m.
  (QErrM m) =>
  -- | the set of all tracked tables
  S.HashSet QualifiedTable ->
  QualifiedTable ->
  S.HashSet PGCol ->
  ComputedFieldName ->
  PG.ComputedFieldDefinition ->
  PGRawFunctionInfo ->
  Comment ->
  m (ComputedFieldInfo ('Postgres pgKind))
buildComputedFieldInfo :: forall (pgKind :: PostgresKind) (m :: * -> *).
QErrM m =>
HashSet QualifiedTable
-> QualifiedTable
-> HashSet PGCol
-> ComputedFieldName
-> ComputedFieldDefinition
-> PGRawFunctionInfo
-> Comment
-> m (ComputedFieldInfo ('Postgres pgKind))
buildComputedFieldInfo HashSet QualifiedTable
trackedTables QualifiedTable
table HashSet PGCol
_tableColumns ComputedFieldName
computedField ComputedFieldDefinition
definition PGRawFunctionInfo
rawFunctionInfo Comment
comment =
  ([ComputedFieldValidateError]
 -> m (ComputedFieldInfo ('Postgres pgKind)))
-> (ComputedFieldInfo ('Postgres pgKind)
    -> m (ComputedFieldInfo ('Postgres pgKind)))
-> Either
     [ComputedFieldValidateError] (ComputedFieldInfo ('Postgres pgKind))
-> m (ComputedFieldInfo ('Postgres pgKind))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Code -> Text -> m (ComputedFieldInfo ('Postgres pgKind))
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported (Text -> m (ComputedFieldInfo ('Postgres pgKind)))
-> ([ComputedFieldValidateError] -> Text)
-> [ComputedFieldValidateError]
-> m (ComputedFieldInfo ('Postgres pgKind))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ComputedFieldValidateError] -> Text
showErrors) ComputedFieldInfo ('Postgres pgKind)
-> m (ComputedFieldInfo ('Postgres pgKind))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
   [ComputedFieldValidateError] (ComputedFieldInfo ('Postgres pgKind))
 -> m (ComputedFieldInfo ('Postgres pgKind)))
-> m (Either
        [ComputedFieldValidateError]
        (ComputedFieldInfo ('Postgres pgKind)))
-> m (ComputedFieldInfo ('Postgres pgKind))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ValidateT
  [ComputedFieldValidateError]
  m
  (ComputedFieldInfo ('Postgres pgKind))
-> m (Either
        [ComputedFieldValidateError]
        (ComputedFieldInfo ('Postgres pgKind)))
forall e (m :: * -> *) a.
Functor m =>
ValidateT e m a -> m (Either e a)
MV.runValidateT ValidateT
  [ComputedFieldValidateError]
  m
  (ComputedFieldInfo ('Postgres pgKind))
forall (n :: * -> *).
MonadValidate [ComputedFieldValidateError] n =>
n (ComputedFieldInfo ('Postgres pgKind))
mkComputedFieldInfo
  where
    inputArgNames :: [FunctionArgName]
inputArgNames = PGRawFunctionInfo -> [FunctionArgName]
rfiInputArgNames PGRawFunctionInfo
rawFunctionInfo
    PG.ComputedFieldDefinition QualifiedFunction
function Maybe FunctionArgName
maybeTableArg Maybe FunctionArgName
maybeSessionArg = ComputedFieldDefinition
definition
    functionReturnType :: QualifiedPGType
functionReturnType =
      SchemaName -> PGScalarType -> PGTypeKind -> QualifiedPGType
QualifiedPGType
        (PGRawFunctionInfo -> SchemaName
rfiReturnTypeSchema PGRawFunctionInfo
rawFunctionInfo)
        (PGRawFunctionInfo -> PGScalarType
rfiReturnTypeName PGRawFunctionInfo
rawFunctionInfo)
        (PGRawFunctionInfo -> PGTypeKind
rfiReturnTypeType PGRawFunctionInfo
rawFunctionInfo)

    computedFieldGraphQLName :: Maybe Name
computedFieldGraphQLName = Text -> Maybe Name
G.mkName (Text -> Maybe Name) -> Text -> Maybe Name
forall a b. (a -> b) -> a -> b
$ ComputedFieldName -> Text
computedFieldNameToText ComputedFieldName
computedField

    mkComputedFieldInfo ::
      (MV.MonadValidate [ComputedFieldValidateError] n) =>
      n (ComputedFieldInfo ('Postgres pgKind))
    mkComputedFieldInfo :: forall (n :: * -> *).
MonadValidate [ComputedFieldValidateError] n =>
n (ComputedFieldInfo ('Postgres pgKind))
mkComputedFieldInfo = do
      -- Check if computed field name is a valid GraphQL name
      Bool -> n () -> n ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe Name -> Bool
forall a. Maybe a -> Bool
isJust Maybe Name
computedFieldGraphQLName)
        (n () -> n ()) -> n () -> n ()
forall a b. (a -> b) -> a -> b
$ [ComputedFieldValidateError] -> n ()
forall e (m :: * -> *). MonadValidate e m => e -> m ()
MV.dispute
        ([ComputedFieldValidateError] -> n ())
-> [ComputedFieldValidateError] -> n ()
forall a b. (a -> b) -> a -> b
$ ComputedFieldValidateError -> [ComputedFieldValidateError]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (ComputedFieldValidateError -> [ComputedFieldValidateError])
-> ComputedFieldValidateError -> [ComputedFieldValidateError]
forall a b. (a -> b) -> a -> b
$ ComputedFieldName -> ComputedFieldValidateError
CFVENotValidGraphQLName ComputedFieldName
computedField

      -- Check if function is VOLATILE
      Bool -> n () -> n ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PGRawFunctionInfo -> FunctionVolatility
rfiFunctionType PGRawFunctionInfo
rawFunctionInfo FunctionVolatility -> FunctionVolatility -> Bool
forall a. Eq a => a -> a -> Bool
== FunctionVolatility
FTVOLATILE)
        (n () -> n ()) -> n () -> n ()
forall a b. (a -> b) -> a -> b
$ [ComputedFieldValidateError] -> n ()
forall e (m :: * -> *). MonadValidate e m => e -> m ()
MV.dispute
        ([ComputedFieldValidateError] -> n ())
-> [ComputedFieldValidateError] -> n ()
forall a b. (a -> b) -> a -> b
$ ComputedFieldValidateError -> [ComputedFieldValidateError]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ComputedFieldValidateError
CFVEFunctionVolatile

      -- Validate and resolve return type
      ComputedFieldReturn
returnType <-
        if PGRawFunctionInfo -> Bool
rfiReturnsTable PGRawFunctionInfo
rawFunctionInfo
          then do
            let returnTable :: QualifiedTable
returnTable = QualifiedPGType -> QualifiedTable
typeToTable QualifiedPGType
functionReturnType
            Bool -> n () -> n ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (QualifiedTable
returnTable QualifiedTable -> HashSet QualifiedTable -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`S.member` HashSet QualifiedTable
trackedTables)
              (n () -> n ()) -> n () -> n ()
forall a b. (a -> b) -> a -> b
$ [ComputedFieldValidateError] -> n ()
forall e (m :: * -> *). MonadValidate e m => e -> m ()
MV.dispute
              ([ComputedFieldValidateError] -> n ())
-> [ComputedFieldValidateError] -> n ()
forall a b. (a -> b) -> a -> b
$ ComputedFieldValidateError -> [ComputedFieldValidateError]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
              (ComputedFieldValidateError -> [ComputedFieldValidateError])
-> ComputedFieldValidateError -> [ComputedFieldValidateError]
forall a b. (a -> b) -> a -> b
$ QualifiedTable -> ComputedFieldValidateError
CFVEReturnTableNotFound QualifiedTable
returnTable
            ComputedFieldReturn -> n ComputedFieldReturn
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ComputedFieldReturn -> n ComputedFieldReturn)
-> ComputedFieldReturn -> n ComputedFieldReturn
forall a b. (a -> b) -> a -> b
$ QualifiedTable -> ComputedFieldReturn
PG.CFRSetofTable QualifiedTable
returnTable
          else do
            let scalarType :: PGScalarType
scalarType = QualifiedPGType -> PGScalarType
_qptName QualifiedPGType
functionReturnType
            Bool -> n () -> n ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (QualifiedPGType -> Bool
isBaseType QualifiedPGType
functionReturnType)
              (n () -> n ()) -> n () -> n ()
forall a b. (a -> b) -> a -> b
$ [ComputedFieldValidateError] -> n ()
forall e (m :: * -> *). MonadValidate e m => e -> m ()
MV.dispute
              ([ComputedFieldValidateError] -> n ())
-> [ComputedFieldValidateError] -> n ()
forall a b. (a -> b) -> a -> b
$ ComputedFieldValidateError -> [ComputedFieldValidateError]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
              (ComputedFieldValidateError -> [ComputedFieldValidateError])
-> ComputedFieldValidateError -> [ComputedFieldValidateError]
forall a b. (a -> b) -> a -> b
$ PGScalarType -> ComputedFieldValidateError
CFVENotBaseReturnType PGScalarType
scalarType
            ComputedFieldReturn -> n ComputedFieldReturn
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ComputedFieldReturn -> n ComputedFieldReturn)
-> ComputedFieldReturn -> n ComputedFieldReturn
forall a b. (a -> b) -> a -> b
$ PGScalarType -> ComputedFieldReturn
PG.CFRScalar PGScalarType
scalarType

      -- Validate and resolve table argument
      let inputArgs :: [FunctionArg]
inputArgs =
            Int -> [QualifiedPGType] -> [FunctionArgName] -> [FunctionArg]
mkFunctionArgs
              (PGRawFunctionInfo -> Int
rfiDefaultArgs PGRawFunctionInfo
rawFunctionInfo)
              (PGRawFunctionInfo -> [QualifiedPGType]
rfiInputArgTypes PGRawFunctionInfo
rawFunctionInfo)
              [FunctionArgName]
inputArgNames
      FunctionTableArgument
tableArgument <- case Maybe FunctionArgName
maybeTableArg of
        Just FunctionArgName
argName ->
          case (FunctionArg -> Bool) -> [FunctionArg] -> Maybe (FunctionArg, Int)
forall a. (a -> Bool) -> [a] -> Maybe (a, Int)
findWithIndex ((FunctionArgName -> Maybe FunctionArgName
forall a. a -> Maybe a
Just FunctionArgName
argName Maybe FunctionArgName -> Maybe FunctionArgName -> Bool
forall a. Eq a => a -> a -> Bool
==) (Maybe FunctionArgName -> Bool)
-> (FunctionArg -> Maybe FunctionArgName) -> FunctionArg -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionArg -> Maybe FunctionArgName
PG.faName) [FunctionArg]
inputArgs of
            Just (FunctionArg
tableArg, Int
index) -> do
              let functionTableArg :: FunctionTableArgument
functionTableArg = FunctionArgName -> Int -> FunctionTableArgument
PG.FTANamed FunctionArgName
argName Int
index
              FunctionTableArgument -> QualifiedPGType -> n ()
forall (n :: * -> *).
MonadValidate [ComputedFieldValidateError] n =>
FunctionTableArgument -> QualifiedPGType -> n ()
validateTableArgumentType FunctionTableArgument
functionTableArg (QualifiedPGType -> n ()) -> QualifiedPGType -> n ()
forall a b. (a -> b) -> a -> b
$ FunctionArg -> QualifiedPGType
PG.faType FunctionArg
tableArg
              FunctionTableArgument -> n FunctionTableArgument
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FunctionTableArgument
functionTableArg
            Maybe (FunctionArg, Int)
Nothing ->
              [ComputedFieldValidateError] -> n FunctionTableArgument
forall a. [ComputedFieldValidateError] -> n a
forall e (m :: * -> *) a. MonadValidate e m => e -> m a
MV.refute ([ComputedFieldValidateError] -> n FunctionTableArgument)
-> [ComputedFieldValidateError] -> n FunctionTableArgument
forall a b. (a -> b) -> a -> b
$ ComputedFieldValidateError -> [ComputedFieldValidateError]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ComputedFieldValidateError -> [ComputedFieldValidateError])
-> ComputedFieldValidateError -> [ComputedFieldValidateError]
forall a b. (a -> b) -> a -> b
$ InvalidTableArgument -> ComputedFieldValidateError
CFVEInvalidTableArgument (InvalidTableArgument -> ComputedFieldValidateError)
-> InvalidTableArgument -> ComputedFieldValidateError
forall a b. (a -> b) -> a -> b
$ FunctionArgName -> InvalidTableArgument
ITANotFound FunctionArgName
argName
        Maybe FunctionArgName
Nothing -> do
          case [FunctionArg]
inputArgs of
            [] -> [ComputedFieldValidateError] -> n ()
forall e (m :: * -> *). MonadValidate e m => e -> m ()
MV.dispute ([ComputedFieldValidateError] -> n ())
-> [ComputedFieldValidateError] -> n ()
forall a b. (a -> b) -> a -> b
$ ComputedFieldValidateError -> [ComputedFieldValidateError]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ComputedFieldValidateError
CFVENoInputArguments
            (FunctionArg
firstArg : [FunctionArg]
_) ->
              FunctionTableArgument -> QualifiedPGType -> n ()
forall (n :: * -> *).
MonadValidate [ComputedFieldValidateError] n =>
FunctionTableArgument -> QualifiedPGType -> n ()
validateTableArgumentType FunctionTableArgument
PG.FTAFirst (QualifiedPGType -> n ()) -> QualifiedPGType -> n ()
forall a b. (a -> b) -> a -> b
$ FunctionArg -> QualifiedPGType
PG.faType FunctionArg
firstArg
          FunctionTableArgument -> n FunctionTableArgument
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FunctionTableArgument
PG.FTAFirst

      Maybe FunctionSessionArgument
maybePGSessionArg <- Maybe (n FunctionSessionArgument)
-> n (Maybe FunctionSessionArgument)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => Maybe (m a) -> m (Maybe a)
sequence (Maybe (n FunctionSessionArgument)
 -> n (Maybe FunctionSessionArgument))
-> Maybe (n FunctionSessionArgument)
-> n (Maybe FunctionSessionArgument)
forall a b. (a -> b) -> a -> b
$ do
        FunctionArgName
argName <- Maybe FunctionArgName
maybeSessionArg
        n FunctionSessionArgument -> Maybe (n FunctionSessionArgument)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (n FunctionSessionArgument -> Maybe (n FunctionSessionArgument))
-> n FunctionSessionArgument -> Maybe (n FunctionSessionArgument)
forall a b. (a -> b) -> a -> b
$ case (FunctionArg -> Bool) -> [FunctionArg] -> Maybe (FunctionArg, Int)
forall a. (a -> Bool) -> [a] -> Maybe (a, Int)
findWithIndex ((FunctionArgName -> Maybe FunctionArgName
forall a. a -> Maybe a
Just FunctionArgName
argName Maybe FunctionArgName -> Maybe FunctionArgName -> Bool
forall a. Eq a => a -> a -> Bool
==) (Maybe FunctionArgName -> Bool)
-> (FunctionArg -> Maybe FunctionArgName) -> FunctionArg -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionArg -> Maybe FunctionArgName
PG.faName) [FunctionArg]
inputArgs of
          Just (FunctionArg
sessionArg, Int
index) -> do
            let functionSessionArg :: FunctionSessionArgument
functionSessionArg = FunctionArgName -> Int -> FunctionSessionArgument
PG.FunctionSessionArgument FunctionArgName
argName Int
index
            FunctionSessionArgument -> QualifiedPGType -> n ()
forall (n :: * -> *).
MonadValidate [ComputedFieldValidateError] n =>
FunctionSessionArgument -> QualifiedPGType -> n ()
validateSessionArgumentType FunctionSessionArgument
functionSessionArg (QualifiedPGType -> n ()) -> QualifiedPGType -> n ()
forall a b. (a -> b) -> a -> b
$ FunctionArg -> QualifiedPGType
PG.faType FunctionArg
sessionArg
            FunctionSessionArgument -> n FunctionSessionArgument
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FunctionSessionArgument
functionSessionArg
          Maybe (FunctionArg, Int)
Nothing ->
            [ComputedFieldValidateError] -> n FunctionSessionArgument
forall a. [ComputedFieldValidateError] -> n a
forall e (m :: * -> *) a. MonadValidate e m => e -> m a
MV.refute ([ComputedFieldValidateError] -> n FunctionSessionArgument)
-> [ComputedFieldValidateError] -> n FunctionSessionArgument
forall a b. (a -> b) -> a -> b
$ ComputedFieldValidateError -> [ComputedFieldValidateError]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ComputedFieldValidateError -> [ComputedFieldValidateError])
-> ComputedFieldValidateError -> [ComputedFieldValidateError]
forall a b. (a -> b) -> a -> b
$ InvalidSessionArgument -> ComputedFieldValidateError
CFVEInvalidSessionArgument (InvalidSessionArgument -> ComputedFieldValidateError)
-> InvalidSessionArgument -> ComputedFieldValidateError
forall a b. (a -> b) -> a -> b
$ FunctionArgName -> InvalidSessionArgument
ISANotFound FunctionArgName
argName

      let inputArgSeq :: Seq FunctionArg
inputArgSeq =
            [FunctionArg] -> Seq FunctionArg
forall a. [a] -> Seq a
Seq.fromList
              ([FunctionArg] -> Seq FunctionArg)
-> [FunctionArg] -> Seq FunctionArg
forall a b. (a -> b) -> a -> b
$ FunctionTableArgument
-> Maybe FunctionSessionArgument -> [FunctionArg] -> [FunctionArg]
dropTableAndSessionArgument FunctionTableArgument
tableArgument Maybe FunctionSessionArgument
maybePGSessionArg [FunctionArg]
inputArgs
          computedFieldArgs :: ComputedFieldImplicitArguments
computedFieldArgs = FunctionTableArgument
-> Maybe FunctionSessionArgument -> ComputedFieldImplicitArguments
PG.ComputedFieldImplicitArguments FunctionTableArgument
tableArgument Maybe FunctionSessionArgument
maybePGSessionArg
          computedFieldFunction :: ComputedFieldFunction ('Postgres pgKind)
computedFieldFunction =
            FunctionName ('Postgres pgKind)
-> Seq (FunctionArgument ('Postgres pgKind))
-> ComputedFieldImplicitArguments ('Postgres pgKind)
-> Maybe PGDescription
-> ComputedFieldFunction ('Postgres pgKind)
forall (b :: BackendType).
FunctionName b
-> Seq (FunctionArgument b)
-> ComputedFieldImplicitArguments b
-> Maybe PGDescription
-> ComputedFieldFunction b
ComputedFieldFunction FunctionName ('Postgres pgKind)
QualifiedFunction
function Seq (FunctionArgument ('Postgres pgKind))
Seq FunctionArg
inputArgSeq ComputedFieldImplicitArguments ('Postgres pgKind)
ComputedFieldImplicitArguments
computedFieldArgs (Maybe PGDescription -> ComputedFieldFunction ('Postgres pgKind))
-> Maybe PGDescription -> ComputedFieldFunction ('Postgres pgKind)
forall a b. (a -> b) -> a -> b
$ PGRawFunctionInfo -> Maybe PGDescription
rfiDescription PGRawFunctionInfo
rawFunctionInfo

      ComputedFieldInfo ('Postgres pgKind)
-> n (ComputedFieldInfo ('Postgres pgKind))
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ComputedFieldInfo ('Postgres pgKind)
 -> n (ComputedFieldInfo ('Postgres pgKind)))
-> ComputedFieldInfo ('Postgres pgKind)
-> n (ComputedFieldInfo ('Postgres pgKind))
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
XComputedField b
-> ComputedFieldName
-> ComputedFieldFunction b
-> ComputedFieldReturn b
-> Maybe Text
-> ComputedFieldInfo b
ComputedFieldInfo @('Postgres pgKind) () ComputedFieldName
computedField ComputedFieldFunction ('Postgres pgKind)
computedFieldFunction ComputedFieldReturn ('Postgres pgKind)
ComputedFieldReturn
returnType Maybe Text
description

    validateTableArgumentType ::
      (MV.MonadValidate [ComputedFieldValidateError] n) =>
      PG.FunctionTableArgument ->
      QualifiedPGType ->
      n ()
    validateTableArgumentType :: forall (n :: * -> *).
MonadValidate [ComputedFieldValidateError] n =>
FunctionTableArgument -> QualifiedPGType -> n ()
validateTableArgumentType FunctionTableArgument
tableArg QualifiedPGType
qpt = do
      Bool -> n () -> n ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (QualifiedPGType -> PGTypeKind
_qptType QualifiedPGType
qpt PGTypeKind -> PGTypeKind -> Bool
forall a. Eq a => a -> a -> Bool
/= PGTypeKind
PGKindComposite)
        (n () -> n ()) -> n () -> n ()
forall a b. (a -> b) -> a -> b
$ [ComputedFieldValidateError] -> n ()
forall e (m :: * -> *). MonadValidate e m => e -> m ()
MV.dispute
        ([ComputedFieldValidateError] -> n ())
-> [ComputedFieldValidateError] -> n ()
forall a b. (a -> b) -> a -> b
$ ComputedFieldValidateError -> [ComputedFieldValidateError]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (ComputedFieldValidateError -> [ComputedFieldValidateError])
-> ComputedFieldValidateError -> [ComputedFieldValidateError]
forall a b. (a -> b) -> a -> b
$ InvalidTableArgument -> ComputedFieldValidateError
CFVEInvalidTableArgument
        (InvalidTableArgument -> ComputedFieldValidateError)
-> InvalidTableArgument -> ComputedFieldValidateError
forall a b. (a -> b) -> a -> b
$ FunctionTableArgument -> InvalidTableArgument
ITANotComposite FunctionTableArgument
tableArg
      let typeTable :: QualifiedTable
typeTable = QualifiedPGType -> QualifiedTable
typeToTable QualifiedPGType
qpt
      Bool -> n () -> n ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (QualifiedTable
table QualifiedTable -> QualifiedTable -> Bool
forall a. Eq a => a -> a -> Bool
== QualifiedTable
typeTable)
        (n () -> n ()) -> n () -> n ()
forall a b. (a -> b) -> a -> b
$ [ComputedFieldValidateError] -> n ()
forall e (m :: * -> *). MonadValidate e m => e -> m ()
MV.dispute
        ([ComputedFieldValidateError] -> n ())
-> [ComputedFieldValidateError] -> n ()
forall a b. (a -> b) -> a -> b
$ ComputedFieldValidateError -> [ComputedFieldValidateError]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (ComputedFieldValidateError -> [ComputedFieldValidateError])
-> ComputedFieldValidateError -> [ComputedFieldValidateError]
forall a b. (a -> b) -> a -> b
$ InvalidTableArgument -> ComputedFieldValidateError
CFVEInvalidTableArgument
        (InvalidTableArgument -> ComputedFieldValidateError)
-> InvalidTableArgument -> ComputedFieldValidateError
forall a b. (a -> b) -> a -> b
$ QualifiedTable -> FunctionTableArgument -> InvalidTableArgument
ITANotTable QualifiedTable
typeTable FunctionTableArgument
tableArg

    validateSessionArgumentType ::
      (MV.MonadValidate [ComputedFieldValidateError] n) =>
      PG.FunctionSessionArgument ->
      QualifiedPGType ->
      n ()
    validateSessionArgumentType :: forall (n :: * -> *).
MonadValidate [ComputedFieldValidateError] n =>
FunctionSessionArgument -> QualifiedPGType -> n ()
validateSessionArgumentType FunctionSessionArgument
sessionArg QualifiedPGType
qpt = do
      Bool -> n () -> n ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (PGScalarType -> Bool
isJSONType (PGScalarType -> Bool) -> PGScalarType -> Bool
forall a b. (a -> b) -> a -> b
$ QualifiedPGType -> PGScalarType
_qptName QualifiedPGType
qpt)
        (n () -> n ()) -> n () -> n ()
forall a b. (a -> b) -> a -> b
$ [ComputedFieldValidateError] -> n ()
forall e (m :: * -> *). MonadValidate e m => e -> m ()
MV.dispute
        ([ComputedFieldValidateError] -> n ())
-> [ComputedFieldValidateError] -> n ()
forall a b. (a -> b) -> a -> b
$ ComputedFieldValidateError -> [ComputedFieldValidateError]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (ComputedFieldValidateError -> [ComputedFieldValidateError])
-> ComputedFieldValidateError -> [ComputedFieldValidateError]
forall a b. (a -> b) -> a -> b
$ InvalidSessionArgument -> ComputedFieldValidateError
CFVEInvalidSessionArgument
        (InvalidSessionArgument -> ComputedFieldValidateError)
-> InvalidSessionArgument -> ComputedFieldValidateError
forall a b. (a -> b) -> a -> b
$ FunctionSessionArgument -> InvalidSessionArgument
ISANotJSON FunctionSessionArgument
sessionArg

    showErrors :: [ComputedFieldValidateError] -> Text
    showErrors :: [ComputedFieldValidateError] -> Text
showErrors [ComputedFieldValidateError]
allErrors =
      Text
"the computed field "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ComputedFieldName
computedField
        ComputedFieldName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" cannot be added to table "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> QualifiedTable
table
        QualifiedTable -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
reasonMessage
      where
        reasonMessage :: Text
reasonMessage = [ComputedFieldValidateError]
-> (ComputedFieldValidateError -> Text) -> Text
forall a. [a] -> (a -> Text) -> Text
makeReasonMessage [ComputedFieldValidateError]
allErrors (QualifiedFunction -> ComputedFieldValidateError -> Text
showError QualifiedFunction
function)

    dropTableAndSessionArgument ::
      PG.FunctionTableArgument ->
      Maybe PG.FunctionSessionArgument ->
      [PG.FunctionArg] ->
      [PG.FunctionArg]
    dropTableAndSessionArgument :: FunctionTableArgument
-> Maybe FunctionSessionArgument -> [FunctionArg] -> [FunctionArg]
dropTableAndSessionArgument FunctionTableArgument
tableArg Maybe FunctionSessionArgument
sessionArg [FunctionArg]
inputArgs =
      let withoutTable :: [FunctionArg]
withoutTable = case FunctionTableArgument
tableArg of
            FunctionTableArgument
PG.FTAFirst -> [FunctionArg] -> [FunctionArg]
forall a. HasCallStack => [a] -> [a]
tail [FunctionArg]
inputArgs
            PG.FTANamed FunctionArgName
argName Int
_ ->
              (FunctionArg -> Bool) -> [FunctionArg] -> [FunctionArg]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe FunctionArgName -> Maybe FunctionArgName -> Bool
forall a. Eq a => a -> a -> Bool
(/=) (FunctionArgName -> Maybe FunctionArgName
forall a. a -> Maybe a
Just FunctionArgName
argName) (Maybe FunctionArgName -> Bool)
-> (FunctionArg -> Maybe FunctionArgName) -> FunctionArg -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionArg -> Maybe FunctionArgName
PG.faName) [FunctionArg]
inputArgs
          alsoWithoutSession :: [FunctionArg]
alsoWithoutSession = case Maybe FunctionSessionArgument
sessionArg of
            Maybe FunctionSessionArgument
Nothing -> [FunctionArg]
withoutTable
            Just (PG.FunctionSessionArgument FunctionArgName
name Int
_) ->
              (FunctionArg -> Bool) -> [FunctionArg] -> [FunctionArg]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe FunctionArgName -> Maybe FunctionArgName -> Bool
forall a. Eq a => a -> a -> Bool
(/=) (FunctionArgName -> Maybe FunctionArgName
forall a. a -> Maybe a
Just FunctionArgName
name) (Maybe FunctionArgName -> Bool)
-> (FunctionArg -> Maybe FunctionArgName) -> FunctionArg -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionArg -> Maybe FunctionArgName
PG.faName) [FunctionArg]
withoutTable
       in [FunctionArg]
alsoWithoutSession

    description :: Maybe Text
    description :: Maybe Text
description =
      case Comment
comment of
        Comment
Automatic -> Maybe Text
commentFromDatabase Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
autogeneratedDescription
        Explicit Maybe NonEmptyText
value -> NonEmptyText -> Text
forall a. ToTxt a => a -> Text
toTxt (NonEmptyText -> Text) -> Maybe NonEmptyText -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe NonEmptyText
value
      where
        commentFromDatabase :: Maybe Text
commentFromDatabase = PGDescription -> Text
getPGDescription (PGDescription -> Text) -> Maybe PGDescription -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PGRawFunctionInfo -> Maybe PGDescription
rfiDescription PGRawFunctionInfo
rawFunctionInfo
        autogeneratedDescription :: Text
autogeneratedDescription =
          Text
"A computed field, executes function " Text -> QualifiedFunction -> Text
forall t. ToTxt t => Text -> t -> Text
<>> QualifiedFunction
function