{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

module Hasura.RQL.Types.SourceCustomization
  ( SourceTypeCustomization,
    RootFieldsCustomization (..),
    mkCustomizedTypename,
    emptySourceCustomization,
    getSourceTypeCustomization,
    getRootFieldsCustomization,
    getRootFieldsCustomizer,
    SourceCustomization (..),
    withSourceCustomization,
    MkRootFieldName (..),
    CustomizeRemoteFieldName (..),
    withRemoteFieldNameCustomization,

    -- * Naming Convention specific
    applyEnumValueCase,
    applyFieldNameCaseCust,
    applyTypeNameCaseCust,
    applyFieldNameCaseIdentifier,
    applyTypeNameCaseIdentifier,
    getNamingConvention,
    getTextFieldName,
    getTextTypeName,

    -- * Field name builders
    mkSelectField,
    mkSelectAggregateField,
    mkSelectByPkField,
    mkSelectStreamField,
    mkInsertField,
    mkInsertOneField,
    mkUpdateField,
    mkUpdateByPkField,
    mkUpdateManyField,
    mkDeleteField,
    mkDeleteByPkField,
    mkRelayConnectionField,

    -- * Type name builders
    mkMultiRowUpdateTypeName,
    mkOnConflictTypeName,
    mkTableConstraintTypeName,
    mkTableAggregateTypeName,
    mkFunctionArgsTypeName,
    mkTableBoolExpTypeName,
    mkTableTypeName,
    mkTableInsertInputTypeName,
    mkTableObjRelInsertInputTypeName,
    mkTableArrRelInsertInputTypeName,
    mkTableMutationResponseTypeName,
    mkTableOrderByTypeName,
    mkTableAggregateOrderByTypeName,
    mkTableAggregateFieldTypeName,
    mkTableAggOperatorTypeName,
    mkTableSelectColumnTypeName,
    mkTableUpdateColumnTypeName,
    mkTableOperatorInputTypeName,
    mkTablePkColumnsInputTypeName,
    mkEnumTableTypeName,
  )
where

import Autodocodec (HasCodec (codec), named)
import Control.Lens
import Data.Aeson.Extended
import Data.Has
import Data.List.NonEmpty qualified as NE
import Data.Monoid
import Data.Text qualified as T
import Data.Text.Casing (GQLNameIdentifier (..))
import Data.Text.Casing qualified as C
import Hasura.Base.Error (Code (NotSupported), QErr, throw400)
import Hasura.GraphQL.Schema.NamingCase
import Hasura.GraphQL.Schema.Typename
import Hasura.Incremental.Internal.Dependency (Cacheable)
import Hasura.Metadata.DTO.Placeholder (placeholderCodecViaJSON)
import Hasura.Name qualified as Name
import Hasura.Prelude
import Hasura.RQL.Types.Backend (SupportedNamingCase (..))
import Hasura.RQL.Types.Instances ()
import Language.GraphQL.Draft.Syntax qualified as G

data RootFieldsCustomization = RootFieldsCustomization
  { RootFieldsCustomization -> Maybe Name
_rootfcNamespace :: Maybe G.Name,
    RootFieldsCustomization -> Maybe Name
_rootfcPrefix :: Maybe G.Name,
    RootFieldsCustomization -> Maybe Name
_rootfcSuffix :: Maybe G.Name
  }
  deriving (RootFieldsCustomization -> RootFieldsCustomization -> Bool
(RootFieldsCustomization -> RootFieldsCustomization -> Bool)
-> (RootFieldsCustomization -> RootFieldsCustomization -> Bool)
-> Eq RootFieldsCustomization
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RootFieldsCustomization -> RootFieldsCustomization -> Bool
$c/= :: RootFieldsCustomization -> RootFieldsCustomization -> Bool
== :: RootFieldsCustomization -> RootFieldsCustomization -> Bool
$c== :: RootFieldsCustomization -> RootFieldsCustomization -> Bool
Eq, Int -> RootFieldsCustomization -> ShowS
[RootFieldsCustomization] -> ShowS
RootFieldsCustomization -> String
(Int -> RootFieldsCustomization -> ShowS)
-> (RootFieldsCustomization -> String)
-> ([RootFieldsCustomization] -> ShowS)
-> Show RootFieldsCustomization
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RootFieldsCustomization] -> ShowS
$cshowList :: [RootFieldsCustomization] -> ShowS
show :: RootFieldsCustomization -> String
$cshow :: RootFieldsCustomization -> String
showsPrec :: Int -> RootFieldsCustomization -> ShowS
$cshowsPrec :: Int -> RootFieldsCustomization -> ShowS
Show, (forall x.
 RootFieldsCustomization -> Rep RootFieldsCustomization x)
-> (forall x.
    Rep RootFieldsCustomization x -> RootFieldsCustomization)
-> Generic RootFieldsCustomization
forall x. Rep RootFieldsCustomization x -> RootFieldsCustomization
forall x. RootFieldsCustomization -> Rep RootFieldsCustomization x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RootFieldsCustomization x -> RootFieldsCustomization
$cfrom :: forall x. RootFieldsCustomization -> Rep RootFieldsCustomization x
Generic)

instance Cacheable RootFieldsCustomization

instance ToJSON RootFieldsCustomization where
  toJSON :: RootFieldsCustomization -> Value
toJSON = Options -> RootFieldsCustomization -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON {omitNothingFields :: Bool
omitNothingFields = Bool
True}

instance FromJSON RootFieldsCustomization where
  parseJSON :: Value -> Parser RootFieldsCustomization
parseJSON = Options -> Value -> Parser RootFieldsCustomization
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON

emptyRootFieldsCustomization :: RootFieldsCustomization
emptyRootFieldsCustomization :: RootFieldsCustomization
emptyRootFieldsCustomization = Maybe Name -> Maybe Name -> Maybe Name -> RootFieldsCustomization
RootFieldsCustomization Maybe Name
forall a. Maybe a
Nothing Maybe Name
forall a. Maybe a
Nothing Maybe Name
forall a. Maybe a
Nothing

