{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}

-- | This module contains Data Connector request/response planning code and utility
-- functions and types that are common across the different categories of requests
-- (ie queries, mutations, etc). It contains code and concepts that are independent
-- of these different categories.
--
-- Both 'Hasura.Backends.DataConnector.Plan.QueryPlan' and
-- 'Hasura.Backends.DataConnector.Plan.MutationPlan' use the contents of this module,
-- for example 'Hasura.Backends.DataConnector.Plan.QueryPlan.mkQueryPlan`.
module Hasura.Backends.DataConnector.Plan.Common
  ( Plan (..),
    TableRelationships (..),
    TableRelationshipsKey (..),
    FieldPrefix,
    noPrefix,
    prefixWith,
    applyPrefix,
    Cardinality (..),
    recordTableRelationship,
    recordTableRelationshipFromRelInfo,
    prepareLiteral,
    translateBoolExpToExpression,
    mkRelationshipName,
    mapFieldNameHashMap,
    encodeAssocListAsObject,
  )
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.Types qualified as J
import Data.Bifunctor (Bifunctor (bimap))
import Data.ByteString qualified as BS
import Data.Has
import Data.HashMap.Strict qualified as HashMap
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Text qualified as T
import Data.Text.Encoding qualified as TE
import Data.Text.Extended (toTxt, (<<>), (<>>))
import Hasura.Backends.DataConnector.API qualified as API
import Hasura.Backends.DataConnector.Adapter.Backend
import Hasura.Backends.DataConnector.Adapter.Types
import Hasura.Base.Error
import Hasura.Prelude
import Hasura.RQL.IR.BoolExp
import Hasura.RQL.IR.Value
import Hasura.RQL.Types.Backend (SessionVarType)
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Relationships.Local (RelInfo (..), RelTarget (..))
import Hasura.SQL.Types (CollectableType (..))
import Hasura.Session
import Witch qualified

--------------------------------------------------------------------------------

-- | Represents a 'request' to be sent to a data connector agent ('_pRequest') and a function
-- that is capable of reshaping the response to that request into the final JSON form expected
-- to be returned by the GraphQL endpoint ('_pResponseReshaper').
data Plan request response = Plan
  { forall request response. Plan request response -> request
_pRequest :: request,
    forall request response.
Plan request response
-> forall (m :: * -> *).
   MonadError QErr m =>
   response -> m Encoding
_pResponseReshaper :: forall m. (MonadError QErr m) => response -> m J.Encoding
  }

--------------------------------------------------------------------------------

-- | Key datatype for TableRelationships to avoid having an Either directly as the key,
--   and make extending the types of relationships easier in future.
data TableRelationshipsKey
  = FunctionNameKey API.FunctionName
  | TableNameKey API.TableName
  deriving stock (TableRelationshipsKey -> TableRelationshipsKey -> Bool
(TableRelationshipsKey -> TableRelationshipsKey -> Bool)
-> (TableRelationshipsKey -> TableRelationshipsKey -> Bool)
-> Eq TableRelationshipsKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TableRelationshipsKey -> TableRelationshipsKey -> Bool
== :: TableRelationshipsKey -> TableRelationshipsKey -> Bool
$c/= :: TableRelationshipsKey -> TableRelationshipsKey -> Bool
/= :: TableRelationshipsKey -> TableRelationshipsKey -> Bool
Eq, Int -> TableRelationshipsKey -> ShowS
[TableRelationshipsKey] -> ShowS
TableRelationshipsKey -> String
(Int -> TableRelationshipsKey -> ShowS)
-> (TableRelationshipsKey -> String)
-> ([TableRelationshipsKey] -> ShowS)
-> Show TableRelationshipsKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TableRelationshipsKey -> ShowS
showsPrec :: Int -> TableRelationshipsKey -> ShowS
$cshow :: TableRelationshipsKey -> String
show :: TableRelationshipsKey -> String
$cshowList :: [TableRelationshipsKey] -> ShowS
showList :: [TableRelationshipsKey] -> ShowS
Show, (forall x. TableRelationshipsKey -> Rep TableRelationshipsKey x)
-> (forall x. Rep TableRelationshipsKey x -> TableRelationshipsKey)
-> Generic TableRelationshipsKey
forall x. Rep TableRelationshipsKey x -> TableRelationshipsKey
forall x. TableRelationshipsKey -> Rep TableRelationshipsKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TableRelationshipsKey -> Rep TableRelationshipsKey x
from :: forall x. TableRelationshipsKey -> Rep TableRelationshipsKey x
$cto :: forall x. Rep TableRelationshipsKey x -> TableRelationshipsKey
to :: forall x. Rep TableRelationshipsKey x -> TableRelationshipsKey
Generic)
  deriving anyclass (Eq TableRelationshipsKey
Eq TableRelationshipsKey
-> (Int -> TableRelationshipsKey -> Int)
-> (TableRelationshipsKey -> Int)
-> Hashable TableRelationshipsKey
Int -> TableRelationshipsKey -> Int
TableRelationshipsKey -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> TableRelationshipsKey -> Int
hashWithSalt :: Int -> TableRelationshipsKey -> Int
$chash :: TableRelationshipsKey -> Int
hash :: TableRelationshipsKey -> Int
Hashable)

-- | A monoidal data structure used to record Table Relationships encountered during request
-- translation. Used with 'recordTableRelationship'.
newtype TableRelationships = TableRelationships
  {TableRelationships
-> HashMap
     TableRelationshipsKey (HashMap RelationshipName Relationship)
unTableRelationships :: HashMap TableRelationshipsKey (HashMap API.RelationshipName API.Relationship)}
  deriving stock (TableRelationships -> TableRelationships -> Bool
(TableRelationships -> TableRelationships -> Bool)
-> (TableRelationships -> TableRelationships -> Bool)
-> Eq TableRelationships
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TableRelationships -> TableRelationships -> Bool
== :: TableRelationships -> TableRelationships -> Bool
$c/= :: TableRelationships -> TableRelationships -> Bool
/= :: TableRelationships -> TableRelationships -> Bool
Eq, Int -> TableRelationships -> ShowS
[TableRelationships] -> ShowS
TableRelationships -> String
(Int -> TableRelationships -> ShowS)
-> (TableRelationships -> String)
-> ([TableRelationships] -> ShowS)
-> Show TableRelationships
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TableRelationships -> ShowS
showsPrec :: Int -> TableRelationships -> ShowS
$cshow :: TableRelationships -> String
show :: TableRelationships -> String
$cshowList :: [TableRelationships] -> ShowS
showList :: [TableRelationships] -> ShowS
Show)

