{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE TemplateHaskellQuotes #-}

-- | Generate the GraphQL schema types related to streaming subscriptions.
module Hasura.GraphQL.Schema.SubscriptionStream
  ( selectStreamTable,
  )
where

import Control.Monad.Memoize
import Data.Has
import Data.List.NonEmpty qualified as NE
import Data.Text.Extended ((<>>))
import Hasura.Base.Error (QErr)
import Hasura.GraphQL.Parser.Class
import Hasura.GraphQL.Schema.Backend
import Hasura.GraphQL.Schema.BoolExp (AggregationPredicatesSchema)
import Hasura.GraphQL.Schema.Common
import Hasura.GraphQL.Schema.NamingCase
import Hasura.GraphQL.Schema.Options qualified as Options
import Hasura.GraphQL.Schema.Parser
  ( InputFieldsParser,
    Kind (..),
    Parser,
  )
import Hasura.GraphQL.Schema.Parser qualified as P
import Hasura.GraphQL.Schema.Select (tablePermissionsInfo, tableSelectionList, tableWhereArg)
import Hasura.GraphQL.Schema.Table (getTableGQLName, tableSelectColumns, tableSelectPermissions)
import Hasura.GraphQL.Schema.Typename
import Hasura.Name qualified as Name
import Hasura.Prelude
import Hasura.RQL.IR.Select qualified as IR
import Hasura.RQL.IR.Value qualified as IR
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.Source
import Hasura.RQL.Types.SourceCustomization (applyFieldNameCaseCust, applyTypeNameCaseCust)
import Hasura.RQL.Types.Subscription
import Hasura.RQL.Types.Table
import Language.GraphQL.Draft.Syntax qualified as G

-- | Argument to limit the maximum number of results returned in a single batch.
cursorBatchSizeArg ::
  forall n.
  MonadParse n =>
  NamingCase ->
  InputFieldsParser n Int
cursorBatchSizeArg :: NamingCase -> InputFieldsParser n Int
cursorBatchSizeArg NamingCase
tCase =
  Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    (Int32 -> Int)
-> InputFieldsParser MetadataObjId n Int32
-> InputFieldsParser n Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name
-> Maybe Description
-> Parser MetadataObjId 'Both n Int32
-> InputFieldsParser MetadataObjId n Int32
forall (m :: * -> *) (k :: Kind) origin a.
(MonadParse m, 'Input <: k) =>
Name
-> Maybe Description
-> Parser origin k m a
-> InputFieldsParser origin m a
P.field Name
batchSizeName Maybe Description
batchSizeDesc Parser MetadataObjId 'Both n Int32
forall (m :: * -> *) origin.
MonadParse m =>
Parser origin 'Both m Int32
P.nonNegativeInt
  where
    batchSizeName :: Name
batchSizeName = NamingCase -> Name -> Name
applyFieldNameCaseCust NamingCase
tCase Name
Name._batch_size
    batchSizeDesc :: Maybe Description
batchSizeDesc = 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
"maximum number of rows returned in a single batch"

-- | Cursor ordering enum fields
--
-- > enum cursor_ordering {
-- >   ASC
-- >   DESC
-- > }
cursorOrderingArgParser ::
  forall n m r.
  (MonadMemoize m, MonadParse n, Has MkTypename r, Has NamingCase r, MonadReader r m) =>
  m (Parser 'Both n CursorOrdering)
cursorOrderingArgParser :: m (Parser 'Both n CursorOrdering)
cursorOrderingArgParser = do
  NamingCase
tCase <- (r -> NamingCase) -> m NamingCase
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> NamingCase
forall a t. Has a t => t -> a
getter
  Name
enumName <- Name -> m Name
forall r (m :: * -> *).
(MonadReader r m, Has MkTypename r) =>
Name -> m Name
mkTypename (Name -> m Name) -> Name -> m Name
forall a b. (a -> b) -> a -> b
$ NamingCase -> Name -> Name
applyTypeNameCaseCust NamingCase
tCase Name
Name._cursor_ordering
  let description :: Maybe Description
description =
        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 -> Description) -> Text -> Description
forall a b. (a -> b) -> a -> b
$
            Text
"ordering argument of a cursor"
  Parser 'Both n CursorOrdering -> m (Parser 'Both n CursorOrdering)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser 'Both n CursorOrdering
 -> m (Parser 'Both n CursorOrdering))
-> Parser 'Both n CursorOrdering
-> m (Parser 'Both n CursorOrdering)
forall a b. (a -> b) -> a -> b
$
    Name
-> Maybe Description
-> NonEmpty
     (Definition MetadataObjId EnumValueInfo, CursorOrdering)
-> Parser 'Both n CursorOrdering
forall (m :: * -> *) origin a.
MonadParse m =>
Name
-> Maybe Description
-> NonEmpty (Definition origin EnumValueInfo, a)
-> Parser origin 'Both m a
P.enum Name
enumName Maybe Description
description (NonEmpty (Definition MetadataObjId EnumValueInfo, CursorOrdering)
 -> Parser 'Both n CursorOrdering)
-> NonEmpty
     (Definition MetadataObjId EnumValueInfo, CursorOrdering)
-> Parser 'Both n CursorOrdering
forall a b. (a -> b) -> a -> b
$
      [(Definition MetadataObjId EnumValueInfo, CursorOrdering)]
-> NonEmpty
     (Definition MetadataObjId EnumValueInfo, CursorOrdering)
forall a. [a] -> NonEmpty a
NE.fromList -- It's fine to use fromList here because we know the list is never empty.
        [ ( (Name, CursorOrdering) -> Definition MetadataObjId EnumValueInfo
forall origin.
(Name, CursorOrdering) -> Definition origin EnumValueInfo
define (Name, CursorOrdering)
enumNameVal,
            (Name, CursorOrdering) -> CursorOrdering
forall a b. (a, b) -> b
snd (Name, CursorOrdering)
enumNameVal
          )
          | (Name, CursorOrdering)
enumNameVal <- [(Name
Name._ASC, CursorOrdering
COAscending), (Name
Name._DESC, CursorOrdering
CODescending)]
        ]
  where
    define :: (Name, CursorOrdering) -> Definition origin EnumValueInfo
define (Name
name, CursorOrdering
val) =
      let orderingTypeDesc :: Text
orderingTypeDesc = Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
"descending" Text
"ascending" (Bool -> Text) -> Bool -> Text
forall a b. (a -> b) -> a -> b
$ CursorOrdering
val CursorOrdering -> CursorOrdering -> Bool
forall a. Eq a => a -> a -> Bool
== CursorOrdering
COAscending
       in Name
-> Maybe Description
-> Maybe origin
-> [Directive Void]
-> EnumValueInfo
-> Definition origin EnumValueInfo
forall origin a.
Name
-> Maybe Description
-> Maybe origin
-> [Directive Void]
-> a
-> Definition origin a
P.Definition Name
name (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 -> Description) -> Text -> Description
forall a b. (a -> b) -> a -> b
$ Text
orderingTypeDesc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ordering of the cursor") Maybe origin
forall a. Maybe a
Nothing [] EnumValueInfo
P.EnumValueInfo

-- | Argument to specify the ordering of the cursor.
-- > ordering: cursor_ordering
cursorOrderingArg ::
  forall n m r.
  (MonadMemoize m, MonadParse n, Has MkTypename r, Has NamingCase r, MonadReader r m) =>
  m (InputFieldsParser n (Maybe CursorOrdering))
cursorOrderingArg :: m (InputFieldsParser n (Maybe CursorOrdering))
cursorOrderingArg = do
  Parser 'Both n CursorOrdering
cursorOrderingParser' <- m (Parser 'Both n CursorOrdering)
forall (n :: * -> *) (m :: * -> *) r.
(MonadMemoize m, MonadParse n, Has MkTypename r, Has NamingCase r,
 MonadReader r m) =>
m (Parser 'Both n CursorOrdering)
cursorOrderingArgParser
  pure do
    Name
-> Maybe Description
-> Parser 'Both n CursorOrdering
-> InputFieldsParser n (Maybe CursorOrdering)
forall (m :: * -> *) (k :: Kind) origin a.
(MonadParse m, 'Input <: k) =>
Name
-> Maybe Description
-> Parser origin k m a
-> InputFieldsParser origin m (Maybe a)
P.fieldOptional Name
Name._ordering (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
"cursor ordering") Parser 'Both n CursorOrdering
cursorOrderingParser'

-- | Input fields parser to parse the value of a table's column
-- > column_name: column_type
streamColumnParserArg ::
  forall b n m r.
  (BackendSchema b, MonadMemoize m, MonadParse n, Has MkTypename r, MonadReader r m, MonadError QErr m, Has NamingCase r) =>
  ColumnInfo b ->
  m (InputFieldsParser n (Maybe (ColumnInfo b, ColumnValue b)))
streamColumnParserArg :: ColumnInfo b
-> m (InputFieldsParser n (Maybe (ColumnInfo b, ColumnValue b)))
streamColumnParserArg ColumnInfo b
colInfo = do
  Parser MetadataObjId 'Both n (ColumnValue b)
fieldParser <- ColumnInfo b -> m (Parser MetadataObjId 'Both n (ColumnValue b))
forall (b :: BackendType) (n :: * -> *) (f :: * -> *) r.
(BackendSchema b, MonadParse n, MonadError QErr f, MonadReader r f,
 Has MkTypename r, Has NamingCase r) =>
ColumnInfo b -> f (Parser MetadataObjId 'Both n (ColumnValue b))
typedParser ColumnInfo b
colInfo
  let fieldName :: Name
fieldName = ColumnInfo b -> Name
forall (b :: BackendType). ColumnInfo b -> Name
ciName ColumnInfo b
colInfo
      fieldDesc :: Maybe Description
fieldDesc = ColumnInfo b -> Maybe Description
forall (b :: BackendType). ColumnInfo b -> Maybe Description
ciDescription ColumnInfo b
colInfo
  InputFieldsParser n (Maybe (ColumnInfo b, ColumnValue b))
-> m (InputFieldsParser n (Maybe (ColumnInfo b, ColumnValue b)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure do
    Name
-> Maybe Description
-> Parser MetadataObjId 'Both n (ColumnValue b)
-> InputFieldsParser MetadataObjId n (Maybe (ColumnValue b))
forall (m :: * -> *) (k :: Kind) origin a.
(MonadParse m, 'Input <: k) =>
Name
-> Maybe Description
-> Parser origin k m a
-> InputFieldsParser origin m (Maybe a)
P.fieldOptional Name
fieldName Maybe Description
fieldDesc Parser MetadataObjId 'Both n (ColumnValue b)
fieldParser InputFieldsParser MetadataObjId n (Maybe (ColumnValue b))
-> (Maybe (ColumnValue b) -> Maybe (ColumnInfo b, ColumnValue b))
-> InputFieldsParser n (Maybe (ColumnInfo b, ColumnValue b))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (ColumnValue b -> (ColumnInfo b, ColumnValue b))
-> Maybe (ColumnValue b) -> Maybe (ColumnInfo b, ColumnValue b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ColumnInfo b
colInfo,)
  where
    typedParser :: ColumnInfo b -> f (Parser MetadataObjId 'Both n (ColumnValue b))
typedParser ColumnInfo b
columnInfo = do
      (ValueWithOrigin (ColumnValue b) -> ColumnValue b)
-> Parser MetadataObjId 'Both n (ValueWithOrigin (ColumnValue b))
-> Parser MetadataObjId 'Both n (ColumnValue b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ValueWithOrigin (ColumnValue b) -> ColumnValue b
forall a. ValueWithOrigin a -> a
IR.openValueOrigin (Parser MetadataObjId 'Both n (ValueWithOrigin (ColumnValue b))
 -> Parser MetadataObjId 'Both n (ColumnValue b))
-> f (Parser
        MetadataObjId 'Both n (ValueWithOrigin (ColumnValue b)))
-> f (Parser MetadataObjId 'Both n (ColumnValue b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ColumnType b
-> Nullability
-> f (Parser
        MetadataObjId 'Both n (ValueWithOrigin (ColumnValue b)))
forall (b :: BackendType) (n :: * -> *) (m :: * -> *) r.
(BackendSchema b, MonadParse n, MonadError QErr m, MonadReader r m,
 Has MkTypename r, Has NamingCase r) =>
ColumnType b
-> Nullability
-> m (Parser 'Both n (ValueWithOrigin (ColumnValue b)))
columnParser (ColumnInfo b -> ColumnType b
forall (b :: BackendType). ColumnInfo b -> ColumnType b
ciType ColumnInfo b
columnInfo) (Bool -> Nullability
G.Nullability (Bool -> Nullability) -> Bool -> Nullability
forall a b. (a -> b) -> a -> b
$ ColumnInfo b -> Bool
forall (b :: BackendType). ColumnInfo b -> Bool
ciIsNullable ColumnInfo b
columnInfo)

-- | Input object parser whose keys are the column names and the values are the
--   initial values of those columns from where the streaming should start.
-- > input table_stream_cursor_value_input {
-- >   col1: col1_type
-- >   col2: col2_type
--     ...
-- > }
streamColumnValueParser ::
  forall b n m r.
  (BackendSchema b, MonadMemoize m, MonadParse n, Has MkTypename r, MonadReader r m, MonadError QErr m, Has NamingCase r) =>
  SourceInfo b ->
  G.Name ->
  [ColumnInfo b] ->
  m (Parser 'Input n [(ColumnInfo b, ColumnValue b)])
streamColumnValueParser :: SourceInfo b
-> Name
-> [ColumnInfo b]
-> m (Parser 'Input n [(ColumnInfo b, ColumnValue b)])
streamColumnValueParser SourceInfo b
sourceInfo Name
tableGQLName [ColumnInfo b]
colInfos =
  Name
-> (SourceName, Name)
-> m (Parser 'Input n [(ColumnInfo b, ColumnValue b)])
-> m (Parser 'Input n [(ColumnInfo b, ColumnValue b)])
forall (m :: * -> *) a p.
(MonadMemoize m, Ord a, Typeable a, Typeable p) =>
Name -> a -> m p -> m p
memoizeOn 'streamColumnValueParser (SourceInfo b -> SourceName
forall (b :: BackendType). SourceInfo b -> SourceName
_siName SourceInfo b
sourceInfo, Name
tableGQLName) (m (Parser 'Input n [(ColumnInfo b, ColumnValue b)])
 -> m (Parser 'Input n [(ColumnInfo b, ColumnValue b)]))
-> m (Parser 'Input n [(ColumnInfo b, ColumnValue b)])
-> m (Parser 'Input n [(ColumnInfo b, ColumnValue b)])
forall a b. (a -> b) -> a -> b
$ do
    NamingCase
tCase <- (r -> NamingCase) -> m NamingCase
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> NamingCase
forall a t. Has a t => t -> a
getter
    InputFieldsParser
  MetadataObjId n [Maybe (ColumnInfo b, ColumnValue b)]
columnVals <- [InputFieldsParser
   MetadataObjId n (Maybe (ColumnInfo b, ColumnValue b))]
-> InputFieldsParser
     MetadataObjId n [Maybe (ColumnInfo b, ColumnValue b)]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA ([InputFieldsParser
    MetadataObjId n (Maybe (ColumnInfo b, ColumnValue b))]
 -> InputFieldsParser
      MetadataObjId n [Maybe (ColumnInfo b, ColumnValue b)])
-> m [InputFieldsParser
        MetadataObjId n (Maybe (ColumnInfo b, ColumnValue b))]
-> m (InputFieldsParser
        MetadataObjId n [Maybe (ColumnInfo b, ColumnValue b)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ColumnInfo b
 -> m (InputFieldsParser
         MetadataObjId n (Maybe (ColumnInfo b, ColumnValue b))))
-> [ColumnInfo b]
-> m [InputFieldsParser
        MetadataObjId n (Maybe (ColumnInfo b, ColumnValue b))]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ColumnInfo b
-> m (InputFieldsParser
        MetadataObjId n (Maybe (ColumnInfo b, ColumnValue b)))
forall (b :: BackendType) (n :: * -> *) (m :: * -> *) r.
(BackendSchema b, MonadMemoize m, MonadParse n, Has MkTypename r,
 MonadReader r m, MonadError QErr m, Has NamingCase r) =>
ColumnInfo b
-> m (InputFieldsParser n (Maybe (ColumnInfo b, ColumnValue b)))
streamColumnParserArg [ColumnInfo b]
colInfos
    Name
objName <- Name -> m Name
forall r (m :: * -> *).
(MonadReader r m, Has MkTypename r) =>
Name -> m Name
mkTypename (Name -> m Name) -> Name -> m Name
forall a b. (a -> b) -> a -> b
$ Name
tableGQLName Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> NamingCase -> Name -> Name
applyTypeNameCaseCust NamingCase
tCase Name
Name.__stream_cursor_value_input
    pure do
      let description :: Description
description = Text -> Description
G.Description (Text -> Description) -> Text -> Description
forall a b. (a -> b) -> a -> b
$ Text
"Initial value of the column from where the streaming should start"
      Name
-> Maybe Description
-> InputFieldsParser
     MetadataObjId n [Maybe (ColumnInfo b, ColumnValue b)]
-> Parser
     MetadataObjId 'Input n [Maybe (ColumnInfo b, ColumnValue b)]
forall (m :: * -> *) origin a.
MonadParse m =>
Name
-> Maybe Description
-> InputFieldsParser origin m a
-> Parser origin 'Input m a
P.object Name
objName (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
description) InputFieldsParser
  MetadataObjId n [Maybe (ColumnInfo b, ColumnValue b)]
columnVals Parser MetadataObjId 'Input n [Maybe (ColumnInfo b, ColumnValue b)]
-> ([Maybe (ColumnInfo b, ColumnValue b)]
    -> [(ColumnInfo b, ColumnValue b)])
-> Parser 'Input n [(ColumnInfo b, ColumnValue b)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [Maybe (ColumnInfo b, ColumnValue b)]
-> [(ColumnInfo b, ColumnValue b)]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes

-- | Argument to accept the initial value from where the streaming should start.
-- > initial_value: table_stream_cursor_value_input!
streamColumnValueParserArg ::
  forall b n m r.
  ( BackendSchema b,
    MonadMemoize m,
    MonadParse n,
    Has MkTypename r,
    MonadReader r m,
    MonadError QErr m,
    Has NamingCase r
  ) =>
  SourceInfo b ->
  G.Name ->
  [ColumnInfo b] ->
  m (InputFieldsParser n [(ColumnInfo b, ColumnValue b)])
streamColumnValueParserArg :: SourceInfo b
-> Name
-> [ColumnInfo b]
-> m (InputFieldsParser n [(ColumnInfo b, ColumnValue b)])
streamColumnValueParserArg SourceInfo b
sourceInfo Name
tableGQLName [ColumnInfo b]
colInfos = do
  NamingCase
tCase <- (r -> NamingCase) -> m NamingCase
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> NamingCase
forall a t. Has a t => t -> a
getter
  Parser 'Input n [(ColumnInfo b, ColumnValue b)]
columnValueParser <- SourceInfo b
-> Name
-> [ColumnInfo b]
-> m (Parser 'Input n [(ColumnInfo b, ColumnValue b)])
forall (b :: BackendType) (n :: * -> *) (m :: * -> *) r.
(BackendSchema b, MonadMemoize m, MonadParse n, Has MkTypename r,
 MonadReader r m, MonadError QErr m, Has NamingCase r) =>
SourceInfo b
-> Name
-> [ColumnInfo b]
-> m (Parser 'Input n [(ColumnInfo b, ColumnValue b)])
streamColumnValueParser SourceInfo b
sourceInfo Name
tableGQLName [ColumnInfo b]
colInfos
  pure do
    Name
-> Maybe Description
-> Parser 'Input n [(ColumnInfo b, ColumnValue b)]
-> InputFieldsParser n [(ColumnInfo b, ColumnValue b)]
forall (m :: * -> *) (k :: Kind) origin a.
(MonadParse m, 'Input <: k) =>
Name
-> Maybe Description
-> Parser origin k m a
-> InputFieldsParser origin m a
P.field (NamingCase -> Name -> Name
applyFieldNameCaseCust NamingCase
tCase Name
Name._initial_value) (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
"Stream column input with initial value") Parser 'Input n [(ColumnInfo b, ColumnValue b)]
columnValueParser

-- | Argument to accept the cursor data. At the time of writing this, only a single
--   column cursor is supported and if multiple column cursors are provided,
--   then a parse error is thrown.
-- >
tableStreamColumnArg ::
  forall n m r b.
  (BackendSchema b, MonadMemoize m, MonadParse n, Has MkTypename r, MonadReader r m, MonadError QErr m, Has NamingCase r) =>
  SourceInfo b ->
  G.Name ->
  [ColumnInfo b] ->
  m (InputFieldsParser n [IR.StreamCursorItem b])
tableStreamColumnArg :: SourceInfo b
-> Name
-> [ColumnInfo b]
-> m (InputFieldsParser n [StreamCursorItem b])
tableStreamColumnArg SourceInfo b
sourceInfo Name
tableGQLName [ColumnInfo b]
colInfos = do
  InputFieldsParser n (Maybe CursorOrdering)
cursorOrderingParser <- m (InputFieldsParser n (Maybe CursorOrdering))
forall (n :: * -> *) (m :: * -> *) r.
(MonadMemoize m, MonadParse n, Has MkTypename r, Has NamingCase r,
 MonadReader r m) =>
m (InputFieldsParser n (Maybe CursorOrdering))
cursorOrderingArg
  InputFieldsParser n [(ColumnInfo b, ColumnValue b)]
streamColumnParser <- SourceInfo b
-> Name
-> [ColumnInfo b]
-> m (InputFieldsParser n [(ColumnInfo b, ColumnValue b)])
forall (b :: BackendType) (n :: * -> *) (m :: * -> *) r.
(BackendSchema b, MonadMemoize m, MonadParse n, Has MkTypename r,
 MonadReader r m, MonadError QErr m, Has NamingCase r) =>
SourceInfo b
-> Name
-> [ColumnInfo b]
-> m (InputFieldsParser n [(ColumnInfo b, ColumnValue b)])
streamColumnValueParserArg SourceInfo b
sourceInfo Name
tableGQLName [ColumnInfo b]
colInfos
  pure $ do
    Maybe CursorOrdering
orderingArg <- InputFieldsParser n (Maybe CursorOrdering)
cursorOrderingParser
    [(ColumnInfo b, ColumnValue b)]
columnArg <- InputFieldsParser n [(ColumnInfo b, ColumnValue b)]
streamColumnParser
    pure $ ((ColumnInfo b -> ColumnValue b -> StreamCursorItem b)
-> (ColumnInfo b, ColumnValue b) -> StreamCursorItem b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (CursorOrdering
-> ColumnInfo b -> ColumnValue b -> StreamCursorItem b
forall (b :: BackendType).
CursorOrdering
-> ColumnInfo b -> ColumnValue b -> StreamCursorItem b
IR.StreamCursorItem (CursorOrdering -> Maybe CursorOrdering -> CursorOrdering
forall a. a -> Maybe a -> a
fromMaybe CursorOrdering
COAscending Maybe CursorOrdering
orderingArg))) ((ColumnInfo b, ColumnValue b) -> StreamCursorItem b)
-> [(ColumnInfo b, ColumnValue b)] -> [StreamCursorItem b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ColumnInfo b, ColumnValue b)]
columnArg

-- | Input object that contains the initial value of a column
--   along with how it needs to be ordered.
-- > input table_stream_cursor_input {
-- >   initial_value: table_stream_cursor_value_input!
-- >   ordering: cursor_ordering
-- > }
tableStreamCursorExp ::
  forall m n r b.
  MonadBuildSchema b r m n =>
  SourceInfo b ->
  TableInfo b ->
  m (Parser 'Input n [(IR.StreamCursorItem b)])
tableStreamCursorExp :: SourceInfo b
-> TableInfo b -> m (Parser 'Input n [StreamCursorItem b])
tableStreamCursorExp SourceInfo b
sourceInfo TableInfo b
tableInfo =
  Name
-> (SourceName, TableName b)
-> m (Parser 'Input n [StreamCursorItem b])
-> m (Parser 'Input n [StreamCursorItem b])
forall (m :: * -> *) a p.
(MonadMemoize m, Ord a, Typeable a, Typeable p) =>
Name -> a -> m p -> m p
memoizeOn 'tableStreamCursorExp (SourceInfo b -> SourceName
forall (b :: BackendType). SourceInfo b -> SourceName
_siName SourceInfo b
sourceInfo, TableInfo b -> TableName b
forall (b :: BackendType). TableInfo b -> TableName b
tableInfoName TableInfo b
tableInfo) (m (Parser 'Input n [StreamCursorItem b])
 -> m (Parser 'Input n [StreamCursorItem b]))
-> m (Parser 'Input n [StreamCursorItem b])
-> m (Parser 'Input n [StreamCursorItem b])
forall a b. (a -> b) -> a -> b
$ do
    NamingCase
tCase <- (r -> NamingCase) -> m NamingCase
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> NamingCase
forall a t. Has a t => t -> a
getter
    Name
tableGQLName <- TableInfo b -> m Name
forall (b :: BackendType) (m :: * -> *).
(Backend b, MonadError QErr m) =>
TableInfo b -> m Name
getTableGQLName TableInfo b
tableInfo
    [ColumnInfo b]
columnInfos <- SourceInfo b -> TableInfo b -> m [ColumnInfo b]
forall (b :: BackendType) r (m :: * -> *).
(Backend b, MonadError QErr m, MonadReader r m,
 Has SchemaContext r) =>
SourceInfo b -> TableInfo b -> m [ColumnInfo b]
tableSelectColumns SourceInfo b
sourceInfo TableInfo b
tableInfo
    Name
objName <- Name -> m Name
forall r (m :: * -> *).
(MonadReader r m, Has MkTypename r) =>
Name -> m Name
mkTypename (Name -> m Name) -> Name -> m Name
forall a b. (a -> b) -> a -> b
$ Name
tableGQLName Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> NamingCase -> Name -> Name
applyTypeNameCaseCust NamingCase
tCase Name
Name.__stream_cursor_input
    let description :: Description
description =
          Text -> Description
G.Description (Text -> Description) -> Text -> Description
forall a b. (a -> b) -> a -> b
$ Text
"Streaming cursor of the table " Text -> Name -> Text
forall t. ToTxt t => Text -> t -> Text
<>> Name
tableGQLName
    InputFieldsParser n [StreamCursorItem b]
columnParsers <- SourceInfo b
-> Name
-> [ColumnInfo b]
-> m (InputFieldsParser n [StreamCursorItem b])
forall (n :: * -> *) (m :: * -> *) r (b :: BackendType).
(BackendSchema b, MonadMemoize m, MonadParse n, Has MkTypename r,
 MonadReader r m, MonadError QErr m, Has NamingCase r) =>
SourceInfo b
-> Name
-> [ColumnInfo b]
-> m (InputFieldsParser n [StreamCursorItem b])
tableStreamColumnArg SourceInfo b
sourceInfo Name
tableGQLName [ColumnInfo b]
columnInfos
    pure $ Name
-> Maybe Description
-> InputFieldsParser n [StreamCursorItem b]
-> Parser 'Input n [StreamCursorItem b]
forall (m :: * -> *) origin a.
MonadParse m =>
Name
-> Maybe Description
-> InputFieldsParser origin m a
-> Parser origin 'Input m a
P.object Name
objName (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
description) InputFieldsParser n [StreamCursorItem b]
columnParsers

-- | Argument to accept the cursor input object.
-- > cursor: [table_stream_cursor_input]!
tableStreamCursorArg ::
  forall b r m n.
  MonadBuildSchema b r m n =>
  SourceInfo b ->
  TableInfo b ->
  m (InputFieldsParser n [IR.StreamCursorItem b])
tableStreamCursorArg :: SourceInfo b
-> TableInfo b -> m (InputFieldsParser n [StreamCursorItem b])
tableStreamCursorArg SourceInfo b
sourceInfo TableInfo b
tableInfo = do
  Parser 'Input n [StreamCursorItem b]
cursorParser <- SourceInfo b
-> TableInfo b -> m (Parser 'Input n [StreamCursorItem b])
forall (m :: * -> *) (n :: * -> *) r (b :: BackendType).
MonadBuildSchema b r m n =>
SourceInfo b
-> TableInfo b -> m (Parser 'Input n [StreamCursorItem b])
tableStreamCursorExp SourceInfo b
sourceInfo TableInfo b
tableInfo
  pure $ do
    [Maybe [StreamCursorItem b]]
cursorArgs <-
      Name
-> Maybe Description
-> Parser MetadataObjId 'Input n [Maybe [StreamCursorItem b]]
-> InputFieldsParser MetadataObjId n [Maybe [StreamCursorItem b]]
forall (m :: * -> *) (k :: Kind) origin a.
(MonadParse m, 'Input <: k) =>
Name
-> Maybe Description
-> Parser origin k m a
-> InputFieldsParser origin m a
P.field Name
cursorName Maybe Description
cursorDesc (Parser MetadataObjId 'Input n [Maybe [StreamCursorItem b]]
 -> InputFieldsParser MetadataObjId n [Maybe [StreamCursorItem b]])
-> Parser MetadataObjId 'Input n [Maybe [StreamCursorItem b]]
-> InputFieldsParser MetadataObjId n [Maybe [StreamCursorItem b]]
forall a b. (a -> b) -> a -> b
$ Parser MetadataObjId 'Input n (Maybe [StreamCursorItem b])
-> Parser MetadataObjId 'Input n [Maybe [StreamCursorItem b]]
forall origin (k :: Kind) (m :: * -> *) a.
(MonadParse m, 'Input <: k) =>
Parser origin k m a -> Parser origin k m [a]
P.list (Parser MetadataObjId 'Input n (Maybe [StreamCursorItem b])
 -> Parser MetadataObjId 'Input n [Maybe [StreamCursorItem b]])
-> Parser MetadataObjId 'Input n (Maybe [StreamCursorItem b])
-> Parser MetadataObjId 'Input n [Maybe [StreamCursorItem b]]
forall a b. (a -> b) -> a -> b
$ Parser 'Input n [StreamCursorItem b]
-> Parser MetadataObjId 'Input n (Maybe [StreamCursorItem b])
forall origin (k :: Kind) (m :: * -> *) a.
(MonadParse m, 'Input <: k) =>
Parser origin k m a -> Parser origin k m (Maybe a)
P.nullable Parser 'Input n [StreamCursorItem b]
cursorParser
    pure $ [[StreamCursorItem b]] -> [StreamCursorItem b]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[StreamCursorItem b]] -> [StreamCursorItem b])
-> [[StreamCursorItem b]] -> [StreamCursorItem b]
forall a b. (a -> b) -> a -> b
$ [Maybe [StreamCursorItem b]] -> [[StreamCursorItem b]]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes [Maybe [StreamCursorItem b]]
cursorArgs
  where
    cursorName :: Name
cursorName = Name
Name._cursor
    cursorDesc :: Maybe Description
cursorDesc = 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
"cursor to stream the results returned by the query"

-- | Arguments to the streaming subscription field.
-- > table_stream (cursor: [table_stream_cursor_input]!, batch_size: Int!, where: table_bool_exp)
tableStreamArguments ::
  forall b r m n.
  ( AggregationPredicatesSchema b,
    MonadBuildSchema b r m n
  ) =>
  SourceInfo b ->
  TableInfo b ->
  m (InputFieldsParser n (SelectStreamArgs b))
tableStreamArguments :: SourceInfo b
-> TableInfo b -> m (InputFieldsParser n (SelectStreamArgs b))
tableStreamArguments SourceInfo b
sourceInfo TableInfo b
tableInfo = do
  NamingCase
tCase <- (r -> NamingCase) -> m NamingCase
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> NamingCase
forall a t. Has a t => t -> a
getter
  InputFieldsParser n (Maybe (AnnBoolExp b (UnpreparedValue b)))
whereParser <- SourceInfo b
-> TableInfo b
-> m (InputFieldsParser
        n (Maybe (AnnBoolExp b (UnpreparedValue b))))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(AggregationPredicatesSchema b, MonadBuildSchema b r m n) =>
SourceInfo b
-> TableInfo b
-> m (InputFieldsParser
        n (Maybe (AnnBoolExp b (UnpreparedValue b))))
tableWhereArg SourceInfo b
sourceInfo TableInfo b
tableInfo
  InputFieldsParser n [StreamCursorItem b]
cursorParser <- SourceInfo b
-> TableInfo b -> m (InputFieldsParser n [StreamCursorItem b])
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema b r m n =>
SourceInfo b
-> TableInfo b -> m (InputFieldsParser n [StreamCursorItem b])
tableStreamCursorArg SourceInfo b
sourceInfo TableInfo b
tableInfo
  pure $ do
    Maybe (AnnBoolExp b (UnpreparedValue b))
whereArg <- InputFieldsParser n (Maybe (AnnBoolExp b (UnpreparedValue b)))
whereParser
    StreamCursorItem b
cursorArg <-
      InputFieldsParser n [StreamCursorItem b]
cursorParser InputFieldsParser n [StreamCursorItem b]
-> ([StreamCursorItem b] -> n (StreamCursorItem b))
-> InputFieldsParser MetadataObjId n (StreamCursorItem b)
forall (m :: * -> *) origin a b.
Monad m =>
InputFieldsParser origin m a
-> (a -> m b) -> InputFieldsParser origin m b
`P.bindFields` \case
        [] -> ErrorMessage -> n (StreamCursorItem b)
forall (m :: * -> *) a. MonadParse m => ErrorMessage -> m a
parseError ErrorMessage
"one streaming column field is expected"
        [StreamCursorItem b
c] -> StreamCursorItem b -> n (StreamCursorItem b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure StreamCursorItem b
c
        [StreamCursorItem b]
_ -> ErrorMessage -> n (StreamCursorItem b)
forall (m :: * -> *) a. MonadParse m => ErrorMessage -> m a
parseError ErrorMessage
"multiple column cursors are not supported yet"
    Int
batchSizeArg <- NamingCase -> InputFieldsParser n Int
forall (n :: * -> *).
MonadParse n =>
NamingCase -> InputFieldsParser n Int
cursorBatchSizeArg NamingCase
tCase
    pure $
      Maybe (AnnBoolExp b (UnpreparedValue b))
-> Int -> StreamCursorItem b -> SelectStreamArgs b
forall (b :: BackendType) v.
Maybe (AnnBoolExp b v)
-> Int -> StreamCursorItem b -> SelectStreamArgsG b v
IR.SelectStreamArgsG Maybe (AnnBoolExp b (UnpreparedValue b))
whereArg Int
batchSizeArg StreamCursorItem b
cursorArg

-- | Field parser for a streaming subscription for a table.
selectStreamTable ::
  forall b r m n.
  ( MonadBuildSchema b r m n,
    AggregationPredicatesSchema b,
    BackendTableSelectSchema b
  ) =>
  SourceInfo b ->
  -- | table info
  TableInfo b ->
  -- | field display name
  G.Name ->
  -- | field description, if any
  Maybe G.Description ->
  m (Maybe (P.FieldParser n (StreamSelectExp b)))
selectStreamTable :: SourceInfo b
-> TableInfo b
-> Name
-> Maybe Description
-> m (Maybe (FieldParser n (StreamSelectExp b)))
selectStreamTable SourceInfo b
sourceInfo TableInfo b
tableInfo Name
fieldName Maybe Description
description = MaybeT m (FieldParser n (StreamSelectExp b))
-> m (Maybe (FieldParser n (StreamSelectExp b)))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT m (FieldParser n (StreamSelectExp b))
 -> m (Maybe (FieldParser n (StreamSelectExp b))))
-> MaybeT m (FieldParser n (StreamSelectExp b))
-> m (Maybe (FieldParser n (StreamSelectExp b)))
forall a b. (a -> b) -> a -> b
$ do
  RoleName
roleName <- (SchemaContext -> RoleName) -> MaybeT m RoleName
forall r (m :: * -> *) a b.
(MonadReader r m, Has a r) =>
(a -> b) -> m b
retrieve SchemaContext -> RoleName
scRole
  SelPermInfo b
selectPermissions <- Maybe (SelPermInfo b) -> MaybeT m (SelPermInfo b)
forall (m :: * -> *) b. Applicative m => Maybe b -> MaybeT m b
hoistMaybe (Maybe (SelPermInfo b) -> MaybeT m (SelPermInfo b))
-> Maybe (SelPermInfo b) -> MaybeT m (SelPermInfo b)
forall a b. (a -> b) -> a -> b
$ RoleName -> TableInfo b -> Maybe (SelPermInfo b)
forall (b :: BackendType).
RoleName -> TableInfo b -> Maybe (SelPermInfo b)
tableSelectPermissions RoleName
roleName TableInfo b
tableInfo
  XStreamingSubscription b
xStreamSubscription <- Maybe (XStreamingSubscription b)
-> MaybeT m (XStreamingSubscription b)
forall (m :: * -> *) b. Applicative m => Maybe b -> MaybeT m b
hoistMaybe (Maybe (XStreamingSubscription b)
 -> MaybeT m (XStreamingSubscription b))
-> Maybe (XStreamingSubscription b)
-> MaybeT m (XStreamingSubscription b)
forall a b. (a -> b) -> a -> b
$ BackendSchema b => Maybe (XStreamingSubscription b)
forall (b :: BackendType).
BackendSchema b =>
Maybe (XStreamingSubscription b)
streamSubscriptionExtension @b
  StringifyNumbers
stringifyNumbers <- (SchemaOptions -> StringifyNumbers) -> MaybeT m StringifyNumbers
forall r (m :: * -> *) a b.
(MonadReader r m, Has a r) =>
(a -> b) -> m b
retrieve SchemaOptions -> StringifyNumbers
Options.soStringifyNumbers
  InputFieldsParser n (SelectStreamArgs b)
tableStreamArgsParser <- m (InputFieldsParser n (SelectStreamArgs b))
-> MaybeT m (InputFieldsParser n (SelectStreamArgs b))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (InputFieldsParser n (SelectStreamArgs b))
 -> MaybeT m (InputFieldsParser n (SelectStreamArgs b)))
-> m (InputFieldsParser n (SelectStreamArgs b))
-> MaybeT m (InputFieldsParser n (SelectStreamArgs b))
forall a b. (a -> b) -> a -> b
$ SourceInfo b
-> TableInfo b -> m (InputFieldsParser n (SelectStreamArgs b))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(AggregationPredicatesSchema b, MonadBuildSchema b r m n) =>
SourceInfo b
-> TableInfo b -> m (InputFieldsParser n (SelectStreamArgs b))
tableStreamArguments SourceInfo b
sourceInfo TableInfo b
tableInfo
  Parser 'Output n (AnnotatedFields b)
selectionSetParser <- m (Maybe (Parser 'Output n (AnnotatedFields b)))
-> MaybeT m (Parser 'Output n (AnnotatedFields b))
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe (Parser 'Output n (AnnotatedFields b)))
 -> MaybeT m (Parser 'Output n (AnnotatedFields b)))
-> m (Maybe (Parser 'Output n (AnnotatedFields b)))
-> MaybeT m (Parser 'Output n (AnnotatedFields b))
forall a b. (a -> b) -> a -> b
$ SourceInfo b
-> TableInfo b -> m (Maybe (Parser 'Output n (AnnotatedFields b)))
forall r (m :: * -> *) (n :: * -> *) (b :: BackendType).
(MonadBuildSchemaBase r m n, BackendTableSelectSchema b) =>
SourceInfo b
-> TableInfo b -> m (Maybe (Parser 'Output n (AnnotatedFields b)))
tableSelectionList SourceInfo b
sourceInfo TableInfo b
tableInfo
  m (FieldParser n (StreamSelectExp b))
-> MaybeT m (FieldParser n (StreamSelectExp b))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (FieldParser n (StreamSelectExp b))
 -> MaybeT m (FieldParser n (StreamSelectExp b)))
-> m (FieldParser n (StreamSelectExp b))
-> MaybeT m (FieldParser n (StreamSelectExp b))
forall a b. (a -> b) -> a -> b
$
    Name
-> (SourceName, TableName b, Name)
-> m (FieldParser n (StreamSelectExp b))
-> m (FieldParser n (StreamSelectExp b))
forall (m :: * -> *) a p.
(MonadMemoize m, Ord a, Typeable a, Typeable p) =>
Name -> a -> m p -> m p
memoizeOn 'selectStreamTable (SourceInfo b -> SourceName
forall (b :: BackendType). SourceInfo b -> SourceName
_siName SourceInfo b
sourceInfo, TableName b
tableName, Name
fieldName) (m (FieldParser n (StreamSelectExp b))
 -> m (FieldParser n (StreamSelectExp b)))
-> m (FieldParser n (StreamSelectExp b))
-> m (FieldParser n (StreamSelectExp b))
forall a b. (a -> b) -> a -> b
$ do
      FieldParser n (StreamSelectExp b)
-> m (FieldParser n (StreamSelectExp b))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldParser n (StreamSelectExp b)
 -> m (FieldParser n (StreamSelectExp b)))
-> FieldParser n (StreamSelectExp b)
-> m (FieldParser n (StreamSelectExp b))
forall a b. (a -> b) -> a -> b
$
        Name
-> Maybe Description
-> InputFieldsParser n (SelectStreamArgs b)
-> Parser 'Output n (AnnotatedFields b)
-> FieldParser
     MetadataObjId n (SelectStreamArgs 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 (SelectStreamArgs b)
tableStreamArgsParser Parser 'Output n (AnnotatedFields b)
selectionSetParser
          FieldParser MetadataObjId n (SelectStreamArgs b, AnnotatedFields b)
-> ((SelectStreamArgs b, AnnotatedFields b) -> StreamSelectExp b)
-> FieldParser n (StreamSelectExp b)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(SelectStreamArgs b
args, AnnotatedFields b
fields) ->
            AnnSelectStreamG :: forall (b :: BackendType) (f :: * -> *) v.
XStreamingSubscription b
-> Fields (f v)
-> SelectFromG b v
-> TablePermG b v
-> SelectStreamArgsG b v
-> StringifyNumbers
-> AnnSelectStreamG b f v
IR.AnnSelectStreamG
              { $sel:_assnXStreamingSubscription:AnnSelectStreamG :: XStreamingSubscription b
IR._assnXStreamingSubscription = XStreamingSubscription b
xStreamSubscription,
                $sel:_assnFields:AnnSelectStreamG :: AnnotatedFields b
IR._assnFields = AnnotatedFields b
fields,
                $sel:_assnFrom:AnnSelectStreamG :: SelectFromG b (UnpreparedValue b)
IR._assnFrom = TableName b -> SelectFromG b (UnpreparedValue b)
forall (b :: BackendType) v. TableName b -> SelectFromG b v
IR.FromTable TableName b
tableName,
                $sel:_assnPerm:AnnSelectStreamG :: TablePermG b (UnpreparedValue b)
IR._assnPerm = SelPermInfo b -> TablePermG b (UnpreparedValue b)
forall (b :: BackendType).
Backend b =>
SelPermInfo b -> TablePerms b
tablePermissionsInfo SelPermInfo b
selectPermissions,
                $sel:_assnArgs:AnnSelectStreamG :: SelectStreamArgs b
IR._assnArgs = SelectStreamArgs b
args,
                $sel:_assnStrfyNum:AnnSelectStreamG :: StringifyNumbers
IR._assnStrfyNum = StringifyNumbers
stringifyNumbers
              }
  where
    tableName :: TableName b
tableName = TableInfo b -> TableName b
forall (b :: BackendType). TableInfo b -> TableName b
tableInfoName TableInfo b
tableInfo