data SourceTypeCustomization = SourceTypeCustomization
  { SourceTypeCustomization -> Maybe Name
_stcPrefix :: Maybe G.Name,
    SourceTypeCustomization -> Maybe Name
_stcSuffix :: Maybe G.Name
  }
  deriving (SourceTypeCustomization -> SourceTypeCustomization -> Bool
(SourceTypeCustomization -> SourceTypeCustomization -> Bool)
-> (SourceTypeCustomization -> SourceTypeCustomization -> Bool)
-> Eq SourceTypeCustomization
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourceTypeCustomization -> SourceTypeCustomization -> Bool
$c/= :: SourceTypeCustomization -> SourceTypeCustomization -> Bool
== :: SourceTypeCustomization -> SourceTypeCustomization -> Bool
$c== :: SourceTypeCustomization -> SourceTypeCustomization -> Bool
Eq, Int -> SourceTypeCustomization -> ShowS
[SourceTypeCustomization] -> ShowS
SourceTypeCustomization -> String
(Int -> SourceTypeCustomization -> ShowS)
-> (SourceTypeCustomization -> String)
-> ([SourceTypeCustomization] -> ShowS)
-> Show SourceTypeCustomization
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SourceTypeCustomization] -> ShowS
$cshowList :: [SourceTypeCustomization] -> ShowS
show :: SourceTypeCustomization -> String
$cshow :: SourceTypeCustomization -> String
showsPrec :: Int -> SourceTypeCustomization -> ShowS
$cshowsPrec :: Int -> SourceTypeCustomization -> ShowS
Show, (forall x.
 SourceTypeCustomization -> Rep SourceTypeCustomization x)
-> (forall x.
    Rep SourceTypeCustomization x -> SourceTypeCustomization)
-> Generic SourceTypeCustomization
forall x. Rep SourceTypeCustomization x -> SourceTypeCustomization
forall x. SourceTypeCustomization -> Rep SourceTypeCustomization x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SourceTypeCustomization x -> SourceTypeCustomization
$cfrom :: forall x. SourceTypeCustomization -> Rep SourceTypeCustomization x
Generic)

instance Cacheable SourceTypeCustomization

instance ToJSON SourceTypeCustomization where
  toJSON :: SourceTypeCustomization -> Value
toJSON = Options -> SourceTypeCustomization -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON {omitNothingFields :: Bool
omitNothingFields = Bool
True}

instance FromJSON SourceTypeCustomization where
  parseJSON :: Value -> Parser SourceTypeCustomization
parseJSON = Options -> Value -> Parser SourceTypeCustomization
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON

emptySourceTypeCustomization :: SourceTypeCustomization
emptySourceTypeCustomization :: SourceTypeCustomization
emptySourceTypeCustomization = Maybe Name -> Maybe Name -> SourceTypeCustomization
SourceTypeCustomization Maybe Name
forall a. Maybe a
Nothing Maybe Name
forall a. Maybe a
Nothing

mkCustomizedTypename :: Maybe SourceTypeCustomization -> NamingCase -> MkTypename
mkCustomizedTypename :: Maybe SourceTypeCustomization -> NamingCase -> MkTypename
mkCustomizedTypename Maybe SourceTypeCustomization
stc NamingCase
tCase = (Name -> Name) -> MkTypename
MkTypename (Maybe SourceTypeCustomization -> NamingCase -> Name -> Name
applyTypeCust Maybe SourceTypeCustomization
stc NamingCase
tCase)

mkCustomizedFieldName :: Maybe RootFieldsCustomization -> NamingCase -> MkRootFieldName
mkCustomizedFieldName :: Maybe RootFieldsCustomization -> NamingCase -> MkRootFieldName
mkCustomizedFieldName Maybe RootFieldsCustomization
rtc NamingCase
tCase = (Name -> Name) -> MkRootFieldName
MkRootFieldName (Maybe RootFieldsCustomization -> NamingCase -> Name -> Name
applyFieldCust Maybe RootFieldsCustomization
rtc NamingCase
tCase)

-- | apply prefix and suffix to type name according to the source customization
applyTypeCust :: Maybe SourceTypeCustomization -> NamingCase -> (G.Name -> G.Name)
applyTypeCust :: Maybe SourceTypeCustomization -> NamingCase -> Name -> Name
applyTypeCust Maybe SourceTypeCustomization
Nothing NamingCase
_ = Name -> Name
forall a. a -> a
id
applyTypeCust (Just SourceTypeCustomization {Maybe Name
_stcSuffix :: Maybe Name
_stcPrefix :: Maybe Name
_stcSuffix :: SourceTypeCustomization -> Maybe Name
_stcPrefix :: SourceTypeCustomization -> Maybe Name
..}) NamingCase
tCase = Maybe Name -> Maybe Name -> NamingCase -> Bool -> Name -> Name
applyPrefixSuffix Maybe Name
_stcPrefix Maybe Name
_stcSuffix NamingCase
tCase Bool
True

-- | apply prefix and suffix to field name according to the source customization
applyFieldCust :: Maybe RootFieldsCustomization -> NamingCase -> (G.Name -> G.Name)
applyFieldCust :: Maybe RootFieldsCustomization -> NamingCase -> Name -> Name
applyFieldCust Maybe RootFieldsCustomization
Nothing NamingCase
_ = Name -> Name
forall a. a -> a
id
applyFieldCust (Just RootFieldsCustomization {Maybe Name
_rootfcSuffix :: Maybe Name
_rootfcPrefix :: Maybe Name
_rootfcNamespace :: Maybe Name
_rootfcSuffix :: RootFieldsCustomization -> Maybe Name
_rootfcPrefix :: RootFieldsCustomization -> Maybe Name
_rootfcNamespace :: RootFieldsCustomization -> Maybe Name
..}) NamingCase
tCase = Maybe Name -> Maybe Name -> NamingCase -> Bool -> Name -> Name
applyPrefixSuffix Maybe Name
_rootfcPrefix Maybe Name
_rootfcSuffix NamingCase
tCase Bool
False

-- | apply naming convention to type name
applyTypeNameCaseCust :: NamingCase -> G.Name -> G.Name
applyTypeNameCaseCust :: NamingCase -> Name -> Name
applyTypeNameCaseCust NamingCase
tCase Name
name = case NamingCase
tCase of
  NamingCase
HasuraCase -> Name
name
  NamingCase
GraphqlCase -> (Text -> Text) -> Name -> Name
C.transformNameWith (Text -> Text
C.snakeToPascal) Name
name