instance Semigroup TableRelationships where
  (TableRelationships HashMap
  TableRelationshipsKey (HashMap RelationshipName Relationship)
l) <> :: TableRelationships -> TableRelationships -> TableRelationships
<> (TableRelationships HashMap
  TableRelationshipsKey (HashMap RelationshipName Relationship)
r) = HashMap
  TableRelationshipsKey (HashMap RelationshipName Relationship)
-> TableRelationships
TableRelationships (HashMap
   TableRelationshipsKey (HashMap RelationshipName Relationship)
 -> TableRelationships)
-> HashMap
     TableRelationshipsKey (HashMap RelationshipName Relationship)
-> TableRelationships
forall a b. (a -> b) -> a -> b
$ (HashMap RelationshipName Relationship
 -> HashMap RelationshipName Relationship
 -> HashMap RelationshipName Relationship)
-> HashMap
     TableRelationshipsKey (HashMap RelationshipName Relationship)
-> HashMap
     TableRelationshipsKey (HashMap RelationshipName Relationship)
-> HashMap
     TableRelationshipsKey (HashMap RelationshipName Relationship)
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HashMap.unionWith HashMap RelationshipName Relationship
-> HashMap RelationshipName Relationship
-> HashMap RelationshipName Relationship
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
HashMap.union HashMap
  TableRelationshipsKey (HashMap RelationshipName Relationship)
l HashMap
  TableRelationshipsKey (HashMap RelationshipName Relationship)
r

instance Monoid TableRelationships where
  mempty :: TableRelationships
mempty = HashMap
  TableRelationshipsKey (HashMap RelationshipName Relationship)
-> TableRelationships
TableRelationships HashMap
  TableRelationshipsKey (HashMap RelationshipName Relationship)
forall a. Monoid a => a
mempty

-- | Records a table relationship encountered during request translation into the output of the current
-- 'CPS.WriterT'
recordTableRelationship ::
  ( Has TableRelationships writerOutput,
    Monoid writerOutput,
    MonadError QErr m
  ) =>
  TableRelationshipsKey ->
  API.RelationshipName ->
  API.Relationship ->
  CPS.WriterT writerOutput m ()
recordTableRelationship :: forall writerOutput (m :: * -> *).
(Has TableRelationships writerOutput, Monoid writerOutput,
 MonadError QErr m) =>
TableRelationshipsKey
-> RelationshipName -> Relationship -> WriterT writerOutput m ()
recordTableRelationship TableRelationshipsKey
sourceName RelationshipName
relationshipName Relationship
relationship =
  let newRelationship :: TableRelationships
newRelationship = HashMap
  TableRelationshipsKey (HashMap RelationshipName Relationship)
-> TableRelationships
TableRelationships (HashMap
   TableRelationshipsKey (HashMap RelationshipName Relationship)
 -> TableRelationships)
-> HashMap
     TableRelationshipsKey (HashMap RelationshipName Relationship)
-> TableRelationships
forall a b. (a -> b) -> a -> b
$ TableRelationshipsKey
-> HashMap RelationshipName Relationship
-> HashMap
     TableRelationshipsKey (HashMap RelationshipName Relationship)
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton TableRelationshipsKey
sourceName (RelationshipName
-> Relationship -> HashMap RelationshipName Relationship
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton RelationshipName
relationshipName Relationship
relationship)
   in writerOutput -> WriterT writerOutput m ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
CPS.tell (writerOutput -> WriterT writerOutput m ())
-> writerOutput -> WriterT writerOutput m ()
forall a b. (a -> b) -> a -> b
$ (TableRelationships -> TableRelationships)
-> writerOutput -> writerOutput
forall a t. Has a t => (a -> a) -> t -> t
modifier (TableRelationships -> TableRelationships -> TableRelationships
forall a b. a -> b -> a
const TableRelationships
newRelationship) writerOutput
forall a. Monoid a => a
mempty

recordTableRelationshipFromRelInfo ::
  ( Has TableRelationships writerOutput,
    Monoid writerOutput,
    MonadError QErr m
  ) =>
  TableRelationshipsKey ->
  RelInfo 'DataConnector ->
  CPS.WriterT writerOutput m (API.RelationshipName, API.Relationship)
recordTableRelationshipFromRelInfo :: forall writerOutput (m :: * -> *).
(Has TableRelationships writerOutput, Monoid writerOutput,
 MonadError QErr m) =>
TableRelationshipsKey
-> RelInfo 'DataConnector
-> WriterT writerOutput m (RelationshipName, Relationship)
recordTableRelationshipFromRelInfo TableRelationshipsKey
sourceTableName RelInfo {Bool
HashMap (Column 'DataConnector) (Column 'DataConnector)
InsertOrder
RelType
RelName
RelTarget 'DataConnector
riName :: RelName
riType :: RelType
riMapping :: HashMap (Column 'DataConnector) (Column 'DataConnector)
riTarget :: RelTarget 'DataConnector
riIsManual :: Bool
riInsertOrder :: InsertOrder
riName :: forall (b :: BackendType). RelInfo b -> RelName
riType :: forall (b :: BackendType). RelInfo b -> RelType
riMapping :: forall (b :: BackendType).
RelInfo b -> HashMap (Column b) (Column b)
riTarget :: forall (b :: BackendType). RelInfo b -> RelTarget b
riIsManual :: forall (b :: BackendType). RelInfo b -> Bool
riInsertOrder :: forall (b :: BackendType). RelInfo b -> InsertOrder
..} = do
  let relationshipName :: RelationshipName
relationshipName = RelName -> RelationshipName
mkRelationshipName RelName
riName
  let relationshipType :: RelationshipType
relationshipType = case RelType
riType of
        RelType
ObjRel -> RelationshipType
API.ObjectRelationship
        RelType
ArrRel -> RelationshipType
API.ArrayRelationship
  case RelTarget 'DataConnector
riTarget of
    RelTargetNativeQuery NativeQueryName
