{-# LANGUAGE TemplateHaskellQuotes #-}
module Hasura.GraphQL.Schema.Relay
( nodeInterface,
nodeField,
)
where
import Control.Lens hiding (index)
import Data.Aeson qualified as J
import Data.Aeson.Types qualified as J
import Data.Align (align)
import Data.Has
import Data.HashMap.Strict.Extended qualified as HashMap
import Data.Sequence.NonEmpty qualified as NESeq
import Data.Text qualified as T
import Data.These (partitionThese)
import Hasura.Base.Error
import Hasura.Base.ErrorMessage
import Hasura.Base.ToErrorValue
import Hasura.GraphQL.Schema.Backend
import Hasura.GraphQL.Schema.Common
import Hasura.GraphQL.Schema.Instances ()
import Hasura.GraphQL.Schema.Node
import Hasura.GraphQL.Schema.Parser (Kind (..), Parser, memoizeOn)
import Hasura.GraphQL.Schema.Parser qualified as P
import Hasura.GraphQL.Schema.Select
import Hasura.GraphQL.Schema.Table
import Hasura.Name qualified as Name
import Hasura.Prelude
import Hasura.RQL.IR qualified as IR
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Schema.Options qualified as Options
import Hasura.RQL.Types.SchemaCache hiding (askTableInfo)
import Hasura.RQL.Types.Source
import Hasura.RQL.Types.SourceCustomization
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.Table.Cache
import Language.GraphQL.Draft.Syntax qualified as G
nodeInterface :: SourceCache -> NodeInterfaceParserBuilder
nodeInterface :: SourceCache -> NodeInterfaceParserBuilder
nodeInterface SourceCache
sourceCache = (forall (m :: * -> *) (n :: * -> *).
MonadBuildSchemaBase m n =>
SchemaContext -> SchemaOptions -> m (Parser 'Output n NodeMap))
-> NodeInterfaceParserBuilder
NodeInterfaceParserBuilder ((forall (m :: * -> *) (n :: * -> *).
MonadBuildSchemaBase m n =>
SchemaContext -> SchemaOptions -> m (Parser 'Output n NodeMap))
-> NodeInterfaceParserBuilder)
-> (forall (m :: * -> *) (n :: * -> *).
MonadBuildSchemaBase m n =>
SchemaContext -> SchemaOptions -> m (Parser 'Output n NodeMap))
-> NodeInterfaceParserBuilder
forall a b. (a -> b) -> a -> b
$ \SchemaContext
context SchemaOptions
options -> Name
-> ()
-> m (Parser 'Output n NodeMap)
-> m (Parser 'Output n NodeMap)
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)
memoizeOn 'nodeInterface () do
let idDescription :: Description
idDescription = Text -> Description
G.Description Text
"A globally unique identifier"
idField :: FieldParser origin n ()
idField = Name
-> Maybe Description
-> Parser origin 'Both n Text
-> FieldParser origin n ()
forall (m :: * -> *) origin a.
MonadParse m =>
Name
-> Maybe Description
-> Parser origin 'Both m a
-> FieldParser origin m ()
P.selection_ Name
Name._id (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
idDescription) Parser origin 'Both n Text
forall (m :: * -> *) origin.
MonadParse m =>
Parser origin 'Both m Text
P.identifier
nodeInterfaceDescription :: Description
nodeInterfaceDescription = Text -> Description
G.Description Text
"An object with globally unique ID"
roleName :: RoleName
roleName = SchemaContext -> RoleName
scRole SchemaContext
context
[Parser 'Output n (SourceName, AnyBackend TableMap)]
tables :: [Parser 'Output n (SourceName, AB.AnyBackend TableMap)] <-
[Maybe (Parser 'Output n (SourceName, AnyBackend TableMap))]
-> [Parser 'Output n (SourceName, AnyBackend TableMap)]
forall a. [Maybe a] -> [a]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes ([Maybe (Parser 'Output n (SourceName, AnyBackend TableMap))]
-> [Parser 'Output n (SourceName, AnyBackend TableMap)])
-> ([[Maybe (Parser 'Output n (SourceName, AnyBackend TableMap))]]
-> [Maybe (Parser 'Output n (SourceName, AnyBackend TableMap))])
-> [[Maybe (Parser 'Output n (SourceName, AnyBackend TableMap))]]
-> [Parser 'Output n (SourceName, AnyBackend TableMap)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Maybe (Parser 'Output n (SourceName, AnyBackend TableMap))]]
-> [Maybe (Parser 'Output n (SourceName, AnyBackend TableMap))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Maybe (Parser 'Output n (SourceName, AnyBackend TableMap))]]
-> [Parser 'Output n (SourceName, AnyBackend TableMap)])
-> m [[Maybe (Parser 'Output n (SourceName, AnyBackend TableMap))]]
-> m [Parser 'Output n (SourceName, AnyBackend TableMap)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(SourceName, BackendSourceInfo)]
-> ((SourceName, BackendSourceInfo)
-> m [Maybe (Parser 'Output n (SourceName, AnyBackend TableMap))])
-> m [[Maybe (Parser 'Output n (SourceName, AnyBackend TableMap))]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (SourceCache -> [(SourceName, BackendSourceInfo)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList SourceCache
sourceCache) \(SourceName
sourceName, BackendSourceInfo
anySourceInfo) ->
forall (c1 :: BackendType -> Constraint)
(c2 :: BackendType -> Constraint) (i :: BackendType -> *) r.
(AllBackendsSatisfy c1, AllBackendsSatisfy c2) =>
AnyBackend i
-> (forall (b :: BackendType). (c1 b, c2 b) => i b -> r) -> r
AB.dispatchAnyBackendWithTwoConstraints @BackendSchema @BackendTableSelectSchema
BackendSourceInfo
anySourceInfo
\(SourceInfo b
sourceInfo :: SourceInfo b) ->
SchemaContext
-> SchemaOptions
-> SourceInfo b
-> SchemaT
(SchemaContext, SchemaOptions, SourceInfo b)
m
[Maybe (Parser 'Output n (SourceName, AnyBackend TableMap))]
-> m [Maybe (Parser 'Output n (SourceName, AnyBackend TableMap))]
forall (b :: BackendType) (m :: * -> *) a.
SchemaContext
-> SchemaOptions
-> SourceInfo b
-> SchemaT (SchemaContext, SchemaOptions, SourceInfo b) m a
-> m a
runSourceSchema SchemaContext
context SchemaOptions
options SourceInfo b
sourceInfo do
[(TableName b, TableInfo b)]
-> ((TableName b, TableInfo b)
-> SchemaT
(SchemaContext, SchemaOptions, SourceInfo b)
m
(Maybe (Parser 'Output n (SourceName, AnyBackend TableMap))))
-> SchemaT
(SchemaContext, SchemaOptions, SourceInfo b)
m
[Maybe (Parser 'Output n (SourceName, AnyBackend TableMap))]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (HashMap (TableName b) (TableInfo b) -> [(TableName b, TableInfo b)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList (HashMap (TableName b) (TableInfo b)
-> [(TableName b, TableInfo b)])
-> HashMap (TableName b) (TableInfo b)
-> [(TableName b, TableInfo b)]
forall a b. (a -> b) -> a -> b
$ HashMap (TableName b) (TableInfo b)
-> HashMap (TableName b) (TableInfo b)
forall (b :: BackendType).
Backend b =>
TableCache b -> TableCache b
takeValidTables (HashMap (TableName b) (TableInfo b)
-> HashMap (TableName b) (TableInfo b))
-> HashMap (TableName b) (TableInfo b)
-> HashMap (TableName b) (TableInfo b)
forall a b. (a -> b) -> a -> b
$ SourceInfo b -> HashMap (TableName b) (TableInfo b)
forall (b :: BackendType). SourceInfo b -> TableCache b
_siTables SourceInfo b
sourceInfo) \(TableName b
tableName, TableInfo b
tableInfo) -> MaybeT
(SchemaT (SchemaContext, SchemaOptions, SourceInfo b) m)
(Parser 'Output n (SourceName, AnyBackend TableMap))
-> SchemaT
(SchemaContext, SchemaOptions, SourceInfo b)
m
(Maybe (Parser 'Output n (SourceName, AnyBackend TableMap)))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
NESeq (ColumnInfo b)
tablePkeyColumns <- Maybe (NESeq (ColumnInfo b))
-> MaybeT
(SchemaT (SchemaContext, SchemaOptions, SourceInfo b) m)
(NESeq (ColumnInfo b))
forall (m :: * -> *) b. Applicative m => Maybe b -> MaybeT m b
hoistMaybe (Maybe (NESeq (ColumnInfo b))
-> MaybeT
(SchemaT (SchemaContext, SchemaOptions, SourceInfo b) m)
(NESeq (ColumnInfo b)))
-> Maybe (NESeq (ColumnInfo b))
-> MaybeT
(SchemaT (SchemaContext, SchemaOptions, SourceInfo b) m)
(NESeq (ColumnInfo b))
forall a b. (a -> b) -> a -> b
$ TableInfo b
tableInfo TableInfo b
-> Getting
(First (NESeq (ColumnInfo b))) (TableInfo b) (NESeq (ColumnInfo b))
-> Maybe (NESeq (ColumnInfo b))
forall s a. s -> Getting (First a) s a -> Maybe a
^? (TableCoreInfo b
-> Const (First (NESeq (ColumnInfo b))) (TableCoreInfo b))
-> TableInfo b
-> Const (First (NESeq (ColumnInfo b))) (TableInfo b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(TableCoreInfo b -> f (TableCoreInfo b))
-> TableInfo b -> f (TableInfo b)
tiCoreInfo ((TableCoreInfo b
-> Const (First (NESeq (ColumnInfo b))) (TableCoreInfo b))
-> TableInfo b
-> Const (First (NESeq (ColumnInfo b))) (TableInfo b))
-> ((NESeq (ColumnInfo b)
-> Const (First (NESeq (ColumnInfo b))) (NESeq (ColumnInfo b)))
-> TableCoreInfo b
-> Const (First (NESeq (ColumnInfo b))) (TableCoreInfo b))
-> Getting
(First (NESeq (ColumnInfo b))) (TableInfo b) (NESeq (ColumnInfo b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (PrimaryKey b (ColumnInfo b))
-> Const
(First (NESeq (ColumnInfo b)))
(Maybe (PrimaryKey b (ColumnInfo b))))
-> TableCoreInfo b
-> Const (First (NESeq (ColumnInfo b))) (TableCoreInfo b)
forall (b :: BackendType) field primaryKeyColumn1 primaryKeyColumn2
(f :: * -> *).
Functor f =>
(Maybe (PrimaryKey b primaryKeyColumn1)
-> f (Maybe (PrimaryKey b primaryKeyColumn2)))
-> TableCoreInfoG b field primaryKeyColumn1
-> f (TableCoreInfoG b field primaryKeyColumn2)
tciPrimaryKey ((Maybe (PrimaryKey b (ColumnInfo b))
-> Const
(First (NESeq (ColumnInfo b)))
(Maybe (PrimaryKey b (ColumnInfo b))))
-> TableCoreInfo b
-> Const (First (NESeq (ColumnInfo b))) (TableCoreInfo b))
-> ((NESeq (ColumnInfo b)
-> Const (First (NESeq (ColumnInfo b))) (NESeq (ColumnInfo b)))
-> Maybe (PrimaryKey b (ColumnInfo b))
-> Const
(First (NESeq (ColumnInfo b)))
(Maybe (PrimaryKey b (ColumnInfo b))))
-> (NESeq (ColumnInfo b)
-> Const (First (NESeq (ColumnInfo b))) (NESeq (ColumnInfo b)))
-> TableCoreInfo b
-> Const (First (NESeq (ColumnInfo b))) (TableCoreInfo b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PrimaryKey b (ColumnInfo b)
-> Const
(First (NESeq (ColumnInfo b))) (PrimaryKey b (ColumnInfo b)))
-> Maybe (PrimaryKey b (ColumnInfo b))
-> Const
(First (NESeq (ColumnInfo b)))
(Maybe (PrimaryKey b (ColumnInfo b)))
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((PrimaryKey b (ColumnInfo b)
-> Const
(First (NESeq (ColumnInfo b))) (PrimaryKey b (ColumnInfo b)))
-> Maybe (PrimaryKey b (ColumnInfo b))
-> Const
(First (NESeq (ColumnInfo b)))
(Maybe (PrimaryKey b (ColumnInfo b))))
-> ((NESeq (ColumnInfo b)
-> Const (First (NESeq (ColumnInfo b))) (NESeq (ColumnInfo b)))
-> PrimaryKey b (ColumnInfo b)
-> Const
(First (NESeq (ColumnInfo b))) (PrimaryKey b (ColumnInfo b)))
-> (NESeq (ColumnInfo b)
-> Const (First (NESeq (ColumnInfo b))) (NESeq (ColumnInfo b)))
-> Maybe (PrimaryKey b (ColumnInfo b))
-> Const
(First (NESeq (ColumnInfo b)))
(Maybe (PrimaryKey b (ColumnInfo b)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NESeq (ColumnInfo b)
-> Const (First (NESeq (ColumnInfo b))) (NESeq (ColumnInfo b)))
-> PrimaryKey b (ColumnInfo b)
-> Const
(First (NESeq (ColumnInfo b))) (PrimaryKey b (ColumnInfo b))
forall (b :: BackendType) a1 a2 (f :: * -> *).
Functor f =>
(NESeq a1 -> f (NESeq a2))
-> PrimaryKey b a1 -> f (PrimaryKey b a2)
pkColumns
SelPermInfo b
selectPermissions <- Maybe (SelPermInfo b)
-> MaybeT
(SchemaT (SchemaContext, SchemaOptions, SourceInfo b) m)
(SelPermInfo b)
forall (m :: * -> *) b. Applicative m => Maybe b -> MaybeT m b
hoistMaybe (Maybe (SelPermInfo b)
-> MaybeT
(SchemaT (SchemaContext, SchemaOptions, SourceInfo b) m)
(SelPermInfo b))
-> Maybe (SelPermInfo b)
-> MaybeT
(SchemaT (SchemaContext, SchemaOptions, SourceInfo b) 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
Parser 'Output n (AnnotatedFields b)
annotatedFieldsParser <- SchemaT
(SchemaContext, SchemaOptions, SourceInfo b)
m
(Maybe (Parser 'Output n (AnnotatedFields b)))
-> MaybeT
(SchemaT (SchemaContext, SchemaOptions, SourceInfo b) m)
(Parser 'Output n (AnnotatedFields b))
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (SchemaT
(SchemaContext, SchemaOptions, SourceInfo b)
m
(Maybe (Parser 'Output n (AnnotatedFields b)))
-> MaybeT
(SchemaT (SchemaContext, SchemaOptions, SourceInfo b) m)
(Parser 'Output n (AnnotatedFields b)))
-> SchemaT
(SchemaContext, SchemaOptions, SourceInfo b)
m
(Maybe (Parser 'Output n (AnnotatedFields b)))
-> MaybeT
(SchemaT (SchemaContext, SchemaOptions, SourceInfo b) m)
(Parser 'Output n (AnnotatedFields b))
forall a b. (a -> b) -> a -> b
$ TableInfo b
-> SchemaT
(SchemaContext, SchemaOptions, SourceInfo b)
m
(Maybe (Parser 'Output n (AnnotatedFields b)))
forall r (m :: * -> *) (n :: * -> *).
MonadBuildSourceSchema b r m n =>
TableInfo b
-> SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(BackendTableSelectSchema b, MonadBuildSourceSchema b r m n) =>
TableInfo b
-> SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
tableSelectionSet TableInfo b
tableInfo
Parser 'Output n (SourceName, AnyBackend TableMap)
-> MaybeT
(SchemaT (SchemaContext, SchemaOptions, SourceInfo b) m)
(Parser 'Output n (SourceName, AnyBackend TableMap))
forall a.
a
-> MaybeT
(SchemaT (SchemaContext, SchemaOptions, SourceInfo b) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(Parser 'Output n (SourceName, AnyBackend TableMap)
-> MaybeT
(SchemaT (SchemaContext, SchemaOptions, SourceInfo b) m)
(Parser 'Output n (SourceName, AnyBackend TableMap)))
-> Parser 'Output n (SourceName, AnyBackend TableMap)
-> MaybeT
(SchemaT (SchemaContext, SchemaOptions, SourceInfo b) m)
(Parser 'Output n (SourceName, AnyBackend TableMap))
forall a b. (a -> b) -> a -> b
$ Parser 'Output n (AnnotatedFields b)
annotatedFieldsParser
Parser 'Output n (AnnotatedFields b)
-> (AnnotatedFields b -> (SourceName, AnyBackend TableMap))
-> Parser 'Output n (SourceName, AnyBackend TableMap)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \AnnotatedFields b
fields ->
( SourceName
sourceName,
TableMap b -> AnyBackend TableMap
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
(TableMap b -> AnyBackend TableMap)
-> TableMap b -> AnyBackend TableMap
forall a b. (a -> b) -> a -> b
$ HashMap (TableName b) (NodeInfo b) -> TableMap b
forall (b :: BackendType).
HashMap (TableName b) (NodeInfo b) -> TableMap b
TableMap
(HashMap (TableName b) (NodeInfo b) -> TableMap b)
-> HashMap (TableName b) (NodeInfo b) -> TableMap b
forall a b. (a -> b) -> a -> b
$ TableName b -> NodeInfo b -> HashMap (TableName b) (NodeInfo b)
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton TableName b
tableName
(NodeInfo b -> HashMap (TableName b) (NodeInfo b))
-> NodeInfo b -> HashMap (TableName b) (NodeInfo b)
forall a b. (a -> b) -> a -> b
$ SourceInfo b
-> SelPermInfo b
-> NESeq (ColumnInfo b)
-> AnnotatedFields b
-> NodeInfo b
forall (b :: BackendType).
SourceInfo b
-> SelPermInfo b
-> PrimaryKeyColumns b
-> AnnFieldsG
b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> NodeInfo b
NodeInfo SourceInfo b
sourceInfo SelPermInfo b
selectPermissions NESeq (ColumnInfo b)
tablePkeyColumns AnnotatedFields b
fields
)
Parser 'Output n NodeMap -> m (Parser 'Output n NodeMap)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(Parser 'Output n NodeMap -> m (Parser 'Output n NodeMap))
-> Parser 'Output n NodeMap -> m (Parser 'Output n NodeMap)
forall a b. (a -> b) -> a -> b
$ (AnyBackend TableMap -> AnyBackend TableMap -> AnyBackend TableMap)
-> [(SourceName, AnyBackend TableMap)] -> NodeMap
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
HashMap.fromListWith AnyBackend TableMap -> AnyBackend TableMap -> AnyBackend TableMap
fuseAnyMaps
([(SourceName, AnyBackend TableMap)] -> NodeMap)
-> Parser
MetadataObjId 'Output n [(SourceName, AnyBackend TableMap)]
-> Parser 'Output n NodeMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name
-> Maybe Description
-> [FieldParser MetadataObjId n ()]
-> [Parser 'Output n (SourceName, AnyBackend TableMap)]
-> Parser
MetadataObjId 'Output n [(SourceName, AnyBackend TableMap)]
forall (n :: * -> *) (t :: * -> *) origin a b.
(MonadParse n, Traversable t) =>
Name
-> Maybe Description
-> [FieldParser origin n a]
-> t (Parser origin 'Output n b)
-> Parser origin 'Output n (t b)
P.selectionSetInterface
Name
Name._Node
(Description -> Maybe Description
forall a. a -> Maybe a
Just Description
nodeInterfaceDescription)
[FieldParser MetadataObjId n ()
forall {origin}. FieldParser origin n ()
idField]
[Parser 'Output n (SourceName, AnyBackend TableMap)]
tables
where
fuseAnyMaps :: AB.AnyBackend TableMap -> AB.AnyBackend TableMap -> AB.AnyBackend TableMap
fuseAnyMaps :: AnyBackend TableMap -> AnyBackend TableMap -> AnyBackend TableMap
fuseAnyMaps AnyBackend TableMap
m1 AnyBackend TableMap
m2 =
forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
(forall (b :: BackendType). c b => i b -> i b -> r)
-> AnyBackend i -> AnyBackend i -> r -> r
AB.composeAnyBackend @Backend TableMap b -> TableMap b -> AnyBackend TableMap
forall (b :: BackendType).
Backend b =>
TableMap b -> TableMap b -> AnyBackend TableMap
fuseMaps AnyBackend TableMap
m1 AnyBackend TableMap
m2
(AnyBackend TableMap -> AnyBackend TableMap)
-> AnyBackend TableMap -> AnyBackend TableMap
forall a b. (a -> b) -> a -> b
$ [Char] -> AnyBackend TableMap
forall a. HasCallStack => [Char] -> a
error [Char]
"panic: two tables of a different backend type within the same source"
fuseMaps :: forall b. (Backend b) => TableMap b -> TableMap b -> AB.AnyBackend TableMap
fuseMaps :: forall (b :: BackendType).
Backend b =>
TableMap b -> TableMap b -> AnyBackend TableMap
fuseMaps (TableMap HashMap (TableName b) (NodeInfo b)
m1) (TableMap HashMap (TableName b) (NodeInfo b)
m2) = forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend @b (TableMap b -> AnyBackend TableMap)
-> TableMap b -> AnyBackend TableMap
forall a b. (a -> b) -> a -> b
$ HashMap (TableName b) (NodeInfo b) -> TableMap b
forall (b :: BackendType).
HashMap (TableName b) (NodeInfo b) -> TableMap b
TableMap (HashMap (TableName b) (NodeInfo b) -> TableMap b)
-> HashMap (TableName b) (NodeInfo b) -> TableMap b
forall a b. (a -> b) -> a -> b
$ HashMap (TableName b) (NodeInfo b)
-> HashMap (TableName b) (NodeInfo b)
-> HashMap (TableName b) (NodeInfo b)
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
HashMap.union HashMap (TableName b) (NodeInfo b)
m1 HashMap (TableName b) (NodeInfo b)
m2
nodeField ::
forall m n.
(MonadError QErr m, P.MonadMemoize m, P.MonadParse n) =>
SourceCache ->
SchemaContext ->
Options.SchemaOptions ->
m (P.FieldParser n (IR.QueryRootField IR.UnpreparedValue))
nodeField :: forall (m :: * -> *) (n :: * -> *).
(MonadError QErr m, MonadMemoize m, MonadParse n) =>
SourceCache
-> SchemaContext
-> SchemaOptions
-> m (FieldParser n (QueryRootField UnpreparedValue))
nodeField SourceCache
sourceCache SchemaContext
context SchemaOptions
options = do
let idDescription :: Description
idDescription = Text -> Description
G.Description Text
"A globally unique id"
idArgument :: InputFieldsParser origin n Text
idArgument = Name
-> Maybe Description
-> Parser origin 'Both n Text
-> InputFieldsParser origin n Text
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
Name._id (Description -> Maybe Description
forall a. a -> Maybe a
Just Description
idDescription) Parser origin 'Both n Text
forall (m :: * -> *) origin.
MonadParse m =>
Parser origin 'Both m Text
P.identifier
stringifyNumbers :: StringifyNumbers
stringifyNumbers = SchemaOptions -> StringifyNumbers
Options.soStringifyNumbers SchemaOptions
options
Parser 'Output n NodeMap
nodeObject <- case SchemaContext -> SchemaKind
scSchemaKind SchemaContext
context of
SchemaKind
HasuraSchema -> Text -> m (Parser 'Output n NodeMap)
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 Text
"internal error: the node field should only be built for the Relay schema"
RelaySchema NodeInterfaceParserBuilder
nodeBuilder -> NodeInterfaceParserBuilder
-> forall (m :: * -> *) (n :: * -> *).
MonadBuildSchemaBase m n =>
SchemaContext -> SchemaOptions -> m (Parser 'Output n NodeMap)
runNodeBuilder NodeInterfaceParserBuilder
nodeBuilder SchemaContext
context SchemaOptions
options
FieldParser n (QueryRootField UnpreparedValue)
-> m (FieldParser n (QueryRootField UnpreparedValue))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(FieldParser n (QueryRootField UnpreparedValue)
-> m (FieldParser n (QueryRootField UnpreparedValue)))
-> FieldParser n (QueryRootField UnpreparedValue)
-> m (FieldParser n (QueryRootField UnpreparedValue))
forall a b. (a -> b) -> a -> b
$ Name
-> Maybe Description
-> InputFieldsParser MetadataObjId n Text
-> Parser 'Output n NodeMap
-> FieldParser MetadataObjId n (Text, NodeMap)
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
Name._node Maybe Description
forall a. Maybe a
Nothing InputFieldsParser MetadataObjId n Text
forall {origin}. InputFieldsParser origin n Text
idArgument Parser 'Output n NodeMap
nodeObject
FieldParser MetadataObjId n (Text, NodeMap)
-> ((Text, NodeMap) -> n (QueryRootField UnpreparedValue))
-> FieldParser n (QueryRootField UnpreparedValue)
forall (m :: * -> *) origin a b.
Monad m =>
FieldParser origin m a -> (a -> m b) -> FieldParser origin m b
`P.bindField` \(Text
ident, NodeMap
parseds) -> do
NodeId
nodeId <- Text -> n NodeId
parseNodeId Text
ident
case NodeId
nodeId of
NodeIdV1 (V1NodeId QualifiedTable
tableName NESeq Value
pKeys) -> do
let matchingTables :: [NodeInfo ('Postgres 'Vanilla)]
matchingTables = ((SourceName -> Maybe (NodeInfo ('Postgres 'Vanilla)))
-> [SourceName] -> [NodeInfo ('Postgres 'Vanilla)])
-> [SourceName]
-> (SourceName -> Maybe (NodeInfo ('Postgres 'Vanilla)))
-> [NodeInfo ('Postgres 'Vanilla)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (SourceName -> Maybe (NodeInfo ('Postgres 'Vanilla)))
-> [SourceName] -> [NodeInfo ('Postgres 'Vanilla)]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (SourceCache -> [SourceName]
forall k v. HashMap k v -> [k]
HashMap.keys SourceCache
sourceCache) \SourceName
sourceName ->
forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> NodeMap -> Maybe (NodeInfo b)
findNode @('Postgres 'Vanilla) SourceName
sourceName TableName ('Postgres 'Vanilla)
QualifiedTable
tableName NodeMap
parseds
case [NodeInfo ('Postgres 'Vanilla)]
matchingTables of
[NodeInfo ('Postgres 'Vanilla)
nodeValue] -> StringifyNumbers
-> TableName ('Postgres 'Vanilla)
-> NodeInfo ('Postgres 'Vanilla)
-> NESeq Value
-> n (QueryRootField UnpreparedValue)
forall (b :: BackendType).
Backend b =>
StringifyNumbers
-> TableName b
-> NodeInfo b
-> NESeq Value
-> n (QueryRootField UnpreparedValue)
createRootField StringifyNumbers
stringifyNumbers TableName ('Postgres 'Vanilla)
QualifiedTable
tableName NodeInfo ('Postgres 'Vanilla)
nodeValue NESeq Value
pKeys
[] -> ErrorMessage -> n (QueryRootField UnpreparedValue)
forall a. ErrorMessage -> n a
throwInvalidNodeId (ErrorMessage -> n (QueryRootField UnpreparedValue))
-> ErrorMessage -> n (QueryRootField UnpreparedValue)
forall a b. (a -> b) -> a -> b
$ ErrorMessage
"no such table found: " ErrorMessage -> ErrorMessage -> ErrorMessage
forall a. Semigroup a => a -> a -> a
<> QualifiedTable -> ErrorMessage
forall a. ToErrorValue a => a -> ErrorMessage
toErrorValue QualifiedTable
tableName
[NodeInfo ('Postgres 'Vanilla)]
l ->
ErrorMessage -> n (QueryRootField UnpreparedValue)
forall a. ErrorMessage -> n a
throwInvalidNodeId
(ErrorMessage -> n (QueryRootField UnpreparedValue))
-> ErrorMessage -> n (QueryRootField UnpreparedValue)
forall a b. (a -> b) -> a -> b
$ ErrorMessage
"this V1 node id matches more than one table across different sources: "
ErrorMessage -> ErrorMessage -> ErrorMessage
forall a. Semigroup a => a -> a -> a
<> QualifiedTable -> ErrorMessage
forall a. ToErrorValue a => a -> ErrorMessage
toErrorValue QualifiedTable
tableName
ErrorMessage -> ErrorMessage -> ErrorMessage
forall a. Semigroup a => a -> a -> a
<> ErrorMessage
" exists in sources "
ErrorMessage -> ErrorMessage -> ErrorMessage
forall a. Semigroup a => a -> a -> a
<> [SourceName] -> ErrorMessage
forall a. ToErrorValue a => a -> ErrorMessage
toErrorValue (SourceInfo ('Postgres 'Vanilla) -> SourceName
forall (b :: BackendType). SourceInfo b -> SourceName
_siName (SourceInfo ('Postgres 'Vanilla) -> SourceName)
-> (NodeInfo ('Postgres 'Vanilla)
-> SourceInfo ('Postgres 'Vanilla))
-> NodeInfo ('Postgres 'Vanilla)
-> SourceName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeInfo ('Postgres 'Vanilla) -> SourceInfo ('Postgres 'Vanilla)
forall (b :: BackendType). NodeInfo b -> SourceInfo b
nvSourceInfo (NodeInfo ('Postgres 'Vanilla) -> SourceName)
-> [NodeInfo ('Postgres 'Vanilla)] -> [SourceName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NodeInfo ('Postgres 'Vanilla)]
l)
NodeIdV2 AnyBackend V2NodeId
nodev2 ->
forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @Backend AnyBackend V2NodeId
nodev2 \(V2NodeId SourceName
sourceName TableName b
tableName NESeq Value
pKeys :: V2NodeId b) -> do
NodeInfo b
nodeValue <-
forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> NodeMap -> Maybe (NodeInfo b)
findNode @b SourceName
sourceName TableName b
tableName NodeMap
parseds
Maybe (NodeInfo b) -> n (NodeInfo b) -> n (NodeInfo b)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` ErrorMessage -> n (NodeInfo b)
forall a. ErrorMessage -> n a
throwInvalidNodeId (ErrorMessage
"no table " ErrorMessage -> ErrorMessage -> ErrorMessage
forall a. Semigroup a => a -> a -> a
<> TableName b -> ErrorMessage
forall a. ToErrorValue a => a -> ErrorMessage
toErrorValue TableName b
tableName ErrorMessage -> ErrorMessage -> ErrorMessage
forall a. Semigroup a => a -> a -> a
<> ErrorMessage
" found in source " ErrorMessage -> ErrorMessage -> ErrorMessage
forall a. Semigroup a => a -> a -> a
<> SourceName -> ErrorMessage
forall a. ToErrorValue a => a -> ErrorMessage
toErrorValue SourceName
sourceName)
StringifyNumbers
-> TableName b
-> NodeInfo b
-> NESeq Value
-> n (QueryRootField UnpreparedValue)
forall (b :: BackendType).
Backend b =>
StringifyNumbers
-> TableName b
-> NodeInfo b
-> NESeq Value
-> n (QueryRootField UnpreparedValue)
createRootField StringifyNumbers
stringifyNumbers TableName b
tableName NodeInfo b
nodeValue NESeq Value
pKeys
where
throwInvalidNodeId :: ErrorMessage -> n a
throwInvalidNodeId :: forall a. ErrorMessage -> n a
throwInvalidNodeId ErrorMessage
t = JSONPathElement -> n a -> n a
forall a. JSONPathElement -> n a -> n a
forall (m :: * -> *) a.
MonadParse m =>
JSONPathElement -> m a -> m a
P.withKey (Key -> JSONPathElement
J.Key Key
"args") (n a -> n a) -> n a -> n a
forall a b. (a -> b) -> a -> b
$ JSONPathElement -> n a -> n a
forall a. JSONPathElement -> n a -> n a
forall (m :: * -> *) a.
MonadParse m =>
JSONPathElement -> m a -> m a
P.withKey (Key -> JSONPathElement
J.Key Key
"id") (n a -> n a) -> n a -> n a
forall a b. (a -> b) -> a -> b
$ ErrorMessage -> n a
forall (m :: * -> *) a. MonadParse m => ErrorMessage -> m a
P.parseError (ErrorMessage -> n a) -> ErrorMessage -> n a
forall a b. (a -> b) -> a -> b
$ ErrorMessage
"invalid node id: " ErrorMessage -> ErrorMessage -> ErrorMessage
forall a. Semigroup a => a -> a -> a
<> ErrorMessage
t
parseNodeId :: Text -> n NodeId
parseNodeId :: Text -> n NodeId
parseNodeId = ([Char] -> n NodeId)
-> (NodeId -> n NodeId) -> Either [Char] NodeId -> n NodeId
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ErrorMessage -> n NodeId
forall a. ErrorMessage -> n a
throwInvalidNodeId (ErrorMessage -> n NodeId)
-> ([Char] -> ErrorMessage) -> [Char] -> n NodeId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ErrorMessage
toErrorMessage (Text -> ErrorMessage)
-> ([Char] -> Text) -> [Char] -> ErrorMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack) NodeId -> n NodeId
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [Char] NodeId -> n NodeId)
-> (Text -> Either [Char] NodeId) -> Text -> n NodeId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either [Char] NodeId
forall a. FromJSON a => ByteString -> Either [Char] a
J.eitherDecode (ByteString -> Either [Char] NodeId)
-> (Text -> ByteString) -> Text -> Either [Char] NodeId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
base64Decode
createRootField ::
forall b.
(Backend b) =>
Options.StringifyNumbers ->
TableName b ->
NodeInfo b ->
NESeq.NESeq J.Value ->
n (IR.QueryRootField IR.UnpreparedValue)
createRootField :: forall (b :: BackendType).
Backend b =>
StringifyNumbers
-> TableName b
-> NodeInfo b
-> NESeq Value
-> n (QueryRootField UnpreparedValue)
createRootField StringifyNumbers
stringifyNumbers TableName b
tableName (NodeInfo SourceInfo b
sourceInfo SelPermInfo b
perms PrimaryKeyColumns b
pKeys AnnFieldsG
b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
fields) NESeq Value
columnValues = do
AnnBoolExp b (UnpreparedValue b)
whereExp <- ScalarTypeParsingContext b
-> NESeq Value
-> PrimaryKeyColumns b
-> n (AnnBoolExp b (UnpreparedValue b))
forall (b :: BackendType).
Backend b =>
ScalarTypeParsingContext b
-> NESeq Value
-> NESeq (ColumnInfo b)
-> n (AnnBoolExp b (UnpreparedValue b))
buildNodeIdBoolExp (SourceConfig b -> ScalarTypeParsingContext b
forall a t. Has a t => t -> a
getter (SourceConfig b -> ScalarTypeParsingContext b)
-> SourceConfig b -> ScalarTypeParsingContext b
forall a b. (a -> b) -> a -> b
$ SourceInfo b -> SourceConfig b
forall (b :: BackendType). SourceInfo b -> SourceConfig b
_siConfiguration SourceInfo b
sourceInfo) NESeq Value
columnValues PrimaryKeyColumns b
pKeys
QueryRootField UnpreparedValue
-> n (QueryRootField UnpreparedValue)
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(QueryRootField UnpreparedValue
-> n (QueryRootField UnpreparedValue))
-> QueryRootField UnpreparedValue
-> n (QueryRootField UnpreparedValue)
forall a b. (a -> b) -> a -> b
$ SourceName
-> AnyBackend
(SourceConfigWith
(QueryDBRoot
(RemoteRelationshipField UnpreparedValue) UnpreparedValue))
-> QueryRootField UnpreparedValue
forall (db :: BackendType -> *) remote action raw.
SourceName
-> AnyBackend (SourceConfigWith db)
-> RootField db remote action raw
IR.RFDB (SourceInfo b -> SourceName
forall (b :: BackendType). SourceInfo b -> SourceName
_siName SourceInfo b
sourceInfo)
(AnyBackend
(SourceConfigWith
(QueryDBRoot
(RemoteRelationshipField UnpreparedValue) UnpreparedValue))
-> QueryRootField UnpreparedValue)
-> AnyBackend
(SourceConfigWith
(QueryDBRoot
(RemoteRelationshipField UnpreparedValue) UnpreparedValue))
-> QueryRootField UnpreparedValue
forall a b. (a -> b) -> a -> b
$ SourceConfigWith
(QueryDBRoot
(RemoteRelationshipField UnpreparedValue) UnpreparedValue)
b
-> AnyBackend
(SourceConfigWith
(QueryDBRoot
(RemoteRelationshipField UnpreparedValue) UnpreparedValue))
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
(SourceConfigWith
(QueryDBRoot
(RemoteRelationshipField UnpreparedValue) UnpreparedValue)
b
-> AnyBackend
(SourceConfigWith
(QueryDBRoot
(RemoteRelationshipField UnpreparedValue) UnpreparedValue)))
-> SourceConfigWith
(QueryDBRoot
(RemoteRelationshipField UnpreparedValue) UnpreparedValue)
b
-> AnyBackend
(SourceConfigWith
(QueryDBRoot
(RemoteRelationshipField UnpreparedValue) UnpreparedValue))
forall a b. (a -> b) -> a -> b
$ SourceConfig b
-> Maybe QueryTagsConfig
-> QueryDBRoot
(RemoteRelationshipField UnpreparedValue) UnpreparedValue b
-> SourceConfigWith
(QueryDBRoot
(RemoteRelationshipField UnpreparedValue) UnpreparedValue)
b
forall (db :: BackendType -> *) (b :: BackendType).
SourceConfig b
-> Maybe QueryTagsConfig -> db b -> SourceConfigWith db b
IR.SourceConfigWith (SourceInfo b -> SourceConfig b
forall (b :: BackendType). SourceInfo b -> SourceConfig b
_siConfiguration SourceInfo b
sourceInfo) Maybe QueryTagsConfig
forall a. Maybe a
Nothing
(QueryDBRoot
(RemoteRelationshipField UnpreparedValue) UnpreparedValue b
-> SourceConfigWith
(QueryDBRoot
(RemoteRelationshipField UnpreparedValue) UnpreparedValue)
b)
-> QueryDBRoot
(RemoteRelationshipField UnpreparedValue) UnpreparedValue b
-> SourceConfigWith
(QueryDBRoot
(RemoteRelationshipField UnpreparedValue) UnpreparedValue)
b
forall a b. (a -> b) -> a -> b
$ QueryDB
b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> QueryDBRoot
(RemoteRelationshipField UnpreparedValue) UnpreparedValue b
forall r (v :: BackendType -> *) (b :: BackendType).
QueryDB b r (v b) -> QueryDBRoot r v b
IR.QDBR
(QueryDB
b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> QueryDBRoot
(RemoteRelationshipField UnpreparedValue) UnpreparedValue b)
-> QueryDB
b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> QueryDBRoot
(RemoteRelationshipField UnpreparedValue) UnpreparedValue b
forall a b. (a -> b) -> a -> b
$ 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
IR.QDBSingleRow
(AnnSimpleSelectG
b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> QueryDB
b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
-> AnnSimpleSelectG
b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> QueryDB
b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
forall a b. (a -> b) -> a -> b
$ IR.AnnSelectG
{ $sel:_asnFields:AnnSelectG :: AnnFieldsG
b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
IR._asnFields = AnnFieldsG
b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
fields,
$sel:_asnFrom:AnnSelectG :: SelectFromG b (UnpreparedValue b)
IR._asnFrom = TableName b -> SelectFromG b (UnpreparedValue b)
forall (b :: BackendType) v. TableName b -> SelectFromG b v
IR.FromTable TableName b
tableName,
$sel:_asnPerm:AnnSelectG :: TablePermG b (UnpreparedValue b)
IR._asnPerm = SelPermInfo b -> TablePermG b (UnpreparedValue b)
forall (b :: BackendType).
Backend b =>
SelPermInfo b -> TablePerms b
tablePermissionsInfo SelPermInfo b
perms,
$sel:_asnArgs:AnnSelectG :: SelectArgsG b (UnpreparedValue b)
IR._asnArgs =
IR.SelectArgs
{ $sel:_saWhere:SelectArgs :: Maybe (AnnBoolExp b (UnpreparedValue b))
IR._saWhere = AnnBoolExp b (UnpreparedValue b)
-> Maybe (AnnBoolExp b (UnpreparedValue b))
forall a. a -> Maybe a
Just AnnBoolExp b (UnpreparedValue b)
whereExp,
$sel:_saOrderBy:SelectArgs :: Maybe (NonEmpty (AnnotatedOrderByItemG b (UnpreparedValue b)))
IR._saOrderBy = Maybe (NonEmpty (AnnotatedOrderByItemG b (UnpreparedValue b)))
forall a. Maybe a
Nothing,
$sel:_saLimit:SelectArgs :: Maybe Int
IR._saLimit = Maybe Int
forall a. Maybe a
Nothing,
$sel:_saOffset:SelectArgs :: Maybe Int64
IR._saOffset = Maybe Int64
forall a. Maybe a
Nothing,
$sel:_saDistinct:SelectArgs :: Maybe (NonEmpty (AnnDistinctColumn b (UnpreparedValue b)))
IR._saDistinct = Maybe (NonEmpty (AnnDistinctColumn b (UnpreparedValue b)))
forall a. Maybe a
Nothing
},
$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 -> Maybe NamingCase) -> NamingCase -> Maybe NamingCase
forall a b. (a -> b) -> a -> b
$ 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
}
buildNodeIdBoolExp ::
(Backend b) =>
ScalarTypeParsingContext b ->
NESeq.NESeq J.Value ->
NESeq.NESeq (ColumnInfo b) ->
n (IR.AnnBoolExp b (IR.UnpreparedValue b))
buildNodeIdBoolExp :: forall (b :: BackendType).
Backend b =>
ScalarTypeParsingContext b
-> NESeq Value
-> NESeq (ColumnInfo b)
-> n (AnnBoolExp b (UnpreparedValue b))
buildNodeIdBoolExp ScalarTypeParsingContext b
scalarTypeParsingContext NESeq Value
columnValues NESeq (ColumnInfo b)
pkeyColumns = do
let ColumnInfo b
firstPkColumn NESeq.:<|| Seq (ColumnInfo b)
remainingPkColumns = NESeq (ColumnInfo b)
pkeyColumns
Value
firstColumnValue NESeq.:<|| Seq Value
remainingColumns = NESeq Value
columnValues
([ColumnInfo b]
nonAlignedPkColumns, [Value]
nonAlignedColumnValues, [(ColumnInfo b, Value)]
alignedTuples) =
[These (ColumnInfo b) Value]
-> ([ColumnInfo b], [Value], [(ColumnInfo b, Value)])
forall a b. [These a b] -> ([a], [b], [(a, b)])
partitionThese ([These (ColumnInfo b) Value]
-> ([ColumnInfo b], [Value], [(ColumnInfo b, Value)]))
-> [These (ColumnInfo b) Value]
-> ([ColumnInfo b], [Value], [(ColumnInfo b, Value)])
forall a b. (a -> b) -> a -> b
$ Seq (These (ColumnInfo b) Value) -> [These (ColumnInfo b) Value]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq (These (ColumnInfo b) Value) -> [These (ColumnInfo b) Value])
-> Seq (These (ColumnInfo b) Value) -> [These (ColumnInfo b) Value]
forall a b. (a -> b) -> a -> b
$ Seq (ColumnInfo b) -> Seq Value -> Seq (These (ColumnInfo b) Value)
forall a b. Seq a -> Seq b -> Seq (These a b)
forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align Seq (ColumnInfo b)
remainingPkColumns Seq Value
remainingColumns
Bool -> n () -> n ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([ColumnInfo b] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ColumnInfo b]
nonAlignedPkColumns)
(n () -> n ()) -> n () -> n ()
forall a b. (a -> b) -> a -> b
$ ErrorMessage -> n ()
forall a. ErrorMessage -> n a
throwInvalidNodeId
(ErrorMessage -> n ()) -> ErrorMessage -> n ()
forall a b. (a -> b) -> a -> b
$ ErrorMessage
"primary key columns "
ErrorMessage -> ErrorMessage -> ErrorMessage
forall a. Semigroup a => a -> a -> a
<> [Column b] -> ErrorMessage
forall a. ToErrorValue a => a -> ErrorMessage
toErrorValue ((ColumnInfo b -> Column b) -> [ColumnInfo b] -> [Column b]
forall a b. (a -> b) -> [a] -> [b]
map ColumnInfo b -> Column b
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn [ColumnInfo b]
nonAlignedPkColumns)
ErrorMessage -> ErrorMessage -> ErrorMessage
forall a. Semigroup a => a -> a -> a
<> ErrorMessage
" are missing"
Bool -> n () -> n ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Value] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Value]
nonAlignedColumnValues)
(n () -> n ()) -> n () -> n ()
forall a b. (a -> b) -> a -> b
$ ErrorMessage -> n ()
forall a. ErrorMessage -> n a
throwInvalidNodeId
(ErrorMessage -> n ()) -> ErrorMessage -> n ()
forall a b. (a -> b) -> a -> b
$ ErrorMessage
"unexpected column values "
ErrorMessage -> ErrorMessage -> ErrorMessage
forall a. Semigroup a => a -> a -> a
<> [Value] -> ErrorMessage
forall a. ToErrorValue a => a -> ErrorMessage
toErrorValue [Value]
nonAlignedColumnValues
let allTuples :: [(ColumnInfo b, Value)]
allTuples = (ColumnInfo b
firstPkColumn, Value
firstColumnValue) (ColumnInfo b, Value)
-> [(ColumnInfo b, Value)] -> [(ColumnInfo b, Value)]
forall a. a -> [a] -> [a]
: [(ColumnInfo b, Value)]
alignedTuples
[AnnBoolExp b (UnpreparedValue b)]
-> AnnBoolExp b (UnpreparedValue b)
forall (backend :: BackendType) field.
[GBoolExp backend field] -> GBoolExp backend field
IR.BoolAnd ([AnnBoolExp b (UnpreparedValue b)]
-> AnnBoolExp b (UnpreparedValue b))
-> n [AnnBoolExp b (UnpreparedValue b)]
-> n (AnnBoolExp b (UnpreparedValue b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ColumnInfo b, Value)]
-> ((ColumnInfo b, Value) -> n (AnnBoolExp b (UnpreparedValue b)))
-> n [AnnBoolExp b (UnpreparedValue b)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(ColumnInfo b, Value)]
allTuples \(ColumnInfo b
columnInfo, Value
columnValue) -> do
let columnType :: ColumnType b
columnType = ColumnInfo b -> ColumnType b
forall (b :: BackendType). ColumnInfo b -> ColumnType b
ciType ColumnInfo b
columnInfo
ScalarValue b
parsedValue <-
ScalarTypeParsingContext b
-> ColumnType b -> Value -> Either QErr (ScalarValue b)
forall (m :: * -> *) (b :: BackendType).
(MonadError QErr m, Backend b) =>
ScalarTypeParsingContext b
-> ColumnType b -> Value -> m (ScalarValue b)
parseScalarValueColumnTypeWithContext ScalarTypeParsingContext b
scalarTypeParsingContext ColumnType b
columnType Value
columnValue Either QErr (ScalarValue b)
-> (QErr -> n (ScalarValue b)) -> n (ScalarValue b)
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
`onLeft` \QErr
e ->
ParseErrorCode -> ErrorMessage -> n (ScalarValue b)
forall a. ParseErrorCode -> ErrorMessage -> n a
forall (m :: * -> *) a.
MonadParse m =>
ParseErrorCode -> ErrorMessage -> m a
P.parseErrorWith ParseErrorCode
P.ParseFailed (ErrorMessage -> n (ScalarValue b))
-> ErrorMessage -> n (ScalarValue b)
forall a b. (a -> b) -> a -> b
$ ErrorMessage
"value of column " ErrorMessage -> ErrorMessage -> ErrorMessage
forall a. Semigroup a => a -> a -> a
<> Column b -> ErrorMessage
forall a. ToErrorValue a => a -> ErrorMessage
toErrorValue (ColumnInfo b -> Column b
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn ColumnInfo b
columnInfo) ErrorMessage -> ErrorMessage -> ErrorMessage
forall a. Semigroup a => a -> a -> a
<> ErrorMessage
" in node id: " ErrorMessage -> ErrorMessage -> ErrorMessage
forall a. Semigroup a => a -> a -> a
<> Text -> ErrorMessage
toErrorMessage (QErr -> Text
qeError QErr
e)
AnnBoolExp b (UnpreparedValue b)
-> n (AnnBoolExp b (UnpreparedValue b))
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(AnnBoolExp b (UnpreparedValue b)
-> n (AnnBoolExp b (UnpreparedValue b)))
-> AnnBoolExp b (UnpreparedValue b)
-> n (AnnBoolExp b (UnpreparedValue b))
forall a b. (a -> b) -> a -> b
$ AnnBoolExpFld b (UnpreparedValue b)
-> AnnBoolExp b (UnpreparedValue b)
forall (backend :: BackendType) field.
field -> GBoolExp backend field
IR.BoolField
(AnnBoolExpFld b (UnpreparedValue b)
-> AnnBoolExp b (UnpreparedValue b))
-> AnnBoolExpFld b (UnpreparedValue b)
-> AnnBoolExp b (UnpreparedValue b)
forall a b. (a -> b) -> a -> b
$ ColumnInfo b
-> [OpExpG b (UnpreparedValue b)]
-> AnnBoolExpFld b (UnpreparedValue b)
forall (backend :: BackendType) leaf.
ColumnInfo backend
-> [OpExpG backend leaf] -> AnnBoolExpFld backend leaf
IR.AVColumn
ColumnInfo b
columnInfo
[ComparisonNullability
-> UnpreparedValue b -> OpExpG b (UnpreparedValue b)
forall (backend :: BackendType) field.
ComparisonNullability -> field -> OpExpG backend field
IR.AEQ ComparisonNullability
IR.NonNullableComparison (UnpreparedValue b -> OpExpG b (UnpreparedValue b))
-> UnpreparedValue b -> OpExpG b (UnpreparedValue b)
forall a b. (a -> b) -> a -> b
$ Provenance -> ColumnValue b -> UnpreparedValue b
forall (b :: BackendType).
Provenance -> ColumnValue b -> UnpreparedValue b
IR.UVParameter Provenance
IR.FreshVar (ColumnValue b -> UnpreparedValue b)
-> ColumnValue b -> UnpreparedValue b
forall a b. (a -> b) -> a -> b
$ ColumnType b -> ScalarValue b -> ColumnValue b
forall (b :: BackendType).
ColumnType b -> ScalarValue b -> ColumnValue b
ColumnValue ColumnType b
columnType ScalarValue b
parsedValue]