-- | apply naming convention to field name
applyFieldNameCaseCust :: NamingCase -> G.Name -> G.Name
applyFieldNameCaseCust :: NamingCase -> Name -> Name
applyFieldNameCaseCust NamingCase
tCase Name
name = case NamingCase
tCase of
  NamingCase
HasuraCase -> Name
name
  NamingCase
GraphqlCase -> (Text -> Text) -> Name -> Name
C.transformNameWith (Text -> Text
C.snakeToCamel) Name
name

-- | returns field name according to the naming conventions as @Text@
getTextFieldName :: NamingCase -> GQLNameIdentifier -> Text
getTextFieldName :: NamingCase -> GQLNameIdentifier -> Text
getTextFieldName NamingCase
tCase GQLNameIdentifier
name = Name -> Text
G.unName (Name -> Text) -> Name -> Text
forall a b. (a -> b) -> a -> b
$ NamingCase -> GQLNameIdentifier -> Name
applyFieldNameCaseIdentifier NamingCase
tCase GQLNameIdentifier
name

-- | applies naming convention and returns field name
--
--  Note: This can't possibly fail as @GQLNameIdentifier@ contains already
--  validated identifiers
applyTypeNameCaseIdentifier :: NamingCase -> GQLNameIdentifier -> G.Name
applyTypeNameCaseIdentifier :: NamingCase -> GQLNameIdentifier -> Name
applyTypeNameCaseIdentifier NamingCase
tCase GQLNameIdentifier
nameLst = case NamingCase
tCase of
  NamingCase
HasuraCase -> GQLNameIdentifier -> Name
C.toSnakeG GQLNameIdentifier
nameLst
  NamingCase
GraphqlCase -> GQLNameIdentifier -> Name
C.toPascalG GQLNameIdentifier
nameLst

-- | returns type name according to the naming conventions as @Text@
getTextTypeName :: NamingCase -> GQLNameIdentifier -> Text
getTextTypeName :: NamingCase -> GQLNameIdentifier -> Text
getTextTypeName NamingCase
tCase GQLNameIdentifier
name = Name -> Text
G.unName (Name -> Text) -> Name -> Text
forall a b. (a -> b) -> a -> b
$ NamingCase -> GQLNameIdentifier -> Name
applyTypeNameCaseIdentifier NamingCase
tCase GQLNameIdentifier
name

-- | applies naming convention and returns type name
--
--  Note: This can't possibly fail as @GQLNameIdentifier@ contains already
--  validated identifiers
applyFieldNameCaseIdentifier :: NamingCase -> GQLNameIdentifier -> G.Name
applyFieldNameCaseIdentifier :: NamingCase -> GQLNameIdentifier -> Name
applyFieldNameCaseIdentifier NamingCase
tCase GQLNameIdentifier
nameLst = case NamingCase
tCase of
  NamingCase
HasuraCase -> GQLNameIdentifier -> Name
C.toSnakeG GQLNameIdentifier
nameLst
  NamingCase
GraphqlCase -> GQLNameIdentifier -> Name
C.toCamelG GQLNameIdentifier
nameLst

applyEnumValueCase :: NamingCase -> G.Name -> G.Name
applyEnumValueCase :: NamingCase -> Name -> Name
applyEnumValueCase NamingCase
tCase Name
v = case NamingCase
tCase of
  NamingCase
HasuraCase -> Name
v
  NamingCase
GraphqlCase -> (Text -> Text) -> Name -> Name
C.transformNameWith (Text -> Text
T.toUpper) Name
v

-- | append/prepend the suffix/prefix in the graphql name
applyPrefixSuffix :: Maybe G.Name -> Maybe G.Name -> NamingCase -> Bool -> G.Name -> G.Name
applyPrefixSuffix :: Maybe Name -> Maybe Name -> NamingCase -> Bool -> Name -> Name
applyPrefixSuffix Maybe Name
Nothing Maybe Name
Nothing NamingCase
tCase Bool
isTypeName Name
name = NamingCase -> Bool -> NonEmpty (Name, NameOrigin) -> Name
concatPrefixSuffix NamingCase
tCase Bool
isTypeName (NonEmpty (Name, NameOrigin) -> Name)
-> NonEmpty (Name, NameOrigin) -> Name
forall a b. (a -> b) -> a -> b
$ [(Name, NameOrigin)] -> NonEmpty (Name, NameOrigin)
forall a. [a] -> NonEmpty a
NE.fromList [(Name
name, NameOrigin
C.CustomName)]
applyPrefixSuffix (Just Name
prefix) Maybe Name
Nothing NamingCase
tCase Bool
isTypeName Name
name = NamingCase -> Bool -> NonEmpty (Name, NameOrigin) -> Name
concatPrefixSuffix NamingCase
tCase Bool
isTypeName (NonEmpty (Name, NameOrigin) -> Name)
-> NonEmpty (Name, NameOrigin) -> Name
forall a b. (a -> b) -> a -> b
$ [(Name, NameOrigin)] -> NonEmpty (Name, NameOrigin)
forall a. [a] -> NonEmpty a
NE.fromList [(Name
prefix, NameOrigin
C.CustomName), (Name
name, NameOrigin
C.AutogeneratedName)]
applyPrefixSuffix Maybe Name
Nothing (Just Name
suffix) NamingCase
tCase Bool
isTypeName Name
name = NamingCase -> Bool -> NonEmpty (Name, NameOrigin) -> Name
concatPrefixSuffix NamingCase
tCase Bool
isTypeName (NonEmpty (Name, NameOrigin) -> Name)
-> NonEmpty (Name, NameOrigin) -> Name
forall a b. (a -> b) -> a -> b
$ [(Name, NameOrigin)] -> NonEmpty (Name, NameOrigin)
forall a. [a] -> NonEmpty a
NE.fromList [(Name
name, NameOrigin
C.CustomName), (Name
suffix, NameOrigin
C.CustomName)]
applyPrefixSuffix (Just Name
prefix) (Just Name
suffix) NamingCase
tCase Bool
isTypeName Name
name = NamingCase -> Bool -> NonEmpty (Name, NameOrigin) -> Name
concatPrefixSuffix NamingCase
tCase Bool
isTypeName (NonEmpty (Name, NameOrigin) -> Name)
-> NonEmpty (Name, NameOrigin) -> Name
forall a b. (a -> b) -> a -> b
$ [(Name, NameOrigin)] -> NonEmpty (Name, NameOrigin)
forall a. [a] -> NonEmpty a
NE.fromList [(Name
prefix, NameOrigin
C.CustomName), (Name
name, NameOrigin
C.AutogeneratedName), (Name
suffix, NameOrigin
C.CustomName)]