_ -> String -> WriterT writerOutput m (RelationshipName, Relationship)
forall a. HasCallStack => String -> a
error String
"recordTableRelationshipFromRelInfo RelTargetNativeQuery"
    RelTargetTable TableName 'DataConnector
targetTableName -> do
      let relationship :: Relationship
relationship =
            API.Relationship
              { _rTargetTable :: TableName
_rTargetTable = TableName -> TableName
forall source target. From source target => source -> target
Witch.from TableName 'DataConnector
TableName
targetTableName,
                _rRelationshipType :: RelationshipType
_rRelationshipType = RelationshipType
relationshipType,
                _rColumnMapping :: HashMap SourceColumnName SourceColumnName
_rColumnMapping = [(SourceColumnName, SourceColumnName)]
-> HashMap SourceColumnName SourceColumnName
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(SourceColumnName, SourceColumnName)]
 -> HashMap SourceColumnName SourceColumnName)
-> [(SourceColumnName, SourceColumnName)]
-> HashMap SourceColumnName SourceColumnName
forall a b. (a -> b) -> a -> b
$ (ColumnName -> SourceColumnName)
-> (ColumnName -> SourceColumnName)
-> (ColumnName, ColumnName)
-> (SourceColumnName, SourceColumnName)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ColumnName -> SourceColumnName
forall source target. From source target => source -> target
Witch.from ColumnName -> SourceColumnName
forall source target. From source target => source -> target
Witch.from ((ColumnName, ColumnName) -> (SourceColumnName, SourceColumnName))
-> [(ColumnName, ColumnName)]
-> [(SourceColumnName, SourceColumnName)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap ColumnName ColumnName -> [(ColumnName, ColumnName)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap (Column 'DataConnector) (Column 'DataConnector)
HashMap ColumnName ColumnName
riMapping
              }
      TableRelationshipsKey
-> RelationshipName -> Relationship -> WriterT writerOutput m ()
forall writerOutput (m :: * -> *).
(Has TableRelationships writerOutput, Monoid writerOutput,
 MonadError QErr m) =>
TableRelationshipsKey
-> RelationshipName -> Relationship -> WriterT writerOutput m ()
recordTableRelationship
        TableRelationshipsKey
sourceTableName
        RelationshipName
relationshipName
        Relationship
relationship
      (RelationshipName, Relationship)
-> WriterT writerOutput m (RelationshipName, Relationship)
forall a. a -> WriterT writerOutput m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationshipName
relationshipName, Relationship
relationship)

--------------------------------------------------------------------------------

-- | Represents a potential prefix that can be applied to a field name, useful for
-- namespacing field names that may be otherwise duplicated.
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
$cshowsPrec :: Int -> FieldPrefix -> ShowS
showsPrec :: Int -> FieldPrefix -> ShowS
$cshow :: FieldPrefix -> String
show :: FieldPrefix -> String
$cshowList :: [FieldPrefix] -> ShowS
showList :: [FieldPrefix] -> ShowS
Show, FieldPrefix -> FieldPrefix -> Bool
(FieldPrefix -> FieldPrefix -> Bool)
-> (FieldPrefix -> FieldPrefix -> Bool) -> Eq FieldPrefix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FieldPrefix -> FieldPrefix -> Bool
== :: FieldPrefix -> FieldPrefix -> Bool
$c/= :: FieldPrefix -> FieldPrefix -> Bool
/= :: 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

--------------------------------------------------------------------------------

data Cardinality
  = Single
  | Many

--------------------------------------------------------------------------------

prepareLiteral ::
  (MonadError QErr m, MonadReader r m, Has API.ScalarTypesCapabilities r) =>
  SessionVariables ->
  UnpreparedValue 'DataConnector ->
  m Literal
prepareLiteral :: forall (m :: * -> *) r.
(MonadError QErr m, MonadReader r m,
 Has ScalarTypesCapabilities r) =>
SessionVariables -> UnpreparedValue 'DataConnector -> m Literal
prepareLiteral SessionVariables
sessionVariables = \case
  UVLiteral SQLExpression 'DataConnector
literal -> SQLExpression 'DataConnector -> m (SQLExpression 'DataConnector)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SQLExpression 'DataConnector -> m (SQLExpression 'DataConnector))
-> SQLExpression 'DataConnector -> m (SQLExpression 'DataConnector)
forall a b. (a -> b) -> a -> b
$ SQLExpression 'DataConnector
literal
  UVParameter Provenance
_ ColumnValue 'DataConnector
e -> Literal -> m Literal
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScalarType -> Value -> Literal
ValueLiteral (ColumnType 'DataConnector -> ScalarType
columnTypeToScalarType (ColumnType 'DataConnector -> ScalarType)
-> ColumnType 'DataConnector -> ScalarType
forall a b. (a -> b) -> a -> b
$ ColumnValue 'DataConnector -> ColumnType 'DataConnector
forall (b :: BackendType). ColumnValue b -> ColumnType b
cvType ColumnValue 'DataConnector
e) (ColumnValue 'DataConnector -> ScalarValue 'DataConnector
forall (b :: BackendType). ColumnValue b -> ScalarValue b
cvValue ColumnValue 'DataConnector
e))
  UnpreparedValue 'DataConnector
UVSession -> Code -> Text -> m Literal
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"prepareLiteral: UVSession"
  UVSessionVar SessionVarType 'DataConnector
sessionVarType SessionVariable
sessionVar -> do
    Text
textValue <-
      SessionVariable -> SessionVariables -> Maybe Text
getSessionVariableValue SessionVariable
sessionVar SessionVariables
sessionVariables
        Maybe Text -> m Text -> m Text
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Code -> Text -> m Text
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported (Text
"prepareLiteral: session var not found: " Text -> SessionVariable -> Text
forall t. ToTxt t => Text -> t -> Text
<>> SessionVariable
sessionVar)
    SessionVariable
-> SessionVarType 'DataConnector -> Text -> m Literal
forall (m :: * -> *) r.
(MonadError QErr m, MonadReader r m,
 Has ScalarTypesCapabilities r) =>
SessionVariable
-> SessionVarType 'DataConnector -> Text -> m Literal
parseSessionVariable SessionVariable
sessionVar SessionVarType 'DataConnector
sessionVarType Text
textValue

