{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | Postgres Instances Types
--
-- Defines a 'Hasura.RQL.Types.Backend.Backend' type class instance for Postgres.
module Hasura.Backends.Postgres.Instances.Types
  (
  )
where

import Autodocodec (HasCodec)
import Data.Aeson (FromJSON)
import Data.Aeson qualified as J
import Data.Kind (Type)
import Data.Typeable
import Hasura.Backends.Postgres.Connection qualified as PG
import Hasura.Backends.Postgres.SQL.DML qualified as PG
import Hasura.Backends.Postgres.SQL.Types qualified as PG
import Hasura.Backends.Postgres.SQL.Value qualified as PG
import Hasura.Backends.Postgres.Types.BoolExp qualified as PG
import Hasura.Backends.Postgres.Types.CitusExtraTableMetadata qualified as Citus
import Hasura.Backends.Postgres.Types.ComputedField qualified as PG
import Hasura.Backends.Postgres.Types.Function qualified as PG
import Hasura.Backends.Postgres.Types.Insert qualified as PG (BackendInsert)
import Hasura.Backends.Postgres.Types.Update qualified as PG
import Hasura.Base.Error
import Hasura.Prelude
import Hasura.RQL.IR.BoolExp.AggregationPredicates qualified as Agg
import Hasura.RQL.Types.Backend
import Hasura.SQL.Backend
import Hasura.SQL.Tag

--------------------------------------------------------------------------------
-- PostgresBackend

-- | This class is an implementation detail of 'Backend'.
-- Some types of 'Backend' differ across different Postgres "kinds". This
-- class alllows each "kind" to specify its own specific implementation. All
-- common code is directly part of the `Backend` instance.
--
-- Note: Users shouldn't ever put this as a constraint. Use `Backend ('Postgres
-- pgKind)` instead.
class
  ( Representable (PgExtraTableMetadata pgKind),
    J.ToJSON (PgExtraTableMetadata pgKind),
    J.FromJSON (PgExtraTableMetadata pgKind)
  ) =>
  PostgresBackend (pgKind :: PostgresKind)
  where
  type PgExtraTableMetadata pgKind :: Type

instance PostgresBackend 'Vanilla where
  type PgExtraTableMetadata 'Vanilla = ()

instance PostgresBackend 'Citus where
  type PgExtraTableMetadata 'Citus = Citus.ExtraTableMetadata

instance PostgresBackend 'Cockroach where
  type PgExtraTableMetadata 'Cockroach = ()

----------------------------------------------------------------
-- Backend instance

instance
  ( HasTag ('Postgres pgKind),
    Typeable ('Postgres pgKind),
    PostgresBackend pgKind,
    FromJSON (BackendSourceKind ('Postgres pgKind)),
    HasCodec (BackendSourceKind ('Postgres pgKind))
  ) =>
  Backend ('Postgres pgKind)
  where
  type BackendConfig ('Postgres pgKind) = ()
  type SourceConfig ('Postgres pgKind) = PG.PGSourceConfig
  type SourceConnConfiguration ('Postgres pgKind) = PG.PostgresConnConfiguration
  type TableName ('Postgres pgKind) = PG.QualifiedTable
  type FunctionName ('Postgres pgKind) = PG.QualifiedFunction
  type FunctionArgument ('Postgres pgKind) = PG.FunctionArg
  type RawFunctionInfo ('Postgres pgKind) = PG.PGRawFunctionInfo
  type ConstraintName ('Postgres pgKind) = PG.ConstraintName
  type BasicOrderType ('Postgres pgKind) = PG.OrderType
  type NullsOrderType ('Postgres pgKind) = PG.NullsOrder
  type CountType ('Postgres pgKind) = PG.CountType
  type Column ('Postgres pgKind) = PG.PGCol
  type ScalarValue ('Postgres pgKind) = PG.PGScalarValue
  type ScalarType ('Postgres pgKind) = PG.PGScalarType
  type BooleanOperators ('Postgres pgKind) = PG.BooleanOperators
  type SQLExpression ('Postgres pgKind) = PG.SQLExp
  type ComputedFieldDefinition ('Postgres pgKind) = PG.ComputedFieldDefinition
  type ScalarSelectionArguments ('Postgres pgKind) = PG.ColumnOp

  type FunctionArgumentExp ('Postgres pgKind) = PG.ArgumentExp
  type ComputedFieldImplicitArguments ('Postgres pgKind) = PG.ComputedFieldImplicitArguments
  type ComputedFieldReturn ('Postgres pgKind) = PG.ComputedFieldReturn

  type BackendUpdate ('Postgres pgKind) = PG.BackendUpdate pgKind

  type AggregationPredicates ('Postgres pgKind) = Agg.AggregationPredicatesImplementation ('Postgres pgKind)

  type ExtraTableMetadata ('Postgres pgKind) = PgExtraTableMetadata pgKind
  type BackendInsert ('Postgres pgKind) = PG.BackendInsert pgKind

  type XComputedField ('Postgres pgKind) = XEnable
  type XRelay ('Postgres pgKind) = XEnable
  type XNodesAgg ('Postgres pgKind) = XEnable
  type XNestedInserts ('Postgres pgKind) = XEnable
  type XStreamingSubscription ('Postgres pgKind) = XEnable

  isComparableType :: ScalarType ('Postgres pgKind) -> Bool
isComparableType = ScalarType ('Postgres pgKind) -> Bool
PGScalarType -> Bool
PG.isComparableType
  isNumType :: ScalarType ('Postgres pgKind) -> Bool
isNumType = ScalarType ('Postgres pgKind) -> Bool
PGScalarType -> Bool
PG.isNumType
  textToScalarValue :: Maybe Text -> ScalarValue ('Postgres pgKind)
textToScalarValue = Maybe Text -> ScalarValue ('Postgres pgKind)
Maybe Text -> PGScalarValue
PG.textToScalarValue
  parseScalarValue :: ScalarType ('Postgres pgKind)
-> Value -> Either QErr (ScalarValue ('Postgres pgKind))
parseScalarValue ScalarType ('Postgres pgKind)
ty Value
val = (Value -> Parser PGScalarValue)
-> Value -> Either QErr PGScalarValue
forall (m :: * -> *) v a. QErrM m => (v -> Parser a) -> v -> m a
runAesonParser (PGScalarType -> Value -> Parser PGScalarValue
PG.parsePGValue ScalarType ('Postgres pgKind)
PGScalarType
ty) Value
val
  scalarValueToJSON :: ScalarValue ('Postgres pgKind) -> Value
scalarValueToJSON = ScalarValue ('Postgres pgKind) -> Value
PGScalarValue -> Value
PG.pgScalarValueToJson
  functionToTable :: FunctionName ('Postgres pgKind) -> TableName ('Postgres pgKind)
functionToTable = (FunctionName -> TableName)
-> QualifiedObject FunctionName -> QualifiedObject TableName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> TableName
PG.TableName (Text -> TableName)
-> (FunctionName -> Text) -> FunctionName -> TableName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionName -> Text
PG.getFunctionTxt)
  tableToFunction :: TableName ('Postgres pgKind) -> FunctionName ('Postgres pgKind)
tableToFunction = (TableName -> FunctionName)
-> QualifiedObject TableName -> QualifiedObject FunctionName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> FunctionName
PG.FunctionName (Text -> FunctionName)
-> (TableName -> Text) -> TableName -> FunctionName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableName -> Text
PG.getTableTxt)
  computedFieldFunction :: ComputedFieldDefinition ('Postgres pgKind)
-> FunctionName ('Postgres pgKind)
computedFieldFunction = ComputedFieldDefinition ('Postgres pgKind)
-> FunctionName ('Postgres pgKind)
ComputedFieldDefinition -> QualifiedObject FunctionName
PG._cfdFunction
  computedFieldReturnType :: ComputedFieldReturn ('Postgres pgKind)
-> ComputedFieldReturnType ('Postgres pgKind)
computedFieldReturnType = \case
    PG.CFRScalar scalarType -> ScalarType ('Postgres pgKind)
-> ComputedFieldReturnType ('Postgres pgKind)
forall (b :: BackendType).
ScalarType b -> ComputedFieldReturnType b
ReturnsScalar ScalarType ('Postgres pgKind)
PGScalarType
scalarType
    PG.CFRSetofTable table -> TableName ('Postgres pgKind)
-> ComputedFieldReturnType ('Postgres pgKind)
forall (b :: BackendType). TableName b -> ComputedFieldReturnType b
ReturnsTable TableName ('Postgres pgKind)
QualifiedObject TableName
table
  fromComputedFieldImplicitArguments :: v
-> ComputedFieldImplicitArguments ('Postgres pgKind)
-> [FunctionArgumentExp ('Postgres pgKind) v]
fromComputedFieldImplicitArguments = v
-> ComputedFieldImplicitArguments ('Postgres pgKind)
-> [FunctionArgumentExp ('Postgres pgKind) v]
forall v. v -> ComputedFieldImplicitArguments -> [ArgumentExp v]
PG.fromComputedFieldImplicitArguments

  tableGraphQLName :: TableName ('Postgres pgKind) -> Either QErr Name
tableGraphQLName = TableName ('Postgres pgKind) -> Either QErr Name
forall a (m :: * -> *).
(ToTxt a, MonadError QErr m) =>
QualifiedObject a -> m Name
PG.qualifiedObjectToName
  functionGraphQLName :: FunctionName ('Postgres pgKind) -> Either QErr Name
functionGraphQLName = FunctionName ('Postgres pgKind) -> Either QErr Name
forall a (m :: * -> *).
(ToTxt a, MonadError QErr m) =>
QualifiedObject a -> m Name
PG.qualifiedObjectToName

  snakeCaseTableName :: TableName ('Postgres pgKind) -> Text
snakeCaseTableName = TableName ('Postgres pgKind) -> Text
forall a. ToTxt a => QualifiedObject a -> Text
PG.snakeCaseQualifiedObject
  getTableIdentifier :: TableName ('Postgres pgKind) -> Either QErr GQLNameIdentifier
getTableIdentifier = TableName ('Postgres pgKind) -> Either QErr GQLNameIdentifier
forall a.
ToTxt a =>
QualifiedObject a -> Either QErr GQLNameIdentifier
PG.getIdentifierQualifiedObject
  namingConventionSupport :: SupportedNamingCase
namingConventionSupport = SupportedNamingCase
PG.namingConventionSupport