concatPrefixSuffix :: NamingCase -> Bool -> NonEmpty (G.Name, C.NameOrigin) -> G.Name
concatPrefixSuffix :: NamingCase -> Bool -> NonEmpty (Name, NameOrigin) -> Name
concatPrefixSuffix (NamingCase
HasuraCase) Bool
_ NonEmpty (Name, NameOrigin)
neList = NonEmpty Name -> Name
forall a. Semigroup a => NonEmpty a -> a
sconcat ((Name, NameOrigin) -> Name
forall a b. (a, b) -> a
fst ((Name, NameOrigin) -> Name)
-> NonEmpty (Name, NameOrigin) -> NonEmpty Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Name, NameOrigin)
neList)
concatPrefixSuffix (NamingCase
GraphqlCase) Bool
isTypeName NonEmpty (Name, NameOrigin)
neList =
  if Bool
isTypeName
    then GQLNameIdentifier -> Name
C.toPascalG GQLNameIdentifier
prefixSuffixGQLIdent
    else GQLNameIdentifier -> (Text -> Text) -> (Text -> Text) -> Name
C.transformPrefixAndSuffixAndConcat GQLNameIdentifier
prefixSuffixGQLIdent Text -> Text
forall a. a -> a
id Text -> Text
C.upperFirstChar
  where
    prefixSuffixGQLIdent :: GQLNameIdentifier
prefixSuffixGQLIdent = NonEmpty (Name, NameOrigin) -> GQLNameIdentifier
C.fromNonEmptyList NonEmpty (Name, NameOrigin)
neList

data SourceCustomization = SourceCustomization
  { SourceCustomization -> Maybe RootFieldsCustomization
_scRootFields :: Maybe RootFieldsCustomization,
    SourceCustomization -> Maybe SourceTypeCustomization
_scTypeNames :: Maybe SourceTypeCustomization,
    SourceCustomization -> Maybe NamingCase
_scNamingConvention :: Maybe NamingCase
  }
  deriving (SourceCustomization -> SourceCustomization -> Bool
(SourceCustomization -> SourceCustomization -> Bool)
-> (SourceCustomization -> SourceCustomization -> Bool)
-> Eq SourceCustomization
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourceCustomization -> SourceCustomization -> Bool
$c/= :: SourceCustomization -> SourceCustomization -> Bool
== :: SourceCustomization -> SourceCustomization -> Bool
$c== :: SourceCustomization -> SourceCustomization -> Bool
Eq, Int -> SourceCustomization -> ShowS
[SourceCustomization] -> ShowS
SourceCustomization -> String
(Int -> SourceCustomization -> ShowS)
-> (SourceCustomization -> String)
-> ([SourceCustomization] -> ShowS)
-> Show SourceCustomization
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SourceCustomization] -> ShowS
$cshowList :: [SourceCustomization] -> ShowS
show :: SourceCustomization -> String
$cshow :: SourceCustomization -> String
showsPrec :: Int -> SourceCustomization -> ShowS
$cshowsPrec :: Int -> SourceCustomization -> ShowS
Show, (forall x. SourceCustomization -> Rep SourceCustomization x)
-> (forall x. Rep SourceCustomization x -> SourceCustomization)
-> Generic SourceCustomization
forall x. Rep SourceCustomization x -> SourceCustomization
forall x. SourceCustomization -> Rep SourceCustomization x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SourceCustomization x -> SourceCustomization
$cfrom :: forall x. SourceCustomization -> Rep SourceCustomization x
Generic)

instance Cacheable SourceCustomization

instance ToJSON SourceCustomization where
  toJSON :: SourceCustomization -> Value
toJSON = Options -> SourceCustomization -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON {omitNothingFields :: Bool
omitNothingFields = Bool
True}

instance FromJSON SourceCustomization where
  parseJSON :: Value -> Parser SourceCustomization
parseJSON = Options -> Value -> Parser SourceCustomization
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON

-- TODO: Write proper codec
instance HasCodec SourceCustomization where
  codec :: JSONCodec SourceCustomization
codec = Text
-> JSONCodec SourceCustomization -> JSONCodec SourceCustomization
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
named Text
"SourceCustomization" JSONCodec SourceCustomization
forall a. (FromJSON a, ToJSON a) => JSONCodec a
placeholderCodecViaJSON

emptySourceCustomization :: SourceCustomization
emptySourceCustomization :: SourceCustomization
emptySourceCustomization = Maybe RootFieldsCustomization
-> Maybe SourceTypeCustomization
-> Maybe NamingCase
-> SourceCustomization
SourceCustomization Maybe RootFieldsCustomization
forall a. Maybe a
Nothing Maybe SourceTypeCustomization
forall a. Maybe a
Nothing Maybe NamingCase
forall a. Maybe a
Nothing

getRootFieldsCustomization :: SourceCustomization -> RootFieldsCustomization
getRootFieldsCustomization :: SourceCustomization -> RootFieldsCustomization
getRootFieldsCustomization = RootFieldsCustomization
-> Maybe RootFieldsCustomization -> RootFieldsCustomization
forall a. a -> Maybe a -> a
fromMaybe RootFieldsCustomization
emptyRootFieldsCustomization (Maybe RootFieldsCustomization -> RootFieldsCustomization)
-> (SourceCustomization -> Maybe RootFieldsCustomization)
-> SourceCustomization
-> RootFieldsCustomization
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceCustomization -> Maybe RootFieldsCustomization
_scRootFields

getSourceTypeCustomization :: SourceCustomization -> SourceTypeCustomization
getSourceTypeCustomization :: SourceCustomization -> SourceTypeCustomization
getSourceTypeCustomization = SourceTypeCustomization
-> Maybe SourceTypeCustomization -> SourceTypeCustomization
forall a. a -> Maybe a -> a
fromMaybe SourceTypeCustomization
emptySourceTypeCustomization (Maybe SourceTypeCustomization -> SourceTypeCustomization)
-> (SourceCustomization -> Maybe SourceTypeCustomization)
-> SourceCustomization
-> SourceTypeCustomization
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceCustomization -> Maybe SourceTypeCustomization
_scTypeNames