parseSessionVariable ::
  forall m r.
  (MonadError QErr m, MonadReader r m, Has API.ScalarTypesCapabilities r) =>
  SessionVariable ->
  SessionVarType 'DataConnector ->
  Text ->
  m Literal
parseSessionVariable :: forall (m :: * -> *) r.
(MonadError QErr m, MonadReader r m,
 Has ScalarTypesCapabilities r) =>
SessionVariable
-> SessionVarType 'DataConnector -> Text -> m Literal
parseSessionVariable SessionVariable
varName SessionVarType 'DataConnector
varType Text
varValue = do
  ScalarTypesCapabilities
scalarTypesCapabilities <- (r -> ScalarTypesCapabilities) -> m ScalarTypesCapabilities
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> ScalarTypesCapabilities
forall a t. Has a t => t -> a
getter
  case SessionVarType 'DataConnector
varType of
    CollectableTypeScalar scalarType :: ScalarType 'DataConnector
scalarType@(ScalarType Text
customTypeName) ->
      ScalarTypesCapabilities -> ScalarType -> Text -> m Literal
parseCustomValue ScalarTypesCapabilities
scalarTypesCapabilities ScalarType 'DataConnector
ScalarType
scalarType (Text
customTypeName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" JSON value")
    CollectableTypeArray scalarType :: ScalarType 'DataConnector
scalarType@(ScalarType Text
customTypeName) ->
      ScalarTypesCapabilities -> ScalarType -> Text -> m Literal
parseCustomArray ScalarTypesCapabilities
scalarTypesCapabilities ScalarType 'DataConnector
ScalarType
scalarType (Text
"JSON array of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
customTypeName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" JSON values")
  where
    parseCustomValue :: API.ScalarTypesCapabilities -> ScalarType -> Text -> m Literal
    parseCustomValue :: ScalarTypesCapabilities -> ScalarType -> Text -> m Literal
parseCustomValue ScalarTypesCapabilities
scalarTypesCapabilities ScalarType
scalarType Text
description = do
      case ScalarTypesCapabilities -> ScalarType -> Maybe GraphQLType
lookupGraphQLType ScalarTypesCapabilities
scalarTypesCapabilities ScalarType
scalarType of
        Just GraphQLType
GraphQLString ->
          -- Special case for string: uses literal session variable value rather than trying to parse a JSON string
          Literal -> m Literal
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Literal -> m Literal) -> (Value -> Literal) -> Value -> m Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScalarType -> Value -> Literal
ValueLiteral ScalarType
scalarType (Value -> m Literal) -> Value -> m Literal
forall a b. (a -> b) -> a -> b
$ Text -> Value
J.String Text
varValue
        Maybe GraphQLType
_ ->
          (Value -> Parser Value) -> (Value -> Literal) -> Text -> m Literal
forall a.
(Value -> Parser a) -> (a -> Literal) -> Text -> m Literal
parseValue' (ScalarTypesCapabilities -> ScalarType -> Value -> Parser Value
parseValue ScalarTypesCapabilities
scalarTypesCapabilities ScalarType
scalarType) (ScalarType -> Value -> Literal
ValueLiteral ScalarType
scalarType) Text
description

    parseCustomArray :: API.ScalarTypesCapabilities -> ScalarType -> Text -> m Literal
    parseCustomArray :: ScalarTypesCapabilities -> ScalarType -> Text -> m Literal
parseCustomArray ScalarTypesCapabilities
scalarTypesCapabilities ScalarType
scalarType =
      (Value -> Parser [Value])
-> ([Value] -> Literal) -> Text -> m Literal
forall a.
(Value -> Parser a) -> (a -> Literal) -> Text -> m Literal
parseValue' Value -> Parser [Value]
parser (ScalarType -> [Value] -> Literal
ArrayLiteral ScalarType
scalarType)
      where
        parser :: (J.Value -> J.Parser [J.Value])
        parser :: Value -> Parser [Value]
parser = String -> (Array -> Parser [Value]) -> Value -> Parser [Value]
forall a. String -> (Array -> Parser a) -> Value -> Parser a
J.withArray String
"array of JSON values" ((Array -> [Value]) -> Parser Array -> Parser [Value]
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Array -> [Value]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Parser Array -> Parser [Value])
-> (Array -> Parser Array) -> Array -> Parser [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Parser Value) -> Array -> Parser Array
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Vector a -> f (Vector b)
traverse (ScalarTypesCapabilities -> ScalarType -> Value -> Parser Value
parseValue ScalarTypesCapabilities
scalarTypesCapabilities ScalarType
scalarType))

    parseValue' :: (J.Value -> J.Parser a) -> (a -> Literal) -> Text -> m Literal
    parseValue' :: forall a.
(Value -> Parser a) -> (a -> Literal) -> Text -> m Literal
parseValue' Value -> Parser a
parser a -> Literal
toLiteral Text
description =
      a -> Literal
toLiteral
        (a -> Literal) -> m a -> m Literal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
J.eitherDecodeStrict' ByteString
valValueBS Either String Value
-> (Value -> Either String a) -> Either String a
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Parser a) -> Value -> Either String a
forall a b. (a -> Parser b) -> a -> Either String b
J.parseEither Value -> Parser a
parser)
        Either String a -> (String -> m a) -> m a
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
`onLeft` (\String
err -> Code -> Text -> m a
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
ParseFailed (Text
"Expected " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
description Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" for session variable " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SessionVariable
varName SessionVariable -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
". " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
err))

    valValueBS :: BS.ByteString
    valValueBS :: ByteString
valValueBS = Text -> ByteString
TE.encodeUtf8 Text
varValue

--------------------------------------------------------------------------------

translateBoolExpToExpression ::
  ( Has TableRelationships writerOutput,
    Monoid writerOutput,
    MonadError QErr m,
    MonadReader r m,
    Has API.ScalarTypesCapabilities r
  ) =>
  SessionVariables ->
  TableRelationshipsKey ->
  AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector) ->
  CPS.WriterT writerOutput m (Maybe API.Expression)
translateBoolExpToExpression :: forall writerOutput (m :: * -> *) r.
(Has TableRelationships writerOutput, Monoid writerOutput,
 MonadError QErr m, MonadReader r m,
 Has ScalarTypesCapabilities r) =>
