module Hasura.Backends.DataConnector.Plan.RemoteRelationshipPlan
( mkRemoteRelationshipPlan,
)
where
import Control.Lens ((?~))
import Control.Monad.Trans.Writer.CPS qualified as CPS
import Data.Aeson qualified as J
import Data.Aeson.Encoding qualified as JE
import Data.Aeson.Key qualified as K
import Data.Aeson.KeyMap qualified as KM
import Data.Has
import Data.HashMap.Strict qualified as HashMap
import Data.List.NonEmpty qualified as NE
import Data.Set qualified as Set
import Data.Text qualified as Text
import Data.Text.Extended (toTxt)
import Hasura.Backends.DataConnector.API qualified as API
import Hasura.Backends.DataConnector.Adapter.Types
import Hasura.Backends.DataConnector.Plan.Common
import Hasura.Backends.DataConnector.Plan.QueryPlan qualified as QueryPlan
import Hasura.Base.Error
import Hasura.Prelude
import Hasura.RQL.IR.Select
import Hasura.RQL.IR.Value
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Common
import Hasura.Session
import Witch qualified
mkRemoteRelationshipPlan ::
forall m r.
(MonadError QErr m, MonadReader r m, Has API.ScalarTypesCapabilities r) =>
SessionVariables ->
SourceConfig ->
NonEmpty J.Object ->
HashMap FieldName (ColumnName, ScalarType) ->
FieldName ->
FieldName ->
SourceRelationshipSelection 'DataConnector Void UnpreparedValue ->
m (Plan API.QueryRequest API.QueryResponse)
mkRemoteRelationshipPlan :: forall (m :: * -> *) r.
(MonadError QErr m, MonadReader r m,
Has ScalarTypesCapabilities r) =>
SessionVariables
-> SourceConfig
-> NonEmpty Object
-> HashMap FieldName (ColumnName, ScalarType)
-> FieldName
-> FieldName
-> SourceRelationshipSelection 'DataConnector Void UnpreparedValue
-> m (Plan QueryRequest QueryResponse)
mkRemoteRelationshipPlan SessionVariables
sessionVariables SourceConfig
_sourceConfig NonEmpty Object
joinIds HashMap FieldName (ColumnName, ScalarType)
joinIdsSchema FieldName
argumentIdFieldName FieldName
resultFieldName SourceRelationshipSelection 'DataConnector Void UnpreparedValue
ir = do
NonEmpty (HashMap ColumnName ScalarValue)
foreachRowFilter <- (Object -> m (HashMap ColumnName ScalarValue))
-> NonEmpty Object -> m (NonEmpty (HashMap ColumnName ScalarValue))
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) -> NonEmpty a -> f (NonEmpty b)
traverse (FieldName
-> HashMap FieldName (ColumnName, ScalarType)
-> Object
-> m (HashMap ColumnName ScalarValue)
forall (m :: * -> *).
MonadError QErr m =>
FieldName
-> HashMap FieldName (ColumnName, ScalarType)
-> Object
-> m (HashMap ColumnName ScalarValue)
translateForeachRowFilter FieldName
argumentIdFieldName HashMap FieldName (ColumnName, ScalarType)
joinIdsSchema) NonEmpty Object
joinIds
NonEmpty Value
argumentIds <- FieldName -> NonEmpty Object -> m (NonEmpty Value)
forall (m :: * -> *).
MonadError QErr m =>
FieldName -> NonEmpty Object -> m (NonEmpty Value)
extractArgumentIds FieldName
argumentIdFieldName NonEmpty Object
joinIds
QueryRequest
queryRequest <- NonEmpty (HashMap ColumnName ScalarValue)
-> SourceRelationshipSelection 'DataConnector Void UnpreparedValue
-> m QueryRequest
translateSourceRelationshipSelection NonEmpty (HashMap ColumnName ScalarValue)
foreachRowFilter SourceRelationshipSelection 'DataConnector Void UnpreparedValue
ir
Plan QueryRequest QueryResponse
-> m (Plan QueryRequest QueryResponse)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Plan QueryRequest QueryResponse
-> m (Plan QueryRequest QueryResponse))
-> Plan QueryRequest QueryResponse
-> m (Plan QueryRequest QueryResponse)
forall a b. (a -> b) -> a -> b
$ QueryRequest
-> (forall (m :: * -> *).
MonadError QErr m =>
QueryResponse -> m Encoding)
-> Plan QueryRequest QueryResponse
forall request response.
request
-> (forall (m :: * -> *).
MonadError QErr m =>
response -> m Encoding)
-> Plan request response
Plan QueryRequest
queryRequest (FieldName
-> NonEmpty Value
-> FieldName
-> SourceRelationshipSelection 'DataConnector Void UnpreparedValue
-> QueryResponse
-> m Encoding
forall (m :: * -> *) (v :: BackendType -> *).
MonadError QErr m =>
FieldName
-> NonEmpty Value
-> FieldName
-> SourceRelationshipSelection 'DataConnector Void v
-> QueryResponse
-> m Encoding
reshapeResponseToRemoteRelationshipQueryShape FieldName
argumentIdFieldName NonEmpty Value
argumentIds FieldName
resultFieldName SourceRelationshipSelection 'DataConnector Void UnpreparedValue
ir)
where
translateSourceRelationshipSelection ::
NonEmpty (HashMap API.ColumnName API.ScalarValue) ->
SourceRelationshipSelection 'DataConnector Void UnpreparedValue ->
m API.QueryRequest
translateSourceRelationshipSelection :: NonEmpty (HashMap ColumnName ScalarValue)
-> SourceRelationshipSelection 'DataConnector Void UnpreparedValue
-> m QueryRequest
translateSourceRelationshipSelection NonEmpty (HashMap ColumnName ScalarValue)
foreachRowFilter = \case
SourceRelationshipObject AnnObjectSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
objectSelect ->
NonEmpty (HashMap ColumnName ScalarValue)
-> AnnObjectSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
-> m QueryRequest
translateAnnObjectSelectToQueryRequest NonEmpty (HashMap ColumnName ScalarValue)
foreachRowFilter AnnObjectSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
objectSelect
SourceRelationshipArray AnnSimpleSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
simpleSelect ->
SessionVariables
-> AnnSimpleSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
-> m QueryRequest
forall (m :: * -> *) r.
(MonadError QErr m, MonadReader r m,
Has ScalarTypesCapabilities r) =>
SessionVariables
-> AnnSimpleSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
-> m QueryRequest
QueryPlan.translateAnnSimpleSelectToQueryRequest SessionVariables
sessionVariables AnnSimpleSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
simpleSelect
m QueryRequest -> (QueryRequest -> QueryRequest) -> m QueryRequest
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ((Maybe (NonEmpty (HashMap ColumnName ScalarValue))
-> Identity (Maybe (NonEmpty (HashMap ColumnName ScalarValue))))
-> QueryRequest -> Identity QueryRequest
Traversal'
QueryRequest (Maybe (NonEmpty (HashMap ColumnName ScalarValue)))
API.qrForeach ((Maybe (NonEmpty (HashMap ColumnName ScalarValue))
-> Identity (Maybe (NonEmpty (HashMap ColumnName ScalarValue))))
-> QueryRequest -> Identity QueryRequest)
-> NonEmpty (HashMap ColumnName ScalarValue)
-> QueryRequest
-> QueryRequest
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ NonEmpty (HashMap ColumnName ScalarValue)
foreachRowFilter)
SourceRelationshipArrayAggregate AnnAggregateSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
aggregateSelect ->
SessionVariables
-> AnnAggregateSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
-> m QueryRequest
forall (m :: * -> *) r.
(MonadError QErr m, MonadReader r m,
Has ScalarTypesCapabilities r) =>
SessionVariables
-> AnnAggregateSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
-> m QueryRequest
QueryPlan.translateAnnAggregateSelectToQueryRequest SessionVariables
sessionVariables AnnAggregateSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
aggregateSelect
m QueryRequest -> (QueryRequest -> QueryRequest) -> m QueryRequest
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ((Maybe (NonEmpty (HashMap ColumnName ScalarValue))
-> Identity (Maybe (NonEmpty (HashMap ColumnName ScalarValue))))
-> QueryRequest -> Identity QueryRequest
Traversal'
QueryRequest (Maybe (NonEmpty (HashMap ColumnName ScalarValue)))
API.qrForeach ((Maybe (NonEmpty (HashMap ColumnName ScalarValue))
-> Identity (Maybe (NonEmpty (HashMap ColumnName ScalarValue))))
-> QueryRequest -> Identity QueryRequest)
-> NonEmpty (HashMap ColumnName ScalarValue)
-> QueryRequest
-> QueryRequest
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ NonEmpty (HashMap ColumnName ScalarValue)
foreachRowFilter)
translateAnnObjectSelectToQueryRequest ::
NonEmpty (HashMap API.ColumnName API.ScalarValue) ->
AnnObjectSelectG 'DataConnector Void (UnpreparedValue 'DataConnector) ->
m API.QueryRequest
translateAnnObjectSelectToQueryRequest :: NonEmpty (HashMap ColumnName ScalarValue)
-> AnnObjectSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
-> m QueryRequest
translateAnnObjectSelectToQueryRequest NonEmpty (HashMap ColumnName ScalarValue)
foreachRowFilter AnnObjectSelectG {AnnFieldsG 'DataConnector Void (UnpreparedValue 'DataConnector)
AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)
SelectFromG 'DataConnector (UnpreparedValue 'DataConnector)
_aosFields :: AnnFieldsG 'DataConnector Void (UnpreparedValue 'DataConnector)
_aosTarget :: SelectFromG 'DataConnector (UnpreparedValue 'DataConnector)
_aosTargetFilter :: AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)
$sel:_aosFields:AnnObjectSelectG :: forall (b :: BackendType) r v.
AnnObjectSelectG b r v -> AnnFieldsG b r v
$sel:_aosTarget:AnnObjectSelectG :: forall (b :: BackendType) r v.
AnnObjectSelectG b r v -> SelectFromG b v
$sel:_aosTargetFilter:AnnObjectSelectG :: forall (b :: BackendType) r v.
AnnObjectSelectG b r v -> AnnBoolExp b v
..} = do
let tableName :: TableName
tableName = case SelectFromG 'DataConnector (UnpreparedValue 'DataConnector)
_aosTarget of
FromTable TableName 'DataConnector
table -> TableName -> TableName
forall source target. From source target => source -> target
Witch.from TableName 'DataConnector
TableName
table
SelectFromG 'DataConnector (UnpreparedValue 'DataConnector)
other -> [Char] -> TableName
forall a. HasCallStack => [Char] -> a
error ([Char] -> TableName) -> [Char] -> TableName
forall a b. (a -> b) -> a -> b
$ [Char]
"translateAnnObjectSelectToQueryRequest: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> SelectFromG 'DataConnector (UnpreparedValue 'DataConnector)
-> [Char]
forall a. Show a => a -> [Char]
show SelectFromG 'DataConnector (UnpreparedValue 'DataConnector)
other
((HashMap FieldName Field
fields, Maybe Expression
whereClause), (TableRelationships HashMap
TableRelationshipsKey (HashMap RelationshipName Relationship)
tableRelationships)) <- WriterT
TableRelationships m (HashMap FieldName Field, Maybe Expression)
-> m ((HashMap FieldName Field, Maybe Expression),
TableRelationships)
forall w (m :: * -> *) a. Monoid w => WriterT w m a -> m (a, w)
CPS.runWriterT (WriterT
TableRelationships m (HashMap FieldName Field, Maybe Expression)
-> m ((HashMap FieldName Field, Maybe Expression),
TableRelationships))
-> WriterT
TableRelationships m (HashMap FieldName Field, Maybe Expression)
-> m ((HashMap FieldName Field, Maybe Expression),
TableRelationships)
forall a b. (a -> b) -> a -> b
$ do
HashMap FieldName Field
fields <- SessionVariables
-> FieldPrefix
-> TableRelationshipsKey
-> AnnFieldsG 'DataConnector Void (UnpreparedValue 'DataConnector)
-> WriterT TableRelationships m (HashMap FieldName Field)
forall writerOutput (m :: * -> *) r.
(Has TableRelationships writerOutput, Monoid writerOutput,
MonadError QErr m, MonadReader r m,
Has ScalarTypesCapabilities r) =>
SessionVariables
-> FieldPrefix
-> TableRelationshipsKey
-> AnnFieldsG 'DataConnector Void (UnpreparedValue 'DataConnector)
-> WriterT writerOutput m (HashMap FieldName Field)
QueryPlan.translateAnnFields SessionVariables
sessionVariables FieldPrefix
noPrefix (TableName -> TableRelationshipsKey
TableNameKey TableName
tableName) AnnFieldsG 'DataConnector Void (UnpreparedValue 'DataConnector)
_aosFields
Maybe Expression
whereClause <- SessionVariables
-> TableRelationshipsKey
-> AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)
-> WriterT TableRelationships m (Maybe Expression)
forall writerOutput (m :: * -> *) r.
(Has TableRelationships writerOutput, Monoid writerOutput,
MonadError QErr m, MonadReader r m,
Has ScalarTypesCapabilities r) =>
SessionVariables
-> TableRelationshipsKey
-> AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)
-> WriterT writerOutput m (Maybe Expression)
translateBoolExpToExpression SessionVariables
sessionVariables (TableName -> TableRelationshipsKey
TableNameKey TableName
tableName) AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)
_aosTargetFilter
(HashMap FieldName Field, Maybe Expression)
-> WriterT
TableRelationships m (HashMap FieldName Field, Maybe Expression)
forall a. a -> WriterT TableRelationships m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap FieldName Field
fields, Maybe Expression
whereClause)
let apiTableRelationships :: Set Relationships
apiTableRelationships = [Relationships] -> Set Relationships
forall a. Ord a => [a] -> Set a
Set.fromList ([Relationships] -> Set Relationships)
-> [Relationships] -> Set Relationships
forall a b. (a -> b) -> a -> b
$ HashMap
TableRelationshipsKey (HashMap RelationshipName Relationship)
-> [Relationships]
tableRelationshipsToList HashMap
TableRelationshipsKey (HashMap RelationshipName Relationship)
tableRelationships
QueryRequest -> m QueryRequest
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(QueryRequest -> m QueryRequest) -> QueryRequest -> m QueryRequest
forall a b. (a -> b) -> a -> b
$ TableRequest -> QueryRequest
API.QRTable
(TableRequest -> QueryRequest) -> TableRequest -> QueryRequest
forall a b. (a -> b) -> a -> b
$ API.TableRequest
{ _trTable :: TableName
_trTable = TableName
tableName,
_trRelationships :: Set Relationships
_trRelationships = Set Relationships
apiTableRelationships,
_trQuery :: Query
_trQuery =
API.Query
{ _qFields :: Maybe (HashMap FieldName Field)
_qFields = HashMap FieldName Field -> Maybe (HashMap FieldName Field)
forall a. a -> Maybe a
Just (HashMap FieldName Field -> Maybe (HashMap FieldName Field))
-> HashMap FieldName Field -> Maybe (HashMap FieldName Field)
forall a b. (a -> b) -> a -> b
$ HashMap FieldName Field -> HashMap FieldName Field
forall v. HashMap FieldName v -> HashMap FieldName v
mapFieldNameHashMap HashMap FieldName Field
fields,
_qAggregates :: Maybe (HashMap FieldName Aggregate)
_qAggregates = Maybe (HashMap FieldName Aggregate)
forall a. Maybe a
Nothing,
_qAggregatesLimit :: Maybe Int
_qAggregatesLimit = Maybe Int
forall a. Maybe a
Nothing,
_qLimit :: Maybe Int
_qLimit = Maybe Int
forall a. Maybe a
Nothing,
_qOffset :: Maybe Int
_qOffset = Maybe Int
forall a. Maybe a
Nothing,
_qWhere :: Maybe Expression
_qWhere = Maybe Expression
whereClause,
_qOrderBy :: Maybe OrderBy
_qOrderBy = Maybe OrderBy
forall a. Maybe a
Nothing
},
_trForeach :: Maybe (NonEmpty (HashMap ColumnName ScalarValue))
_trForeach = NonEmpty (HashMap ColumnName ScalarValue)
-> Maybe (NonEmpty (HashMap ColumnName ScalarValue))
forall a. a -> Maybe a
Just NonEmpty (HashMap ColumnName ScalarValue)
foreachRowFilter
}
tableRelationshipsToList :: HashMap TableRelationshipsKey (HashMap API.RelationshipName API.Relationship) -> [API.Relationships]
tableRelationshipsToList :: HashMap
TableRelationshipsKey (HashMap RelationshipName Relationship)
-> [Relationships]
tableRelationshipsToList HashMap
TableRelationshipsKey (HashMap RelationshipName Relationship)
m = ((TableRelationshipsKey, HashMap RelationshipName Relationship)
-> Relationships)
-> [(TableRelationshipsKey, HashMap RelationshipName Relationship)]
-> [Relationships]
forall a b. (a -> b) -> [a] -> [b]
map (((FunctionName, HashMap RelationshipName Relationship)
-> Relationships)
-> ((TableName, HashMap RelationshipName Relationship)
-> Relationships)
-> Either
(FunctionName, HashMap RelationshipName Relationship)
(TableName, HashMap RelationshipName Relationship)
-> Relationships
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FunctionRelationships -> Relationships
API.RFunction (FunctionRelationships -> Relationships)
-> ((FunctionName, HashMap RelationshipName Relationship)
-> FunctionRelationships)
-> (FunctionName, HashMap RelationshipName Relationship)
-> Relationships
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FunctionName
-> HashMap RelationshipName Relationship -> FunctionRelationships)
-> (FunctionName, HashMap RelationshipName Relationship)
-> FunctionRelationships
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry FunctionName
-> HashMap RelationshipName Relationship -> FunctionRelationships
API.FunctionRelationships) (TableRelationships -> Relationships
API.RTable (TableRelationships -> Relationships)
-> ((TableName, HashMap RelationshipName Relationship)
-> TableRelationships)
-> (TableName, HashMap RelationshipName Relationship)
-> Relationships
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TableName
-> HashMap RelationshipName Relationship -> TableRelationships)
-> (TableName, HashMap RelationshipName Relationship)
-> TableRelationships
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TableName
-> HashMap RelationshipName Relationship -> TableRelationships
API.TableRelationships) (Either
(FunctionName, HashMap RelationshipName Relationship)
(TableName, HashMap RelationshipName Relationship)
-> Relationships)
-> ((TableRelationshipsKey, HashMap RelationshipName Relationship)
-> Either
(FunctionName, HashMap RelationshipName Relationship)
(TableName, HashMap RelationshipName Relationship))
-> (TableRelationshipsKey, HashMap RelationshipName Relationship)
-> Relationships
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TableRelationshipsKey, HashMap RelationshipName Relationship)
-> Either
(FunctionName, HashMap RelationshipName Relationship)
(TableName, HashMap RelationshipName Relationship)
forall c.
(TableRelationshipsKey, c)
-> Either (FunctionName, c) (TableName, c)
tableRelationshipsKeyToEither) (HashMap
TableRelationshipsKey (HashMap RelationshipName Relationship)
-> [(TableRelationshipsKey, HashMap RelationshipName Relationship)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap
TableRelationshipsKey (HashMap RelationshipName Relationship)
m)
tableRelationshipsKeyToEither :: (TableRelationshipsKey, c) -> Either (API.FunctionName, c) (API.TableName, c)
tableRelationshipsKeyToEither :: forall c.
(TableRelationshipsKey, c)
-> Either (FunctionName, c) (TableName, c)
tableRelationshipsKeyToEither (FunctionNameKey FunctionName
f, c
x) = (FunctionName, c) -> Either (FunctionName, c) (TableName, c)
forall a b. a -> Either a b
Left (FunctionName
f, c
x)
tableRelationshipsKeyToEither (TableNameKey TableName
t, c
x) = (TableName, c) -> Either (FunctionName, c) (TableName, c)
forall a b. b -> Either a b
Right (TableName
t, c
x)
translateForeachRowFilter :: (MonadError QErr m) => FieldName -> HashMap FieldName (ColumnName, ScalarType) -> J.Object -> m (HashMap API.ColumnName API.ScalarValue)
translateForeachRowFilter :: forall (m :: * -> *).
MonadError QErr m =>
FieldName
-> HashMap FieldName (ColumnName, ScalarType)
-> Object
-> m (HashMap ColumnName ScalarValue)
translateForeachRowFilter FieldName
argumentIdFieldName HashMap FieldName (ColumnName, ScalarType)
joinIdsSchema Object
joinIds =
Object
joinIds
Object -> (Object -> [(Key, Value)]) -> [(Key, Value)]
forall a b. a -> (a -> b) -> b
& Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KM.toList
[(Key, Value)]
-> ([(Key, Value)] -> [(FieldName, Value)]) -> [(FieldName, Value)]
forall a b. a -> (a -> b) -> b
& ((Key, Value) -> Maybe (FieldName, Value))
-> [(Key, Value)] -> [(FieldName, Value)]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe
( \(Key
propertyKey, Value
value) ->
let propertyKeyText :: Text
propertyKeyText = [Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Key -> [Char]
K.toString Key
propertyKey
joinIdField :: FieldName
joinIdField = Text -> FieldName
FieldName Text
propertyKeyText
in if FieldName
joinIdField FieldName -> FieldName -> Bool
forall a. Eq a => a -> a -> Bool
== FieldName
argumentIdFieldName
then Maybe (FieldName, Value)
forall a. Maybe a
Nothing
else (FieldName, Value) -> Maybe (FieldName, Value)
forall a. a -> Maybe a
Just (FieldName
joinIdField, Value
value)
)
[(FieldName, Value)]
-> ([(FieldName, Value)] -> m [(ColumnName, ScalarValue)])
-> m [(ColumnName, ScalarValue)]
forall a b. a -> (a -> b) -> b
& ((FieldName, Value) -> m (ColumnName, ScalarValue))
-> [(FieldName, Value)] -> m [(ColumnName, ScalarValue)]
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
( \(FieldName
joinIdField, Value
value) -> do
(ColumnName
columnName, ScalarType
scalarType) <-
FieldName
-> HashMap FieldName (ColumnName, ScalarType)
-> Maybe (ColumnName, ScalarType)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup FieldName
joinIdField HashMap FieldName (ColumnName, ScalarType)
joinIdsSchema
Maybe (ColumnName, ScalarType)
-> m (ColumnName, ScalarType) -> m (ColumnName, ScalarType)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Text -> m (ColumnName, ScalarType)
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text
"translateForeachRowFilter: Unable to find join id field " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FieldName -> Text
forall a. ToTxt a => a -> Text
toTxt FieldName
joinIdField Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in join id schema")
let scalarValue :: ScalarValue
scalarValue = Value -> ScalarType -> ScalarValue
API.ScalarValue Value
value (ScalarType -> ScalarType
forall source target. From source target => source -> target
Witch.from ScalarType
scalarType)
(ColumnName, ScalarValue) -> m (ColumnName, ScalarValue)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ColumnName -> ColumnName
forall source target. From source target => source -> target
Witch.from ColumnName
columnName, ScalarValue
scalarValue)
)
m [(ColumnName, ScalarValue)]
-> (m [(ColumnName, ScalarValue)]
-> m (HashMap ColumnName ScalarValue))
-> m (HashMap ColumnName ScalarValue)
forall a b. a -> (a -> b) -> b
& ([(ColumnName, ScalarValue)] -> HashMap ColumnName ScalarValue)
-> m [(ColumnName, ScalarValue)]
-> m (HashMap ColumnName ScalarValue)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(ColumnName, ScalarValue)] -> HashMap ColumnName ScalarValue
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
extractArgumentIds :: (MonadError QErr m) => FieldName -> NonEmpty J.Object -> m (NonEmpty J.Value)
FieldName
argumentIdFieldName NonEmpty Object
joinIds =
let argumentIdPropertyKey :: Key
argumentIdPropertyKey = Text -> Key
K.fromText (Text -> Key) -> Text -> Key
forall a b. (a -> b) -> a -> b
$ FieldName -> Text
getFieldNameTxt FieldName
argumentIdFieldName
in NonEmpty Object
joinIds
NonEmpty Object
-> (NonEmpty Object -> m (NonEmpty Value)) -> m (NonEmpty Value)
forall a b. a -> (a -> b) -> b
& (Object -> m Value) -> NonEmpty Object -> m (NonEmpty Value)
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) -> NonEmpty a -> f (NonEmpty b)
traverse
( \Object
joinIdsObj ->
Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
argumentIdPropertyKey Object
joinIdsObj
Maybe Value -> m Value -> m Value
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Text -> m Value
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text
"translateForeachRowFilter: Unable to find argument id field " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FieldName -> Text
forall a. ToTxt a => a -> Text
toTxt FieldName
argumentIdFieldName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in join id object")
)
reshapeResponseToRemoteRelationshipQueryShape ::
(MonadError QErr m) =>
FieldName ->
NonEmpty J.Value ->
FieldName ->
SourceRelationshipSelection 'DataConnector Void v ->
API.QueryResponse ->
m J.Encoding
reshapeResponseToRemoteRelationshipQueryShape :: forall (m :: * -> *) (v :: BackendType -> *).
MonadError QErr m =>
FieldName
-> NonEmpty Value
-> FieldName
-> SourceRelationshipSelection 'DataConnector Void v
-> QueryResponse
-> m Encoding
reshapeResponseToRemoteRelationshipQueryShape FieldName
argumentIdFieldName NonEmpty Value
argumentIdValues FieldName
resultFieldName SourceRelationshipSelection 'DataConnector Void v
sourceRelationshipSelection API.QueryResponse {Maybe [HashMap FieldName FieldValue]
Maybe (HashMap FieldName Value)
_qrRows :: Maybe [HashMap FieldName FieldValue]
_qrAggregates :: Maybe (HashMap FieldName Value)
_qrRows :: QueryResponse -> Maybe [HashMap FieldName FieldValue]
_qrAggregates :: QueryResponse -> Maybe (HashMap FieldName Value)
..} = do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
actualRowCount Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
expectedRowCount)
(m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text
"Data Connector agent returned " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
actualRowCount Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" foreach query response rows, but " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
expectedRowCount Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" were expected")
[Encoding]
argumentResultObjects <- [(HashMap FieldName FieldValue, Value)]
-> ((HashMap FieldName FieldValue, Value) -> m Encoding)
-> m [Encoding]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([HashMap FieldName FieldValue]
-> [Value] -> [(HashMap FieldName FieldValue, Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip [HashMap FieldName FieldValue]
rows (NonEmpty Value -> [Value]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty Value
argumentIdValues)) (((HashMap FieldName FieldValue, Value) -> m Encoding)
-> m [Encoding])
-> ((HashMap FieldName FieldValue, Value) -> m Encoding)
-> m [Encoding]
forall a b. (a -> b) -> a -> b
$ \(HashMap FieldName FieldValue
row, Value
argumentId) -> do
FieldValue
queryFieldValue <-
FieldName -> HashMap FieldName FieldValue -> Maybe FieldValue
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (Text -> FieldName
API.FieldName Text
"query") HashMap FieldName FieldValue
row
Maybe FieldValue -> m FieldValue -> m FieldValue
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Text -> m FieldValue
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 Text
"Data Connector agent returned foreach query response row without expected 'query' field"
QueryResponse
foreachQueryResponse <-
FieldValue -> Either Text QueryResponse
API.deserializeAsRelationshipFieldValue FieldValue
queryFieldValue
Either Text QueryResponse
-> (Text -> m QueryResponse) -> m QueryResponse
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
`onLeft` (\Text
err -> Text -> m QueryResponse
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text -> m QueryResponse) -> Text -> m QueryResponse
forall a b. (a -> b) -> a -> b
$ Text
"Found column field value where relationship field value was expected in foreach query response field returned by Data Connector agent: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err)
Encoding
reshapedForeachQueryResponse <- SourceRelationshipSelection 'DataConnector Void v
-> QueryResponse -> m Encoding
forall (m :: * -> *) (v :: BackendType -> *).
MonadError QErr m =>
SourceRelationshipSelection 'DataConnector Void v
-> QueryResponse -> m Encoding
reshapeForeachQueryResponse SourceRelationshipSelection 'DataConnector Void v
sourceRelationshipSelection QueryResponse
foreachQueryResponse
let argumentResponseWrapperFields :: [(Text, Encoding)]
argumentResponseWrapperFields =
[ (FieldName -> Text
getFieldNameTxt FieldName
resultFieldName, Encoding
reshapedForeachQueryResponse),
(FieldName -> Text
getFieldNameTxt FieldName
argumentIdFieldName, Value -> Encoding
forall a. ToJSON a => a -> Encoding
J.toEncoding Value
argumentId)
]
Encoding -> m Encoding
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoding -> m Encoding) -> Encoding -> m Encoding
forall a b. (a -> b) -> a -> b
$ [(Text, Encoding)] -> Encoding
encodeAssocListAsObject [(Text, Encoding)]
argumentResponseWrapperFields
Encoding -> m Encoding
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoding -> m Encoding) -> Encoding -> m Encoding
forall a b. (a -> b) -> a -> b
$ (Encoding -> Encoding) -> [Encoding] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
JE.list Encoding -> Encoding
forall a. a -> a
id [Encoding]
argumentResultObjects
where
rows :: [HashMap FieldName FieldValue]
rows = [HashMap FieldName FieldValue]
-> Maybe [HashMap FieldName FieldValue]
-> [HashMap FieldName FieldValue]
forall a. a -> Maybe a -> a
fromMaybe [HashMap FieldName FieldValue]
forall a. Monoid a => a
mempty Maybe [HashMap FieldName FieldValue]
_qrRows
actualRowCount :: Int
actualRowCount = [HashMap FieldName FieldValue] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [HashMap FieldName FieldValue]
rows
expectedRowCount :: Int
expectedRowCount = NonEmpty Value -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty Value
argumentIdValues
reshapeForeachQueryResponse ::
(MonadError QErr m) =>
SourceRelationshipSelection 'DataConnector Void v ->
API.QueryResponse ->
m J.Encoding
reshapeForeachQueryResponse :: forall (m :: * -> *) (v :: BackendType -> *).
MonadError QErr m =>
SourceRelationshipSelection 'DataConnector Void v
-> QueryResponse -> m Encoding
reshapeForeachQueryResponse SourceRelationshipSelection 'DataConnector Void v
sourceRelationshipSelection QueryResponse
response =
case SourceRelationshipSelection 'DataConnector Void v
sourceRelationshipSelection of
SourceRelationshipObject AnnObjectSelectG 'DataConnector Void (v 'DataConnector)
objectSelect -> Cardinality
-> AnnFieldsG 'DataConnector Void (v 'DataConnector)
-> QueryResponse
-> m Encoding
forall (m :: * -> *) v.
MonadError QErr m =>
Cardinality
-> AnnFieldsG 'DataConnector Void v -> QueryResponse -> m Encoding
QueryPlan.reshapeSimpleSelectRows Cardinality
Single (AnnObjectSelectG 'DataConnector Void (v 'DataConnector)
-> AnnFieldsG 'DataConnector Void (v 'DataConnector)
forall (b :: BackendType) r v.
AnnObjectSelectG b r v -> AnnFieldsG b r v
_aosFields AnnObjectSelectG 'DataConnector Void (v 'DataConnector)
objectSelect) QueryResponse
response
SourceRelationshipArray AnnSimpleSelectG 'DataConnector Void (v 'DataConnector)
simpleSelect -> Cardinality
-> AnnFieldsG 'DataConnector Void (v 'DataConnector)
-> QueryResponse
-> m Encoding
forall (m :: * -> *) v.
MonadError QErr m =>
Cardinality
-> AnnFieldsG 'DataConnector Void v -> QueryResponse -> m Encoding
QueryPlan.reshapeSimpleSelectRows Cardinality
Many (AnnSimpleSelectG 'DataConnector Void (v 'DataConnector)
-> AnnFieldsG 'DataConnector Void (v 'DataConnector)
forall (b :: BackendType) (f :: * -> *) v.
AnnSelectG b f v -> Fields (f v)
_asnFields AnnSimpleSelectG 'DataConnector Void (v 'DataConnector)
simpleSelect) QueryResponse
response
SourceRelationshipArrayAggregate AnnAggregateSelectG 'DataConnector Void (v 'DataConnector)
aggregateSelect -> TableAggregateFieldsG 'DataConnector Void (v 'DataConnector)
-> QueryResponse -> m Encoding
forall (m :: * -> *) v.
MonadError QErr m =>
TableAggregateFieldsG 'DataConnector Void v
-> QueryResponse -> m Encoding
QueryPlan.reshapeTableAggregateFields (AnnAggregateSelectG 'DataConnector Void (v 'DataConnector)
-> TableAggregateFieldsG 'DataConnector Void (v 'DataConnector)
forall (b :: BackendType) (f :: * -> *) v.
AnnSelectG b f v -> Fields (f v)
_asnFields AnnAggregateSelectG 'DataConnector Void (v 'DataConnector)
aggregateSelect) QueryResponse
response