getNamingConvention :: SourceCustomization -> Maybe NamingCase -> NamingCase
getNamingConvention :: SourceCustomization -> Maybe NamingCase -> NamingCase
getNamingConvention SourceCustomization
sc Maybe NamingCase
defaultNC = NamingCase -> Maybe NamingCase -> NamingCase
forall a. a -> Maybe a -> a
fromMaybe NamingCase
HasuraCase (Maybe NamingCase -> NamingCase) -> Maybe NamingCase -> NamingCase
forall a b. (a -> b) -> a -> b
$ SourceCustomization -> Maybe NamingCase
_scNamingConvention SourceCustomization
sc Maybe NamingCase -> Maybe NamingCase -> Maybe NamingCase
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe NamingCase
defaultNC

-- | Function to apply root field name customizations.
newtype MkRootFieldName = MkRootFieldName {MkRootFieldName -> Name -> Name
runMkRootFieldName :: G.Name -> G.Name}
  deriving (b -> MkRootFieldName -> MkRootFieldName
NonEmpty MkRootFieldName -> MkRootFieldName
MkRootFieldName -> MkRootFieldName -> MkRootFieldName
(MkRootFieldName -> MkRootFieldName -> MkRootFieldName)
-> (NonEmpty MkRootFieldName -> MkRootFieldName)
-> (forall b.
    Integral b =>
    b -> MkRootFieldName -> MkRootFieldName)
-> Semigroup MkRootFieldName
forall b. Integral b => b -> MkRootFieldName -> MkRootFieldName
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> MkRootFieldName -> MkRootFieldName
$cstimes :: forall b. Integral b => b -> MkRootFieldName -> MkRootFieldName
sconcat :: NonEmpty MkRootFieldName -> MkRootFieldName
$csconcat :: NonEmpty MkRootFieldName -> MkRootFieldName
<> :: MkRootFieldName -> MkRootFieldName -> MkRootFieldName
$c<> :: MkRootFieldName -> MkRootFieldName -> MkRootFieldName
Semigroup, Semigroup MkRootFieldName
MkRootFieldName
Semigroup MkRootFieldName
-> MkRootFieldName
-> (MkRootFieldName -> MkRootFieldName -> MkRootFieldName)
-> ([MkRootFieldName] -> MkRootFieldName)
-> Monoid MkRootFieldName
[MkRootFieldName] -> MkRootFieldName
MkRootFieldName -> MkRootFieldName -> MkRootFieldName
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [MkRootFieldName] -> MkRootFieldName
$cmconcat :: [MkRootFieldName] -> MkRootFieldName
mappend :: MkRootFieldName -> MkRootFieldName -> MkRootFieldName
$cmappend :: MkRootFieldName -> MkRootFieldName -> MkRootFieldName
mempty :: MkRootFieldName
$cmempty :: MkRootFieldName
$cp1Monoid :: Semigroup MkRootFieldName
Monoid) via (Endo G.Name)

getRootFieldsCustomizer ::
  forall m.
  (MonadError QErr m) =>
  SourceCustomization ->
  SupportedNamingCase ->
  Maybe NamingCase ->
  m MkRootFieldName
getRootFieldsCustomizer :: SourceCustomization
-> SupportedNamingCase -> Maybe NamingCase -> m MkRootFieldName
getRootFieldsCustomizer sc :: SourceCustomization
sc@SourceCustomization {Maybe NamingCase
Maybe SourceTypeCustomization
Maybe RootFieldsCustomization
_scNamingConvention :: Maybe NamingCase
_scTypeNames :: Maybe SourceTypeCustomization
_scRootFields :: Maybe RootFieldsCustomization
_scNamingConvention :: SourceCustomization -> Maybe NamingCase
_scTypeNames :: SourceCustomization -> Maybe SourceTypeCustomization
_scRootFields :: SourceCustomization -> Maybe RootFieldsCustomization
..} SupportedNamingCase
namingConventionSupport Maybe NamingCase
defaultNC = do
  NamingCase
tCase <- SourceCustomization
-> SupportedNamingCase -> Maybe NamingCase -> m NamingCase
forall (m :: * -> *).
MonadError QErr m =>
SourceCustomization
-> SupportedNamingCase -> Maybe NamingCase -> m NamingCase
getNamingCase SourceCustomization
sc SupportedNamingCase
namingConventionSupport Maybe NamingCase
defaultNC
  MkRootFieldName -> m MkRootFieldName
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MkRootFieldName -> m MkRootFieldName)
-> MkRootFieldName -> m MkRootFieldName
forall a b. (a -> b) -> a -> b
$ Maybe RootFieldsCustomization -> NamingCase -> MkRootFieldName
mkCustomizedFieldName Maybe RootFieldsCustomization
_scRootFields NamingCase
tCase

-- | Inject NamingCase, typename and root field name customizations from @SourceCustomization@ into
-- the environment.
withSourceCustomization ::
  forall m r a.
  (MonadReader r m, Has MkTypename r, Has NamingCase r, MonadError QErr m) =>
  SourceCustomization ->
  SupportedNamingCase ->
  Maybe NamingCase ->
  m a ->
  m a
withSourceCustomization :: SourceCustomization
-> SupportedNamingCase -> Maybe NamingCase -> m a -> m a
withSourceCustomization sc :: SourceCustomization
sc@SourceCustomization {Maybe NamingCase
Maybe SourceTypeCustomization
Maybe RootFieldsCustomization
_scNamingConvention :: Maybe NamingCase
_scTypeNames :: Maybe SourceTypeCustomization
_scRootFields :: Maybe RootFieldsCustomization
_scNamingConvention :: SourceCustomization -> Maybe NamingCase
_scTypeNames :: SourceCustomization -> Maybe SourceTypeCustomization
_scRootFields :: SourceCustomization -> Maybe RootFieldsCustomization
..} SupportedNamingCase
namingConventionSupport Maybe NamingCase
defaultNC m a
m = do
  NamingCase
tCase <- SourceCustomization
-> SupportedNamingCase -> Maybe NamingCase -> m NamingCase
forall (m :: * -> *).
MonadError QErr m =>
SourceCustomization
-> SupportedNamingCase -> Maybe NamingCase -> m NamingCase
getNamingCase SourceCustomization
sc SupportedNamingCase
namingConventionSupport Maybe NamingCase
defaultNC
  MkTypename -> m a -> m a
