{-# LANGUAGE TemplateHaskellQuotes #-}

-- | Schema parsers for native queries.
module Hasura.NativeQuery.Schema
  ( defaultSelectNativeQuery,
    defaultSelectNativeQueryObject,
    defaultBuildNativeQueryRootFields,
  )
where

import Data.Has (Has (getter))
import Data.HashMap.Strict qualified as HashMap
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
import Data.Set qualified as S
import Hasura.Base.Error (throw500)
import Hasura.GraphQL.Parser.Internal.Parser qualified as IP
import Hasura.GraphQL.Schema.Backend
  ( BackendLogicalModelSelectSchema (..),
    BackendNativeQuerySelectSchema (..),
    MonadBuildSchema,
  )
import Hasura.GraphQL.Schema.Common
  ( AnnotatedField,
    AnnotatedFields,
    SchemaT,
    askNativeQueryInfo,
    parsedSelectionsToFields,
    retrieve,
    textToName,
  )
import Hasura.GraphQL.Schema.Parser qualified as P
import Hasura.LogicalModel.Cache (LogicalModelInfo (..))
import Hasura.LogicalModel.Schema (buildLogicalModelIR, buildLogicalModelPermissions, logicalModelFieldParsers, logicalModelSelectionList)
import Hasura.LogicalModelResolver.Schema (argumentsSchema)
import Hasura.NativeQuery.Cache (NativeQueryInfo (..))
import Hasura.NativeQuery.IR (NativeQuery (..))
import Hasura.NativeQuery.Metadata (ArgumentName (..), InterpolatedQuery (..))
import Hasura.NativeQuery.Types (NullableScalarType (..), getNativeQueryName)
import Hasura.Prelude
import Hasura.RQL.IR.Root (RemoteRelationshipField)
import Hasura.RQL.IR.Select (QueryDB (QDBMultipleRows))
import Hasura.RQL.IR.Select qualified as IR
import Hasura.RQL.IR.Value (Provenance (FreshVar), UnpreparedValue (UVParameter))
import Hasura.RQL.Types.Column qualified as Column
import Hasura.RQL.Types.Common (RelType (..), relNameToTxt)
import Hasura.RQL.Types.Metadata.Object qualified as MO
import Hasura.RQL.Types.Relationships.Local (Nullable (..), RelInfo (..), RelTarget (..))
import Hasura.RQL.Types.Schema.Options qualified as Options
import Hasura.RQL.Types.Source
  ( SourceInfo (_siCustomization, _siName),
  )
import Hasura.RQL.Types.SourceCustomization
  ( ResolvedSourceCustomization (_rscNamingConvention),
  )
import Hasura.SQL.AnyBackend (mkAnyBackend)
import Language.GraphQL.Draft.Syntax qualified as G

defaultSelectNativeQueryObject ::
  forall b r m n.
  ( MonadBuildSchema b r m n,
    BackendNativeQuerySelectSchema b
  ) =>
  -- native query info
  NativeQueryInfo b ->
  -- field name
  G.Name ->
  -- field description, if any
  Maybe G.Description ->
  SchemaT
    r
    m
    (Maybe (P.FieldParser n (IR.AnnObjectSelectG b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
defaultSelectNativeQueryObject :: forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, BackendNativeQuerySelectSchema b) =>
NativeQueryInfo b
-> Name
-> Maybe Description
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (AnnObjectSelectG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
defaultSelectNativeQueryObject nqi :: NativeQueryInfo b
nqi@NativeQueryInfo {Maybe Text
HashMap ArgumentName (NullableScalarType b)
InsOrdHashMap RelName (RelInfo b)
NativeQueryName
InterpolatedQuery ArgumentName
LogicalModelInfo b
_nqiRootFieldName :: NativeQueryName
_nqiCode :: InterpolatedQuery ArgumentName
_nqiReturns :: LogicalModelInfo b
_nqiArguments :: HashMap ArgumentName (NullableScalarType b)
_nqiRelationships :: InsOrdHashMap RelName (RelInfo b)
_nqiDescription :: Maybe Text
_nqiRootFieldName :: forall (b :: BackendType). NativeQueryInfo b -> NativeQueryName
_nqiCode :: forall (b :: BackendType).
NativeQueryInfo b -> InterpolatedQuery ArgumentName
_nqiReturns :: forall (b :: BackendType). NativeQueryInfo b -> LogicalModelInfo b
_nqiArguments :: forall (b :: BackendType).
NativeQueryInfo b -> HashMap ArgumentName (NullableScalarType b)
_nqiRelationships :: forall (b :: BackendType).
NativeQueryInfo b -> InsOrdHashMap RelName (RelInfo b)
_nqiDescription :: forall (b :: BackendType). NativeQueryInfo b -> Maybe Text
..} Name
fieldName Maybe Description
description = MaybeT
  (SchemaT r m)
  (FieldParser
     n
     (AnnObjectSelectG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (AnnObjectSelectG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT
   (SchemaT r m)
   (FieldParser
      n
      (AnnObjectSelectG
         b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
 -> SchemaT
      r
      m
      (Maybe
         (FieldParser
            n
            (AnnObjectSelectG
               b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))))
-> MaybeT
     (SchemaT r m)
     (FieldParser
        n
        (AnnObjectSelectG
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (AnnObjectSelectG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
forall a b. (a -> b) -> a -> b
$ do
  InputFieldsParser n (HashMap ArgumentName (ColumnValue b))
nativeQueryArgsParser <-
    forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema b r m n =>
Name
-> HashMap ArgumentName (NullableScalarType b)
-> MaybeT
     (SchemaT r m)
     (InputFieldsParser n (HashMap ArgumentName (ColumnValue b)))
nativeQueryArgumentsSchema @b @r @m @n Name
fieldName HashMap ArgumentName (NullableScalarType b)
_nqiArguments

  SourceInfo b
sourceInfo :: SourceInfo b <- (r -> SourceInfo b) -> MaybeT (SchemaT r m) (SourceInfo b)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> SourceInfo b
forall a t. Has a t => t -> a
getter

  let sourceName :: SourceName
sourceName = SourceInfo b -> SourceName
forall (b :: BackendType). SourceInfo b -> SourceName
_siName SourceInfo b
sourceInfo

  TablePermG b (UnpreparedValue b)
logicalModelPermissions <-
    SchemaT r m (Maybe (TablePermG b (UnpreparedValue b)))
-> MaybeT (SchemaT r m) (TablePermG b (UnpreparedValue b))
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT
      (SchemaT r m (Maybe (TablePermG b (UnpreparedValue b)))
 -> MaybeT (SchemaT r m) (TablePermG b (UnpreparedValue b)))
-> SchemaT r m (Maybe (TablePermG b (UnpreparedValue b)))
-> MaybeT (SchemaT r m) (TablePermG b (UnpreparedValue b))
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema b r m n =>
LogicalModelInfo b
-> SchemaT r m (Maybe (TablePermG b (UnpreparedValue b)))
buildLogicalModelPermissions @b @r @m @n LogicalModelInfo b
_nqiReturns

  -- if we have any relationships, we use a Native Query rather than Logical
  -- Model parser
  let hasExtraFields :: Bool
hasExtraFields = Bool -> Bool
not (InsOrdHashMap RelName (RelInfo b) -> Bool
forall a. InsOrdHashMap RelName a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null InsOrdHashMap RelName (RelInfo b)
_nqiRelationships)

  Parser 'Output n (AnnotatedFields b)
selectionSetParser <-
    if Bool
hasExtraFields
      then SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
-> MaybeT (SchemaT r m) (Parser 'Output n (AnnotatedFields b))
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
 -> MaybeT (SchemaT r m) (Parser 'Output n (AnnotatedFields b)))
-> SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
-> MaybeT (SchemaT r m) (Parser 'Output n (AnnotatedFields b))
forall a b. (a -> b) -> a -> b
$ NativeQueryInfo b
-> SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, BackendNativeQuerySelectSchema b) =>
NativeQueryInfo b
-> SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
nativeQuerySelectionSet NativeQueryInfo b
nqi
      else SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
-> MaybeT (SchemaT r m) (Parser 'Output n (AnnotatedFields b))
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
 -> MaybeT (SchemaT r m) (Parser 'Output n (AnnotatedFields b)))
-> SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
-> MaybeT (SchemaT r m) (Parser 'Output n (AnnotatedFields b))
forall a b. (a -> b) -> a -> b
$ LogicalModelInfo b
-> SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
forall r (m :: * -> *) (n :: * -> *).
MonadBuildSourceSchema b r m n =>
LogicalModelInfo b
-> SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(BackendLogicalModelSelectSchema b,
 MonadBuildSourceSchema b r m n) =>
LogicalModelInfo b
-> SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
logicalModelSelectionSet LogicalModelInfo b
_nqiReturns

  let sourceObj :: MetadataObjId
sourceObj =
        SourceName -> AnyBackend SourceMetadataObjId -> MetadataObjId
MO.MOSourceObjId
          SourceName
sourceName
          (SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
mkAnyBackend (SourceMetadataObjId b -> AnyBackend SourceMetadataObjId)
-> SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType). NativeQueryName -> SourceMetadataObjId b
MO.SMONativeQuery @b NativeQueryName
_nqiRootFieldName)

  SchemaT
  r
  m
  (FieldParser
     n
     (AnnObjectSelectG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
-> MaybeT
     (SchemaT r m)
     (FieldParser
        n
        (AnnObjectSelectG
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SchemaT
   r
   m
   (FieldParser
      n
      (AnnObjectSelectG
         b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
 -> MaybeT
      (SchemaT r m)
      (FieldParser
         n
         (AnnObjectSelectG
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
-> SchemaT
     r
     m
     (FieldParser
        n
        (AnnObjectSelectG
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
-> MaybeT
     (SchemaT r m)
     (FieldParser
        n
        (AnnObjectSelectG
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
forall a b. (a -> b) -> a -> b
$ Name
-> (SourceName, Name)
-> SchemaT
     r
     m
     (FieldParser
        n
        (AnnObjectSelectG
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
-> SchemaT
     r
     m
     (FieldParser
        n
        (AnnObjectSelectG
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
forall (m :: * -> *) a (p :: (* -> *) -> * -> *) (n :: * -> *) b.
(MonadMemoize m, Ord a, Typeable a, Typeable p, MonadParse n,
 Typeable b) =>
Name -> a -> m (p n b) -> m (p n b)
P.memoizeOn 'defaultSelectNativeQueryObject (SourceName
sourceName, Name
fieldName) do
    FieldParser
  n
  (AnnObjectSelectG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
-> SchemaT
     r
     m
     (FieldParser
        n
        (AnnObjectSelectG
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (FieldParser
   n
   (AnnObjectSelectG
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
 -> SchemaT
      r
      m
      (FieldParser
         n
         (AnnObjectSelectG
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
-> FieldParser
     n
     (AnnObjectSelectG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
-> SchemaT
     r
     m
     (FieldParser
        n
        (AnnObjectSelectG
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
forall a b. (a -> b) -> a -> b
$ MetadataObjId
-> FieldParser
     n
     (AnnObjectSelectG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
-> FieldParser
     n
     (AnnObjectSelectG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
forall (m :: * -> *) origin a.
origin -> FieldParser origin m a -> FieldParser origin m a
P.setFieldParserOrigin MetadataObjId
sourceObj
      (FieldParser
   n
   (AnnObjectSelectG
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
 -> FieldParser
      n
      (AnnObjectSelectG
         b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
-> FieldParser
     n
     (AnnObjectSelectG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
-> FieldParser
     n
     (AnnObjectSelectG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
forall a b. (a -> b) -> a -> b
$ Name
-> Maybe Description
-> InputFieldsParser n (HashMap ArgumentName (ColumnValue b))
-> Parser 'Output n (AnnotatedFields b)
-> FieldParser
     MetadataObjId
     n
     (HashMap ArgumentName (ColumnValue b), AnnotatedFields b)
forall (m :: * -> *) origin a b.
MonadParse m =>
Name
-> Maybe Description
-> InputFieldsParser origin m a
-> Parser origin 'Output m b
-> FieldParser origin m (a, b)
P.subselection
        Name
fieldName
        Maybe Description
description
        InputFieldsParser n (HashMap ArgumentName (ColumnValue b))
nativeQueryArgsParser
        Parser 'Output n (AnnotatedFields b)
selectionSetParser
      FieldParser
  MetadataObjId
  n
  (HashMap ArgumentName (ColumnValue b), AnnotatedFields b)
-> ((HashMap ArgumentName (ColumnValue b), AnnotatedFields b)
    -> AnnObjectSelectG
         b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
-> FieldParser
     n
     (AnnObjectSelectG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(HashMap ArgumentName (ColumnValue b)
nqArgs, AnnotatedFields b
fields) ->
        AnnotatedFields b
-> SelectFromG b (UnpreparedValue b)
-> AnnBoolExp b (UnpreparedValue b)
-> AnnObjectSelectG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
forall (b :: BackendType) r v.
AnnFieldsG b r v
-> SelectFromG b v -> AnnBoolExp b v -> AnnObjectSelectG b r v
IR.AnnObjectSelectG
          AnnotatedFields b
fields
          ( NativeQuery b (UnpreparedValue b)
-> SelectFromG b (UnpreparedValue b)
forall (b :: BackendType) v. NativeQuery b v -> SelectFromG b v
IR.FromNativeQuery
              NativeQuery
                { nqRootFieldName :: NativeQueryName
nqRootFieldName = NativeQueryName
_nqiRootFieldName,
                  nqInterpolatedQuery :: InterpolatedQuery (UnpreparedValue b)
nqInterpolatedQuery = InterpolatedQuery ArgumentName
-> HashMap ArgumentName (ColumnValue b)
-> InterpolatedQuery (UnpreparedValue b)
forall (b :: BackendType).
InterpolatedQuery ArgumentName
-> HashMap ArgumentName (ColumnValue b)
-> InterpolatedQuery (UnpreparedValue b)
interpolatedQuery InterpolatedQuery ArgumentName
_nqiCode HashMap ArgumentName (ColumnValue b)
nqArgs,
                  nqLogicalModel :: LogicalModel b
nqLogicalModel = LogicalModelInfo b -> LogicalModel b
forall (b :: BackendType). LogicalModelInfo b -> LogicalModel b
buildLogicalModelIR LogicalModelInfo b
_nqiReturns
                }
          )
          (TablePermG b (UnpreparedValue b)
-> AnnBoolExp b (UnpreparedValue b)
forall (b :: BackendType) v. TablePermG b v -> AnnBoolExp b v
IR._tpFilter TablePermG b (UnpreparedValue b)
logicalModelPermissions)

nativeQuerySelectionList ::
  (MonadBuildSchema b r m n, BackendNativeQuerySelectSchema b) =>
  Nullable ->
  NativeQueryInfo b ->
  SchemaT r m (Maybe (P.Parser 'P.Output n (AnnotatedFields b)))
nativeQuerySelectionList :: forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, BackendNativeQuerySelectSchema b) =>
Nullable
-> NativeQueryInfo b
-> SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
nativeQuerySelectionList Nullable
nullability NativeQueryInfo b
nativeQuery =
  (Parser 'Output n (AnnotatedFields b)
 -> Parser 'Output n (AnnotatedFields b))
-> Maybe (Parser 'Output n (AnnotatedFields b))
-> Maybe (Parser 'Output n (AnnotatedFields b))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Parser 'Output n (AnnotatedFields b)
-> Parser 'Output n (AnnotatedFields b)
nullabilityModifier (Maybe (Parser 'Output n (AnnotatedFields b))
 -> Maybe (Parser 'Output n (AnnotatedFields b)))
-> SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
-> SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NativeQueryInfo b
-> SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, BackendNativeQuerySelectSchema b) =>
NativeQueryInfo b
-> SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
nativeQuerySelectionSet NativeQueryInfo b
nativeQuery
  where
    nullabilityModifier :: Parser 'Output n (AnnotatedFields b)
-> Parser 'Output n (AnnotatedFields b)
nullabilityModifier =
      case Nullable
nullability of
        Nullable
Nullable -> Parser 'Output n (AnnotatedFields b)
-> Parser 'Output n (AnnotatedFields b)
forall (m :: * -> *) a. Parser 'Output m a -> Parser 'Output m a
nullableObjectList
        Nullable
NotNullable -> Parser 'Output n (AnnotatedFields b)
-> Parser 'Output n (AnnotatedFields b)
forall (m :: * -> *) a. Parser 'Output m a -> Parser 'Output m a
nonNullableObjectList

    -- \| Converts an output type parser from object_type to [object_type!]!
    nonNullableObjectList :: P.Parser 'P.Output m a -> P.Parser 'P.Output m a
    nonNullableObjectList :: forall (m :: * -> *) a. Parser 'Output m a -> Parser 'Output m a
nonNullableObjectList =
      Parser MetadataObjId 'Output m a
-> Parser MetadataObjId 'Output m a
forall (m :: * -> *) origin (k :: Kind) a.
Parser origin k m a -> Parser origin k m a
P.nonNullableParser (Parser MetadataObjId 'Output m a
 -> Parser MetadataObjId 'Output m a)
-> (Parser MetadataObjId 'Output m a
    -> Parser MetadataObjId 'Output m a)
-> Parser MetadataObjId 'Output m a
-> Parser MetadataObjId 'Output m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser MetadataObjId 'Output m a
-> Parser MetadataObjId 'Output m a
forall (m :: * -> *) origin a.
Parser origin 'Output m a -> Parser origin 'Output m a
P.multiple (Parser MetadataObjId 'Output m a
 -> Parser MetadataObjId 'Output m a)
-> (Parser MetadataObjId 'Output m a
    -> Parser MetadataObjId 'Output m a)
-> Parser MetadataObjId 'Output m a
-> Parser MetadataObjId 'Output m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser MetadataObjId 'Output m a
-> Parser MetadataObjId 'Output m a
forall (m :: * -> *) origin (k :: Kind) a.
Parser origin k m a -> Parser origin k m a
P.nonNullableParser

    -- \| Converts an output type parser from object_type to [object_type!]
    nullableObjectList :: P.Parser 'P.Output m a -> P.Parser 'P.Output m a
    nullableObjectList :: forall (m :: * -> *) a. Parser 'Output m a -> Parser 'Output m a
nullableObjectList =
      Parser MetadataObjId 'Output m a
-> Parser MetadataObjId 'Output m a
forall (m :: * -> *) origin a.
Parser origin 'Output m a -> Parser origin 'Output m a
P.multiple (Parser MetadataObjId 'Output m a
 -> Parser MetadataObjId 'Output m a)
-> (Parser MetadataObjId 'Output m a
    -> Parser MetadataObjId 'Output m a)
-> Parser MetadataObjId 'Output m a
-> Parser MetadataObjId 'Output m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser MetadataObjId 'Output m a
-> Parser MetadataObjId 'Output m a
forall (m :: * -> *) origin (k :: Kind) a.
Parser origin k m a -> Parser origin k m a
P.nonNullableParser

-- | select a native query - implementation is the same for root fields and
-- array relationships
defaultSelectNativeQuery ::
  forall b r m n.
  ( MonadBuildSchema b r m n,
    BackendNativeQuerySelectSchema b
  ) =>
  -- native query info
  NativeQueryInfo b ->
  -- field name
  G.Name ->
  -- are fields nullable?
  Nullable ->
  -- field description, if any
  Maybe G.Description ->
  SchemaT
    r
    m
    (Maybe (P.FieldParser n (IR.AnnSimpleSelectG b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
defaultSelectNativeQuery :: forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, BackendNativeQuerySelectSchema b) =>
NativeQueryInfo b
-> Name
-> Nullable
-> Maybe Description
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (AnnSimpleSelectG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
defaultSelectNativeQuery nqi :: NativeQueryInfo b
nqi@NativeQueryInfo {Maybe Text
HashMap ArgumentName (NullableScalarType b)
InsOrdHashMap RelName (RelInfo b)
NativeQueryName
InterpolatedQuery ArgumentName
LogicalModelInfo b
_nqiRootFieldName :: forall (b :: BackendType). NativeQueryInfo b -> NativeQueryName
_nqiCode :: forall (b :: BackendType).
NativeQueryInfo b -> InterpolatedQuery ArgumentName
_nqiReturns :: forall (b :: BackendType). NativeQueryInfo b -> LogicalModelInfo b
_nqiArguments :: forall (b :: BackendType).
NativeQueryInfo b -> HashMap ArgumentName (NullableScalarType b)
_nqiRelationships :: forall (b :: BackendType).
NativeQueryInfo b -> InsOrdHashMap RelName (RelInfo b)
_nqiDescription :: forall (b :: BackendType). NativeQueryInfo b -> Maybe Text
_nqiRootFieldName :: NativeQueryName
_nqiCode :: InterpolatedQuery ArgumentName
_nqiReturns :: LogicalModelInfo b
_nqiArguments :: HashMap ArgumentName (NullableScalarType b)
_nqiRelationships :: InsOrdHashMap RelName (RelInfo b)
_nqiDescription :: Maybe Text
..} Name
fieldName Nullable
nullability Maybe Description
description = MaybeT
  (SchemaT r m)
  (FieldParser
     n
     (AnnSimpleSelectG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (AnnSimpleSelectG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT
   (SchemaT r m)
   (FieldParser
      n
      (AnnSimpleSelectG
         b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
 -> SchemaT
      r
      m
      (Maybe
         (FieldParser
            n
            (AnnSimpleSelectG
               b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))))
-> MaybeT
     (SchemaT r m)
     (FieldParser
        n
        (AnnSimpleSelectG
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (AnnSimpleSelectG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
forall a b. (a -> b) -> a -> b
$ do
  InputFieldsParser n (HashMap ArgumentName (ColumnValue b))
nativeQueryArgsParser <-
    forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema b r m n =>
Name
-> HashMap ArgumentName (NullableScalarType b)
-> MaybeT
     (SchemaT r m)
     (InputFieldsParser n (HashMap ArgumentName (ColumnValue b)))
nativeQueryArgumentsSchema @b @r @m @n Name
fieldName HashMap ArgumentName (NullableScalarType b)
_nqiArguments

  SourceInfo b
sourceInfo :: SourceInfo b <- (r -> SourceInfo b) -> MaybeT (SchemaT r m) (SourceInfo b)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> SourceInfo b
forall a t. Has a t => t -> a
getter

  let sourceName :: SourceName
sourceName = SourceInfo b -> SourceName
forall (b :: BackendType). SourceInfo b -> SourceName
_siName SourceInfo b
sourceInfo
      tCase :: NamingCase
tCase = ResolvedSourceCustomization -> NamingCase
_rscNamingConvention (ResolvedSourceCustomization -> NamingCase)
-> ResolvedSourceCustomization -> NamingCase
forall a b. (a -> b) -> a -> b
$ SourceInfo b -> ResolvedSourceCustomization
forall (b :: BackendType).
SourceInfo b -> ResolvedSourceCustomization
_siCustomization SourceInfo b
sourceInfo

  StringifyNumbers
stringifyNumbers <- (SchemaOptions -> StringifyNumbers)
-> MaybeT (SchemaT r m) StringifyNumbers
forall r (m :: * -> *) a b.
(MonadReader r m, Has a r) =>
(a -> b) -> m b
retrieve SchemaOptions -> StringifyNumbers
Options.soStringifyNumbers

  TablePermG b (UnpreparedValue b)
logicalModelPermissions <-
    SchemaT r m (Maybe (TablePermG b (UnpreparedValue b)))
-> MaybeT (SchemaT r m) (TablePermG b (UnpreparedValue b))
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT
      (SchemaT r m (Maybe (TablePermG b (UnpreparedValue b)))
 -> MaybeT (SchemaT r m) (TablePermG b (UnpreparedValue b)))
-> SchemaT r m (Maybe (TablePermG b (UnpreparedValue b)))
-> MaybeT (SchemaT r m) (TablePermG b (UnpreparedValue b))
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema b r m n =>
LogicalModelInfo b
-> SchemaT r m (Maybe (TablePermG b (UnpreparedValue b)))
buildLogicalModelPermissions @b @r @m @n LogicalModelInfo b
_nqiReturns

  -- if we have any relationships, we use a Native Query rather than Logical
  -- Model parser
  let hasExtraFields :: Bool
hasExtraFields = Bool -> Bool
not (InsOrdHashMap RelName (RelInfo b) -> Bool
forall a. InsOrdHashMap RelName a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null InsOrdHashMap RelName (RelInfo b)
_nqiRelationships)

  Parser 'Output n (AnnotatedFields b)
selectionListParser <-
    if Bool
hasExtraFields
      then SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
-> MaybeT (SchemaT r m) (Parser 'Output n (AnnotatedFields b))
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
 -> MaybeT (SchemaT r m) (Parser 'Output n (AnnotatedFields b)))
-> SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
-> MaybeT (SchemaT r m) (Parser 'Output n (AnnotatedFields b))
forall a b. (a -> b) -> a -> b
$ Nullable
-> NativeQueryInfo b
-> SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, BackendNativeQuerySelectSchema b) =>
Nullable
-> NativeQueryInfo b
-> SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
nativeQuerySelectionList Nullable
nullability NativeQueryInfo b
nqi
      else SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
-> MaybeT (SchemaT r m) (Parser 'Output n (AnnotatedFields b))
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
 -> MaybeT (SchemaT r m) (Parser 'Output n (AnnotatedFields b)))
-> SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
-> MaybeT (SchemaT r m) (Parser 'Output n (AnnotatedFields b))
forall a b. (a -> b) -> a -> b
$ Nullable
-> LogicalModelInfo b
-> SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, BackendLogicalModelSelectSchema b) =>
Nullable
-> LogicalModelInfo b
-> SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
logicalModelSelectionList Nullable
nullability LogicalModelInfo b
_nqiReturns

  InputFieldsParser n (SelectArgsG b (UnpreparedValue b))
logicalModelsArgsParser <- SchemaT
  r m (InputFieldsParser n (SelectArgsG b (UnpreparedValue b)))
-> MaybeT
     (SchemaT r m)
     (InputFieldsParser n (SelectArgsG b (UnpreparedValue b)))
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SchemaT
   r m (InputFieldsParser n (SelectArgsG b (UnpreparedValue b)))
 -> MaybeT
      (SchemaT r m)
      (InputFieldsParser n (SelectArgsG b (UnpreparedValue b))))
-> SchemaT
     r m (InputFieldsParser n (SelectArgsG b (UnpreparedValue b)))
-> MaybeT
     (SchemaT r m)
     (InputFieldsParser n (SelectArgsG b (UnpreparedValue b)))
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(BackendLogicalModelSelectSchema b,
 MonadBuildSourceSchema b r m n) =>
LogicalModelInfo b
-> SchemaT
     r m (InputFieldsParser n (SelectArgsG b (UnpreparedValue b)))
logicalModelArguments @b @r @m @n LogicalModelInfo b
_nqiReturns

  let sourceObj :: MetadataObjId
sourceObj =
        SourceName -> AnyBackend SourceMetadataObjId -> MetadataObjId
MO.MOSourceObjId
          SourceName
sourceName
          (SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
mkAnyBackend (SourceMetadataObjId b -> AnyBackend SourceMetadataObjId)
-> SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType). NativeQueryName -> SourceMetadataObjId b
MO.SMONativeQuery @b NativeQueryName
_nqiRootFieldName)

  FieldParser
  n
  (AnnSimpleSelectG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
-> MaybeT
     (SchemaT r m)
     (FieldParser
        n
        (AnnSimpleSelectG
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
forall a. a -> MaybeT (SchemaT r m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (FieldParser
   n
   (AnnSimpleSelectG
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
 -> MaybeT
      (SchemaT r m)
      (FieldParser
         n
         (AnnSimpleSelectG
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
-> FieldParser
     n
     (AnnSimpleSelectG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
-> MaybeT
     (SchemaT r m)
     (FieldParser
        n
        (AnnSimpleSelectG
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
forall a b. (a -> b) -> a -> b
$ MetadataObjId
-> FieldParser
     n
     (AnnSimpleSelectG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
-> FieldParser
     n
     (AnnSimpleSelectG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
forall (m :: * -> *) origin a.
origin -> FieldParser origin m a -> FieldParser origin m a
P.setFieldParserOrigin MetadataObjId
sourceObj
    (FieldParser
   n
   (AnnSimpleSelectG
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
 -> FieldParser
      n
      (AnnSimpleSelectG
         b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
-> FieldParser
     n
     (AnnSimpleSelectG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
-> FieldParser
     n
     (AnnSimpleSelectG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
forall a b. (a -> b) -> a -> b
$ Name
-> Maybe Description
-> InputFieldsParser
     MetadataObjId
     n
     (SelectArgsG b (UnpreparedValue b),
      HashMap ArgumentName (ColumnValue b))
-> Parser 'Output n (AnnotatedFields b)
-> FieldParser
     MetadataObjId
     n
     ((SelectArgsG b (UnpreparedValue b),
       HashMap ArgumentName (ColumnValue b)),
      AnnotatedFields b)
forall (m :: * -> *) origin a b.
MonadParse m =>
Name
-> Maybe Description
-> InputFieldsParser origin m a
-> Parser origin 'Output m b
-> FieldParser origin m (a, b)
P.subselection
      Name
fieldName
      Maybe Description
description
      ( (,)
          (SelectArgsG b (UnpreparedValue b)
 -> HashMap ArgumentName (ColumnValue b)
 -> (SelectArgsG b (UnpreparedValue b),
     HashMap ArgumentName (ColumnValue b)))
-> InputFieldsParser n (SelectArgsG b (UnpreparedValue b))
-> InputFieldsParser
     MetadataObjId
     n
     (HashMap ArgumentName (ColumnValue b)
      -> (SelectArgsG b (UnpreparedValue b),
          HashMap ArgumentName (ColumnValue b)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InputFieldsParser n (SelectArgsG b (UnpreparedValue b))
logicalModelsArgsParser
          InputFieldsParser
  MetadataObjId
  n
  (HashMap ArgumentName (ColumnValue b)
   -> (SelectArgsG b (UnpreparedValue b),
       HashMap ArgumentName (ColumnValue b)))
-> InputFieldsParser n (HashMap ArgumentName (ColumnValue b))
-> InputFieldsParser
     MetadataObjId
     n
     (SelectArgsG b (UnpreparedValue b),
      HashMap ArgumentName (ColumnValue b))
forall a b.
InputFieldsParser MetadataObjId n (a -> b)
-> InputFieldsParser MetadataObjId n a
-> InputFieldsParser MetadataObjId n b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InputFieldsParser n (HashMap ArgumentName (ColumnValue b))
nativeQueryArgsParser
      )
      Parser 'Output n (AnnotatedFields b)
selectionListParser
    FieldParser
  MetadataObjId
  n
  ((SelectArgsG b (UnpreparedValue b),
    HashMap ArgumentName (ColumnValue b)),
   AnnotatedFields b)
-> (((SelectArgsG b (UnpreparedValue b),
      HashMap ArgumentName (ColumnValue b)),
     AnnotatedFields b)
    -> AnnSimpleSelectG
         b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
-> FieldParser
     n
     (AnnSimpleSelectG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \((SelectArgsG b (UnpreparedValue b)
lmArgs, HashMap ArgumentName (ColumnValue b)
nqArgs), AnnotatedFields b
fields) ->
      IR.AnnSelectG
        { $sel:_asnFields:AnnSelectG :: AnnotatedFields b
IR._asnFields = AnnotatedFields b
fields,
          $sel:_asnFrom:AnnSelectG :: SelectFromG b (UnpreparedValue b)
IR._asnFrom =
            NativeQuery b (UnpreparedValue b)
-> SelectFromG b (UnpreparedValue b)
forall (b :: BackendType) v. NativeQuery b v -> SelectFromG b v
IR.FromNativeQuery
              NativeQuery
                { nqRootFieldName :: NativeQueryName
nqRootFieldName = NativeQueryName
_nqiRootFieldName,
                  nqInterpolatedQuery :: InterpolatedQuery (UnpreparedValue b)
nqInterpolatedQuery = InterpolatedQuery ArgumentName
-> HashMap ArgumentName (ColumnValue b)
-> InterpolatedQuery (UnpreparedValue b)
forall (b :: BackendType).
InterpolatedQuery ArgumentName
-> HashMap ArgumentName (ColumnValue b)
-> InterpolatedQuery (UnpreparedValue b)
interpolatedQuery InterpolatedQuery ArgumentName
_nqiCode HashMap ArgumentName (ColumnValue b)
nqArgs,
                  nqLogicalModel :: LogicalModel b
nqLogicalModel = LogicalModelInfo b -> LogicalModel b
forall (b :: BackendType). LogicalModelInfo b -> LogicalModel b
buildLogicalModelIR LogicalModelInfo b
_nqiReturns
                },
          $sel:_asnPerm:AnnSelectG :: TablePermG b (UnpreparedValue b)
IR._asnPerm = TablePermG b (UnpreparedValue b)
logicalModelPermissions,
          $sel:_asnArgs:AnnSelectG :: SelectArgsG b (UnpreparedValue b)
IR._asnArgs = SelectArgsG b (UnpreparedValue b)
lmArgs,
          $sel:_asnStrfyNum:AnnSelectG :: StringifyNumbers
IR._asnStrfyNum = StringifyNumbers
stringifyNumbers,
          $sel:_asnNamingConvention:AnnSelectG :: Maybe NamingCase
IR._asnNamingConvention = NamingCase -> Maybe NamingCase
forall a. a -> Maybe a
Just NamingCase
tCase
        }

defaultBuildNativeQueryRootFields ::
  forall b r m n.
  ( MonadBuildSchema b r m n,
    BackendNativeQuerySelectSchema b
  ) =>
  NativeQueryInfo b ->
  SchemaT
    r
    m
    (Maybe (P.FieldParser n (QueryDB b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
defaultBuildNativeQueryRootFields :: forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, BackendNativeQuerySelectSchema b) =>
NativeQueryInfo b
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (QueryDB
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
defaultBuildNativeQueryRootFields nqi :: NativeQueryInfo b
nqi@NativeQueryInfo {Maybe Text
HashMap ArgumentName (NullableScalarType b)
InsOrdHashMap RelName (RelInfo b)
NativeQueryName
InterpolatedQuery ArgumentName
LogicalModelInfo b
_nqiRootFieldName :: forall (b :: BackendType). NativeQueryInfo b -> NativeQueryName
_nqiCode :: forall (b :: BackendType).
NativeQueryInfo b -> InterpolatedQuery ArgumentName
_nqiReturns :: forall (b :: BackendType). NativeQueryInfo b -> LogicalModelInfo b
_nqiArguments :: forall (b :: BackendType).
NativeQueryInfo b -> HashMap ArgumentName (NullableScalarType b)
_nqiRelationships :: forall (b :: BackendType).
NativeQueryInfo b -> InsOrdHashMap RelName (RelInfo b)
_nqiDescription :: forall (b :: BackendType). NativeQueryInfo b -> Maybe Text
_nqiRootFieldName :: NativeQueryName
_nqiCode :: InterpolatedQuery ArgumentName
_nqiReturns :: LogicalModelInfo b
_nqiArguments :: HashMap ArgumentName (NullableScalarType b)
_nqiRelationships :: InsOrdHashMap RelName (RelInfo b)
_nqiDescription :: Maybe Text
..} = do
  let fieldName :: Name
fieldName = NativeQueryName -> Name
getNativeQueryName NativeQueryName
_nqiRootFieldName
      description :: Maybe Description
description = Text -> Description
G.Description (Text -> Description) -> Maybe Text -> Maybe Description
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
_nqiDescription
  ((Maybe
   (FieldParser
      MetadataObjId
      n
      (AnnSimpleSelectG
         b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
 -> Maybe
      (FieldParser
         n
         (QueryDB
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           MetadataObjId
           n
           (AnnSimpleSelectG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (QueryDB
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
forall a b. (a -> b) -> SchemaT r m a -> SchemaT r m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe
    (FieldParser
       MetadataObjId
       n
       (AnnSimpleSelectG
          b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
  -> Maybe
       (FieldParser
          n
          (QueryDB
             b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
 -> SchemaT
      r
      m
      (Maybe
         (FieldParser
            MetadataObjId
            n
            (AnnSimpleSelectG
               b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
 -> SchemaT
      r
      m
      (Maybe
         (FieldParser
            n
            (QueryDB
               b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))))
-> ((AnnSimpleSelectG
       b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
     -> QueryDB
          b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
    -> Maybe
         (FieldParser
            MetadataObjId
            n
            (AnnSimpleSelectG
               b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
    -> Maybe
         (FieldParser
            n
            (QueryDB
               b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
-> (AnnSimpleSelectG
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
    -> QueryDB
         b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           MetadataObjId
           n
           (AnnSimpleSelectG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (QueryDB
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldParser
   MetadataObjId
   n
   (AnnSimpleSelectG
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
 -> FieldParser
      n
      (QueryDB
         b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
-> Maybe
     (FieldParser
        MetadataObjId
        n
        (AnnSimpleSelectG
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
-> Maybe
     (FieldParser
        n
        (QueryDB
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FieldParser
    MetadataObjId
    n
    (AnnSimpleSelectG
       b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
  -> FieldParser
       n
       (QueryDB
          b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
 -> Maybe
      (FieldParser
         MetadataObjId
         n
         (AnnSimpleSelectG
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
 -> Maybe
      (FieldParser
         n
         (QueryDB
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
-> ((AnnSimpleSelectG
       b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
     -> QueryDB
          b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
    -> FieldParser
         MetadataObjId
         n
         (AnnSimpleSelectG
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
    -> FieldParser
         n
         (QueryDB
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
-> (AnnSimpleSelectG
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
    -> QueryDB
         b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
-> Maybe
     (FieldParser
        MetadataObjId
        n
        (AnnSimpleSelectG
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
-> Maybe
     (FieldParser
        n
        (QueryDB
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AnnSimpleSelectG
   b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
 -> QueryDB
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
-> FieldParser
     MetadataObjId
     n
     (AnnSimpleSelectG
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
-> FieldParser
     n
     (QueryDB
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
forall a b.
(a -> b)
-> FieldParser MetadataObjId n a -> FieldParser MetadataObjId n b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) AnnSimpleSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> QueryDB
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
forall (b :: BackendType) r v.
AnnSimpleSelectG b r v -> QueryDB b r v
QDBMultipleRows (NativeQueryInfo b
-> Name
-> Nullable
-> Maybe Description
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           MetadataObjId
           n
           (AnnSimpleSelectG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, BackendNativeQuerySelectSchema b) =>
NativeQueryInfo b
-> Name
-> Nullable
-> Maybe Description
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (AnnSimpleSelectG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
defaultSelectNativeQuery NativeQueryInfo b
nqi Name
fieldName Nullable
NotNullable Maybe Description
description)

nativeQueryArgumentsSchema ::
  forall b r m n.
  (MonadBuildSchema b r m n) =>
  G.Name ->
  HashMap ArgumentName (NullableScalarType b) ->
  MaybeT (SchemaT r m) (P.InputFieldsParser n (HashMap ArgumentName (Column.ColumnValue b)))
nativeQueryArgumentsSchema :: forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema b r m n =>
Name
-> HashMap ArgumentName (NullableScalarType b)
-> MaybeT
     (SchemaT r m)
     (InputFieldsParser n (HashMap ArgumentName (ColumnValue b)))
nativeQueryArgumentsSchema = Text
-> Name
-> HashMap ArgumentName (NullableScalarType b)
-> MaybeT
     (SchemaT r m)
     (InputFieldsParser n (HashMap ArgumentName (ColumnValue b)))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema b r m n =>
Text
-> Name
-> HashMap ArgumentName (NullableScalarType b)
-> MaybeT
     (SchemaT r m)
     (InputFieldsParser n (HashMap ArgumentName (ColumnValue b)))
argumentsSchema Text
"Native Query"

-- | swap the template names in our query for unprepared values
interpolatedQuery ::
  InterpolatedQuery ArgumentName ->
  HashMap ArgumentName (Column.ColumnValue b) ->
  InterpolatedQuery (UnpreparedValue b)
interpolatedQuery :: forall (b :: BackendType).
InterpolatedQuery ArgumentName
-> HashMap ArgumentName (ColumnValue b)
-> InterpolatedQuery (UnpreparedValue b)
interpolatedQuery InterpolatedQuery ArgumentName
nqiCode HashMap ArgumentName (ColumnValue b)
nqArgs =
  [InterpolatedItem (UnpreparedValue b)]
-> InterpolatedQuery (UnpreparedValue b)
forall variable.
[InterpolatedItem variable] -> InterpolatedQuery variable
InterpolatedQuery
    ([InterpolatedItem (UnpreparedValue b)]
 -> InterpolatedQuery (UnpreparedValue b))
-> [InterpolatedItem (UnpreparedValue b)]
-> InterpolatedQuery (UnpreparedValue b)
forall a b. (a -> b) -> a -> b
$ ((InterpolatedItem ArgumentName
 -> InterpolatedItem (UnpreparedValue b))
-> [InterpolatedItem ArgumentName]
-> [InterpolatedItem (UnpreparedValue b)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((InterpolatedItem ArgumentName
  -> InterpolatedItem (UnpreparedValue b))
 -> [InterpolatedItem ArgumentName]
 -> [InterpolatedItem (UnpreparedValue b)])
-> ((ArgumentName -> UnpreparedValue b)
    -> InterpolatedItem ArgumentName
    -> InterpolatedItem (UnpreparedValue b))
-> (ArgumentName -> UnpreparedValue b)
-> [InterpolatedItem ArgumentName]
-> [InterpolatedItem (UnpreparedValue b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ArgumentName -> UnpreparedValue b)
-> InterpolatedItem ArgumentName
-> InterpolatedItem (UnpreparedValue b)
forall a b. (a -> b) -> InterpolatedItem a -> InterpolatedItem b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap)
      ( \ArgumentName
var -> case ArgumentName
-> HashMap ArgumentName (ColumnValue b) -> Maybe (ColumnValue b)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup ArgumentName
var HashMap ArgumentName (ColumnValue b)
nqArgs of
          Just ColumnValue b
arg -> Provenance -> ColumnValue b -> UnpreparedValue b
forall (b :: BackendType).
Provenance -> ColumnValue b -> UnpreparedValue b
UVParameter Provenance
FreshVar ColumnValue b
arg
          Maybe (ColumnValue b)
Nothing ->
            -- the `nativeQueryArgsParser` will already have checked
            -- we have all the args the query needs so this _should
            -- not_ happen
            [Char] -> UnpreparedValue b
forall a. HasCallStack => [Char] -> a
error ([Char] -> UnpreparedValue b) -> [Char] -> UnpreparedValue b
forall a b. (a -> b) -> a -> b
$ [Char]
"No native query arg passed for " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> ArgumentName -> [Char]
forall a. Show a => a -> [Char]
show ArgumentName
var
      )
      (InterpolatedQuery ArgumentName -> [InterpolatedItem ArgumentName]
forall variable.
InterpolatedQuery variable -> [InterpolatedItem variable]
getInterpolatedQuery InterpolatedQuery ArgumentName
nqiCode)

-- these functions become specific to the suppliers of the types
-- again, as they must
-- a) get the field parsers for the Logical Model
-- b) add any parsers for relationships etc
nativeQuerySelectionSet ::
  forall b r m n.
  ( MonadBuildSchema b r m n,
    BackendNativeQuerySelectSchema b
  ) =>
  NativeQueryInfo b ->
  SchemaT r m (Maybe (P.Parser 'P.Output n (AnnotatedFields b)))
nativeQuerySelectionSet :: forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, BackendNativeQuerySelectSchema b) =>
NativeQueryInfo b
-> SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
nativeQuerySelectionSet NativeQueryInfo b
nativeQuery = MaybeT (SchemaT r m) (Parser 'Output n (AnnotatedFields b))
-> SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
  let logicalModel :: LogicalModelInfo b
logicalModel = NativeQueryInfo b -> LogicalModelInfo b
forall (b :: BackendType). NativeQueryInfo b -> LogicalModelInfo b
_nqiReturns NativeQueryInfo b
nativeQuery
      description :: Maybe Description
description = Text -> Description
G.Description (Text -> Description) -> Maybe Text -> Maybe Description
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LogicalModelInfo b -> Maybe Text
forall (b :: BackendType). LogicalModelInfo b -> Maybe Text
_lmiDescription LogicalModelInfo b
logicalModel

  -- what name shall we call the selection set? (and thus, it's type in GraphQL
  -- schema?)
  let typeName :: Name
typeName = NativeQueryName -> Name
getNativeQueryName (NativeQueryInfo b -> NativeQueryName
forall (b :: BackendType). NativeQueryInfo b -> NativeQueryName
_nqiRootFieldName NativeQueryInfo b
nativeQuery)

  -- What interfaces does this type implement?
  let implementsInterfaces :: [a]
implementsInterfaces = []

  SchemaT r m (Parser 'Output n (AnnotatedFields b))
-> MaybeT (SchemaT r m) (Parser 'Output n (AnnotatedFields b))
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SchemaT r m (Parser 'Output n (AnnotatedFields b))
 -> MaybeT (SchemaT r m) (Parser 'Output n (AnnotatedFields b)))
-> SchemaT r m (Parser 'Output n (AnnotatedFields b))
-> MaybeT (SchemaT r m) (Parser 'Output n (AnnotatedFields b))
forall a b. (a -> b) -> a -> b
$ Name
-> Name
-> SchemaT r m (Parser 'Output n (AnnotatedFields b))
-> SchemaT r m (Parser 'Output n (AnnotatedFields b))
forall (m :: * -> *) a (p :: (* -> *) -> * -> *) (n :: * -> *) b.
(MonadMemoize m, Ord a, Typeable a, Typeable p, MonadParse n,
 Typeable b) =>
Name -> a -> m (p n b) -> m (p n b)
P.memoizeOn 'nativeQuerySelectionSet Name
typeName do
    -- list of relationship names to allow as Logimo fields
    let knownRelNames :: Set RelName
knownRelNames = [RelName] -> Set RelName
forall a. Ord a => [a] -> Set a
S.fromList ([RelName] -> Set RelName) -> [RelName] -> Set RelName
forall a b. (a -> b) -> a -> b
$ InsOrdHashMap RelName (RelInfo b) -> [RelName]
forall k v. InsOrdHashMap k v -> [k]
InsOrdHashMap.keys (InsOrdHashMap RelName (RelInfo b) -> [RelName])
-> InsOrdHashMap RelName (RelInfo b) -> [RelName]
forall a b. (a -> b) -> a -> b
$ NativeQueryInfo b -> InsOrdHashMap RelName (RelInfo b)
forall (b :: BackendType).
NativeQueryInfo b -> InsOrdHashMap RelName (RelInfo b)
_nqiRelationships NativeQueryInfo b
nativeQuery

    -- a pile 'o' parsers
    [FieldParser n (AnnotatedField b)]
logicalModelFields <- Set RelName
-> LogicalModelInfo b
-> SchemaT r m [FieldParser n (AnnotatedField b)]
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema b r m n =>
Set RelName
-> LogicalModelInfo b
-> SchemaT r m [FieldParser MetadataObjId n (AnnotatedField b)]
logicalModelFieldParsers Set RelName
knownRelNames LogicalModelInfo b
logicalModel

    [FieldParser n (AnnotatedField b)]
relationshipFields <- [Maybe (FieldParser n (AnnotatedField b))]
-> [FieldParser n (AnnotatedField b)]
forall a. [Maybe a] -> [a]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes ([Maybe (FieldParser n (AnnotatedField b))]
 -> [FieldParser n (AnnotatedField b)])
-> SchemaT r m [Maybe (FieldParser n (AnnotatedField b))]
-> SchemaT r m [FieldParser n (AnnotatedField b)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RelInfo b
 -> SchemaT r m (Maybe (FieldParser n (AnnotatedField b))))
-> [RelInfo b]
-> SchemaT r m [Maybe (FieldParser n (AnnotatedField b))]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse RelInfo b -> SchemaT r m (Maybe (FieldParser n (AnnotatedField b)))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(BackendNativeQuerySelectSchema b, MonadBuildSchema b r m n) =>
RelInfo b -> SchemaT r m (Maybe (FieldParser n (AnnotatedField b)))
nativeQueryRelationshipField (InsOrdHashMap RelName (RelInfo b) -> [RelInfo b]
forall k v. InsOrdHashMap k v -> [v]
InsOrdHashMap.elems (InsOrdHashMap RelName (RelInfo b) -> [RelInfo b])
-> InsOrdHashMap RelName (RelInfo b) -> [RelInfo b]
forall a b. (a -> b) -> a -> b
$ NativeQueryInfo b -> InsOrdHashMap RelName (RelInfo b)
forall (b :: BackendType).
NativeQueryInfo b -> InsOrdHashMap RelName (RelInfo b)
_nqiRelationships NativeQueryInfo b
nativeQuery)

    let parsers :: [FieldParser n (AnnotatedField b)]
parsers = [FieldParser n (AnnotatedField b)]
relationshipFields [FieldParser n (AnnotatedField b)]
-> [FieldParser n (AnnotatedField b)]
-> [FieldParser n (AnnotatedField b)]
forall a. Semigroup a => a -> a -> a
<> [FieldParser n (AnnotatedField b)]
logicalModelFields

    Parser 'Output n (AnnotatedFields b)
-> SchemaT r m (Parser 'Output n (AnnotatedFields b))
forall a. a -> SchemaT r m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (Parser 'Output n (AnnotatedFields b)
 -> SchemaT r m (Parser 'Output n (AnnotatedFields b)))
-> Parser 'Output n (AnnotatedFields b)
-> SchemaT r m (Parser 'Output n (AnnotatedFields b))
forall a b. (a -> b) -> a -> b
$ Name
-> Maybe Description
-> [FieldParser n (AnnotatedField b)]
-> [Parser MetadataObjId 'Output n Any]
-> Parser
     MetadataObjId
     'Output
     n
     (InsOrdHashMap Name (ParsedSelection (AnnotatedField b)))
forall (m :: * -> *) origin a b.
MonadParse m =>
Name
-> Maybe Description
-> [FieldParser origin m a]
-> [Parser origin 'Output m b]
-> Parser origin 'Output m (InsOrdHashMap Name (ParsedSelection a))
P.selectionSetObject Name
typeName Maybe Description
description [FieldParser n (AnnotatedField b)]
parsers [Parser MetadataObjId 'Output n Any]
forall a. [a]
implementsInterfaces
      Parser
  MetadataObjId
  'Output
  n
  (InsOrdHashMap Name (ParsedSelection (AnnotatedField b)))
-> (InsOrdHashMap Name (ParsedSelection (AnnotatedField b))
    -> AnnotatedFields b)
-> Parser 'Output n (AnnotatedFields b)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Text -> AnnotatedField b)
-> InsOrdHashMap Name (ParsedSelection (AnnotatedField b))
-> AnnotatedFields b
forall a.
(Text -> a) -> InsOrdHashMap Name (ParsedSelection a) -> Fields a
parsedSelectionsToFields Text -> AnnotatedField b
forall (b :: BackendType) r v. Text -> AnnFieldG b r v
IR.AFExpression

-- | Field parsers for a logical model object relationship
nativeQueryRelationshipField ::
  forall b r m n.
  ( BackendNativeQuerySelectSchema b,
    MonadBuildSchema b r m n
  ) =>
  RelInfo b ->
  SchemaT r m (Maybe (P.FieldParser n (AnnotatedField b)))
nativeQueryRelationshipField :: forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(BackendNativeQuerySelectSchema b, MonadBuildSchema b r m n) =>
RelInfo b -> SchemaT r m (Maybe (FieldParser n (AnnotatedField b)))
nativeQueryRelationshipField RelInfo b
ri | RelInfo b -> RelType
forall (b :: BackendType). RelInfo b -> RelType
riType RelInfo b
ri RelType -> RelType -> Bool
forall a. Eq a => a -> a -> Bool
== RelType
ObjRel = MaybeT (SchemaT r m) (FieldParser n (AnnotatedField b))
-> SchemaT r m (Maybe (FieldParser n (AnnotatedField b)))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
  case RelInfo b -> RelTarget b
forall (b :: BackendType). RelInfo b -> RelTarget b
riTarget RelInfo b
ri of
    RelTargetNativeQuery NativeQueryName
nativeQueryName -> do
      NativeQueryInfo b
nativeQueryInfo <- NativeQueryName -> MaybeT (SchemaT r m) (NativeQueryInfo b)
forall (b :: BackendType) r (m :: * -> *).
(MonadError QErr m, MonadReader r m, Has (SourceInfo b) r) =>
NativeQueryName -> m (NativeQueryInfo b)
askNativeQueryInfo NativeQueryName
nativeQueryName

      Name
relFieldName <- SchemaT r m Name -> MaybeT (SchemaT r m) Name
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SchemaT r m Name -> MaybeT (SchemaT r m) Name)
-> SchemaT r m Name -> MaybeT (SchemaT r m) Name
forall a b. (a -> b) -> a -> b
$ Text -> SchemaT r m Name
forall (m :: * -> *). MonadError QErr m => Text -> m Name
textToName (Text -> SchemaT r m Name) -> Text -> SchemaT r m Name
forall a b. (a -> b) -> a -> b
$ RelName -> Text
relNameToTxt (RelName -> Text) -> RelName -> Text
forall a b. (a -> b) -> a -> b
$ RelInfo b -> RelName
forall (b :: BackendType). RelInfo b -> RelName
riName RelInfo b
ri

      let objectRelDesc :: Maybe Description
objectRelDesc = Description -> Maybe Description
forall a. a -> Maybe a
Just (Description -> Maybe Description)
-> Description -> Maybe Description
forall a b. (a -> b) -> a -> b
$ Text -> Description
G.Description Text
"An object relationship"

      FieldParser
  n
  (AnnObjectSelectG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
nativeQueryParser <-
        SchemaT
  r
  m
  (Maybe
     (FieldParser
        n
        (AnnObjectSelectG
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
-> MaybeT
     (SchemaT r m)
     (FieldParser
        n
        (AnnObjectSelectG
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (SchemaT
   r
   m
   (Maybe
      (FieldParser
         n
         (AnnObjectSelectG
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
 -> MaybeT
      (SchemaT r m)
      (FieldParser
         n
         (AnnObjectSelectG
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (AnnObjectSelectG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
-> MaybeT
     (SchemaT r m)
     (FieldParser
        n
        (AnnObjectSelectG
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
forall a b. (a -> b) -> a -> b
$ NativeQueryInfo b
-> Name
-> Maybe Description
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (AnnObjectSelectG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
forall r (m :: * -> *) (n :: * -> *).
MonadBuildSchema b r m n =>
NativeQueryInfo b
-> Name
-> Maybe Description
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (AnnObjectSelectG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(BackendNativeQuerySelectSchema b, MonadBuildSchema b r m n) =>
NativeQueryInfo b
-> Name
-> Maybe Description
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (AnnObjectSelectG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
selectNativeQueryObject NativeQueryInfo b
nativeQueryInfo Name
relFieldName Maybe Description
objectRelDesc

      -- this only affects the generated GraphQL type
      let nullability :: Nullable
nullability = Nullable
Nullable
      let nullabilityModifier :: FieldParser origin m a -> FieldParser origin m a
nullabilityModifier =
            case Nullable
nullability of
              Nullable
Nullable -> FieldParser origin m a -> FieldParser origin m a
forall a. a -> a
id
              Nullable
NotNullable -> FieldParser origin m a -> FieldParser origin m a
forall (m :: * -> *) origin a.
FieldParser origin m a -> FieldParser origin m a
IP.nonNullableField

      FieldParser n (AnnotatedField b)
-> MaybeT (SchemaT r m) (FieldParser n (AnnotatedField b))
forall a. a -> MaybeT (SchemaT r m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (FieldParser n (AnnotatedField b)
 -> MaybeT (SchemaT r m) (FieldParser n (AnnotatedField b)))
-> FieldParser n (AnnotatedField b)
-> MaybeT (SchemaT r m) (FieldParser n (AnnotatedField b))
forall a b. (a -> b) -> a -> b
$ FieldParser n (AnnotatedField b)
-> FieldParser n (AnnotatedField b)
forall {origin} {m :: * -> *} {a}.
FieldParser origin m a -> FieldParser origin m a
nullabilityModifier
        (FieldParser n (AnnotatedField b)
 -> FieldParser n (AnnotatedField b))
-> FieldParser n (AnnotatedField b)
-> FieldParser n (AnnotatedField b)
forall a b. (a -> b) -> a -> b
$ FieldParser
  n
  (AnnObjectSelectG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
nativeQueryParser
        FieldParser
  n
  (AnnObjectSelectG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
-> (AnnObjectSelectG
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
    -> AnnotatedField b)
-> FieldParser n (AnnotatedField b)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \AnnObjectSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
selectExp ->
          ObjectRelationSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> AnnotatedField b
forall (b :: BackendType) r v.
ObjectRelationSelectG b r v -> AnnFieldG b r v
IR.AFObjectRelation (RelName
-> HashMap (Column b) (Column b)
-> Nullable
-> AnnObjectSelectG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> ObjectRelationSelectG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
forall (b :: BackendType) a.
RelName
-> HashMap (Column b) (Column b)
-> Nullable
-> a
-> AnnRelationSelectG b a
IR.AnnRelationSelectG (RelInfo b -> RelName
forall (b :: BackendType). RelInfo b -> RelName
riName RelInfo b
ri) (RelInfo b -> HashMap (Column b) (Column b)
forall (b :: BackendType).
RelInfo b -> HashMap (Column b) (Column b)
riMapping RelInfo b
ri) Nullable
nullability AnnObjectSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
selectExp)
    RelTargetTable TableName b
_otherTableName -> do
      Text -> MaybeT (SchemaT r m) (FieldParser n (AnnotatedField b))
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 Text
"Object relationships from native queries to tables are not implemented"
nativeQueryRelationshipField RelInfo b
ri = MaybeT (SchemaT r m) (FieldParser n (AnnotatedField b))
-> SchemaT r m (Maybe (FieldParser n (AnnotatedField b)))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
  case RelInfo b -> RelTarget b
forall (b :: BackendType). RelInfo b -> RelTarget b
riTarget RelInfo b
ri of
    RelTargetNativeQuery NativeQueryName
nativeQueryName -> do
      NativeQueryInfo b
nativeQueryInfo <- NativeQueryName -> MaybeT (SchemaT r m) (NativeQueryInfo b)
forall (b :: BackendType) r (m :: * -> *).
(MonadError QErr m, MonadReader r m, Has (SourceInfo b) r) =>
NativeQueryName -> m (NativeQueryInfo b)
askNativeQueryInfo NativeQueryName
nativeQueryName
      Name
relFieldName <- SchemaT r m Name -> MaybeT (SchemaT r m) Name
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SchemaT r m Name -> MaybeT (SchemaT r m) Name)
-> SchemaT r m Name -> MaybeT (SchemaT r m) Name
forall a b. (a -> b) -> a -> b
$ Text -> SchemaT r m Name
forall (m :: * -> *). MonadError QErr m => Text -> m Name
textToName (Text -> SchemaT r m Name) -> Text -> SchemaT r m Name
forall a b. (a -> b) -> a -> b
$ RelName -> Text
relNameToTxt (RelName -> Text) -> RelName -> Text
forall a b. (a -> b) -> a -> b
$ RelInfo b -> RelName
forall (b :: BackendType). RelInfo b -> RelName
riName RelInfo b
ri

      let objectRelDesc :: Maybe Description
objectRelDesc = Description -> Maybe Description
forall a. a -> Maybe a
Just (Description -> Maybe Description)
-> Description -> Maybe Description
forall a b. (a -> b) -> a -> b
$ Text -> Description
G.Description Text
"An array relationship"
          arrayNullability :: Nullable
arrayNullability = Nullable
Nullable
          innerNullability :: Nullable
innerNullability = Nullable
Nullable

      FieldParser
  n
  (AnnSimpleSelectG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
nativeQueryParser <-
        SchemaT
  r
  m
  (Maybe
     (FieldParser
        n
        (AnnSimpleSelectG
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
-> MaybeT
     (SchemaT r m)
     (FieldParser
        n
        (AnnSimpleSelectG
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (SchemaT
   r
   m
   (Maybe
      (FieldParser
         n
         (AnnSimpleSelectG
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
 -> MaybeT
      (SchemaT r m)
      (FieldParser
         n
         (AnnSimpleSelectG
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (AnnSimpleSelectG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
-> MaybeT
     (SchemaT r m)
     (FieldParser
        n
        (AnnSimpleSelectG
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
forall a b. (a -> b) -> a -> b
$ NativeQueryInfo b
-> Name
-> Nullable
-> Maybe Description
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (AnnSimpleSelectG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
forall r (m :: * -> *) (n :: * -> *).
MonadBuildSourceSchema b r m n =>
NativeQueryInfo b
-> Name
-> Nullable
-> Maybe Description
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (AnnSimpleSelectG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(BackendNativeQuerySelectSchema b,
 MonadBuildSourceSchema b r m n) =>
NativeQueryInfo b
-> Name
-> Nullable
-> Maybe Description
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (AnnSimpleSelectG
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
selectNativeQuery NativeQueryInfo b
nativeQueryInfo Name
relFieldName Nullable
arrayNullability Maybe Description
objectRelDesc
      FieldParser n (AnnotatedField b)
-> MaybeT (SchemaT r m) (FieldParser n (AnnotatedField b))
forall a. a -> MaybeT (SchemaT r m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (FieldParser n (AnnotatedField b)
 -> MaybeT (SchemaT r m) (FieldParser n (AnnotatedField b)))
-> FieldParser n (AnnotatedField b)
-> MaybeT (SchemaT r m) (FieldParser n (AnnotatedField b))
forall a b. (a -> b) -> a -> b
$ FieldParser
  n
  (AnnSimpleSelectG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
nativeQueryParser
        FieldParser
  n
  (AnnSimpleSelectG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
-> (AnnSimpleSelectG
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
    -> AnnotatedField b)
-> FieldParser n (AnnotatedField b)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \AnnSimpleSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
selectExp ->
          ArraySelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> AnnotatedField b
forall (b :: BackendType) r v.
ArraySelectG b r v -> AnnFieldG b r v
IR.AFArrayRelation
            (ArraySelectG
   b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
 -> AnnotatedField b)
-> ArraySelectG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> AnnotatedField b
forall a b. (a -> b) -> a -> b
$ ArrayRelationSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> ArraySelectG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
forall (b :: BackendType) r v.
ArrayRelationSelectG b r v -> ArraySelectG b r v
IR.ASSimple
            (ArrayRelationSelectG
   b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
 -> ArraySelectG
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
-> ArrayRelationSelectG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> ArraySelectG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
forall a b. (a -> b) -> a -> b
$ RelName
-> HashMap (Column b) (Column b)
-> Nullable
-> AnnSimpleSelectG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> ArrayRelationSelectG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
forall (b :: BackendType) a.
RelName
-> HashMap (Column b) (Column b)
-> Nullable
-> a
-> AnnRelationSelectG b a
IR.AnnRelationSelectG (RelInfo b -> RelName
forall (b :: BackendType). RelInfo b -> RelName
riName RelInfo b
ri) (RelInfo b -> HashMap (Column b) (Column b)
forall (b :: BackendType).
RelInfo b -> HashMap (Column b) (Column b)
riMapping RelInfo b
ri) Nullable
innerNullability AnnSimpleSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
selectExp
    RelTargetTable TableName b
_otherTableName -> do
      Text -> MaybeT (SchemaT r m) (FieldParser n (AnnotatedField b))
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 Text
"Array relationships from logical models to tables are not implemented"