SessionVariables
-> TableRelationshipsKey
-> AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)
-> WriterT writerOutput m (Maybe Expression)
translateBoolExpToExpression SessionVariables
sessionVariables TableRelationshipsKey
sourceName AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)
boolExp = do
  Expression -> Maybe Expression
removeAlwaysTrueExpression (Expression -> Maybe Expression)
-> WriterT writerOutput m Expression
-> WriterT writerOutput m (Maybe Expression)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SessionVariables
-> TableRelationshipsKey
-> AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)
-> WriterT writerOutput m Expression
forall writerOutput (m :: * -> *) r.
(Has TableRelationships writerOutput, Monoid writerOutput,
 MonadError QErr m, MonadReader r m,
 Has ScalarTypesCapabilities r) =>
SessionVariables
-> TableRelationshipsKey
-> AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)
-> WriterT writerOutput m Expression
translateBoolExp SessionVariables
sessionVariables TableRelationshipsKey
sourceName AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)
boolExp

translateBoolExp ::
  ( Has TableRelationships writerOutput,
    Monoid writerOutput,
    MonadError QErr m,
    MonadReader r m,
    Has API.ScalarTypesCapabilities r
  ) =>
  SessionVariables ->
  TableRelationshipsKey ->
  AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector) ->
  CPS.WriterT writerOutput m API.Expression
translateBoolExp :: forall writerOutput (m :: * -> *) r.
(Has TableRelationships writerOutput, Monoid writerOutput,
 MonadError QErr m, MonadReader r m,
 Has ScalarTypesCapabilities r) =>
SessionVariables
-> TableRelationshipsKey
-> AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)
-> WriterT writerOutput m Expression
translateBoolExp SessionVariables
sessionVariables TableRelationshipsKey
sourceName = \case
  BoolAnd [AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)]
xs ->
    (Set Expression -> Expression) -> [Expression] -> Expression
mkIfZeroOrMany Set Expression -> Expression
API.And ([Expression] -> Expression)
-> ([Expression] -> [Expression]) -> [Expression] -> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expression -> Maybe Expression) -> [Expression] -> [Expression]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe Expression -> Maybe Expression
removeAlwaysTrueExpression ([Expression] -> Expression)
-> WriterT writerOutput m [Expression]
-> WriterT writerOutput m Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)
 -> WriterT writerOutput m Expression)
-> [AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)]
-> WriterT writerOutput m [Expression]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (TableRelationshipsKey
-> AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)
-> WriterT writerOutput m Expression
translateBoolExp' TableRelationshipsKey
sourceName) [AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)]
xs
  BoolOr [AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)]
xs ->
    (Set Expression -> Expression) -> [Expression] -> Expression
mkIfZeroOrMany Set Expression -> Expression
API.Or ([Expression] -> Expression)
-> ([Expression] -> [Expression]) -> [Expression] -> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expression -> Maybe Expression) -> [Expression] -> [Expression]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe Expression -> Maybe Expression
removeAlwaysFalseExpression ([Expression] -> Expression)
-> WriterT writerOutput m [Expression]
-> WriterT writerOutput m Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)
 -> WriterT writerOutput m Expression)
-> [AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)]
-> WriterT writerOutput m [Expression]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (TableRelationshipsKey
-> AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)
-> WriterT writerOutput m Expression
translateBoolExp' TableRelationshipsKey
sourceName) [AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)]
xs
  BoolNot AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)
x ->
    Expression -> Expression
API.Not (Expression -> Expression)
-> WriterT writerOutput m Expression
-> WriterT writerOutput m Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TableRelationshipsKey
-> AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)
-> WriterT writerOutput m Expression
translateBoolExp' TableRelationshipsKey
sourceName) AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)
x
  BoolField (AVColumn ColumnInfo 'DataConnector
c [OpExpG 'DataConnector (UnpreparedValue 'DataConnector)]
xs) ->
    m Expression -> WriterT writerOutput m Expression
forall (m :: * -> *) a. Monad m => m a -> WriterT writerOutput m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Expression -> WriterT writerOutput m Expression)
-> m Expression -> WriterT writerOutput m Expression
forall a b. (a -> b) -> a -> b
$ (Set Expression -> Expression) -> [Expression] -> Expression
mkIfZeroOrMany Set Expression -> Expression
API.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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (SessionVariables
-> SourceColumnName
-> ScalarType
-> OpExpG 'DataConnector (UnpreparedValue 'DataConnector)
-> m Expression
forall (m :: * -> *) r.
(MonadError QErr m, MonadReader r m,
 Has ScalarTypesCapabilities r) =>
SessionVariables
-> SourceColumnName
-> ScalarType
-> OpExpG 'DataConnector (UnpreparedValue 'DataConnector)
-> m Expression
translateOp SessionVariables
sessionVariables (ColumnName -> SourceColumnName
forall source target. From source target => source -> target
Witch.from (ColumnName -> SourceColumnName) -> ColumnName -> SourceColumnName
forall a b. (a -> b) -> a -> b
$ ColumnInfo 'DataConnector -> Column 'DataConnector
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn ColumnInfo 'DataConnector
c) (ScalarType -> ScalarType
forall source target. From source target => source -> target
Witch.from (ScalarType -> ScalarType)
-> (ColumnType 'DataConnector -> ScalarType)
-> ColumnType 'DataConnector
-> ScalarType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnType 'DataConnector -> ScalarType
columnTypeToScalarType (ColumnType 'DataConnector -> ScalarType)
-> ColumnType 'DataConnector -> ScalarType
forall a b. (a -> b) -> a -> b
$ ColumnInfo 'DataConnector -> ColumnType 'DataConnector
forall (b :: BackendType). ColumnInfo b -> ColumnType b
ciType ColumnInfo 'DataConnector
c)) [OpExpG 'DataConnector (UnpreparedValue 'DataConnector)]
xs
  BoolField (AVRelationship RelInfo 'DataConnector
relationshipInfo (RelationshipFilters {AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)
rfTargetTablePermissions :: AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)
rfTargetTablePermissions :: forall (backend :: BackendType) leaf.
RelationshipFilters backend leaf -> AnnBoolExp backend leaf
rfTargetTablePermissions, AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)
rfFilter :: AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)
rfFilter :: forall (backend :: BackendType) leaf.
RelationshipFilters backend leaf -> AnnBoolExp backend leaf
rfFilter})) -> do
    (RelationshipName
relationshipName, API.Relationship {HashMap SourceColumnName SourceColumnName
TableName
RelationshipType
_rTargetTable :: Relationship -> TableName
_rRelationshipType :: Relationship -> RelationshipType
_rColumnMapping :: Relationship -> HashMap SourceColumnName SourceColumnName
_rTargetTable :: TableName
_rRelationshipType :: RelationshipType
_rColumnMapping :: HashMap SourceColumnName SourceColumnName
..}) <- TableRelationshipsKey
-> RelInfo 'DataConnector
-> WriterT writerOutput m (RelationshipName, Relationship)
forall writerOutput (m :: * -> *).
(Has TableRelationships writerOutput, Monoid writerOutput,
 MonadError QErr m) =>