forall (m :: * -> *) r a.
(MonadReader r m, Has MkTypename r) =>
MkTypename -> m a -> m a
withTypenameCustomization (Maybe SourceTypeCustomization -> NamingCase -> MkTypename
mkCustomizedTypename Maybe SourceTypeCustomization
_scTypeNames NamingCase
tCase)
    (m a -> m a) -> (m a -> m a) -> m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamingCase -> m a -> m a
forall (m :: * -> *) r a.
(MonadReader r m, Has NamingCase r) =>
NamingCase -> m a -> m a
withNamingCaseCustomization NamingCase
tCase
    (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ m a
m

getNamingCase ::
  forall m.
  (MonadError QErr m) =>
  SourceCustomization ->
  SupportedNamingCase ->
  Maybe NamingCase ->
  m NamingCase
getNamingCase :: SourceCustomization
-> SupportedNamingCase -> Maybe NamingCase -> m NamingCase
getNamingCase SourceCustomization
sc SupportedNamingCase
namingConventionSupport Maybe NamingCase
defaultNC = do
  let namingConv :: NamingCase
namingConv = SourceCustomization -> Maybe NamingCase -> NamingCase
getNamingConvention SourceCustomization
sc Maybe NamingCase
defaultNC
  -- The console currently constructs a graphql query based on table name and
  -- schema name to fetch the data from the database (other than postgres).
  -- Now, when we set @GraphqlCase@ for other (than postgres) databases, this
  -- custom query constructed by console won't work (because the field names
  -- has changed) and thus the data explorer tab won't work properly. So, we
  -- have restricted this feature to postgres for now.
  case SupportedNamingCase
namingConventionSupport of
    SupportedNamingCase
AllConventions -> NamingCase -> m NamingCase
forall (f :: * -> *) a. Applicative f => a -> f a
pure NamingCase
namingConv
    SupportedNamingCase
OnlyHasuraCase -> case NamingCase
namingConv of
      NamingCase
GraphqlCase -> Code -> Text -> m NamingCase
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported (Text -> m NamingCase) -> Text -> m NamingCase
forall a b. (a -> b) -> a -> b
$ Text
"sources other than postgres do not support graphql-default as naming convention yet"
      NamingCase
HasuraCase -> NamingCase -> m NamingCase
forall (f :: * -> *) a. Applicative f => a -> f a
pure NamingCase
HasuraCase

withNamingCaseCustomization :: forall m r a. (MonadReader r m, Has NamingCase r) => NamingCase -> m a -> m a
withNamingCaseCustomization :: NamingCase -> m a -> m a
withNamingCaseCustomization = (r -> r) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ((r -> r) -> m a -> m a)
-> (NamingCase -> r -> r) -> NamingCase -> m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter r r NamingCase NamingCase -> NamingCase -> r -> r
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter r r NamingCase NamingCase
forall a t. Has a t => Lens t a
hasLens

newtype CustomizeRemoteFieldName = CustomizeRemoteFieldName
  { CustomizeRemoteFieldName -> Name -> Name -> Name
runCustomizeRemoteFieldName :: G.Name -> G.Name -> G.Name
  }
  deriving (b -> CustomizeRemoteFieldName -> CustomizeRemoteFieldName
NonEmpty CustomizeRemoteFieldName -> CustomizeRemoteFieldName
CustomizeRemoteFieldName
-> CustomizeRemoteFieldName -> CustomizeRemoteFieldName
(CustomizeRemoteFieldName
 -> CustomizeRemoteFieldName -> CustomizeRemoteFieldName)
-> (NonEmpty CustomizeRemoteFieldName -> CustomizeRemoteFieldName)
-> (forall b.
    Integral b =>
    b -> CustomizeRemoteFieldName -> CustomizeRemoteFieldName)
-> Semigroup CustomizeRemoteFieldName
forall b.
Integral b =>
b -> CustomizeRemoteFieldName -> CustomizeRemoteFieldName
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> CustomizeRemoteFieldName -> CustomizeRemoteFieldName
$cstimes :: forall b.
Integral b =>
b -> CustomizeRemoteFieldName -> CustomizeRemoteFieldName
sconcat :: NonEmpty CustomizeRemoteFieldName -> CustomizeRemoteFieldName
$csconcat :: NonEmpty CustomizeRemoteFieldName -> CustomizeRemoteFieldName
<> :: CustomizeRemoteFieldName
-> CustomizeRemoteFieldName -> CustomizeRemoteFieldName
$c<> :: CustomizeRemoteFieldName
-> CustomizeRemoteFieldName -> CustomizeRemoteFieldName
Semigroup, Semigroup CustomizeRemoteFieldName
CustomizeRemoteFieldName
Semigroup CustomizeRemoteFieldName
-> CustomizeRemoteFieldName
-> (CustomizeRemoteFieldName
    -> CustomizeRemoteFieldName -> CustomizeRemoteFieldName)
-> ([CustomizeRemoteFieldName] -> CustomizeRemoteFieldName)
-> Monoid CustomizeRemoteFieldName
[CustomizeRemoteFieldName] -> CustomizeRemoteFieldName
CustomizeRemoteFieldName
-> CustomizeRemoteFieldName -> CustomizeRemoteFieldName
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [CustomizeRemoteFieldName] -> CustomizeRemoteFieldName
$cmconcat :: [CustomizeRemoteFieldName] -> CustomizeRemoteFieldName
mappend :: CustomizeRemoteFieldName
-> CustomizeRemoteFieldName -> CustomizeRemoteFieldName
$cmappend :: CustomizeRemoteFieldName
-> CustomizeRemoteFieldName -> CustomizeRemoteFieldName
mempty :: CustomizeRemoteFieldName
$cmempty :: CustomizeRemoteFieldName
$cp1Monoid :: Semigroup CustomizeRemoteFieldName
Monoid) via (G.Name -> Endo G.Name)

