module Hasura.Backends.DataConnector.Plan
( QueryPlan (..),
mkPlan,
renderQuery,
queryHasRelations,
)
where
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 (KeyMap)
import Data.Aeson.KeyMap qualified as KM
import Data.ByteString.Lazy qualified as BL
import Data.HashMap.Strict qualified as HashMap
import Data.List.NonEmpty qualified as NE
import Data.Semigroup (Min (..))
import Data.Text.Encoding qualified as TE
import Data.Text.Extended ((<>>))
import Hasura.Backends.DataConnector.API qualified as API
import Hasura.Backends.DataConnector.Adapter.Backend
import Hasura.Backends.DataConnector.Adapter.Types
import Hasura.Backends.DataConnector.IR.Aggregate qualified as IR.A
import Hasura.Backends.DataConnector.IR.Column qualified as IR.C
import Hasura.Backends.DataConnector.IR.Expression (UnaryComparisonOperator (CustomUnaryComparisonOperator))
import Hasura.Backends.DataConnector.IR.Expression qualified as IR.E
import Hasura.Backends.DataConnector.IR.OrderBy qualified as IR.O
import Hasura.Backends.DataConnector.IR.Query qualified as IR.Q
import Hasura.Backends.DataConnector.IR.Relationships qualified as IR.R
import Hasura.Backends.DataConnector.IR.Scalar.Value qualified as IR.S
import Hasura.Backends.DataConnector.IR.Table qualified as IR.T
import Hasura.Base.Error
import Hasura.Prelude
import Hasura.RQL.IR.BoolExp
import Hasura.RQL.IR.OrderBy
import Hasura.RQL.IR.Select
import Hasura.RQL.IR.Value
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Relationships.Local (RelInfo (..))
import Hasura.SQL.Backend
import Hasura.Session
import Witch qualified
data QueryPlan = QueryPlan
{ QueryPlan -> QueryRequest
_qpRequest :: IR.Q.QueryRequest,
QueryPlan
-> forall (m :: * -> *).
MonadError QErr m =>
QueryResponse -> m Encoding
_qpResponseReshaper :: forall m. (MonadError QErr m) => API.QueryResponse -> m J.Encoding
}
data FieldsAndAggregates = FieldsAndAggregates
{ FieldsAndAggregates -> HashMap FieldName Field
_faaFields :: HashMap FieldName IR.Q.Field,
FieldsAndAggregates -> HashMap FieldName Aggregate
_faaAggregates :: HashMap FieldName IR.A.Aggregate
}
deriving stock (Int -> FieldsAndAggregates -> ShowS
[FieldsAndAggregates] -> ShowS
FieldsAndAggregates -> String
(Int -> FieldsAndAggregates -> ShowS)
-> (FieldsAndAggregates -> String)
-> ([FieldsAndAggregates] -> ShowS)
-> Show FieldsAndAggregates
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FieldsAndAggregates] -> ShowS
$cshowList :: [FieldsAndAggregates] -> ShowS
show :: FieldsAndAggregates -> String
$cshow :: FieldsAndAggregates -> String
showsPrec :: Int -> FieldsAndAggregates -> ShowS
$cshowsPrec :: Int -> FieldsAndAggregates -> ShowS
Show, FieldsAndAggregates -> FieldsAndAggregates -> Bool
(FieldsAndAggregates -> FieldsAndAggregates -> Bool)
-> (FieldsAndAggregates -> FieldsAndAggregates -> Bool)
-> Eq FieldsAndAggregates
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldsAndAggregates -> FieldsAndAggregates -> Bool
$c/= :: FieldsAndAggregates -> FieldsAndAggregates -> Bool
== :: FieldsAndAggregates -> FieldsAndAggregates -> Bool
$c== :: FieldsAndAggregates -> FieldsAndAggregates -> Bool
Eq)
instance Semigroup FieldsAndAggregates where
FieldsAndAggregates
left <> :: FieldsAndAggregates -> FieldsAndAggregates -> FieldsAndAggregates
<> FieldsAndAggregates
right =
HashMap FieldName Field
-> HashMap FieldName Aggregate -> FieldsAndAggregates
FieldsAndAggregates
(FieldsAndAggregates -> HashMap FieldName Field
_faaFields FieldsAndAggregates
left HashMap FieldName Field
-> HashMap FieldName Field -> HashMap FieldName Field
forall a. Semigroup a => a -> a -> a
<> FieldsAndAggregates -> HashMap FieldName Field
_faaFields FieldsAndAggregates
right)
(FieldsAndAggregates -> HashMap FieldName Aggregate
_faaAggregates FieldsAndAggregates
left HashMap FieldName Aggregate
-> HashMap FieldName Aggregate -> HashMap FieldName Aggregate
forall a. Semigroup a => a -> a -> a
<> FieldsAndAggregates -> HashMap FieldName Aggregate
_faaAggregates FieldsAndAggregates
right)
instance Monoid FieldsAndAggregates where
mempty :: FieldsAndAggregates
mempty = HashMap FieldName Field
-> HashMap FieldName Aggregate -> FieldsAndAggregates
FieldsAndAggregates HashMap FieldName Field
forall a. Monoid a => a
mempty HashMap FieldName Aggregate
forall a. Monoid a => a
mempty
newtype FieldPrefix = FieldPrefix (Maybe FieldName)
deriving stock (Int -> FieldPrefix -> ShowS
[FieldPrefix] -> ShowS
FieldPrefix -> String
(Int -> FieldPrefix -> ShowS)
-> (FieldPrefix -> String)
-> ([FieldPrefix] -> ShowS)
-> Show FieldPrefix
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FieldPrefix] -> ShowS
$cshowList :: [FieldPrefix] -> ShowS
show :: FieldPrefix -> String
$cshow :: FieldPrefix -> String
showsPrec :: Int -> FieldPrefix -> ShowS
$cshowsPrec :: Int -> FieldPrefix -> ShowS
Show, FieldPrefix -> FieldPrefix -> Bool
(FieldPrefix -> FieldPrefix -> Bool)
-> (FieldPrefix -> FieldPrefix -> Bool) -> Eq FieldPrefix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldPrefix -> FieldPrefix -> Bool
$c/= :: FieldPrefix -> FieldPrefix -> Bool
== :: FieldPrefix -> FieldPrefix -> Bool
$c== :: FieldPrefix -> FieldPrefix -> Bool
Eq)
instance Semigroup FieldPrefix where
(FieldPrefix Maybe FieldName
Nothing) <> :: FieldPrefix -> FieldPrefix -> FieldPrefix
<> (FieldPrefix Maybe FieldName
something) = Maybe FieldName -> FieldPrefix
FieldPrefix Maybe FieldName
something
(FieldPrefix Maybe FieldName
something) <> (FieldPrefix Maybe FieldName
Nothing) = Maybe FieldName -> FieldPrefix
FieldPrefix Maybe FieldName
something
(FieldPrefix (Just FieldName
l)) <> (FieldPrefix (Just FieldName
r)) = Maybe FieldName -> FieldPrefix
FieldPrefix (Maybe FieldName -> FieldPrefix)
-> (FieldName -> Maybe FieldName) -> FieldName -> FieldPrefix
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldName -> Maybe FieldName
forall a. a -> Maybe a
Just (FieldName -> FieldPrefix) -> FieldName -> FieldPrefix
forall a b. (a -> b) -> a -> b
$ FieldName
l FieldName -> FieldName -> FieldName
forall a. Semigroup a => a -> a -> a
<> FieldName
"_" FieldName -> FieldName -> FieldName
forall a. Semigroup a => a -> a -> a
<> FieldName
r
instance Monoid FieldPrefix where
mempty :: FieldPrefix
mempty = Maybe FieldName -> FieldPrefix
FieldPrefix Maybe FieldName
forall a. Maybe a
Nothing
noPrefix :: FieldPrefix
noPrefix :: FieldPrefix
noPrefix = Maybe FieldName -> FieldPrefix
FieldPrefix Maybe FieldName
forall a. Maybe a
Nothing
prefixWith :: FieldName -> FieldPrefix
prefixWith :: FieldName -> FieldPrefix
prefixWith = Maybe FieldName -> FieldPrefix
FieldPrefix (Maybe FieldName -> FieldPrefix)
-> (FieldName -> Maybe FieldName) -> FieldName -> FieldPrefix
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldName -> Maybe FieldName
forall a. a -> Maybe a
Just
applyPrefix :: FieldPrefix -> FieldName -> FieldName
applyPrefix :: FieldPrefix -> FieldName -> FieldName
applyPrefix (FieldPrefix Maybe FieldName
fieldNamePrefix) FieldName
fieldName = FieldName
-> (FieldName -> FieldName) -> Maybe FieldName -> FieldName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FieldName
fieldName (\FieldName
prefix -> FieldName
prefix FieldName -> FieldName -> FieldName
forall a. Semigroup a => a -> a -> a
<> FieldName
"_" FieldName -> FieldName -> FieldName
forall a. Semigroup a => a -> a -> a
<> FieldName
fieldName) Maybe FieldName
fieldNamePrefix
renderQuery :: IR.Q.QueryRequest -> Text
renderQuery :: QueryRequest -> Text
renderQuery =
ByteString -> Text
TE.decodeUtf8 (ByteString -> Text)
-> (QueryRequest -> ByteString) -> QueryRequest -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> (QueryRequest -> ByteString) -> QueryRequest -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryRequest -> ByteString
forall a. ToJSON a => a -> ByteString
J.encode (QueryRequest -> ByteString)
-> (QueryRequest -> QueryRequest) -> QueryRequest -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall source. From source QueryRequest => source -> QueryRequest
forall target source. From source target => source -> target
Witch.into @API.QueryRequest
mkPlan ::
forall m.
MonadError QErr m =>
SessionVariables ->
SourceConfig ->
QueryDB 'DataConnector Void (UnpreparedValue 'DataConnector) ->
m QueryPlan
mkPlan :: SessionVariables
-> SourceConfig
-> QueryDB 'DataConnector Void (UnpreparedValue 'DataConnector)
-> m QueryPlan
mkPlan SessionVariables
session (SourceConfig {}) QueryDB 'DataConnector Void (UnpreparedValue 'DataConnector)
ir = do
QueryRequest
queryRequest <- QueryDB 'DataConnector Void (UnpreparedValue 'DataConnector)
-> m QueryRequest
translateQueryDB QueryDB 'DataConnector Void (UnpreparedValue 'DataConnector)
ir
QueryPlan -> m QueryPlan
forall (f :: * -> *) a. Applicative f => a -> f a
pure (QueryPlan -> m QueryPlan) -> QueryPlan -> m QueryPlan
forall a b. (a -> b) -> a -> b
$ QueryRequest
-> (forall (m :: * -> *).
MonadError QErr m =>
QueryResponse -> m Encoding)
-> QueryPlan
QueryPlan QueryRequest
queryRequest (QueryDB 'DataConnector Void (UnpreparedValue 'DataConnector)
-> QueryResponse -> m Encoding
forall (m :: * -> *).
MonadError QErr m =>
QueryDB 'DataConnector Void (UnpreparedValue 'DataConnector)
-> QueryResponse -> m Encoding
reshapeResponseToQueryShape QueryDB 'DataConnector Void (UnpreparedValue 'DataConnector)
ir)
where
translateQueryDB ::
QueryDB 'DataConnector Void (UnpreparedValue 'DataConnector) ->
m IR.Q.QueryRequest
translateQueryDB :: QueryDB 'DataConnector Void (UnpreparedValue 'DataConnector)
-> m QueryRequest
translateQueryDB =
\case
QDBMultipleRows AnnSimpleSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
annSelect -> (Name
-> Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m FieldsAndAggregates)
-> AnnSimpleSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
-> m QueryRequest
forall (fieldType :: * -> *).
(Name
-> Fields (fieldType (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m FieldsAndAggregates)
-> AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector)
-> m QueryRequest
translateAnnSelectToQueryRequest (FieldPrefix
-> Name
-> Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m FieldsAndAggregates
translateAnnFields FieldPrefix
noPrefix) AnnSimpleSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
annSelect
QDBSingleRow AnnSimpleSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
annSelect -> (Name
-> Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m FieldsAndAggregates)
-> AnnSimpleSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
-> m QueryRequest
forall (fieldType :: * -> *).
(Name
-> Fields (fieldType (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m FieldsAndAggregates)
-> AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector)
-> m QueryRequest
translateAnnSelectToQueryRequest (FieldPrefix
-> Name
-> Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m FieldsAndAggregates
translateAnnFields FieldPrefix
noPrefix) AnnSimpleSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
annSelect
QDBAggregation AnnAggregateSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
annSelect -> (Name
-> Fields
(TableAggregateFieldG
'DataConnector Void (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m FieldsAndAggregates)
-> AnnAggregateSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
-> m QueryRequest
forall (fieldType :: * -> *).
(Name
-> Fields (fieldType (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m FieldsAndAggregates)
-> AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector)
-> m QueryRequest
translateAnnSelectToQueryRequest Name
-> Fields
(TableAggregateFieldG
'DataConnector Void (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m FieldsAndAggregates
translateTableAggregateFields AnnAggregateSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
annSelect
translateAnnSelectToQueryRequest ::
(IR.T.Name -> Fields (fieldType (UnpreparedValue 'DataConnector)) -> CPS.WriterT IR.R.TableRelationships m FieldsAndAggregates) ->
AnnSelectG 'DataConnector fieldType (UnpreparedValue 'DataConnector) ->
m IR.Q.QueryRequest
translateAnnSelectToQueryRequest :: (Name
-> Fields (fieldType (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m FieldsAndAggregates)
-> AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector)
-> m QueryRequest
translateAnnSelectToQueryRequest Name
-> Fields (fieldType (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m FieldsAndAggregates
translateFieldsAndAggregates AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector)
selectG = do
Name
tableName <- AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector)
-> m Name
forall (fieldsType :: * -> *) valueType.
AnnSelectG 'DataConnector fieldsType valueType -> m Name
extractTableName AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector)
selectG
(Query
query, TableRelationships
tableRelationships) <- WriterT TableRelationships m Query -> m (Query, TableRelationships)
forall w (m :: * -> *) a. Monoid w => WriterT w m a -> m (a, w)
CPS.runWriterT ((Name
-> Fields (fieldType (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m FieldsAndAggregates)
-> Name
-> AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector)
-> WriterT TableRelationships m Query
forall (fieldType :: * -> *).
(Name
-> Fields (fieldType (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m FieldsAndAggregates)
-> Name
-> AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector)
-> WriterT TableRelationships m Query
translateAnnSelect Name
-> Fields (fieldType (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m FieldsAndAggregates
translateFieldsAndAggregates Name
tableName AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector)
selectG)
QueryRequest -> m QueryRequest
forall (f :: * -> *) a. Applicative f => a -> f a
pure (QueryRequest -> m QueryRequest) -> QueryRequest -> m QueryRequest
forall a b. (a -> b) -> a -> b
$
QueryRequest :: Name -> TableRelationships -> Query -> QueryRequest
IR.Q.QueryRequest
{ _qrTable :: Name
_qrTable = Name
tableName,
_qrTableRelationships :: TableRelationships
_qrTableRelationships = TableRelationships
tableRelationships,
_qrQuery :: Query
_qrQuery = Query
query
}
extractTableName :: AnnSelectG 'DataConnector fieldsType valueType -> m IR.T.Name
extractTableName :: AnnSelectG 'DataConnector fieldsType valueType -> m Name
extractTableName AnnSelectG 'DataConnector fieldsType valueType
selectG =
case AnnSelectG 'DataConnector fieldsType valueType
-> SelectFromG 'DataConnector valueType
forall (b :: BackendType) (f :: * -> *) v.
AnnSelectG b f v -> SelectFromG b v
_asnFrom AnnSelectG 'DataConnector fieldsType valueType
selectG of
FromTable TableName 'DataConnector
tn -> Name -> m Name
forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
TableName 'DataConnector
tn
FromIdentifier FIIdentifier
_ -> Code -> Text -> m Name
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"AnnSelectG: FromIdentifier not supported"
FromFunction {} -> Code -> Text -> m Name
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"AnnSelectG: FromFunction not supported"
recordTableRelationship :: IR.T.Name -> IR.R.RelationshipName -> IR.R.Relationship -> CPS.WriterT IR.R.TableRelationships m ()
recordTableRelationship :: Name
-> RelationshipName
-> Relationship
-> WriterT TableRelationships m ()
recordTableRelationship Name
sourceTableName RelationshipName
relationshipName Relationship
relationship =
TableRelationships -> WriterT TableRelationships m ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
CPS.tell (TableRelationships -> WriterT TableRelationships m ())
-> (HashMap Name (HashMap RelationshipName Relationship)
-> TableRelationships)
-> HashMap Name (HashMap RelationshipName Relationship)
-> WriterT TableRelationships m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Name (HashMap RelationshipName Relationship)
-> TableRelationships
IR.R.TableRelationships (HashMap Name (HashMap RelationshipName Relationship)
-> WriterT TableRelationships m ())
-> HashMap Name (HashMap RelationshipName Relationship)
-> WriterT TableRelationships m ()
forall a b. (a -> b) -> a -> b
$ Name
-> HashMap RelationshipName Relationship
-> HashMap Name (HashMap RelationshipName Relationship)
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Name
sourceTableName (RelationshipName
-> Relationship -> HashMap RelationshipName Relationship
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton RelationshipName
relationshipName Relationship
relationship)
translateAnnSelect ::
(IR.T.Name -> Fields (fieldType (UnpreparedValue 'DataConnector)) -> CPS.WriterT IR.R.TableRelationships m FieldsAndAggregates) ->
IR.T.Name ->
AnnSelectG 'DataConnector fieldType (UnpreparedValue 'DataConnector) ->
CPS.WriterT IR.R.TableRelationships m IR.Q.Query
translateAnnSelect :: (Name
-> Fields (fieldType (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m FieldsAndAggregates)
-> Name
-> AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector)
-> WriterT TableRelationships m Query
translateAnnSelect Name
-> Fields (fieldType (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m FieldsAndAggregates
translateFieldsAndAggregates Name
tableName AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector)
selectG = do
FieldsAndAggregates {HashMap FieldName Aggregate
HashMap FieldName Field
_faaAggregates :: HashMap FieldName Aggregate
_faaFields :: HashMap FieldName Field
_faaAggregates :: FieldsAndAggregates -> HashMap FieldName Aggregate
_faaFields :: FieldsAndAggregates -> HashMap FieldName Field
..} <- Name
-> Fields (fieldType (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m FieldsAndAggregates
translateFieldsAndAggregates Name
tableName (AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector)
-> Fields (fieldType (UnpreparedValue 'DataConnector))
forall (b :: BackendType) (f :: * -> *) v.
AnnSelectG b f v -> Fields (f v)
_asnFields AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector)
selectG)
let whereClauseWithPermissions :: GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))
whereClauseWithPermissions =
case SelectArgsG 'DataConnector (UnpreparedValue 'DataConnector)
-> Maybe
(GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector)))
forall (b :: BackendType) v.
SelectArgsG b v -> Maybe (AnnBoolExp b v)
_saWhere (AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector)
-> SelectArgsG 'DataConnector (UnpreparedValue 'DataConnector)
forall (b :: BackendType) (f :: * -> *) v.
AnnSelectG b f v -> SelectArgsG b v
_asnArgs AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector)
selectG) of
Just GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))
expr -> [GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))]
-> GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))
forall (backend :: BackendType) field.
[GBoolExp backend field] -> GBoolExp backend field
BoolAnd [GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))
expr, TablePermG 'DataConnector (UnpreparedValue 'DataConnector)
-> GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))
forall (b :: BackendType) v. TablePermG b v -> AnnBoolExp b v
_tpFilter (AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector)
-> TablePermG 'DataConnector (UnpreparedValue 'DataConnector)
forall (b :: BackendType) (f :: * -> *) v.
AnnSelectG b f v -> TablePermG b v
_asnPerm AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector)
selectG)]
Maybe
(GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector)))
Nothing -> TablePermG 'DataConnector (UnpreparedValue 'DataConnector)
-> GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))
forall (b :: BackendType) v. TablePermG b v -> AnnBoolExp b v
_tpFilter (AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector)
-> TablePermG 'DataConnector (UnpreparedValue 'DataConnector)
forall (b :: BackendType) (f :: * -> *) v.
AnnSelectG b f v -> TablePermG b v
_asnPerm AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector)
selectG)
Maybe Expression
whereClause <- [RelationshipName]
-> Name
-> GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m (Maybe Expression)
translateBoolExpToExpression [] Name
tableName GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))
whereClauseWithPermissions
Maybe OrderBy
orderBy <- (NonEmpty
(AnnotatedOrderByItemG
'DataConnector (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m OrderBy)
-> Maybe
(NonEmpty
(AnnotatedOrderByItemG
'DataConnector (UnpreparedValue 'DataConnector)))
-> WriterT TableRelationships m (Maybe OrderBy)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Name
-> NonEmpty
(AnnotatedOrderByItemG
'DataConnector (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m OrderBy
translateOrderBy Name
tableName) (SelectArgsG 'DataConnector (UnpreparedValue 'DataConnector)
-> Maybe
(NonEmpty
(AnnotatedOrderByItemG
'DataConnector (UnpreparedValue 'DataConnector)))
forall (b :: BackendType) v.
SelectArgsG b v -> Maybe (NonEmpty (AnnotatedOrderByItemG b v))
_saOrderBy (SelectArgsG 'DataConnector (UnpreparedValue 'DataConnector)
-> Maybe
(NonEmpty
(AnnotatedOrderByItemG
'DataConnector (UnpreparedValue 'DataConnector))))
-> SelectArgsG 'DataConnector (UnpreparedValue 'DataConnector)
-> Maybe
(NonEmpty
(AnnotatedOrderByItemG
'DataConnector (UnpreparedValue 'DataConnector)))
forall a b. (a -> b) -> a -> b
$ AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector)
-> SelectArgsG 'DataConnector (UnpreparedValue 'DataConnector)
forall (b :: BackendType) (f :: * -> *) v.
AnnSelectG b f v -> SelectArgsG b v
_asnArgs AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector)
selectG)
Query -> WriterT TableRelationships m Query
forall (f :: * -> *) a. Applicative f => a -> f a
pure
Query :: HashMap FieldName Field
-> HashMap FieldName Aggregate
-> Maybe Int
-> Maybe Int
-> Maybe Expression
-> Maybe OrderBy
-> Query
IR.Q.Query
{ _qFields :: HashMap FieldName Field
_qFields = HashMap FieldName Field
_faaFields,
_qAggregates :: HashMap FieldName Aggregate
_qAggregates = HashMap FieldName Aggregate
_faaAggregates,
_qLimit :: Maybe Int
_qLimit =
(Min Int -> Int) -> Maybe (Min Int) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Min Int -> Int
forall a. Min a -> a
getMin (Maybe (Min Int) -> Maybe Int) -> Maybe (Min Int) -> Maybe Int
forall a b. (a -> b) -> a -> b
$
(Maybe Int -> Maybe (Min Int)) -> [Maybe Int] -> Maybe (Min Int)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
((Int -> Min Int) -> Maybe Int -> Maybe (Min Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Min Int
forall a. a -> Min a
Min)
[ SelectArgsG 'DataConnector (UnpreparedValue 'DataConnector)
-> Maybe Int
forall (b :: BackendType) v. SelectArgsG b v -> Maybe Int
_saLimit (AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector)
-> SelectArgsG 'DataConnector (UnpreparedValue 'DataConnector)
forall (b :: BackendType) (f :: * -> *) v.
AnnSelectG b f v -> SelectArgsG b v
_asnArgs AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector)
selectG),
TablePermG 'DataConnector (UnpreparedValue 'DataConnector)
-> Maybe Int
forall (b :: BackendType) v. TablePermG b v -> Maybe Int
_tpLimit (AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector)
-> TablePermG 'DataConnector (UnpreparedValue 'DataConnector)
forall (b :: BackendType) (f :: * -> *) v.
AnnSelectG b f v -> TablePermG b v
_asnPerm AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector)
selectG)
],
_qOffset :: Maybe Int
_qOffset = (Int64 -> Int) -> Maybe Int64 -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SelectArgsG 'DataConnector (UnpreparedValue 'DataConnector)
-> Maybe Int64
forall (b :: BackendType) v. SelectArgsG b v -> Maybe Int64
_saOffset (AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector)
-> SelectArgsG 'DataConnector (UnpreparedValue 'DataConnector)
forall (b :: BackendType) (f :: * -> *) v.
AnnSelectG b f v -> SelectArgsG b v
_asnArgs AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector)
selectG)),
_qWhere :: Maybe Expression
_qWhere = Maybe Expression
whereClause,
_qOrderBy :: Maybe OrderBy
_qOrderBy = Maybe OrderBy
orderBy
}
translateOrderBy ::
IR.T.Name ->
NE.NonEmpty (AnnotatedOrderByItemG 'DataConnector (UnpreparedValue 'DataConnector)) ->
CPS.WriterT IR.R.TableRelationships m IR.O.OrderBy
translateOrderBy :: Name
-> NonEmpty
(AnnotatedOrderByItemG
'DataConnector (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m OrderBy
translateOrderBy Name
sourceTableName NonEmpty
(AnnotatedOrderByItemG
'DataConnector (UnpreparedValue 'DataConnector))
orderByItems = do
NonEmpty (OrderByElement, HashMap RelationshipName OrderByRelation)
orderByElementsAndRelations <- NonEmpty
(AnnotatedOrderByItemG
'DataConnector (UnpreparedValue 'DataConnector))
-> (AnnotatedOrderByItemG
'DataConnector (UnpreparedValue 'DataConnector)
-> WriterT
TableRelationships
m
(OrderByElement, HashMap RelationshipName OrderByRelation))
-> WriterT
TableRelationships
m
(NonEmpty
(OrderByElement, HashMap RelationshipName OrderByRelation))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for NonEmpty
(AnnotatedOrderByItemG
'DataConnector (UnpreparedValue 'DataConnector))
orderByItems \OrderByItemG {Maybe (BasicOrderType 'DataConnector)
Maybe (NullsOrderType 'DataConnector)
AnnotatedOrderByElement
'DataConnector (UnpreparedValue 'DataConnector)
obiNulls :: forall (b :: BackendType) a.
OrderByItemG b a -> Maybe (NullsOrderType b)
obiColumn :: forall (b :: BackendType) a. OrderByItemG b a -> a
obiType :: forall (b :: BackendType) a.
OrderByItemG b a -> Maybe (BasicOrderType b)
obiNulls :: Maybe (NullsOrderType 'DataConnector)
obiColumn :: AnnotatedOrderByElement
'DataConnector (UnpreparedValue 'DataConnector)
obiType :: Maybe (BasicOrderType 'DataConnector)
..} -> do
let orderDirection :: OrderDirection
orderDirection = OrderDirection -> Maybe OrderDirection -> OrderDirection
forall a. a -> Maybe a -> a
fromMaybe OrderDirection
IR.O.Ascending Maybe OrderDirection
Maybe (BasicOrderType 'DataConnector)
obiType
Name
-> OrderDirection
-> [RelationshipName]
-> AnnotatedOrderByElement
'DataConnector (UnpreparedValue 'DataConnector)
-> WriterT
TableRelationships
m
(OrderByElement, HashMap RelationshipName OrderByRelation)
translateOrderByElement Name
sourceTableName OrderDirection
orderDirection [] AnnotatedOrderByElement
'DataConnector (UnpreparedValue 'DataConnector)
obiColumn
HashMap RelationshipName OrderByRelation
relations <- m (HashMap RelationshipName OrderByRelation)
-> WriterT
TableRelationships m (HashMap RelationshipName OrderByRelation)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (HashMap RelationshipName OrderByRelation)
-> WriterT
TableRelationships m (HashMap RelationshipName OrderByRelation))
-> (NonEmpty (HashMap RelationshipName OrderByRelation)
-> m (HashMap RelationshipName OrderByRelation))
-> NonEmpty (HashMap RelationshipName OrderByRelation)
-> WriterT
TableRelationships m (HashMap RelationshipName OrderByRelation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (HashMap RelationshipName OrderByRelation)
-> m (HashMap RelationshipName OrderByRelation)
forall (f :: * -> *).
Foldable f =>
f (HashMap RelationshipName OrderByRelation)
-> m (HashMap RelationshipName OrderByRelation)
mergeOrderByRelations (NonEmpty (HashMap RelationshipName OrderByRelation)
-> WriterT
TableRelationships m (HashMap RelationshipName OrderByRelation))
-> NonEmpty (HashMap RelationshipName OrderByRelation)
-> WriterT
TableRelationships m (HashMap RelationshipName OrderByRelation)
forall a b. (a -> b) -> a -> b
$ (OrderByElement, HashMap RelationshipName OrderByRelation)
-> HashMap RelationshipName OrderByRelation
forall a b. (a, b) -> b
snd ((OrderByElement, HashMap RelationshipName OrderByRelation)
-> HashMap RelationshipName OrderByRelation)
-> NonEmpty
(OrderByElement, HashMap RelationshipName OrderByRelation)
-> NonEmpty (HashMap RelationshipName OrderByRelation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (OrderByElement, HashMap RelationshipName OrderByRelation)
orderByElementsAndRelations
OrderBy -> WriterT TableRelationships m OrderBy
forall (f :: * -> *) a. Applicative f => a -> f a
pure
OrderBy :: HashMap RelationshipName OrderByRelation
-> NonEmpty OrderByElement -> OrderBy
IR.O.OrderBy
{ _obRelations :: HashMap RelationshipName OrderByRelation
_obRelations = HashMap RelationshipName OrderByRelation
relations,
_obElements :: NonEmpty OrderByElement
_obElements = (OrderByElement, HashMap RelationshipName OrderByRelation)
-> OrderByElement
forall a b. (a, b) -> a
fst ((OrderByElement, HashMap RelationshipName OrderByRelation)
-> OrderByElement)
-> NonEmpty
(OrderByElement, HashMap RelationshipName OrderByRelation)
-> NonEmpty OrderByElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (OrderByElement, HashMap RelationshipName OrderByRelation)
orderByElementsAndRelations
}
translateOrderByElement ::
IR.T.Name ->
IR.O.OrderDirection ->
[IR.R.RelationshipName] ->
AnnotatedOrderByElement 'DataConnector (UnpreparedValue 'DataConnector) ->
CPS.WriterT IR.R.TableRelationships m (IR.O.OrderByElement, HashMap IR.R.RelationshipName IR.O.OrderByRelation)
translateOrderByElement :: Name
-> OrderDirection
-> [RelationshipName]
-> AnnotatedOrderByElement
'DataConnector (UnpreparedValue 'DataConnector)
-> WriterT
TableRelationships
m
(OrderByElement, HashMap RelationshipName OrderByRelation)
translateOrderByElement Name
sourceTableName OrderDirection
orderDirection [RelationshipName]
targetReversePath = \case
AOCColumn (ColumnInfo {Bool
Int
Maybe Description
Name
Column 'DataConnector
ColumnType 'DataConnector
ColumnMutability
ciMutability :: forall (b :: BackendType). ColumnInfo b -> ColumnMutability
ciDescription :: forall (b :: BackendType). ColumnInfo b -> Maybe Description
ciIsNullable :: forall (b :: BackendType). ColumnInfo b -> Bool
ciType :: forall (b :: BackendType). ColumnInfo b -> ColumnType b
ciPosition :: forall (b :: BackendType). ColumnInfo b -> Int
ciName :: forall (b :: BackendType). ColumnInfo b -> Name
ciColumn :: forall (b :: BackendType). ColumnInfo b -> Column b
ciMutability :: ColumnMutability
ciDescription :: Maybe Description
ciIsNullable :: Bool
ciType :: ColumnType 'DataConnector
ciPosition :: Int
ciName :: Name
ciColumn :: Column 'DataConnector
..}) ->
(OrderByElement, HashMap RelationshipName OrderByRelation)
-> WriterT
TableRelationships
m
(OrderByElement, HashMap RelationshipName OrderByRelation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( OrderByElement :: [RelationshipName]
-> OrderByTarget -> OrderDirection -> OrderByElement
IR.O.OrderByElement
{ _obeTargetPath :: [RelationshipName]
_obeTargetPath = [RelationshipName] -> [RelationshipName]
forall a. [a] -> [a]
reverse [RelationshipName]
targetReversePath,
_obeTarget :: OrderByTarget
_obeTarget = Name -> OrderByTarget
IR.O.OrderByColumn Name
Column 'DataConnector
ciColumn,
_obeOrderDirection :: OrderDirection
_obeOrderDirection = OrderDirection
orderDirection
},
HashMap RelationshipName OrderByRelation
forall a. Monoid a => a
mempty
)
AOCObjectRelation RelInfo 'DataConnector
relationshipInfo GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))
filterExp AnnotatedOrderByElement
'DataConnector (UnpreparedValue 'DataConnector)
orderByElement -> do
(RelationshipName
relationshipName, IR.R.Relationship {HashMap Name Name
Name
RelationshipType
_rColumnMapping :: Relationship -> HashMap Name Name
_rRelationshipType :: Relationship -> RelationshipType
_rTargetTable :: Relationship -> Name
_rColumnMapping :: HashMap Name Name
_rRelationshipType :: RelationshipType
_rTargetTable :: Name
..}) <- Name
-> RelInfo 'DataConnector
-> WriterT TableRelationships m (RelationshipName, Relationship)
recordTableRelationshipFromRelInfo Name
sourceTableName RelInfo 'DataConnector
relationshipInfo
(OrderByElement
translatedOrderByElement, HashMap RelationshipName OrderByRelation
subOrderByRelations) <- Name
-> OrderDirection
-> [RelationshipName]
-> AnnotatedOrderByElement
'DataConnector (UnpreparedValue 'DataConnector)
-> WriterT
TableRelationships
m
(OrderByElement, HashMap RelationshipName OrderByRelation)
translateOrderByElement Name
_rTargetTable OrderDirection
orderDirection (RelationshipName
relationshipName RelationshipName -> [RelationshipName] -> [RelationshipName]
forall a. a -> [a] -> [a]
: [RelationshipName]
targetReversePath) AnnotatedOrderByElement
'DataConnector (UnpreparedValue 'DataConnector)
orderByElement
Maybe Expression
targetTableWhereExp <- [RelationshipName]
-> Name
-> GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m (Maybe Expression)
translateBoolExpToExpression [] Name
_rTargetTable GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))
filterExp
let orderByRelations :: HashMap RelationshipName OrderByRelation
orderByRelations = [(RelationshipName, OrderByRelation)]
-> HashMap RelationshipName OrderByRelation
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(RelationshipName
relationshipName, Maybe Expression
-> HashMap RelationshipName OrderByRelation -> OrderByRelation
IR.O.OrderByRelation Maybe Expression
targetTableWhereExp HashMap RelationshipName OrderByRelation
subOrderByRelations)]
(OrderByElement, HashMap RelationshipName OrderByRelation)
-> WriterT
TableRelationships
m
(OrderByElement, HashMap RelationshipName OrderByRelation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OrderByElement
translatedOrderByElement, HashMap RelationshipName OrderByRelation
orderByRelations)
AOCArrayAggregation RelInfo 'DataConnector
relationshipInfo GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))
filterExp AnnotatedAggregateOrderBy 'DataConnector
aggregateOrderByElement -> do
(RelationshipName
relationshipName, IR.R.Relationship {HashMap Name Name
Name
RelationshipType
_rColumnMapping :: HashMap Name Name
_rRelationshipType :: RelationshipType
_rTargetTable :: Name
_rColumnMapping :: Relationship -> HashMap Name Name
_rRelationshipType :: Relationship -> RelationshipType
_rTargetTable :: Relationship -> Name
..}) <- Name
-> RelInfo 'DataConnector
-> WriterT TableRelationships m (RelationshipName, Relationship)
recordTableRelationshipFromRelInfo Name
sourceTableName RelInfo 'DataConnector
relationshipInfo
OrderByTarget
orderByTarget <- case AnnotatedAggregateOrderBy 'DataConnector
aggregateOrderByElement of
AnnotatedAggregateOrderBy 'DataConnector
AAOCount ->
OrderByTarget -> WriterT TableRelationships m OrderByTarget
forall (f :: * -> *) a. Applicative f => a -> f a
pure OrderByTarget
IR.O.OrderByStarCountAggregate
AAOOp Text
aggFunctionTxt ColumnInfo {Bool
Int
Maybe Description
Name
Column 'DataConnector
ColumnType 'DataConnector
ColumnMutability
ciMutability :: ColumnMutability
ciDescription :: Maybe Description
ciIsNullable :: Bool
ciType :: ColumnType 'DataConnector
ciPosition :: Int
ciName :: Name
ciColumn :: Column 'DataConnector
ciMutability :: forall (b :: BackendType). ColumnInfo b -> ColumnMutability
ciDescription :: forall (b :: BackendType). ColumnInfo b -> Maybe Description
ciIsNullable :: forall (b :: BackendType). ColumnInfo b -> Bool
ciType :: forall (b :: BackendType). ColumnInfo b -> ColumnType b
ciPosition :: forall (b :: BackendType). ColumnInfo b -> Int
ciName :: forall (b :: BackendType). ColumnInfo b -> Name
ciColumn :: forall (b :: BackendType). ColumnInfo b -> Column b
..} -> do
SingleColumnAggregateFunction
aggFunction <- m SingleColumnAggregateFunction
-> WriterT TableRelationships m SingleColumnAggregateFunction
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m SingleColumnAggregateFunction
-> WriterT TableRelationships m SingleColumnAggregateFunction)
-> m SingleColumnAggregateFunction
-> WriterT TableRelationships m SingleColumnAggregateFunction
forall a b. (a -> b) -> a -> b
$ Text -> m SingleColumnAggregateFunction
translateSingleColumnAggregateFunction Text
aggFunctionTxt
OrderByTarget -> WriterT TableRelationships m OrderByTarget
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OrderByTarget -> WriterT TableRelationships m OrderByTarget)
-> (SingleColumnAggregate -> OrderByTarget)
-> SingleColumnAggregate
-> WriterT TableRelationships m OrderByTarget
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingleColumnAggregate -> OrderByTarget
IR.O.OrderBySingleColumnAggregate (SingleColumnAggregate
-> WriterT TableRelationships m OrderByTarget)
-> SingleColumnAggregate
-> WriterT TableRelationships m OrderByTarget
forall a b. (a -> b) -> a -> b
$ SingleColumnAggregateFunction -> Name -> SingleColumnAggregate
IR.A.SingleColumnAggregate SingleColumnAggregateFunction
aggFunction Name
Column 'DataConnector
ciColumn
let translatedOrderByElement :: OrderByElement
translatedOrderByElement =
OrderByElement :: [RelationshipName]
-> OrderByTarget -> OrderDirection -> OrderByElement
IR.O.OrderByElement
{ _obeTargetPath :: [RelationshipName]
_obeTargetPath = [RelationshipName] -> [RelationshipName]
forall a. [a] -> [a]
reverse (RelationshipName
relationshipName RelationshipName -> [RelationshipName] -> [RelationshipName]
forall a. a -> [a] -> [a]
: [RelationshipName]
targetReversePath),
_obeTarget :: OrderByTarget
_obeTarget = OrderByTarget
orderByTarget,
_obeOrderDirection :: OrderDirection
_obeOrderDirection = OrderDirection
orderDirection
}
Maybe Expression
targetTableWhereExp <- [RelationshipName]
-> Name
-> GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m (Maybe Expression)
translateBoolExpToExpression [] Name
_rTargetTable GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))
filterExp
let orderByRelations :: HashMap RelationshipName OrderByRelation
orderByRelations = [(RelationshipName, OrderByRelation)]
-> HashMap RelationshipName OrderByRelation
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(RelationshipName
relationshipName, Maybe Expression
-> HashMap RelationshipName OrderByRelation -> OrderByRelation
IR.O.OrderByRelation Maybe Expression
targetTableWhereExp HashMap RelationshipName OrderByRelation
forall a. Monoid a => a
mempty)]
(OrderByElement, HashMap RelationshipName OrderByRelation)
-> WriterT
TableRelationships
m
(OrderByElement, HashMap RelationshipName OrderByRelation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OrderByElement
translatedOrderByElement, HashMap RelationshipName OrderByRelation
orderByRelations)
mergeOrderByRelations ::
Foldable f =>
f (HashMap IR.R.RelationshipName IR.O.OrderByRelation) ->
m (HashMap IR.R.RelationshipName IR.O.OrderByRelation)
mergeOrderByRelations :: f (HashMap RelationshipName OrderByRelation)
-> m (HashMap RelationshipName OrderByRelation)
mergeOrderByRelations f (HashMap RelationshipName OrderByRelation)
orderByRelationsList =
(HashMap RelationshipName OrderByRelation
-> HashMap RelationshipName OrderByRelation
-> m (HashMap RelationshipName OrderByRelation))
-> HashMap RelationshipName OrderByRelation
-> f (HashMap RelationshipName OrderByRelation)
-> m (HashMap RelationshipName OrderByRelation)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM HashMap RelationshipName OrderByRelation
-> HashMap RelationshipName OrderByRelation
-> m (HashMap RelationshipName OrderByRelation)
mergeMap HashMap RelationshipName OrderByRelation
forall a. Monoid a => a
mempty f (HashMap RelationshipName OrderByRelation)
orderByRelationsList
where
mergeMap :: HashMap IR.R.RelationshipName IR.O.OrderByRelation -> HashMap IR.R.RelationshipName IR.O.OrderByRelation -> m (HashMap IR.R.RelationshipName IR.O.OrderByRelation)
mergeMap :: HashMap RelationshipName OrderByRelation
-> HashMap RelationshipName OrderByRelation
-> m (HashMap RelationshipName OrderByRelation)
mergeMap HashMap RelationshipName OrderByRelation
left HashMap RelationshipName OrderByRelation
right = (HashMap RelationshipName OrderByRelation
-> (RelationshipName, OrderByRelation)
-> m (HashMap RelationshipName OrderByRelation))
-> HashMap RelationshipName OrderByRelation
-> [(RelationshipName, OrderByRelation)]
-> m (HashMap RelationshipName OrderByRelation)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\HashMap RelationshipName OrderByRelation
targetMap (RelationshipName
relName, OrderByRelation
orderByRel) -> (Maybe OrderByRelation -> m (Maybe OrderByRelation))
-> RelationshipName
-> HashMap RelationshipName OrderByRelation
-> m (HashMap RelationshipName OrderByRelation)
forall (f :: * -> *) k v.
(Functor f, Eq k, Hashable k) =>
(Maybe v -> f (Maybe v)) -> k -> HashMap k v -> f (HashMap k v)
HashMap.alterF (m (Maybe OrderByRelation)
-> (OrderByRelation -> m (Maybe OrderByRelation))
-> Maybe OrderByRelation
-> m (Maybe OrderByRelation)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe OrderByRelation -> m (Maybe OrderByRelation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe OrderByRelation -> m (Maybe OrderByRelation))
-> Maybe OrderByRelation -> m (Maybe OrderByRelation)
forall a b. (a -> b) -> a -> b
$ OrderByRelation -> Maybe OrderByRelation
forall a. a -> Maybe a
Just OrderByRelation
orderByRel) ((OrderByRelation -> Maybe OrderByRelation)
-> m OrderByRelation -> m (Maybe OrderByRelation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OrderByRelation -> Maybe OrderByRelation
forall a. a -> Maybe a
Just (m OrderByRelation -> m (Maybe OrderByRelation))
-> (OrderByRelation -> m OrderByRelation)
-> OrderByRelation
-> m (Maybe OrderByRelation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrderByRelation -> OrderByRelation -> m OrderByRelation
mergeOrderByRelation OrderByRelation
orderByRel)) RelationshipName
relName HashMap RelationshipName OrderByRelation
targetMap) HashMap RelationshipName OrderByRelation
left ([(RelationshipName, OrderByRelation)]
-> m (HashMap RelationshipName OrderByRelation))
-> [(RelationshipName, OrderByRelation)]
-> m (HashMap RelationshipName OrderByRelation)
forall a b. (a -> b) -> a -> b
$ HashMap RelationshipName OrderByRelation
-> [(RelationshipName, OrderByRelation)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap RelationshipName OrderByRelation
right
mergeOrderByRelation :: IR.O.OrderByRelation -> IR.O.OrderByRelation -> m IR.O.OrderByRelation
mergeOrderByRelation :: OrderByRelation -> OrderByRelation -> m OrderByRelation
mergeOrderByRelation OrderByRelation
right OrderByRelation
left =
if OrderByRelation -> Maybe Expression
IR.O._obrWhere OrderByRelation
left Maybe Expression -> Maybe Expression -> Bool
forall a. Eq a => a -> a -> Bool
== OrderByRelation -> Maybe Expression
IR.O._obrWhere OrderByRelation
right
then do
HashMap RelationshipName OrderByRelation
mergedSubrelations <- HashMap RelationshipName OrderByRelation
-> HashMap RelationshipName OrderByRelation
-> m (HashMap RelationshipName OrderByRelation)
mergeMap (OrderByRelation -> HashMap RelationshipName OrderByRelation
IR.O._obrSubrelations OrderByRelation
left) (OrderByRelation -> HashMap RelationshipName OrderByRelation
IR.O._obrSubrelations OrderByRelation
right)
OrderByRelation -> m OrderByRelation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OrderByRelation -> m OrderByRelation)
-> OrderByRelation -> m OrderByRelation
forall a b. (a -> b) -> a -> b
$ Maybe Expression
-> HashMap RelationshipName OrderByRelation -> OrderByRelation
IR.O.OrderByRelation (OrderByRelation -> Maybe Expression
IR.O._obrWhere OrderByRelation
left) HashMap RelationshipName OrderByRelation
mergedSubrelations
else Text -> m OrderByRelation
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 Text
"mergeOrderByRelations: Differing filter expressions found for the same table"
recordTableRelationshipFromRelInfo ::
IR.T.Name ->
RelInfo 'DataConnector ->
CPS.WriterT IR.R.TableRelationships m (IR.R.RelationshipName, IR.R.Relationship)
recordTableRelationshipFromRelInfo :: Name
-> RelInfo 'DataConnector
-> WriterT TableRelationships m (RelationshipName, Relationship)
recordTableRelationshipFromRelInfo Name
sourceTableName RelInfo {Bool
HashMap (Column 'DataConnector) (Column 'DataConnector)
InsertOrder
RelType
RelName
TableName 'DataConnector
riInsertOrder :: forall (b :: BackendType). RelInfo b -> InsertOrder
riIsManual :: forall (b :: BackendType). RelInfo b -> Bool
riRTable :: forall (b :: BackendType). RelInfo b -> TableName b
riMapping :: forall (b :: BackendType).
RelInfo b -> HashMap (Column b) (Column b)
riType :: forall (b :: BackendType). RelInfo b -> RelType
riName :: forall (b :: BackendType). RelInfo b -> RelName
riInsertOrder :: InsertOrder
riIsManual :: Bool
riRTable :: TableName 'DataConnector
riMapping :: HashMap (Column 'DataConnector) (Column 'DataConnector)
riType :: RelType
riName :: RelName
..} = do
let relationshipName :: RelationshipName
relationshipName = RelName -> RelationshipName
IR.R.mkRelationshipName RelName
riName
let relationshipType :: RelationshipType
relationshipType = case RelType
riType of
RelType
ObjRel -> RelationshipType
IR.R.ObjectRelationship
RelType
ArrRel -> RelationshipType
IR.R.ArrayRelationship
let relationship :: Relationship
relationship =
Relationship :: Name -> RelationshipType -> HashMap Name Name -> Relationship
IR.R.Relationship
{ _rTargetTable :: Name
_rTargetTable = Name
TableName 'DataConnector
riRTable,
_rRelationshipType :: RelationshipType
_rRelationshipType = RelationshipType
relationshipType,
_rColumnMapping :: HashMap Name Name
_rColumnMapping = HashMap Name Name
HashMap (Column 'DataConnector) (Column 'DataConnector)
riMapping
}
Name
-> RelationshipName
-> Relationship
-> WriterT TableRelationships m ()
recordTableRelationship
Name
sourceTableName
RelationshipName
relationshipName
Relationship
relationship
(RelationshipName, Relationship)
-> WriterT TableRelationships m (RelationshipName, Relationship)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationshipName
relationshipName, Relationship
relationship)
translateAnnFields ::
FieldPrefix ->
IR.T.Name ->
AnnFieldsG 'DataConnector Void (UnpreparedValue 'DataConnector) ->
CPS.WriterT IR.R.TableRelationships m FieldsAndAggregates
translateAnnFields :: FieldPrefix
-> Name
-> Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m FieldsAndAggregates
translateAnnFields FieldPrefix
fieldNamePrefix Name
sourceTableName Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
fields = do
[(FieldName, Maybe Field)]
translatedFields <- ((FieldName,
AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m (FieldName, Maybe Field))
-> Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m [(FieldName, Maybe Field)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector)
-> WriterT TableRelationships m (Maybe Field))
-> (FieldName,
AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m (FieldName, Maybe Field)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Name
-> AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector)
-> WriterT TableRelationships m (Maybe Field)
translateAnnField Name
sourceTableName)) Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
fields
let translatedFields' :: HashMap FieldName Field
translatedFields' = [(FieldName, Field)] -> HashMap FieldName Field
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(FieldName, Field)] -> HashMap FieldName Field)
-> ([Maybe (FieldName, Field)] -> [(FieldName, Field)])
-> [Maybe (FieldName, Field)]
-> HashMap FieldName Field
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (FieldName, Field)] -> [(FieldName, Field)]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes ([Maybe (FieldName, Field)] -> HashMap FieldName Field)
-> [Maybe (FieldName, Field)] -> HashMap FieldName Field
forall a b. (a -> b) -> a -> b
$ (\(FieldName
fieldName, Maybe Field
field) -> (FieldPrefix -> FieldName -> FieldName
applyPrefix FieldPrefix
fieldNamePrefix FieldName
fieldName,) (Field -> (FieldName, Field))
-> Maybe Field -> Maybe (FieldName, Field)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Field
field) ((FieldName, Maybe Field) -> Maybe (FieldName, Field))
-> [(FieldName, Maybe Field)] -> [Maybe (FieldName, Field)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(FieldName, Maybe Field)]
translatedFields
FieldsAndAggregates
-> WriterT TableRelationships m FieldsAndAggregates
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldsAndAggregates
-> WriterT TableRelationships m FieldsAndAggregates)
-> FieldsAndAggregates
-> WriterT TableRelationships m FieldsAndAggregates
forall a b. (a -> b) -> a -> b
$
HashMap FieldName Field
-> HashMap FieldName Aggregate -> FieldsAndAggregates
FieldsAndAggregates
HashMap FieldName Field
translatedFields'
HashMap FieldName Aggregate
forall a. Monoid a => a
mempty
translateAnnField ::
IR.T.Name ->
AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector) ->
CPS.WriterT IR.R.TableRelationships m (Maybe IR.Q.Field)
translateAnnField :: Name
-> AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector)
-> WriterT TableRelationships m (Maybe Field)
translateAnnField Name
sourceTableName = \case
AFColumn AnnColumnField 'DataConnector (UnpreparedValue 'DataConnector)
colField ->
Maybe Field -> WriterT TableRelationships m (Maybe Field)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Field -> WriterT TableRelationships m (Maybe Field))
-> (Name -> Maybe Field)
-> Name
-> WriterT TableRelationships m (Maybe Field)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field -> Maybe Field
forall a. a -> Maybe a
Just (Field -> Maybe Field) -> (Name -> Field) -> Name -> Maybe Field
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Field
IR.Q.ColumnField (Name -> WriterT TableRelationships m (Maybe Field))
-> Name -> WriterT TableRelationships m (Maybe Field)
forall a b. (a -> b) -> a -> b
$ AnnColumnField 'DataConnector (UnpreparedValue 'DataConnector)
-> Column 'DataConnector
forall (b :: BackendType) v. AnnColumnField b v -> Column b
_acfColumn AnnColumnField 'DataConnector (UnpreparedValue 'DataConnector)
colField
AFObjectRelation ObjectRelationSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
objRel -> do
let targetTable :: TableName 'DataConnector
targetTable = AnnObjectSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
-> TableName 'DataConnector
forall (b :: BackendType) r v.
AnnObjectSelectG b r v -> TableName b
_aosTableFrom (ObjectRelationSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
-> AnnObjectSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
forall (b :: BackendType) a. AnnRelationSelectG b a -> a
_aarAnnSelect ObjectRelationSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
objRel)
let relationshipName :: RelationshipName
relationshipName = RelName -> RelationshipName
IR.R.mkRelationshipName (RelName -> RelationshipName) -> RelName -> RelationshipName
forall a b. (a -> b) -> a -> b
$ ObjectRelationSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
-> RelName
forall (b :: BackendType) a. AnnRelationSelectG b a -> RelName
_aarRelationshipName ObjectRelationSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
objRel
FieldsAndAggregates {HashMap FieldName Aggregate
HashMap FieldName Field
_faaAggregates :: HashMap FieldName Aggregate
_faaFields :: HashMap FieldName Field
_faaAggregates :: FieldsAndAggregates -> HashMap FieldName Aggregate
_faaFields :: FieldsAndAggregates -> HashMap FieldName Field
..} <- FieldPrefix
-> Name
-> Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m FieldsAndAggregates
translateAnnFields FieldPrefix
noPrefix Name
TableName 'DataConnector
targetTable (AnnObjectSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
-> Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
forall (b :: BackendType) r v.
AnnObjectSelectG b r v -> AnnFieldsG b r v
_aosFields (ObjectRelationSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
-> AnnObjectSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
forall (b :: BackendType) a. AnnRelationSelectG b a -> a
_aarAnnSelect ObjectRelationSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
objRel))
Maybe Expression
whereClause <- [RelationshipName]
-> Name
-> GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m (Maybe Expression)
translateBoolExpToExpression [] Name
TableName 'DataConnector
targetTable (AnnObjectSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
-> GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))
forall (b :: BackendType) r v.
AnnObjectSelectG b r v -> AnnBoolExp b v
_aosTableFilter (ObjectRelationSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
-> AnnObjectSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
forall (b :: BackendType) a. AnnRelationSelectG b a -> a
_aarAnnSelect ObjectRelationSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
objRel))
Name
-> RelationshipName
-> Relationship
-> WriterT TableRelationships m ()
recordTableRelationship
Name
sourceTableName
RelationshipName
relationshipName
Relationship :: Name -> RelationshipType -> HashMap Name Name -> Relationship
IR.R.Relationship
{ _rTargetTable :: Name
_rTargetTable = Name
TableName 'DataConnector
targetTable,
_rRelationshipType :: RelationshipType
_rRelationshipType = RelationshipType
IR.R.ObjectRelationship,
_rColumnMapping :: HashMap Name Name
_rColumnMapping = ObjectRelationSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
-> HashMap (Column 'DataConnector) (Column 'DataConnector)
forall (b :: BackendType) a.
AnnRelationSelectG b a -> HashMap (Column b) (Column b)
_aarColumnMapping ObjectRelationSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
objRel
}
Maybe Field -> WriterT TableRelationships m (Maybe Field)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Field -> WriterT TableRelationships m (Maybe Field))
-> (RelationshipField -> Maybe Field)
-> RelationshipField
-> WriterT TableRelationships m (Maybe Field)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field -> Maybe Field
forall a. a -> Maybe a
Just (Field -> Maybe Field)
-> (RelationshipField -> Field) -> RelationshipField -> Maybe Field
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelationshipField -> Field
IR.Q.RelField (RelationshipField -> WriterT TableRelationships m (Maybe Field))
-> RelationshipField -> WriterT TableRelationships m (Maybe Field)
forall a b. (a -> b) -> a -> b
$
RelationshipName -> Query -> RelationshipField
IR.Q.RelationshipField
RelationshipName
relationshipName
( Query :: HashMap FieldName Field
-> HashMap FieldName Aggregate
-> Maybe Int
-> Maybe Int
-> Maybe Expression
-> Maybe OrderBy
-> Query
IR.Q.Query
{ _qFields :: HashMap FieldName Field
_qFields = HashMap FieldName Field
_faaFields,
_qAggregates :: HashMap FieldName Aggregate
_qAggregates = HashMap FieldName Aggregate
_faaAggregates,
_qWhere :: Maybe Expression
_qWhere = Maybe Expression
whereClause,
_qLimit :: Maybe Int
_qLimit = Maybe Int
forall a. Maybe a
Nothing,
_qOffset :: Maybe Int
_qOffset = Maybe Int
forall a. Maybe a
Nothing,
_qOrderBy :: Maybe OrderBy
_qOrderBy = Maybe OrderBy
forall a. Maybe a
Nothing
}
)
AFArrayRelation (ASSimple ArrayRelationSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
arrayRelationSelect) -> do
Field -> Maybe Field
forall a. a -> Maybe a
Just (Field -> Maybe Field)
-> WriterT TableRelationships m Field
-> WriterT TableRelationships m (Maybe Field)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name
-> (Name
-> Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m FieldsAndAggregates)
-> ArrayRelationSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
-> WriterT TableRelationships m Field
forall (fieldType :: * -> *).
Name
-> (Name
-> Fields (fieldType (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m FieldsAndAggregates)
-> AnnRelationSelectG
'DataConnector
(AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m Field
translateArrayRelationSelect Name
sourceTableName (FieldPrefix
-> Name
-> Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m FieldsAndAggregates
translateAnnFields FieldPrefix
noPrefix) ArrayRelationSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
arrayRelationSelect
AFArrayRelation (ASAggregate ArrayAggregateSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
arrayRelationSelect) ->
Field -> Maybe Field
forall a. a -> Maybe a
Just (Field -> Maybe Field)
-> WriterT TableRelationships m Field
-> WriterT TableRelationships m (Maybe Field)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name
-> (Name
-> Fields
(TableAggregateFieldG
'DataConnector Void (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m FieldsAndAggregates)
-> ArrayAggregateSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
-> WriterT TableRelationships m Field
forall (fieldType :: * -> *).
Name
-> (Name
-> Fields (fieldType (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m FieldsAndAggregates)
-> AnnRelationSelectG
'DataConnector
(AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m Field
translateArrayRelationSelect Name
sourceTableName Name
-> Fields
(TableAggregateFieldG
'DataConnector Void (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m FieldsAndAggregates
translateTableAggregateFields ArrayAggregateSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
arrayRelationSelect
AFExpression Text
_literal ->
Maybe Field -> WriterT TableRelationships m (Maybe Field)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Field
forall a. Maybe a
Nothing
translateArrayRelationSelect ::
IR.T.Name ->
(IR.T.Name -> Fields (fieldType (UnpreparedValue 'DataConnector)) -> CPS.WriterT IR.R.TableRelationships m FieldsAndAggregates) ->
AnnRelationSelectG 'DataConnector (AnnSelectG 'DataConnector fieldType (UnpreparedValue 'DataConnector)) ->
CPS.WriterT IR.R.TableRelationships m IR.Q.Field
translateArrayRelationSelect :: Name
-> (Name
-> Fields (fieldType (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m FieldsAndAggregates)
-> AnnRelationSelectG
'DataConnector
(AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m Field
translateArrayRelationSelect Name
sourceTableName Name
-> Fields (fieldType (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m FieldsAndAggregates
translateFieldsAndAggregates AnnRelationSelectG
'DataConnector
(AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector))
arrRel = do
Name
targetTable <- m Name -> WriterT TableRelationships m Name
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Name -> WriterT TableRelationships m Name)
-> m Name -> WriterT TableRelationships m Name
forall a b. (a -> b) -> a -> b
$ AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector)
-> m Name
forall (fieldsType :: * -> *) valueType.
AnnSelectG 'DataConnector fieldsType valueType -> m Name
extractTableName (AnnRelationSelectG
'DataConnector
(AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector))
-> AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector)
forall (b :: BackendType) a. AnnRelationSelectG b a -> a
_aarAnnSelect AnnRelationSelectG
'DataConnector
(AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector))
arrRel)
Query
query <- (Name
-> Fields (fieldType (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m FieldsAndAggregates)
-> Name
-> AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector)
-> WriterT TableRelationships m Query
forall (fieldType :: * -> *).
(Name
-> Fields (fieldType (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m FieldsAndAggregates)
-> Name
-> AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector)
-> WriterT TableRelationships m Query
translateAnnSelect Name
-> Fields (fieldType (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m FieldsAndAggregates
translateFieldsAndAggregates Name
targetTable (AnnRelationSelectG
'DataConnector
(AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector))
-> AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector)
forall (b :: BackendType) a. AnnRelationSelectG b a -> a
_aarAnnSelect AnnRelationSelectG
'DataConnector
(AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector))
arrRel)
let relationshipName :: RelationshipName
relationshipName = RelName -> RelationshipName
IR.R.mkRelationshipName (RelName -> RelationshipName) -> RelName -> RelationshipName
forall a b. (a -> b) -> a -> b
$ AnnRelationSelectG
'DataConnector
(AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector))
-> RelName
forall (b :: BackendType) a. AnnRelationSelectG b a -> RelName
_aarRelationshipName AnnRelationSelectG
'DataConnector
(AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector))
arrRel
Name
-> RelationshipName
-> Relationship
-> WriterT TableRelationships m ()
recordTableRelationship
Name
sourceTableName
RelationshipName
relationshipName
Relationship :: Name -> RelationshipType -> HashMap Name Name -> Relationship
IR.R.Relationship
{ _rTargetTable :: Name
_rTargetTable = Name
targetTable,
_rRelationshipType :: RelationshipType
_rRelationshipType = RelationshipType
IR.R.ArrayRelationship,
_rColumnMapping :: HashMap Name Name
_rColumnMapping = AnnRelationSelectG
'DataConnector
(AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector))
-> HashMap (Column 'DataConnector) (Column 'DataConnector)
forall (b :: BackendType) a.
AnnRelationSelectG b a -> HashMap (Column b) (Column b)
_aarColumnMapping AnnRelationSelectG
'DataConnector
(AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector))
arrRel
}
Field -> WriterT TableRelationships m Field
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Field -> WriterT TableRelationships m Field)
-> (RelationshipField -> Field)
-> RelationshipField
-> WriterT TableRelationships m Field
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelationshipField -> Field
IR.Q.RelField (RelationshipField -> WriterT TableRelationships m Field)
-> RelationshipField -> WriterT TableRelationships m Field
forall a b. (a -> b) -> a -> b
$
RelationshipName -> Query -> RelationshipField
IR.Q.RelationshipField
RelationshipName
relationshipName
Query
query
translateTableAggregateFields ::
IR.T.Name ->
TableAggregateFieldsG 'DataConnector Void (UnpreparedValue 'DataConnector) ->
CPS.WriterT IR.R.TableRelationships m FieldsAndAggregates
translateTableAggregateFields :: Name
-> Fields
(TableAggregateFieldG
'DataConnector Void (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m FieldsAndAggregates
translateTableAggregateFields Name
sourceTableName Fields
(TableAggregateFieldG
'DataConnector Void (UnpreparedValue 'DataConnector))
fields = do
[FieldsAndAggregates] -> FieldsAndAggregates
forall a. Monoid a => [a] -> a
mconcat ([FieldsAndAggregates] -> FieldsAndAggregates)
-> WriterT TableRelationships m [FieldsAndAggregates]
-> WriterT TableRelationships m FieldsAndAggregates
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((FieldName,
TableAggregateFieldG
'DataConnector Void (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m FieldsAndAggregates)
-> Fields
(TableAggregateFieldG
'DataConnector Void (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m [FieldsAndAggregates]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((FieldName
-> TableAggregateFieldG
'DataConnector Void (UnpreparedValue 'DataConnector)
-> WriterT TableRelationships m FieldsAndAggregates)
-> (FieldName,
TableAggregateFieldG
'DataConnector Void (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m FieldsAndAggregates
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Name
-> FieldName
-> TableAggregateFieldG
'DataConnector Void (UnpreparedValue 'DataConnector)
-> WriterT TableRelationships m FieldsAndAggregates
translateTableAggregateField Name
sourceTableName)) Fields
(TableAggregateFieldG
'DataConnector Void (UnpreparedValue 'DataConnector))
fields
translateTableAggregateField ::
IR.T.Name ->
FieldName ->
TableAggregateFieldG 'DataConnector Void (UnpreparedValue 'DataConnector) ->
CPS.WriterT IR.R.TableRelationships m FieldsAndAggregates
translateTableAggregateField :: Name
-> FieldName
-> TableAggregateFieldG
'DataConnector Void (UnpreparedValue 'DataConnector)
-> WriterT TableRelationships m FieldsAndAggregates
translateTableAggregateField Name
sourceTableName FieldName
fieldName = \case
TAFAgg AggregateFields 'DataConnector
aggregateFields -> do
let fieldNamePrefix :: FieldPrefix
fieldNamePrefix = FieldName -> FieldPrefix
prefixWith FieldName
fieldName
HashMap FieldName Aggregate
translatedAggregateFields <- m (HashMap FieldName Aggregate)
-> WriterT TableRelationships m (HashMap FieldName Aggregate)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (HashMap FieldName Aggregate)
-> WriterT TableRelationships m (HashMap FieldName Aggregate))
-> m (HashMap FieldName Aggregate)
-> WriterT TableRelationships m (HashMap FieldName Aggregate)
forall a b. (a -> b) -> a -> b
$ [HashMap FieldName Aggregate] -> HashMap FieldName Aggregate
forall a. Monoid a => [a] -> a
mconcat ([HashMap FieldName Aggregate] -> HashMap FieldName Aggregate)
-> m [HashMap FieldName Aggregate]
-> m (HashMap FieldName Aggregate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((FieldName, AggregateField 'DataConnector)
-> m (HashMap FieldName Aggregate))
-> AggregateFields 'DataConnector
-> m [HashMap FieldName Aggregate]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((FieldName
-> AggregateField 'DataConnector
-> m (HashMap FieldName Aggregate))
-> (FieldName, AggregateField 'DataConnector)
-> m (HashMap FieldName Aggregate)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (FieldPrefix
-> FieldName
-> AggregateField 'DataConnector
-> m (HashMap FieldName Aggregate)
translateAggregateField FieldPrefix
fieldNamePrefix)) AggregateFields 'DataConnector
aggregateFields
FieldsAndAggregates
-> WriterT TableRelationships m FieldsAndAggregates
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldsAndAggregates
-> WriterT TableRelationships m FieldsAndAggregates)
-> FieldsAndAggregates
-> WriterT TableRelationships m FieldsAndAggregates
forall a b. (a -> b) -> a -> b
$
HashMap FieldName Field
-> HashMap FieldName Aggregate -> FieldsAndAggregates
FieldsAndAggregates
HashMap FieldName Field
forall a. Monoid a => a
mempty
HashMap FieldName Aggregate
translatedAggregateFields
TAFNodes XNodesAgg 'DataConnector
_ Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
fields ->
FieldPrefix
-> Name
-> Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m FieldsAndAggregates
translateAnnFields (FieldName -> FieldPrefix
prefixWith FieldName
fieldName) Name
sourceTableName Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
fields
TAFExp Text
_txt ->
FieldsAndAggregates
-> WriterT TableRelationships m FieldsAndAggregates
forall (f :: * -> *) a. Applicative f => a -> f a
pure FieldsAndAggregates
forall a. Monoid a => a
mempty
translateAggregateField ::
FieldPrefix ->
FieldName ->
AggregateField 'DataConnector ->
m (HashMap FieldName IR.A.Aggregate)
translateAggregateField :: FieldPrefix
-> FieldName
-> AggregateField 'DataConnector
-> m (HashMap FieldName Aggregate)
translateAggregateField FieldPrefix
fieldPrefix FieldName
fieldName = \case
AFCount CountType 'DataConnector
countAggregate -> HashMap FieldName Aggregate -> m (HashMap FieldName Aggregate)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap FieldName Aggregate -> m (HashMap FieldName Aggregate))
-> HashMap FieldName Aggregate -> m (HashMap FieldName Aggregate)
forall a b. (a -> b) -> a -> b
$ FieldName -> Aggregate -> HashMap FieldName Aggregate
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton (FieldPrefix -> FieldName -> FieldName
applyPrefix FieldPrefix
fieldPrefix FieldName
fieldName) (CountAggregate -> Aggregate
IR.A.Count CountAggregate
CountType 'DataConnector
countAggregate)
AFOp AggregateOp {ColumnFields 'DataConnector
Text
$sel:_aoFields:AggregateOp :: forall (b :: BackendType). AggregateOp b -> ColumnFields b
$sel:_aoOp:AggregateOp :: forall (b :: BackendType). AggregateOp b -> Text
_aoFields :: ColumnFields 'DataConnector
_aoOp :: Text
..} -> do
let fieldPrefix' :: FieldPrefix
fieldPrefix' = FieldPrefix
fieldPrefix FieldPrefix -> FieldPrefix -> FieldPrefix
forall a. Semigroup a => a -> a -> a
<> FieldName -> FieldPrefix
prefixWith FieldName
fieldName
SingleColumnAggregateFunction
aggFunction <- Text -> m SingleColumnAggregateFunction
translateSingleColumnAggregateFunction Text
_aoOp
([Maybe (FieldName, Aggregate)] -> HashMap FieldName Aggregate)
-> m [Maybe (FieldName, Aggregate)]
-> m (HashMap FieldName Aggregate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([(FieldName, Aggregate)] -> HashMap FieldName Aggregate
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(FieldName, Aggregate)] -> HashMap FieldName Aggregate)
-> ([Maybe (FieldName, Aggregate)] -> [(FieldName, Aggregate)])
-> [Maybe (FieldName, Aggregate)]
-> HashMap FieldName Aggregate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (FieldName, Aggregate)] -> [(FieldName, Aggregate)]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes) (m [Maybe (FieldName, Aggregate)]
-> m (HashMap FieldName Aggregate))
-> (((FieldName, ColFld 'DataConnector)
-> m (Maybe (FieldName, Aggregate)))
-> m [Maybe (FieldName, Aggregate)])
-> ((FieldName, ColFld 'DataConnector)
-> m (Maybe (FieldName, Aggregate)))
-> m (HashMap FieldName Aggregate)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnFields 'DataConnector
-> ((FieldName, ColFld 'DataConnector)
-> m (Maybe (FieldName, Aggregate)))
-> m [Maybe (FieldName, Aggregate)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ColumnFields 'DataConnector
_aoFields (((FieldName, ColFld 'DataConnector)
-> m (Maybe (FieldName, Aggregate)))
-> m (HashMap FieldName Aggregate))
-> ((FieldName, ColFld 'DataConnector)
-> m (Maybe (FieldName, Aggregate)))
-> m (HashMap FieldName Aggregate)
forall a b. (a -> b) -> a -> b
$ \(FieldName
columnFieldName, ColFld 'DataConnector
columnField) ->
case ColFld 'DataConnector
columnField of
CFCol Column 'DataConnector
column ColumnType 'DataConnector
_columnType ->
Maybe (FieldName, Aggregate) -> m (Maybe (FieldName, Aggregate))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (FieldName, Aggregate) -> m (Maybe (FieldName, Aggregate)))
-> ((FieldName, Aggregate) -> Maybe (FieldName, Aggregate))
-> (FieldName, Aggregate)
-> m (Maybe (FieldName, Aggregate))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldName, Aggregate) -> Maybe (FieldName, Aggregate)
forall a. a -> Maybe a
Just ((FieldName, Aggregate) -> m (Maybe (FieldName, Aggregate)))
-> (FieldName, Aggregate) -> m (Maybe (FieldName, Aggregate))
forall a b. (a -> b) -> a -> b
$ (FieldPrefix -> FieldName -> FieldName
applyPrefix FieldPrefix
fieldPrefix' FieldName
columnFieldName, SingleColumnAggregate -> Aggregate
IR.A.SingleColumn (SingleColumnAggregate -> Aggregate)
-> SingleColumnAggregate -> Aggregate
forall a b. (a -> b) -> a -> b
$ SingleColumnAggregateFunction -> Name -> SingleColumnAggregate
IR.A.SingleColumnAggregate SingleColumnAggregateFunction
aggFunction Name
Column 'DataConnector
column)
CFExp Text
_txt ->
Maybe (FieldName, Aggregate) -> m (Maybe (FieldName, Aggregate))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (FieldName, Aggregate)
forall a. Maybe a
Nothing
AFExp Text
_txt ->
HashMap FieldName Aggregate -> m (HashMap FieldName Aggregate)
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap FieldName Aggregate
forall a. Monoid a => a
mempty
translateSingleColumnAggregateFunction :: Text -> m IR.A.SingleColumnAggregateFunction
translateSingleColumnAggregateFunction :: Text -> m SingleColumnAggregateFunction
translateSingleColumnAggregateFunction = \case
Text
"avg" -> SingleColumnAggregateFunction -> m SingleColumnAggregateFunction
forall (f :: * -> *) a. Applicative f => a -> f a
pure SingleColumnAggregateFunction
IR.A.Average
Text
"max" -> SingleColumnAggregateFunction -> m SingleColumnAggregateFunction
forall (f :: * -> *) a. Applicative f => a -> f a
pure SingleColumnAggregateFunction
IR.A.Max
Text
"min" -> SingleColumnAggregateFunction -> m SingleColumnAggregateFunction
forall (f :: * -> *) a. Applicative f => a -> f a
pure SingleColumnAggregateFunction
IR.A.Min
Text
"stddev_pop" -> SingleColumnAggregateFunction -> m SingleColumnAggregateFunction
forall (f :: * -> *) a. Applicative f => a -> f a
pure SingleColumnAggregateFunction
IR.A.StandardDeviationPopulation
Text
"stddev_samp" -> SingleColumnAggregateFunction -> m SingleColumnAggregateFunction
forall (f :: * -> *) a. Applicative f => a -> f a
pure SingleColumnAggregateFunction
IR.A.StandardDeviationSample
Text
"stddev" -> SingleColumnAggregateFunction -> m SingleColumnAggregateFunction
forall (f :: * -> *) a. Applicative f => a -> f a
pure SingleColumnAggregateFunction
IR.A.StandardDeviationSample
Text
"sum" -> SingleColumnAggregateFunction -> m SingleColumnAggregateFunction
forall (f :: * -> *) a. Applicative f => a -> f a
pure SingleColumnAggregateFunction
IR.A.Sum
Text
"var_pop" -> SingleColumnAggregateFunction -> m SingleColumnAggregateFunction
forall (f :: * -> *) a. Applicative f => a -> f a
pure SingleColumnAggregateFunction
IR.A.VariancePopulation
Text
"var_samp" -> SingleColumnAggregateFunction -> m SingleColumnAggregateFunction
forall (f :: * -> *) a. Applicative f => a -> f a
pure SingleColumnAggregateFunction
IR.A.VarianceSample
Text
"variance" -> SingleColumnAggregateFunction -> m SingleColumnAggregateFunction
forall (f :: * -> *) a. Applicative f => a -> f a
pure SingleColumnAggregateFunction
IR.A.VarianceSample
Text
unknownFunc -> Text -> m SingleColumnAggregateFunction
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text -> m SingleColumnAggregateFunction)
-> Text -> m SingleColumnAggregateFunction
forall a b. (a -> b) -> a -> b
$ Text
"translateSingleColumnAggregateFunction: Unknown aggregate function encountered: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
unknownFunc
prepareLiterals ::
UnpreparedValue 'DataConnector ->
m IR.S.Literal
prepareLiterals :: UnpreparedValue 'DataConnector -> m Literal
prepareLiterals (UVLiteral SQLExpression 'DataConnector
literal) = Literal -> m Literal
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Literal -> m Literal) -> Literal -> m Literal
forall a b. (a -> b) -> a -> b
$ Literal
SQLExpression 'DataConnector
literal
prepareLiterals (UVParameter Maybe VariableInfo
_ ColumnValue 'DataConnector
e) = Literal -> m Literal
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Literal
IR.S.ValueLiteral (ColumnValue 'DataConnector -> ScalarValue 'DataConnector
forall (b :: BackendType). ColumnValue b -> ScalarValue b
cvValue ColumnValue 'DataConnector
e))
prepareLiterals UnpreparedValue 'DataConnector
UVSession = Code -> Text -> m Literal
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"prepareLiterals: UVSession"
prepareLiterals (UVSessionVar SessionVarType 'DataConnector
_ SessionVariable
v) =
case SessionVariable -> SessionVariables -> Maybe Text
getSessionVariableValue SessionVariable
v SessionVariables
session of
Maybe Text
Nothing -> Code -> Text -> m Literal
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported (Text
"prepareLiterals: session var not found: " Text -> SessionVariable -> Text
forall t. ToTxt t => Text -> t -> Text
<>> SessionVariable
v)
Just Text
s -> Literal -> m Literal
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Literal
IR.S.ValueLiteral (Text -> Value
IR.S.String Text
s))
translateBoolExpToExpression ::
[IR.R.RelationshipName] ->
IR.T.Name ->
AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector) ->
CPS.WriterT IR.R.TableRelationships m (Maybe IR.E.Expression)
translateBoolExpToExpression :: [RelationshipName]
-> Name
-> GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m (Maybe Expression)
translateBoolExpToExpression [RelationshipName]
columnRelationshipReversePath Name
sourceTableName GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))
boolExp = do
Expression -> Maybe Expression
removeAlwaysTrueExpression (Expression -> Maybe Expression)
-> WriterT TableRelationships m Expression
-> WriterT TableRelationships m (Maybe Expression)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RelationshipName]
-> Name
-> GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m Expression
translateBoolExp [RelationshipName]
columnRelationshipReversePath Name
sourceTableName GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))
boolExp
translateBoolExp ::
[IR.R.RelationshipName] ->
IR.T.Name ->
AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector) ->
CPS.WriterT IR.R.TableRelationships m IR.E.Expression
translateBoolExp :: [RelationshipName]
-> Name
-> GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m Expression
translateBoolExp [RelationshipName]
columnRelationshipReversePath Name
sourceTableName = \case
BoolAnd [GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))]
xs ->
([Expression] -> Expression) -> [Expression] -> Expression
mkIfZeroOrMany [Expression] -> Expression
IR.E.And ([Expression] -> Expression)
-> ([Expression] -> [Expression]) -> [Expression] -> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expression -> Maybe Expression) -> [Expression] -> [Expression]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe Expression -> Maybe Expression
removeAlwaysTrueExpression ([Expression] -> Expression)
-> WriterT TableRelationships m [Expression]
-> WriterT TableRelationships m Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m Expression)
-> [GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))]
-> WriterT TableRelationships m [Expression]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ([RelationshipName]
-> Name
-> GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m Expression
translateBoolExp [RelationshipName]
columnRelationshipReversePath Name
sourceTableName) [GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))]
xs
BoolOr [GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))]
xs ->
([Expression] -> Expression) -> [Expression] -> Expression
mkIfZeroOrMany [Expression] -> Expression
IR.E.Or ([Expression] -> Expression)
-> ([Expression] -> [Expression]) -> [Expression] -> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expression -> Maybe Expression) -> [Expression] -> [Expression]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe Expression -> Maybe Expression
removeAlwaysFalseExpression ([Expression] -> Expression)
-> WriterT TableRelationships m [Expression]
-> WriterT TableRelationships m Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m Expression)
-> [GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))]
-> WriterT TableRelationships m [Expression]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ([RelationshipName]
-> Name
-> GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m Expression
translateBoolExp [RelationshipName]
columnRelationshipReversePath Name
sourceTableName) [GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))]
xs
BoolNot GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))
x ->
Expression -> Expression
IR.E.Not (Expression -> Expression)
-> WriterT TableRelationships m Expression
-> WriterT TableRelationships m Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([RelationshipName]
-> Name
-> GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m Expression
translateBoolExp [RelationshipName]
columnRelationshipReversePath Name
sourceTableName) GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))
x
BoolField (AVColumn ColumnInfo 'DataConnector
c [OpExpG 'DataConnector (UnpreparedValue 'DataConnector)]
xs) ->
m Expression -> WriterT TableRelationships m Expression
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Expression -> WriterT TableRelationships m Expression)
-> m Expression -> WriterT TableRelationships m Expression
forall a b. (a -> b) -> a -> b
$ ([Expression] -> Expression) -> [Expression] -> Expression
mkIfZeroOrMany [Expression] -> Expression
IR.E.And ([Expression] -> Expression) -> m [Expression] -> m Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (OpExpG 'DataConnector (UnpreparedValue 'DataConnector)
-> m Expression)
-> [OpExpG 'DataConnector (UnpreparedValue 'DataConnector)]
-> m [Expression]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ([RelationshipName]
-> Name
-> OpExpG 'DataConnector (UnpreparedValue 'DataConnector)
-> m Expression
translateOp [RelationshipName]
columnRelationshipReversePath (ColumnInfo 'DataConnector -> Column 'DataConnector
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn ColumnInfo 'DataConnector
c)) [OpExpG 'DataConnector (UnpreparedValue 'DataConnector)]
xs
BoolField (AVRelationship RelInfo 'DataConnector
relationshipInfo GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))
boolExp) -> do
(RelationshipName
relationshipName, IR.R.Relationship {HashMap Name Name
Name
RelationshipType
_rColumnMapping :: HashMap Name Name
_rRelationshipType :: RelationshipType
_rTargetTable :: Name
_rColumnMapping :: Relationship -> HashMap Name Name
_rRelationshipType :: Relationship -> RelationshipType
_rTargetTable :: Relationship -> Name
..}) <- Name
-> RelInfo 'DataConnector
-> WriterT TableRelationships m (RelationshipName, Relationship)
recordTableRelationshipFromRelInfo Name
sourceTableName RelInfo 'DataConnector
relationshipInfo
[RelationshipName]
-> Name
-> GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))
-> WriterT TableRelationships m Expression
translateBoolExp (RelationshipName
relationshipName RelationshipName -> [RelationshipName] -> [RelationshipName]
forall a. a -> [a] -> [a]
: [RelationshipName]
columnRelationshipReversePath) Name
_rTargetTable GBoolExp
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))
boolExp
BoolExists GExists
'DataConnector
(AnnBoolExpFld 'DataConnector (UnpreparedValue 'DataConnector))
_ ->
m Expression -> WriterT TableRelationships m Expression
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Expression -> WriterT TableRelationships m Expression)
-> m Expression -> WriterT TableRelationships m Expression
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m Expression
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"The BoolExists expression type is not supported by the Data Connector backend"
where
mkIfZeroOrMany :: ([IR.E.Expression] -> IR.E.Expression) -> [IR.E.Expression] -> IR.E.Expression
mkIfZeroOrMany :: ([Expression] -> Expression) -> [Expression] -> Expression
mkIfZeroOrMany [Expression] -> Expression
mk = \case
[Expression
singleExp] -> Expression
singleExp
[Expression]
zeroOrManyExps -> [Expression] -> Expression
mk [Expression]
zeroOrManyExps
removeAlwaysTrueExpression :: IR.E.Expression -> Maybe IR.E.Expression
removeAlwaysTrueExpression :: Expression -> Maybe Expression
removeAlwaysTrueExpression = \case
IR.E.And [] -> Maybe Expression
forall a. Maybe a
Nothing
IR.E.Not (IR.E.Or []) -> Maybe Expression
forall a. Maybe a
Nothing
Expression
other -> Expression -> Maybe Expression
forall a. a -> Maybe a
Just Expression
other
removeAlwaysFalseExpression :: IR.E.Expression -> Maybe IR.E.Expression
removeAlwaysFalseExpression :: Expression -> Maybe Expression
removeAlwaysFalseExpression = \case
IR.E.Or [] -> Maybe Expression
forall a. Maybe a
Nothing
IR.E.Not (IR.E.And []) -> Maybe Expression
forall a. Maybe a
Nothing
Expression
other -> Expression -> Maybe Expression
forall a. a -> Maybe a
Just Expression
other
translateOp ::
[IR.R.RelationshipName] ->
IR.C.Name ->
OpExpG 'DataConnector (UnpreparedValue 'DataConnector) ->
m IR.E.Expression
translateOp :: [RelationshipName]
-> Name
-> OpExpG 'DataConnector (UnpreparedValue 'DataConnector)
-> m Expression
translateOp [RelationshipName]
columnRelationshipReversePath Name
columnName OpExpG 'DataConnector (UnpreparedValue 'DataConnector)
opExp = do
OpExpG 'DataConnector Literal
preparedOpExp <- (UnpreparedValue 'DataConnector -> m Literal)
-> OpExpG 'DataConnector (UnpreparedValue 'DataConnector)
-> m (OpExpG 'DataConnector Literal)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse UnpreparedValue 'DataConnector -> m Literal
prepareLiterals (OpExpG 'DataConnector (UnpreparedValue 'DataConnector)
-> m (OpExpG 'DataConnector Literal))
-> OpExpG 'DataConnector (UnpreparedValue 'DataConnector)
-> m (OpExpG 'DataConnector Literal)
forall a b. (a -> b) -> a -> b
$ OpExpG 'DataConnector (UnpreparedValue 'DataConnector)
opExp
case OpExpG 'DataConnector Literal
preparedOpExp of
AEQ Bool
_ (IR.S.ValueLiteral Value
value) ->
Expression -> m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ BinaryComparisonOperator -> Value -> Expression
mkApplyBinaryComparisonOperatorToScalar BinaryComparisonOperator
IR.E.Equal Value
value
AEQ Bool
_ (IR.S.ArrayLiteral [Value]
_array) ->
Code -> Text -> m Expression
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"Array literals not supported for AEQ operator"
ANE Bool
_ (IR.S.ValueLiteral Value
value) ->
Expression -> m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> m Expression)
-> (Expression -> Expression) -> Expression -> m Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expression -> Expression
IR.E.Not (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ BinaryComparisonOperator -> Value -> Expression
mkApplyBinaryComparisonOperatorToScalar BinaryComparisonOperator
IR.E.Equal Value
value
ANE Bool
_ (IR.S.ArrayLiteral [Value]
_array) ->
Code -> Text -> m Expression
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"Array literals not supported for ANE operator"
AGT (IR.S.ValueLiteral Value
value) ->
Expression -> m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ BinaryComparisonOperator -> Value -> Expression
mkApplyBinaryComparisonOperatorToScalar BinaryComparisonOperator
IR.E.GreaterThan Value
value
AGT (IR.S.ArrayLiteral [Value]
_array) ->
Code -> Text -> m Expression
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"Array literals not supported for AGT operator"
ALT (IR.S.ValueLiteral Value
value) ->
Expression -> m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ BinaryComparisonOperator -> Value -> Expression
mkApplyBinaryComparisonOperatorToScalar BinaryComparisonOperator
IR.E.LessThan Value
value
ALT (IR.S.ArrayLiteral [Value]
_array) ->
Code -> Text -> m Expression
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"Array literals not supported for ALT operator"
AGTE (IR.S.ValueLiteral Value
value) ->
Expression -> m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ BinaryComparisonOperator -> Value -> Expression
mkApplyBinaryComparisonOperatorToScalar BinaryComparisonOperator
IR.E.GreaterThanOrEqual Value
value
AGTE (IR.S.ArrayLiteral [Value]
_array) ->
Code -> Text -> m Expression
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"Array literals not supported for AGTE operator"
ALTE (IR.S.ValueLiteral Value
value) ->
Expression -> m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ BinaryComparisonOperator -> Value -> Expression
mkApplyBinaryComparisonOperatorToScalar BinaryComparisonOperator
IR.E.LessThanOrEqual Value
value
ALTE (IR.S.ArrayLiteral [Value]
_array) ->
Code -> Text -> m Expression
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"Array literals not supported for ALTE operator"
OpExpG 'DataConnector Literal
ANISNULL ->
Expression -> m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ UnaryComparisonOperator -> ComparisonColumn -> Expression
IR.E.ApplyUnaryComparisonOperator UnaryComparisonOperator
IR.E.IsNull ComparisonColumn
currentComparisonColumn
OpExpG 'DataConnector Literal
ANISNOTNULL ->
Expression -> m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ Expression -> Expression
IR.E.Not (UnaryComparisonOperator -> ComparisonColumn -> Expression
IR.E.ApplyUnaryComparisonOperator UnaryComparisonOperator
IR.E.IsNull ComparisonColumn
currentComparisonColumn)
AIN Literal
literal -> Expression -> m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ Literal -> Expression
inOperator Literal
literal
ANIN Literal
literal -> Expression -> m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> m Expression)
-> (Expression -> Expression) -> Expression -> m Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expression -> Expression
IR.E.Not (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ Literal -> Expression
inOperator Literal
literal
CEQ RootOrCurrentColumn 'DataConnector
rootOrCurrentColumn ->
Expression -> m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ BinaryComparisonOperator
-> RootOrCurrentColumn 'DataConnector -> Expression
mkApplyBinaryComparisonOperatorToAnotherColumn BinaryComparisonOperator
IR.E.Equal RootOrCurrentColumn 'DataConnector
rootOrCurrentColumn
CNE RootOrCurrentColumn 'DataConnector
rootOrCurrentColumn ->
Expression -> m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ Expression -> Expression
IR.E.Not (Expression -> Expression) -> Expression -> Expression
forall a b. (a -> b) -> a -> b
$ BinaryComparisonOperator
-> RootOrCurrentColumn 'DataConnector -> Expression
mkApplyBinaryComparisonOperatorToAnotherColumn BinaryComparisonOperator
IR.E.Equal RootOrCurrentColumn 'DataConnector
rootOrCurrentColumn
CGT RootOrCurrentColumn 'DataConnector
rootOrCurrentColumn ->
Expression -> m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ BinaryComparisonOperator
-> RootOrCurrentColumn 'DataConnector -> Expression
mkApplyBinaryComparisonOperatorToAnotherColumn BinaryComparisonOperator
IR.E.GreaterThan RootOrCurrentColumn 'DataConnector
rootOrCurrentColumn
CLT RootOrCurrentColumn 'DataConnector
rootOrCurrentColumn ->
Expression -> m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ BinaryComparisonOperator
-> RootOrCurrentColumn 'DataConnector -> Expression
mkApplyBinaryComparisonOperatorToAnotherColumn BinaryComparisonOperator
IR.E.LessThan RootOrCurrentColumn 'DataConnector
rootOrCurrentColumn
CGTE RootOrCurrentColumn 'DataConnector
rootOrCurrentColumn ->
Expression -> m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ BinaryComparisonOperator
-> RootOrCurrentColumn 'DataConnector -> Expression
mkApplyBinaryComparisonOperatorToAnotherColumn BinaryComparisonOperator
IR.E.GreaterThanOrEqual RootOrCurrentColumn 'DataConnector
rootOrCurrentColumn
CLTE RootOrCurrentColumn 'DataConnector
rootOrCurrentColumn ->
Expression -> m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ BinaryComparisonOperator
-> RootOrCurrentColumn 'DataConnector -> Expression
mkApplyBinaryComparisonOperatorToAnotherColumn BinaryComparisonOperator
IR.E.LessThanOrEqual RootOrCurrentColumn 'DataConnector
rootOrCurrentColumn
ALIKE Literal
_literal ->
Code -> Text -> m Expression
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"The ALIKE operator is not supported by the Data Connector backend"
ANLIKE Literal
_literal ->
Code -> Text -> m Expression
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"The ANLIKE operator is not supported by the Data Connector backend"
ACast CastExp 'DataConnector Literal
_literal ->
Code -> Text -> m Expression
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"The ACast operator is not supported by the Data Connector backend"
ABackendSpecific CustomBooleanOperator {..} -> case Maybe (Either (RootOrCurrentColumn 'DataConnector) Literal)
_cboRHS of
Maybe (Either (RootOrCurrentColumn 'DataConnector) Literal)
Nothing -> Expression -> m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ UnaryComparisonOperator -> ComparisonColumn -> Expression
IR.E.ApplyUnaryComparisonOperator (Text -> UnaryComparisonOperator
CustomUnaryComparisonOperator Text
_cboName) ComparisonColumn
currentComparisonColumn
Just (Left RootOrCurrentColumn 'DataConnector
rootOrCurrentColumn) ->
Expression -> m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ BinaryComparisonOperator
-> RootOrCurrentColumn 'DataConnector -> Expression
mkApplyBinaryComparisonOperatorToAnotherColumn (Text -> BinaryComparisonOperator
IR.E.CustomBinaryComparisonOperator Text
_cboName) RootOrCurrentColumn 'DataConnector
rootOrCurrentColumn
Just (Right (IR.S.ValueLiteral Value
value)) ->
Expression -> m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ BinaryComparisonOperator -> Value -> Expression
mkApplyBinaryComparisonOperatorToScalar (Text -> BinaryComparisonOperator
IR.E.CustomBinaryComparisonOperator Text
_cboName) Value
value
Just (Right (IR.S.ArrayLiteral [Value]
array)) ->
Expression -> m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ BinaryArrayComparisonOperator
-> ComparisonColumn -> [Value] -> Expression
IR.E.ApplyBinaryArrayComparisonOperator (Text -> BinaryArrayComparisonOperator
IR.E.CustomBinaryArrayComparisonOperator Text
_cboName) ComparisonColumn
currentComparisonColumn [Value]
array
where
currentComparisonColumn :: IR.E.ComparisonColumn
currentComparisonColumn :: ComparisonColumn
currentComparisonColumn = [RelationshipName] -> Name -> ComparisonColumn
IR.E.ComparisonColumn ([RelationshipName] -> [RelationshipName]
forall a. [a] -> [a]
reverse [RelationshipName]
columnRelationshipReversePath) Name
columnName
mkApplyBinaryComparisonOperatorToAnotherColumn :: IR.E.BinaryComparisonOperator -> RootOrCurrentColumn 'DataConnector -> IR.E.Expression
mkApplyBinaryComparisonOperatorToAnotherColumn :: BinaryComparisonOperator
-> RootOrCurrentColumn 'DataConnector -> Expression
mkApplyBinaryComparisonOperatorToAnotherColumn BinaryComparisonOperator
operator (RootOrCurrentColumn RootOrCurrent
rootOrCurrent Column 'DataConnector
otherColumnName) =
let columnPath :: [RelationshipName]
columnPath = case RootOrCurrent
rootOrCurrent of
RootOrCurrent
IsRoot -> []
RootOrCurrent
IsCurrent -> ([RelationshipName] -> [RelationshipName]
forall a. [a] -> [a]
reverse [RelationshipName]
columnRelationshipReversePath)
in BinaryComparisonOperator
-> ComparisonColumn -> ComparisonValue -> Expression
IR.E.ApplyBinaryComparisonOperator BinaryComparisonOperator
operator ComparisonColumn
currentComparisonColumn (ComparisonColumn -> ComparisonValue
IR.E.AnotherColumn (ComparisonColumn -> ComparisonValue)
-> ComparisonColumn -> ComparisonValue
forall a b. (a -> b) -> a -> b
$ [RelationshipName] -> Name -> ComparisonColumn
IR.E.ComparisonColumn [RelationshipName]
columnPath Name
Column 'DataConnector
otherColumnName)
inOperator :: IR.S.Literal -> IR.E.Expression
inOperator :: Literal -> Expression
inOperator Literal
literal =
let values :: [Value]
values = case Literal
literal of
IR.S.ArrayLiteral [Value]
array -> [Value]
array
IR.S.ValueLiteral Value
value -> [Value
value]
in BinaryArrayComparisonOperator
-> ComparisonColumn -> [Value] -> Expression
IR.E.ApplyBinaryArrayComparisonOperator BinaryArrayComparisonOperator
IR.E.In ComparisonColumn
currentComparisonColumn [Value]
values
mkApplyBinaryComparisonOperatorToScalar :: IR.E.BinaryComparisonOperator -> IR.S.Value -> IR.E.Expression
mkApplyBinaryComparisonOperatorToScalar :: BinaryComparisonOperator -> Value -> Expression
mkApplyBinaryComparisonOperatorToScalar BinaryComparisonOperator
operator Value
value =
BinaryComparisonOperator
-> ComparisonColumn -> ComparisonValue -> Expression
IR.E.ApplyBinaryComparisonOperator BinaryComparisonOperator
operator ComparisonColumn
currentComparisonColumn (Value -> ComparisonValue
IR.E.ScalarValue Value
value)
queryHasRelations :: IR.Q.QueryRequest -> Bool
queryHasRelations :: QueryRequest -> Bool
queryHasRelations IR.Q.QueryRequest {Name
TableRelationships
Query
_qrQuery :: Query
_qrTableRelationships :: TableRelationships
_qrTable :: Name
_qrQuery :: QueryRequest -> Query
_qrTableRelationships :: QueryRequest -> TableRelationships
_qrTable :: QueryRequest -> Name
..} = TableRelationships
_qrTableRelationships TableRelationships -> TableRelationships -> Bool
forall a. Eq a => a -> a -> Bool
/= TableRelationships
forall a. Monoid a => a
mempty
data Cardinality
= Single
| Many
reshapeResponseToQueryShape ::
MonadError QErr m =>
QueryDB 'DataConnector Void (UnpreparedValue 'DataConnector) ->
API.QueryResponse ->
m J.Encoding
reshapeResponseToQueryShape :: QueryDB 'DataConnector Void (UnpreparedValue 'DataConnector)
-> QueryResponse -> m Encoding
reshapeResponseToQueryShape QueryDB 'DataConnector Void (UnpreparedValue 'DataConnector)
queryDb QueryResponse
response =
case QueryDB 'DataConnector Void (UnpreparedValue 'DataConnector)
queryDb of
QDBMultipleRows AnnSimpleSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
simpleSelect -> Cardinality
-> Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
-> QueryResponse
-> m Encoding
forall (m :: * -> *).
MonadError QErr m =>
Cardinality
-> Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
-> QueryResponse
-> m Encoding
reshapeSimpleSelectRows Cardinality
Many (AnnSimpleSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
-> Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
forall (b :: BackendType) (f :: * -> *) v.
AnnSelectG b f v -> Fields (f v)
_asnFields AnnSimpleSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
simpleSelect) QueryResponse
response
QDBSingleRow AnnSimpleSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
simpleSelect -> Cardinality
-> Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
-> QueryResponse
-> m Encoding
forall (m :: * -> *).
MonadError QErr m =>
Cardinality
-> Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
-> QueryResponse
-> m Encoding
reshapeSimpleSelectRows Cardinality
Single (AnnSimpleSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
-> Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
forall (b :: BackendType) (f :: * -> *) v.
AnnSelectG b f v -> Fields (f v)
_asnFields AnnSimpleSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
simpleSelect) QueryResponse
response
QDBAggregation AnnAggregateSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
aggregateSelect -> Fields
(TableAggregateFieldG
'DataConnector Void (UnpreparedValue 'DataConnector))
-> QueryResponse -> m Encoding
forall (m :: * -> *).
MonadError QErr m =>
Fields
(TableAggregateFieldG
'DataConnector Void (UnpreparedValue 'DataConnector))
-> QueryResponse -> m Encoding
reshapeTableAggregateFields (AnnAggregateSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
-> Fields
(TableAggregateFieldG
'DataConnector Void (UnpreparedValue 'DataConnector))
forall (b :: BackendType) (f :: * -> *) v.
AnnSelectG b f v -> Fields (f v)
_asnFields AnnAggregateSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
aggregateSelect) QueryResponse
response
reshapeSimpleSelectRows ::
MonadError QErr m =>
Cardinality ->
AnnFieldsG 'DataConnector Void (UnpreparedValue 'DataConnector) ->
API.QueryResponse ->
m J.Encoding
reshapeSimpleSelectRows :: Cardinality
-> Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
-> QueryResponse
-> m Encoding
reshapeSimpleSelectRows Cardinality
cardinality Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
fields API.QueryResponse {Maybe [KeyMap FieldValue]
Maybe (KeyMap Value)
_qrRows :: QueryResponse -> Maybe [KeyMap FieldValue]
_qrAggregates :: QueryResponse -> Maybe (KeyMap Value)
_qrAggregates :: Maybe (KeyMap Value)
_qrRows :: Maybe [KeyMap FieldValue]
..} =
case Cardinality
cardinality of
Cardinality
Single ->
case [KeyMap FieldValue]
rows of
[] -> Encoding -> m Encoding
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoding -> m Encoding) -> Encoding -> m Encoding
forall a b. (a -> b) -> a -> b
$ Value -> Encoding
forall a. ToJSON a => a -> Encoding
J.toEncoding Value
J.Null
[KeyMap FieldValue
singleRow] -> FieldPrefix
-> Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
-> KeyMap FieldValue
-> m Encoding
forall (m :: * -> *).
MonadError QErr m =>
FieldPrefix
-> Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
-> KeyMap FieldValue
-> m Encoding
reshapeAnnFields FieldPrefix
noPrefix Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
fields KeyMap FieldValue
singleRow
[KeyMap FieldValue]
_multipleRows ->
Text -> m Encoding
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 Text
"Data Connector agent returned multiple rows when only one was expected"
Cardinality
Many -> do
[Encoding]
reshapedRows <- (KeyMap FieldValue -> m Encoding)
-> [KeyMap FieldValue] -> m [Encoding]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (FieldPrefix
-> Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
-> KeyMap FieldValue
-> m Encoding
forall (m :: * -> *).
MonadError QErr m =>
FieldPrefix
-> Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
-> KeyMap FieldValue
-> m Encoding
reshapeAnnFields FieldPrefix
noPrefix Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
fields) [KeyMap FieldValue]
rows
Encoding -> m Encoding
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]
reshapedRows
where
rows :: [KeyMap FieldValue]
rows = [KeyMap FieldValue]
-> Maybe [KeyMap FieldValue] -> [KeyMap FieldValue]
forall a. a -> Maybe a -> a
fromMaybe [KeyMap FieldValue]
forall a. Monoid a => a
mempty Maybe [KeyMap FieldValue]
_qrRows
reshapeTableAggregateFields ::
MonadError QErr m =>
TableAggregateFieldsG 'DataConnector Void (UnpreparedValue 'DataConnector) ->
API.QueryResponse ->
m J.Encoding
reshapeTableAggregateFields :: Fields
(TableAggregateFieldG
'DataConnector Void (UnpreparedValue 'DataConnector))
-> QueryResponse -> m Encoding
reshapeTableAggregateFields Fields
(TableAggregateFieldG
'DataConnector Void (UnpreparedValue 'DataConnector))
tableAggregateFields API.QueryResponse {Maybe [KeyMap FieldValue]
Maybe (KeyMap Value)
_qrAggregates :: Maybe (KeyMap Value)
_qrRows :: Maybe [KeyMap FieldValue]
_qrRows :: QueryResponse -> Maybe [KeyMap FieldValue]
_qrAggregates :: QueryResponse -> Maybe (KeyMap Value)
..} = do
[(Text, Encoding)]
reshapedFields <- Fields
(TableAggregateFieldG
'DataConnector Void (UnpreparedValue 'DataConnector))
-> ((FieldName,
TableAggregateFieldG
'DataConnector Void (UnpreparedValue 'DataConnector))
-> m (Text, Encoding))
-> m [(Text, Encoding)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Fields
(TableAggregateFieldG
'DataConnector Void (UnpreparedValue 'DataConnector))
tableAggregateFields (((FieldName,
TableAggregateFieldG
'DataConnector Void (UnpreparedValue 'DataConnector))
-> m (Text, Encoding))
-> m [(Text, Encoding)])
-> ((FieldName,
TableAggregateFieldG
'DataConnector Void (UnpreparedValue 'DataConnector))
-> m (Text, Encoding))
-> m [(Text, Encoding)]
forall a b. (a -> b) -> a -> b
$ \(fieldName :: FieldName
fieldName@(FieldName Text
fieldNameText), TableAggregateFieldG
'DataConnector Void (UnpreparedValue 'DataConnector)
tableAggregateField) -> do
case TableAggregateFieldG
'DataConnector Void (UnpreparedValue 'DataConnector)
tableAggregateField of
TAFAgg AggregateFields 'DataConnector
aggregateFields -> do
Encoding
reshapedAggregateFields <- FieldPrefix
-> AggregateFields 'DataConnector -> KeyMap Value -> m Encoding
forall (m :: * -> *).
MonadError QErr m =>
FieldPrefix
-> AggregateFields 'DataConnector -> KeyMap Value -> m Encoding
reshapeAggregateFields (FieldName -> FieldPrefix
prefixWith FieldName
fieldName) AggregateFields 'DataConnector
aggregateFields KeyMap Value
responseAggregates
(Text, Encoding) -> m (Text, Encoding)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Text, Encoding) -> m (Text, Encoding))
-> (Text, Encoding) -> m (Text, Encoding)
forall a b. (a -> b) -> a -> b
$ (Text
fieldNameText, Encoding
reshapedAggregateFields)
TAFNodes XNodesAgg 'DataConnector
_ Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
annFields -> do
[Encoding]
reshapedRows <- (KeyMap FieldValue -> m Encoding)
-> [KeyMap FieldValue] -> m [Encoding]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (FieldPrefix
-> Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
-> KeyMap FieldValue
-> m Encoding
forall (m :: * -> *).
MonadError QErr m =>
FieldPrefix
-> Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
-> KeyMap FieldValue
-> m Encoding
reshapeAnnFields (FieldName -> FieldPrefix
prefixWith FieldName
fieldName) Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
annFields) [KeyMap FieldValue]
responseRows
(Text, Encoding) -> m (Text, Encoding)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Text, Encoding) -> m (Text, Encoding))
-> (Text, Encoding) -> m (Text, Encoding)
forall a b. (a -> b) -> a -> b
$ (Text
fieldNameText, (Encoding -> Encoding) -> [Encoding] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
JE.list Encoding -> Encoding
forall a. a -> a
id [Encoding]
reshapedRows)
TAFExp Text
txt ->
(Text, Encoding) -> m (Text, Encoding)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Text, Encoding) -> m (Text, Encoding))
-> (Text, Encoding) -> m (Text, Encoding)
forall a b. (a -> b) -> a -> b
$ (Text
fieldNameText, Text -> Encoding
forall a. Text -> Encoding' a
JE.text Text
txt)
Encoding -> m Encoding
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)]
reshapedFields
where
responseRows :: [KeyMap FieldValue]
responseRows = [KeyMap FieldValue]
-> Maybe [KeyMap FieldValue] -> [KeyMap FieldValue]
forall a. a -> Maybe a -> a
fromMaybe [KeyMap FieldValue]
forall a. Monoid a => a
mempty Maybe [KeyMap FieldValue]
_qrRows
responseAggregates :: KeyMap Value
responseAggregates = KeyMap Value -> Maybe (KeyMap Value) -> KeyMap Value
forall a. a -> Maybe a -> a
fromMaybe KeyMap Value
forall a. Monoid a => a
mempty Maybe (KeyMap Value)
_qrAggregates
reshapeAggregateFields ::
MonadError QErr m =>
FieldPrefix ->
AggregateFields 'DataConnector ->
KeyMap API.Value ->
m J.Encoding
reshapeAggregateFields :: FieldPrefix
-> AggregateFields 'DataConnector -> KeyMap Value -> m Encoding
reshapeAggregateFields FieldPrefix
fieldPrefix AggregateFields 'DataConnector
aggregateFields KeyMap Value
responseAggregates = do
[(Text, Encoding)]
reshapedFields <- AggregateFields 'DataConnector
-> ((FieldName, AggregateField 'DataConnector)
-> m (Text, Encoding))
-> m [(Text, Encoding)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM AggregateFields 'DataConnector
aggregateFields (((FieldName, AggregateField 'DataConnector) -> m (Text, Encoding))
-> m [(Text, Encoding)])
-> ((FieldName, AggregateField 'DataConnector)
-> m (Text, Encoding))
-> m [(Text, Encoding)]
forall a b. (a -> b) -> a -> b
$ \(fieldName :: FieldName
fieldName@(FieldName Text
fieldNameText), AggregateField 'DataConnector
aggregateField) ->
case AggregateField 'DataConnector
aggregateField of
AFCount CountType 'DataConnector
_countAggregate -> do
let fieldNameKey :: Key
fieldNameKey = Text -> Key
K.fromText (Text -> Key) -> (FieldName -> Text) -> FieldName -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldName -> Text
getFieldNameTxt (FieldName -> Key) -> FieldName -> Key
forall a b. (a -> b) -> a -> b
$ FieldPrefix -> FieldName -> FieldName
applyPrefix FieldPrefix
fieldPrefix FieldName
fieldName
Value
responseAggregateValue <-
Key -> KeyMap Value -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
fieldNameKey KeyMap Value
responseAggregates
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
"Unable to find expected aggregate " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Key -> Text
K.toText Key
fieldNameKey Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in aggregates returned by Data Connector agent")
(Text, Encoding) -> m (Text, Encoding)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
fieldNameText, Value -> Encoding
forall a. ToJSON a => a -> Encoding
J.toEncoding Value
responseAggregateValue)
AFOp AggregateOp {ColumnFields 'DataConnector
Text
_aoFields :: ColumnFields 'DataConnector
_aoOp :: Text
$sel:_aoFields:AggregateOp :: forall (b :: BackendType). AggregateOp b -> ColumnFields b
$sel:_aoOp:AggregateOp :: forall (b :: BackendType). AggregateOp b -> Text
..} -> do
[(Text, Encoding)]
reshapedColumnFields <- ColumnFields 'DataConnector
-> ((FieldName, ColFld 'DataConnector) -> m (Text, Encoding))
-> m [(Text, Encoding)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ColumnFields 'DataConnector
_aoFields (((FieldName, ColFld 'DataConnector) -> m (Text, Encoding))
-> m [(Text, Encoding)])
-> ((FieldName, ColFld 'DataConnector) -> m (Text, Encoding))
-> m [(Text, Encoding)]
forall a b. (a -> b) -> a -> b
$ \(columnFieldName :: FieldName
columnFieldName@(FieldName Text
columnFieldNameText), ColFld 'DataConnector
columnField) ->
case ColFld 'DataConnector
columnField of
CFCol Column 'DataConnector
_column ColumnType 'DataConnector
_columnType -> do
let fieldPrefix' :: FieldPrefix
fieldPrefix' = FieldPrefix
fieldPrefix FieldPrefix -> FieldPrefix -> FieldPrefix
forall a. Semigroup a => a -> a -> a
<> FieldName -> FieldPrefix
prefixWith FieldName
fieldName
let columnFieldNameKey :: Key
columnFieldNameKey = Text -> Key
K.fromText (Text -> Key) -> (FieldName -> Text) -> FieldName -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldName -> Text
getFieldNameTxt (FieldName -> Key) -> FieldName -> Key
forall a b. (a -> b) -> a -> b
$ FieldPrefix -> FieldName -> FieldName
applyPrefix FieldPrefix
fieldPrefix' FieldName
columnFieldName
Value
responseAggregateValue <-
Key -> KeyMap Value -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
columnFieldNameKey KeyMap Value
responseAggregates
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
"Unable to find expected aggregate " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Key -> Text
K.toText Key
columnFieldNameKey Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in aggregates returned by Data Connector agent")
(Text, Encoding) -> m (Text, Encoding)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
columnFieldNameText, Value -> Encoding
forall a. ToJSON a => a -> Encoding
J.toEncoding Value
responseAggregateValue)
CFExp Text
txt ->
(Text, Encoding) -> m (Text, Encoding)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
columnFieldNameText, Text -> Encoding
forall a. Text -> Encoding' a
JE.text Text
txt)
(Text, Encoding) -> m (Text, Encoding)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
fieldNameText, [(Text, Encoding)] -> Encoding
encodeAssocListAsObject [(Text, Encoding)]
reshapedColumnFields)
AFExp Text
txt ->
(Text, Encoding) -> m (Text, Encoding)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
fieldNameText, Text -> Encoding
forall a. Text -> Encoding' a
JE.text Text
txt)
Encoding -> m Encoding
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)]
reshapedFields
reshapeAnnFields ::
MonadError QErr m =>
FieldPrefix ->
AnnFieldsG 'DataConnector Void (UnpreparedValue 'DataConnector) ->
KeyMap API.FieldValue ->
m J.Encoding
reshapeAnnFields :: FieldPrefix
-> Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
-> KeyMap FieldValue
-> m Encoding
reshapeAnnFields FieldPrefix
fieldNamePrefix Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
fields KeyMap FieldValue
responseRow = do
[(Text, Encoding)]
reshapedFields <- Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
-> ((FieldName,
AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
-> m (Text, Encoding))
-> m [(Text, Encoding)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
fields (((FieldName,
AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
-> m (Text, Encoding))
-> m [(Text, Encoding)])
-> ((FieldName,
AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
-> m (Text, Encoding))
-> m [(Text, Encoding)]
forall a b. (a -> b) -> a -> b
$ \(fieldName :: FieldName
fieldName@(FieldName Text
fieldNameText), AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector)
field) -> do
let fieldNameKey :: Key
fieldNameKey = Text -> Key
K.fromText (Text -> Key) -> (FieldName -> Text) -> FieldName -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldName -> Text
getFieldNameTxt (FieldName -> Key) -> FieldName -> Key
forall a b. (a -> b) -> a -> b
$ FieldPrefix -> FieldName -> FieldName
applyPrefix FieldPrefix
fieldNamePrefix FieldName
fieldName
let responseField :: m FieldValue
responseField =
Key -> KeyMap FieldValue -> Maybe FieldValue
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
fieldNameKey KeyMap FieldValue
responseRow
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
"Unable to find expected field " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Key -> Text
K.toText Key
fieldNameKey Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in row returned by Data Connector agent")
Encoding
reshapedField <- AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector)
-> m FieldValue -> m Encoding
forall (m :: * -> *).
MonadError QErr m =>
AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector)
-> m FieldValue -> m Encoding
reshapeField AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector)
field m FieldValue
responseField
(Text, Encoding) -> m (Text, Encoding)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
fieldNameText, Encoding
reshapedField)
Encoding -> m Encoding
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)]
reshapedFields
encodeAssocListAsObject :: [(Text, J.Encoding)] -> J.Encoding
encodeAssocListAsObject :: [(Text, Encoding)] -> Encoding
encodeAssocListAsObject =
(Text -> Encoding' Key)
-> (Encoding -> Encoding)
-> (forall a.
(Text -> Encoding -> a -> a) -> a -> [(Text, Encoding)] -> a)
-> [(Text, Encoding)]
-> Encoding
forall k v m.
(k -> Encoding' Key)
-> (v -> Encoding)
-> (forall a. (k -> v -> a -> a) -> a -> m -> a)
-> m
-> Encoding
JE.dict
Text -> Encoding' Key
forall a. Text -> Encoding' a
JE.text
Encoding -> Encoding
forall a. a -> a
id
(\Text -> Encoding -> a -> a
fn -> ((Text, Encoding) -> a -> a) -> a -> [(Text, Encoding)] -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Text -> Encoding -> a -> a) -> (Text, Encoding) -> a -> a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Encoding -> a -> a
fn))
reshapeField ::
MonadError QErr m =>
AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector) ->
m API.FieldValue ->
m J.Encoding
reshapeField :: AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector)
-> m FieldValue -> m Encoding
reshapeField AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector)
field m FieldValue
responseFieldValue =
case AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector)
field of
AFColumn AnnColumnField 'DataConnector (UnpreparedValue 'DataConnector)
_columnField -> do
Value
columnFieldValue <- FieldValue -> Value
API.deserializeAsColumnFieldValue (FieldValue -> Value) -> m FieldValue -> m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m FieldValue
responseFieldValue
Encoding -> m Encoding
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoding -> m Encoding) -> Encoding -> m Encoding
forall a b. (a -> b) -> a -> b
$ Value -> Encoding
forall a. ToJSON a => a -> Encoding
J.toEncoding Value
columnFieldValue
AFObjectRelation ObjectRelationSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
objectRelationField -> do
Either Text QueryResponse
relationshipFieldValue <- FieldValue -> Either Text QueryResponse
API.deserializeAsRelationshipFieldValue (FieldValue -> Either Text QueryResponse)
-> m FieldValue -> m (Either Text QueryResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m FieldValue
responseFieldValue
case Either Text QueryResponse
relationshipFieldValue of
Left Text
err -> Text -> m Encoding
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text -> m Encoding) -> Text -> m Encoding
forall a b. (a -> b) -> a -> b
$ Text
"Found column field value where relationship field value was expected in field returned by Data Connector agent: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err
Right QueryResponse
subqueryResponse ->
let fields :: Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
fields = AnnObjectSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
-> Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
forall (b :: BackendType) r v.
AnnObjectSelectG b r v -> AnnFieldsG b r v
_aosFields (AnnObjectSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
-> Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector)))
-> AnnObjectSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
-> Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
forall a b. (a -> b) -> a -> b
$ ObjectRelationSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
-> AnnObjectSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
forall (b :: BackendType) a. AnnRelationSelectG b a -> a
_aarAnnSelect ObjectRelationSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
objectRelationField
in Cardinality
-> Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
-> QueryResponse
-> m Encoding
forall (m :: * -> *).
MonadError QErr m =>
Cardinality
-> Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
-> QueryResponse
-> m Encoding
reshapeSimpleSelectRows Cardinality
Single Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
fields QueryResponse
subqueryResponse
AFArrayRelation (ASSimple ArrayRelationSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
simpleArrayRelationField) ->
(Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
-> QueryResponse -> m Encoding)
-> ArrayRelationSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
-> FieldValue
-> m Encoding
forall (m :: * -> *) (fieldType :: * -> *).
MonadError QErr m =>
(Fields (fieldType (UnpreparedValue 'DataConnector))
-> QueryResponse -> m Encoding)
-> AnnRelationSelectG
'DataConnector
(AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector))
-> FieldValue
-> m Encoding
reshapeAnnRelationSelect (Cardinality
-> Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
-> QueryResponse
-> m Encoding
forall (m :: * -> *).
MonadError QErr m =>
Cardinality
-> Fields
(AnnFieldG 'DataConnector Void (UnpreparedValue 'DataConnector))
-> QueryResponse
-> m Encoding
reshapeSimpleSelectRows Cardinality
Many) ArrayRelationSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
simpleArrayRelationField (FieldValue -> m Encoding) -> m FieldValue -> m Encoding
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m FieldValue
responseFieldValue
AFArrayRelation (ASAggregate ArrayAggregateSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
aggregateArrayRelationField) ->
(Fields
(TableAggregateFieldG
'DataConnector Void (UnpreparedValue 'DataConnector))
-> QueryResponse -> m Encoding)
-> ArrayAggregateSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
-> FieldValue
-> m Encoding
forall (m :: * -> *) (fieldType :: * -> *).
MonadError QErr m =>
(Fields (fieldType (UnpreparedValue 'DataConnector))
-> QueryResponse -> m Encoding)
-> AnnRelationSelectG
'DataConnector
(AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector))
-> FieldValue
-> m Encoding
reshapeAnnRelationSelect Fields
(TableAggregateFieldG
'DataConnector Void (UnpreparedValue 'DataConnector))
-> QueryResponse -> m Encoding
forall (m :: * -> *).
MonadError QErr m =>
Fields
(TableAggregateFieldG
'DataConnector Void (UnpreparedValue 'DataConnector))
-> QueryResponse -> m Encoding
reshapeTableAggregateFields ArrayAggregateSelectG
'DataConnector Void (UnpreparedValue 'DataConnector)
aggregateArrayRelationField (FieldValue -> m Encoding) -> m FieldValue -> m Encoding
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m FieldValue
responseFieldValue
AFExpression Text
txt -> Encoding -> m Encoding
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoding -> m Encoding) -> Encoding -> m Encoding
forall a b. (a -> b) -> a -> b
$ Text -> Encoding
forall a. Text -> Encoding' a
JE.text Text
txt
reshapeAnnRelationSelect ::
MonadError QErr m =>
(Fields (fieldType (UnpreparedValue 'DataConnector)) -> API.QueryResponse -> m J.Encoding) ->
AnnRelationSelectG 'DataConnector (AnnSelectG 'DataConnector fieldType (UnpreparedValue 'DataConnector)) ->
API.FieldValue ->
m J.Encoding
reshapeAnnRelationSelect :: (Fields (fieldType (UnpreparedValue 'DataConnector))
-> QueryResponse -> m Encoding)
-> AnnRelationSelectG
'DataConnector
(AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector))
-> FieldValue
-> m Encoding
reshapeAnnRelationSelect Fields (fieldType (UnpreparedValue 'DataConnector))
-> QueryResponse -> m Encoding
reshapeFields AnnRelationSelectG
'DataConnector
(AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector))
annRelationSelect FieldValue
fieldValue =
case FieldValue -> Either Text QueryResponse
API.deserializeAsRelationshipFieldValue FieldValue
fieldValue of
Left Text
err -> Text -> m Encoding
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text -> m Encoding) -> Text -> m Encoding
forall a b. (a -> b) -> a -> b
$ Text
"Found column field value where relationship field value was expected in field returned by Data Connector agent: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err
Right QueryResponse
subqueryResponse ->
let annSimpleSelect :: AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector)
annSimpleSelect = AnnRelationSelectG
'DataConnector
(AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector))
-> AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector)
forall (b :: BackendType) a. AnnRelationSelectG b a -> a
_aarAnnSelect AnnRelationSelectG
'DataConnector
(AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector))
annRelationSelect
in Fields (fieldType (UnpreparedValue 'DataConnector))
-> QueryResponse -> m Encoding
reshapeFields (AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector)
-> Fields (fieldType (UnpreparedValue 'DataConnector))
forall (b :: BackendType) (f :: * -> *) v.
AnnSelectG b f v -> Fields (f v)
_asnFields AnnSelectG
'DataConnector fieldType (UnpreparedValue 'DataConnector)
annSimpleSelect) QueryResponse
subqueryResponse