TableRelationshipsKey
-> RelInfo 'DataConnector
-> WriterT writerOutput m (RelationshipName, Relationship)
recordTableRelationshipFromRelInfo TableRelationshipsKey
sourceName RelInfo 'DataConnector
relationshipInfo
    -- TODO: How does this function keep track of the root table?
    ExistsInTable -> Expression -> Expression
API.Exists (RelationshipName -> ExistsInTable
API.RelatedTable RelationshipName
relationshipName) (Expression -> Expression)
-> WriterT writerOutput m Expression
-> WriterT writerOutput m Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TableRelationshipsKey
-> AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)
-> WriterT writerOutput m Expression
translateBoolExp' (TableName -> TableRelationshipsKey
TableNameKey TableName
_rTargetTable) ([AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)]
-> AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)
forall (backend :: BackendType) field.
[GBoolExp backend field] -> GBoolExp backend field
BoolAnd [AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)
rfTargetTablePermissions, AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)
rfFilter])
  BoolExists GExists {TableName 'DataConnector
AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)
_geTable :: TableName 'DataConnector
_geWhere :: AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)
_geTable :: forall (backend :: BackendType) field.
GExists backend field -> TableName backend
_geWhere :: forall (backend :: BackendType) field.
GExists backend field -> GBoolExp backend field
..} ->
    let tableName :: TableName
tableName = TableName -> TableName
forall source target. From source target => source -> target
Witch.from TableName 'DataConnector
TableName
_geTable
     in ExistsInTable -> Expression -> Expression
API.Exists (TableName -> ExistsInTable
API.UnrelatedTable TableName
tableName) (Expression -> Expression)
-> WriterT writerOutput m Expression
-> WriterT writerOutput m Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TableRelationshipsKey
-> AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)
-> WriterT writerOutput m Expression
translateBoolExp' (TableName -> TableRelationshipsKey
TableNameKey TableName
tableName) AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)
_geWhere
  where
    translateBoolExp' :: TableRelationshipsKey
-> AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)
-> WriterT writerOutput m Expression
translateBoolExp' = SessionVariables
-> TableRelationshipsKey
-> AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)
-> WriterT writerOutput m Expression
forall writerOutput (m :: * -> *) r.
(Has TableRelationships writerOutput, Monoid writerOutput,
 MonadError QErr m, MonadReader r m,
 Has ScalarTypesCapabilities r) =>
SessionVariables
-> TableRelationshipsKey
-> AnnBoolExp 'DataConnector (UnpreparedValue 'DataConnector)
-> WriterT writerOutput m Expression
translateBoolExp SessionVariables
sessionVariables

    -- Makes an 'API.Expression' like 'API.And' if there is zero or many input expressions otherwise
    -- just returns the singleton expression. This helps remove redundant 'API.And' etcs from the expression.
    mkIfZeroOrMany :: (Set API.Expression -> API.Expression) -> [API.Expression] -> API.Expression
    mkIfZeroOrMany :: (Set Expression -> Expression) -> [Expression] -> Expression
mkIfZeroOrMany Set Expression -> Expression
mk = \case
      [Expression
singleExp] -> Expression
singleExp
      [Expression]
zeroOrManyExps -> Set Expression -> Expression
mk (Set Expression -> Expression) -> Set Expression -> Expression
forall a b. (a -> b) -> a -> b
$ [Expression] -> Set Expression
forall a. Ord a => [a] -> Set a
Set.fromList [Expression]
zeroOrManyExps

removeAlwaysTrueExpression :: API.Expression -> Maybe API.Expression
removeAlwaysTrueExpression :: Expression -> Maybe Expression
removeAlwaysTrueExpression = \case
  API.And Set Expression
exprs | Set Expression
exprs Set Expression -> Set Expression -> Bool
forall a. Eq a => a -> a -> Bool
== Set Expression
forall a. Monoid a => a
mempty -> Maybe Expression
forall a. Maybe a
Nothing
  API.Not (API.Or Set Expression
exprs) | Set Expression
exprs Set Expression -> Set Expression -> Bool
forall a. Eq a => a -> a -> Bool
== Set Expression
forall a. Monoid a => a
mempty -> Maybe Expression
forall a. Maybe a
Nothing
  Expression
other -> Expression -> Maybe Expression
forall a. a -> Maybe a
Just Expression
other

removeAlwaysFalseExpression :: API.Expression -> Maybe API.Expression
removeAlwaysFalseExpression :: Expression -> Maybe Expression
removeAlwaysFalseExpression = \case
  API.Or Set Expression
exprs | Set Expression
exprs Set Expression -> Set Expression -> Bool
forall a. Eq a => a -> a -> Bool
== Set Expression
forall a. Monoid a => a
mempty -> Maybe Expression
forall a. Maybe a
Nothing
  API.Not (API.And Set Expression
exprs) | Set Expression
exprs Set Expression -> Set Expression -> Bool
forall a. Eq a => a -> a -> Bool
== Set Expression
forall a. Monoid a => a
mempty -> Maybe Expression
forall a. Maybe a
Nothing
  Expression
other -> Expression -> Maybe Expression
forall a. a -> Maybe a
Just Expression
other

translateOp ::
  (MonadError QErr m, MonadReader r m, Has API.ScalarTypesCapabilities r) =>
  SessionVariables ->
  API.ColumnName ->
  API.ScalarType ->
  OpExpG 'DataConnector (UnpreparedValue 'DataConnector) ->
  m API.Expression