withRemoteFieldNameCustomization :: forall m r a. (MonadReader r m, Has CustomizeRemoteFieldName r) => CustomizeRemoteFieldName -> m a -> m a
withRemoteFieldNameCustomization :: CustomizeRemoteFieldName -> m a -> m a
withRemoteFieldNameCustomization = (r -> r) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ((r -> r) -> m a -> m a)
-> (CustomizeRemoteFieldName -> r -> r)
-> CustomizeRemoteFieldName
-> m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter r r CustomizeRemoteFieldName CustomizeRemoteFieldName
-> CustomizeRemoteFieldName -> r -> r
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter r r CustomizeRemoteFieldName CustomizeRemoteFieldName
forall a t. Has a t => Lens t a
hasLens

-------------------------------------------------------------------------------
-- Some helper functions to build the field names as an identifier

mkSelectField :: GQLNameIdentifier -> GQLNameIdentifier
mkSelectField :: GQLNameIdentifier -> GQLNameIdentifier
mkSelectField = GQLNameIdentifier -> GQLNameIdentifier
forall a. a -> a
id

mkSelectAggregateField :: GQLNameIdentifier -> GQLNameIdentifier
mkSelectAggregateField :: GQLNameIdentifier -> GQLNameIdentifier
mkSelectAggregateField GQLNameIdentifier
name = GQLNameIdentifier
name GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> Name -> GQLNameIdentifier
C.fromAutogeneratedName Name
Name._aggregate

mkSelectByPkField :: GQLNameIdentifier -> GQLNameIdentifier
mkSelectByPkField :: GQLNameIdentifier -> GQLNameIdentifier
mkSelectByPkField GQLNameIdentifier
name = GQLNameIdentifier
name GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> (Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["by", "pk"])

mkInsertField :: GQLNameIdentifier -> GQLNameIdentifier
mkInsertField :: GQLNameIdentifier -> GQLNameIdentifier
mkInsertField GQLNameIdentifier
name = Name -> GQLNameIdentifier
C.fromAutogeneratedName Name
Name._insert GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> GQLNameIdentifier
name

mkInsertOneField :: GQLNameIdentifier -> GQLNameIdentifier
mkInsertOneField :: GQLNameIdentifier -> GQLNameIdentifier
mkInsertOneField GQLNameIdentifier
name = Name -> GQLNameIdentifier
C.fromAutogeneratedName Name
Name._insert GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> GQLNameIdentifier
name GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> Name -> GQLNameIdentifier
C.fromAutogeneratedName Name
Name._one

mkUpdateField :: GQLNameIdentifier -> GQLNameIdentifier
mkUpdateField :: GQLNameIdentifier -> GQLNameIdentifier
mkUpdateField GQLNameIdentifier
name = Name -> GQLNameIdentifier
C.fromAutogeneratedName Name
Name._update GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> GQLNameIdentifier
name

mkUpdateByPkField :: GQLNameIdentifier -> GQLNameIdentifier
mkUpdateByPkField :: GQLNameIdentifier -> GQLNameIdentifier
mkUpdateByPkField GQLNameIdentifier
name = Name -> GQLNameIdentifier
C.fromAutogeneratedName Name
Name._update GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> GQLNameIdentifier
name GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> (Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["by", "pk"])

mkUpdateManyField :: GQLNameIdentifier -> GQLNameIdentifier
mkUpdateManyField :: GQLNameIdentifier -> GQLNameIdentifier
mkUpdateManyField GQLNameIdentifier
name = Name -> GQLNameIdentifier
C.fromAutogeneratedName Name
Name._update GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> GQLNameIdentifier
name GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> Name -> GQLNameIdentifier
C.fromAutogeneratedName Name
Name._many

mkDeleteField :: GQLNameIdentifier -> GQLNameIdentifier
mkDeleteField :: GQLNameIdentifier -> GQLNameIdentifier
mkDeleteField GQLNameIdentifier
name = Name -> GQLNameIdentifier
C.fromAutogeneratedName Name
Name._delete GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> GQLNameIdentifier
name

mkDeleteByPkField :: GQLNameIdentifier -> GQLNameIdentifier
mkDeleteByPkField :: GQLNameIdentifier -> GQLNameIdentifier
mkDeleteByPkField GQLNameIdentifier
name = Name -> GQLNameIdentifier
C.fromAutogeneratedName Name
Name._delete GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> GQLNameIdentifier
name GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> (Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["by", "pk"])

mkRelayConnectionField :: GQLNameIdentifier -> GQLNameIdentifier
mkRelayConnectionField :: GQLNameIdentifier -> GQLNameIdentifier
mkRelayConnectionField GQLNameIdentifier
name = GQLNameIdentifier
name GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> Name -> GQLNameIdentifier
C.fromAutogeneratedName Name
Name._connection

mkSelectStreamField :: GQLNameIdentifier -> GQLNameIdentifier
mkSelectStreamField :: GQLNameIdentifier -> GQLNameIdentifier
mkSelectStreamField GQLNameIdentifier
name = GQLNameIdentifier
name GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> Name -> GQLNameIdentifier
C.fromAutogeneratedName Name
Name._stream

mkMultiRowUpdateTypeName :: GQLNameIdentifier -> GQLNameIdentifier
mkMultiRowUpdateTypeName :: GQLNameIdentifier -> GQLNameIdentifier
mkMultiRowUpdateTypeName GQLNameIdentifier
name = GQLNameIdentifier
name GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> Name -> GQLNameIdentifier
C.fromAutogeneratedName $$(G.litName "updates")

mkOnConflictTypeName :: GQLNameIdentifier -> GQLNameIdentifier
mkOnConflictTypeName :: GQLNameIdentifier -> GQLNameIdentifier
mkOnConflictTypeName GQLNameIdentifier
name = GQLNameIdentifier
name GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> (Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["on", "conflict"])

mkTableConstraintTypeName :: GQLNameIdentifier -> GQLNameIdentifier
mkTableConstraintTypeName :: GQLNameIdentifier -> GQLNameIdentifier
mkTableConstraintTypeName GQLNameIdentifier
name = GQLNameIdentifier
name GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> Name -> GQLNameIdentifier
C.fromAutogeneratedName $$(G.litName "constraint")

mkTableAggregateTypeName :: GQLNameIdentifier -> GQLNameIdentifier
mkTableAggregateTypeName :: GQLNameIdentifier -> GQLNameIdentifier
mkTableAggregateTypeName GQLNameIdentifier
name = GQLNameIdentifier
name GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> Name -> GQLNameIdentifier
C.fromAutogeneratedName $$(G.litName "aggregate")

mkTableAggregateFieldTypeName :: GQLNameIdentifier -> GQLNameIdentifier
mkTableAggregateFieldTypeName :: GQLNameIdentifier -> GQLNameIdentifier
mkTableAggregateFieldTypeName GQLNameIdentifier
name = GQLNameIdentifier
name GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> (Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["aggregate", "fields"])

mkFunctionArgsTypeName :: G.Name -> GQLNameIdentifier -> GQLNameIdentifier
mkFunctionArgsTypeName :: Name -> GQLNameIdentifier -> GQLNameIdentifier
mkFunctionArgsTypeName Name
computedFieldName GQLNameIdentifier
tableName = Name -> GQLNameIdentifier
C.fromAutogeneratedName Name
computedFieldName GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> GQLNameIdentifier
tableName GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> Name -> GQLNameIdentifier
C.fromAutogeneratedName $$(G.litName "args")

mkTableBoolExpTypeName :: GQLNameIdentifier -> GQLNameIdentifier
mkTableBoolExpTypeName :: GQLNameIdentifier -> GQLNameIdentifier
mkTableBoolExpTypeName GQLNameIdentifier
name = GQLNameIdentifier
name GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> (Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["bool", "exp"])

mkTableTypeName :: GQLNameIdentifier -> GQLNameIdentifier
mkTableTypeName :: GQLNameIdentifier -> GQLNameIdentifier
mkTableTypeName = GQLNameIdentifier -> GQLNameIdentifier
forall a. a -> a
id

mkTableInsertInputTypeName :: GQLNameIdentifier -> GQLNameIdentifier
mkTableInsertInputTypeName :: GQLNameIdentifier -> GQLNameIdentifier
mkTableInsertInputTypeName GQLNameIdentifier
name = GQLNameIdentifier
name GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> (Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["insert", "input"])

mkTableObjRelInsertInputTypeName :: GQLNameIdentifier -> GQLNameIdentifier
mkTableObjRelInsertInputTypeName :: GQLNameIdentifier -> GQLNameIdentifier
mkTableObjRelInsertInputTypeName GQLNameIdentifier
name = GQLNameIdentifier
name GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> (Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["obj", "rel", "insert", "input"])

mkTableArrRelInsertInputTypeName :: GQLNameIdentifier -> GQLNameIdentifier
mkTableArrRelInsertInputTypeName :: GQLNameIdentifier -> GQLNameIdentifier
mkTableArrRelInsertInputTypeName GQLNameIdentifier
name = GQLNameIdentifier
name GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> (Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["arr", "rel", "insert", "input"])

mkTableMutationResponseTypeName :: GQLNameIdentifier -> GQLNameIdentifier
mkTableMutationResponseTypeName :: GQLNameIdentifier -> GQLNameIdentifier
mkTableMutationResponseTypeName GQLNameIdentifier
name = GQLNameIdentifier
name GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> (Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["mutation", "response"])

mkTableOrderByTypeName :: GQLNameIdentifier -> GQLNameIdentifier
mkTableOrderByTypeName :: GQLNameIdentifier -> GQLNameIdentifier
mkTableOrderByTypeName GQLNameIdentifier
name = GQLNameIdentifier
name GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> (Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["order", "by"])

mkTableAggregateOrderByTypeName :: GQLNameIdentifier -> GQLNameIdentifier
mkTableAggregateOrderByTypeName :: GQLNameIdentifier -> GQLNameIdentifier
mkTableAggregateOrderByTypeName GQLNameIdentifier
name = GQLNameIdentifier
name GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> (Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["aggregate", "order", "by"])

mkTableAggOperatorTypeName :: GQLNameIdentifier -> G.Name -> GQLNameIdentifier
mkTableAggOperatorTypeName :: GQLNameIdentifier -> Name -> GQLNameIdentifier
mkTableAggOperatorTypeName GQLNameIdentifier
tableName Name
operator = GQLNameIdentifier
tableName GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> Name -> GQLNameIdentifier
C.fromAutogeneratedName Name
operator GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> Name -> GQLNameIdentifier
C.fromAutogeneratedName $$(G.litName "fields")

mkTableSelectColumnTypeName :: GQLNameIdentifier -> GQLNameIdentifier
mkTableSelectColumnTypeName :: GQLNameIdentifier -> GQLNameIdentifier
mkTableSelectColumnTypeName GQLNameIdentifier
name = GQLNameIdentifier
name GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> (Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["select", "column"])

mkTableUpdateColumnTypeName :: GQLNameIdentifier -> GQLNameIdentifier
mkTableUpdateColumnTypeName :: GQLNameIdentifier -> GQLNameIdentifier
mkTableUpdateColumnTypeName GQLNameIdentifier
name = GQLNameIdentifier
name GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> (Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["update", "column"])

mkTableOperatorInputTypeName :: GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
mkTableOperatorInputTypeName :: GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
mkTableOperatorInputTypeName GQLNameIdentifier
tableName GQLNameIdentifier
operator = GQLNameIdentifier
tableName GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> GQLNameIdentifier
operator GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> Name -> GQLNameIdentifier
C.fromAutogeneratedName $$(G.litName "input")

mkTablePkColumnsInputTypeName :: GQLNameIdentifier -> GQLNameIdentifier
mkTablePkColumnsInputTypeName :: GQLNameIdentifier -> GQLNameIdentifier
mkTablePkColumnsInputTypeName GQLNameIdentifier
name = GQLNameIdentifier
name GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> (Name, [NameSuffix]) -> GQLNameIdentifier
C.fromAutogeneratedTuple $$(G.litGQLIdentifier ["pk", "columns", "input"])

mkEnumTableTypeName :: GQLNameIdentifier -> Maybe G.Name -> GQLNameIdentifier
mkEnumTableTypeName :: GQLNameIdentifier -> Maybe Name -> GQLNameIdentifier
mkEnumTableTypeName GQLNameIdentifier
name (Just Name
customName) = Name -> GQLNameIdentifier
C.fromCustomName Name
customName GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> Name -> GQLNameIdentifier
C.fromAutogeneratedName $$(G.litName "enum")
mkEnumTableTypeName GQLNameIdentifier
name Maybe Name
Nothing = GQLNameIdentifier
name GQLNameIdentifier -> GQLNameIdentifier -> GQLNameIdentifier
forall a. Semigroup a => a -> a -> a
<> Name -> GQLNameIdentifier
C.fromAutogeneratedName $$(G.litName "enum")