translateOp :: forall (m :: * -> *) r.
(MonadError QErr m, MonadReader r m,
 Has ScalarTypesCapabilities r) =>
SessionVariables
-> SourceColumnName
-> ScalarType
-> OpExpG 'DataConnector (UnpreparedValue 'DataConnector)
-> m Expression
translateOp SessionVariables
sessionVariables SourceColumnName
columnName ScalarType
columnType 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> OpExpG 'DataConnector a -> f (OpExpG 'DataConnector b)
traverse (SessionVariables -> UnpreparedValue 'DataConnector -> m Literal
forall (m :: * -> *) r.
(MonadError QErr m, MonadReader r m,
 Has ScalarTypesCapabilities r) =>
SessionVariables -> UnpreparedValue 'DataConnector -> m Literal
prepareLiteral SessionVariables
sessionVariables) (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 ComparisonNullability
_ (ValueLiteral ScalarType
scalarType Value
value) ->
      Expression -> m Expression
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ BinaryComparisonOperator -> Value -> ScalarType -> Expression
mkApplyBinaryComparisonOperatorToScalar BinaryComparisonOperator
API.Equal Value
value ScalarType
scalarType
    AEQ ComparisonNullability
_ (ArrayLiteral ScalarType
_scalarType [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 ComparisonNullability
_ (ValueLiteral ScalarType
scalarType Value
value) ->
      Expression -> m Expression
forall a. a -> m a
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
API.Not (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ BinaryComparisonOperator -> Value -> ScalarType -> Expression
mkApplyBinaryComparisonOperatorToScalar BinaryComparisonOperator
API.Equal Value
value ScalarType
scalarType
    ANE ComparisonNullability
_ (ArrayLiteral ScalarType
_scalarType [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 (ValueLiteral ScalarType
scalarType Value
value) ->
      Expression -> m Expression
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ BinaryComparisonOperator -> Value -> ScalarType -> Expression
mkApplyBinaryComparisonOperatorToScalar BinaryComparisonOperator
API.GreaterThan Value
value ScalarType
scalarType
    AGT (ArrayLiteral ScalarType
_scalarType [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 (ValueLiteral ScalarType
scalarType Value
value) ->
      Expression -> m Expression
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ BinaryComparisonOperator -> Value -> ScalarType -> Expression
mkApplyBinaryComparisonOperatorToScalar BinaryComparisonOperator
API.LessThan Value
value ScalarType
scalarType
    ALT (ArrayLiteral ScalarType
_scalarType [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 (ValueLiteral ScalarType
scalarType Value
value) ->
      Expression -> m Expression
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ BinaryComparisonOperator -> Value -> ScalarType -> Expression
mkApplyBinaryComparisonOperatorToScalar BinaryComparisonOperator
API.GreaterThanOrEqual Value
value ScalarType
scalarType
    AGTE (ArrayLiteral ScalarType
_scalarType [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 (ValueLiteral ScalarType
scalarType Value
value) ->
      Expression -> m Expression
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ BinaryComparisonOperator -> Value -> ScalarType -> Expression
mkApplyBinaryComparisonOperatorToScalar BinaryComparisonOperator
API.LessThanOrEqual Value
value ScalarType
scalarType
    ALTE (ArrayLiteral ScalarType
_scalarType [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 a. a -> m a
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
API.ApplyUnaryComparisonOperator UnaryComparisonOperator
API.IsNull ComparisonColumn
currentComparisonColumn
    OpExpG 'DataConnector Literal
ANISNOTNULL ->
      Expression -> m Expression
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ Expression -> Expression
API.Not (UnaryComparisonOperator -> ComparisonColumn -> Expression
API.ApplyUnaryComparisonOperator UnaryComparisonOperator
API.IsNull ComparisonColumn
currentComparisonColumn)
    AIN Literal
literal -> Expression -> m Expression
forall a. a -> m a
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 a. a -> m a
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
API.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 a. a -> m a
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
API.Equal RootOrCurrentColumn 'DataConnector
rootOrCurrentColumn
    CNE RootOrCurrentColumn 'DataConnector
rootOrCurrentColumn ->
      Expression -> m Expression
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ Expression -> Expression
API.Not (Expression -> Expression) -> Expression -> Expression
forall a b. (a -> b) -> a -> b
$ BinaryComparisonOperator
-> RootOrCurrentColumn 'DataConnector -> Expression
mkApplyBinaryComparisonOperatorToAnotherColumn BinaryComparisonOperator
API.Equal RootOrCurrentColumn 'DataConnector
rootOrCurrentColumn
    CGT RootOrCurrentColumn 'DataConnector
rootOrCurrentColumn ->
      Expression -> m Expression
forall a. a -> m a
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
API.GreaterThan RootOrCurrentColumn 'DataConnector
rootOrCurrentColumn
    CLT RootOrCurrentColumn 'DataConnector
rootOrCurrentColumn ->
      Expression -> m Expression
forall a. a -> m a
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
API.LessThan RootOrCurrentColumn 'DataConnector
rootOrCurrentColumn
    CGTE RootOrCurrentColumn 'DataConnector
rootOrCurrentColumn ->
      Expression -> m Expression
forall a. a -> m a
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
API.GreaterThanOrEqual RootOrCurrentColumn 'DataConnector
rootOrCurrentColumn
    CLTE RootOrCurrentColumn 'DataConnector
rootOrCurrentColumn ->
      Expression -> m Expression
forall a. a -> m a
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
API.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 {Maybe (Either (RootOrCurrentColumn 'DataConnector) Literal)
Text
_cboName :: Text
_cboRHS :: Maybe (Either (RootOrCurrentColumn 'DataConnector) Literal)
_cboName :: forall a. CustomBooleanOperator a -> Text
_cboRHS :: forall a.
CustomBooleanOperator a
-> Maybe (Either (RootOrCurrentColumn 'DataConnector) a)
..} -> case Maybe (Either (RootOrCurrentColumn 'DataConnector) Literal)
_cboRHS of
      Maybe (Either (RootOrCurrentColumn 'DataConnector) Literal)
Nothing -> Expression -> m Expression
forall a. a -> m a
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
API.ApplyUnaryComparisonOperator (Text -> UnaryComparisonOperator
API.CustomUnaryComparisonOperator Text
_cboName) ComparisonColumn
currentComparisonColumn
      Just (Left RootOrCurrentColumn 'DataConnector
rootOrCurrentColumn) ->
        Expression -> m Expression
forall a. a -> m a
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
API.CustomBinaryComparisonOperator Text
_cboName) RootOrCurrentColumn 'DataConnector
rootOrCurrentColumn
      Just (Right (ValueLiteral ScalarType
scalarType Value
value)) ->
        Expression -> m Expression
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ BinaryComparisonOperator -> Value -> ScalarType -> Expression
mkApplyBinaryComparisonOperatorToScalar (Text -> BinaryComparisonOperator
API.CustomBinaryComparisonOperator Text
_cboName) Value
value ScalarType
scalarType
      Just (Right (ArrayLiteral ScalarType
scalarType [Value]
array)) ->
        Expression -> m Expression
forall a. a -> m a
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] -> ScalarType -> Expression
API.ApplyBinaryArrayComparisonOperator (Text -> BinaryArrayComparisonOperator
API.CustomBinaryArrayComparisonOperator Text
_cboName) ComparisonColumn
currentComparisonColumn [Value]
array (ScalarType -> ScalarType
forall source target. From source target => source -> target
Witch.from ScalarType
scalarType)
  where
    currentComparisonColumn :: API.ComparisonColumn
    currentComparisonColumn :: ComparisonColumn
currentComparisonColumn = ColumnPath -> SourceColumnName -> ScalarType -> ComparisonColumn
API.ComparisonColumn ColumnPath
API.CurrentTable SourceColumnName
columnName ScalarType
columnType

    mkApplyBinaryComparisonOperatorToAnotherColumn :: API.BinaryComparisonOperator -> RootOrCurrentColumn 'DataConnector -> API.Expression
    mkApplyBinaryComparisonOperatorToAnotherColumn :: BinaryComparisonOperator
-> RootOrCurrentColumn 'DataConnector -> Expression
mkApplyBinaryComparisonOperatorToAnotherColumn BinaryComparisonOperator
operator (RootOrCurrentColumn RootOrCurrent
rootOrCurrent Column 'DataConnector
otherColumnName) =
      let columnPath :: ColumnPath
columnPath = case RootOrCurrent
rootOrCurrent of
            RootOrCurrent
IsRoot -> ColumnPath
API.QueryTable
            RootOrCurrent
IsCurrent -> ColumnPath
API.CurrentTable
       in BinaryComparisonOperator
-> ComparisonColumn -> ComparisonValue -> Expression
API.ApplyBinaryComparisonOperator BinaryComparisonOperator
operator ComparisonColumn
currentComparisonColumn (ComparisonColumn -> ComparisonValue
API.AnotherColumnComparison (ComparisonColumn -> ComparisonValue)
-> ComparisonColumn -> ComparisonValue
forall a b. (a -> b) -> a -> b
$ ColumnPath -> SourceColumnName -> ScalarType -> ComparisonColumn
API.ComparisonColumn ColumnPath
columnPath (ColumnName -> SourceColumnName
forall source target. From source target => source -> target
Witch.from Column 'DataConnector
ColumnName
otherColumnName) ScalarType
columnType)

    inOperator :: Literal -> API.Expression
    inOperator :: Literal -> Expression
inOperator Literal
literal =
      let ([Value]
values, ScalarType
scalarType) = case Literal
literal of
            ArrayLiteral ScalarType
scalarType' [Value]
array -> ([Value]
array, ScalarType
scalarType')
            ValueLiteral ScalarType
scalarType' Value
value -> ([Value
value], ScalarType
scalarType')
       in BinaryArrayComparisonOperator
-> ComparisonColumn -> [Value] -> ScalarType -> Expression
API.ApplyBinaryArrayComparisonOperator BinaryArrayComparisonOperator
API.In ComparisonColumn
currentComparisonColumn [Value]
values (ScalarType -> ScalarType
forall source target. From source target => source -> target
Witch.from ScalarType
scalarType)

    mkApplyBinaryComparisonOperatorToScalar :: API.BinaryComparisonOperator -> J.Value -> ScalarType -> API.Expression
    mkApplyBinaryComparisonOperatorToScalar :: BinaryComparisonOperator -> Value -> ScalarType -> Expression
mkApplyBinaryComparisonOperatorToScalar BinaryComparisonOperator
operator Value
value ScalarType
scalarType =
      BinaryComparisonOperator
-> ComparisonColumn -> ComparisonValue -> Expression
API.ApplyBinaryComparisonOperator BinaryComparisonOperator
operator ComparisonColumn
currentComparisonColumn (ScalarValue -> ComparisonValue
API.ScalarValueComparison (ScalarValue -> ComparisonValue) -> ScalarValue -> ComparisonValue
forall a b. (a -> b) -> a -> b
$ Value -> ScalarType -> ScalarValue
API.ScalarValue Value
value (ScalarType -> ScalarType
forall source target. From source target => source -> target
Witch.from ScalarType
scalarType))

--------------------------------------------------------------------------------

mkRelationshipName :: RelName -> API.RelationshipName
mkRelationshipName :: RelName -> RelationshipName
mkRelationshipName RelName
relName = Text -> RelationshipName
API.RelationshipName (Text -> RelationshipName) -> Text -> RelationshipName
forall a b. (a -> b) -> a -> b
$ RelName -> Text
forall a. ToTxt a => a -> Text
toTxt RelName
relName

mapFieldNameHashMap :: HashMap FieldName v -> HashMap API.FieldName v
mapFieldNameHashMap :: forall v. HashMap FieldName v -> HashMap FieldName v
mapFieldNameHashMap = (FieldName -> FieldName)
-> HashMap FieldName v -> HashMap FieldName v
forall k2 k1 v.
(Eq k2, Hashable k2) =>
(k1 -> k2) -> HashMap k1 v -> HashMap k2 v
HashMap.mapKeys (Text -> FieldName
API.FieldName (Text -> FieldName)
-> (FieldName -> Text) -> FieldName -> FieldName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldName -> Text
getFieldNameTxt)

--------------------------------------------------------------------------------

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 a b. (a -> b -> b) -> b -> [a] -> b
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))