mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-17 12:31:52 +03:00
29158900d8
Source typename customization (hasura/graphql-engine@aac64f2c81) introduced a mechanism to change certain names in the GraphQL schema that is exposed. In particular it allows last-minute modification of: 1. the names of some types, and 2. the names of some root fields. The above two items are assigned distinct customization algorithms, and at times both algorithms are in scope. So a need to distinguish them is needed. In the original design, this was addressed by introducing a newtype wrapper `Typename` around GraphQL `Name`s, dedicated to the names of types. However, in the majority of the codebase, type names are also represented by `Name`. For this reason, it was unavoidable to allow for easy conversion. This was supported by a `HasName Typename` instance, as well as by publishing the constructors of `Typename`. This means that the type safety that newtypes can add is lost. In particular, it is now very easy to confuse type name customization with root field name customization. This refactors the above design by instead introducing newtypes around the customization operations: ```haskell newtype MkTypename = MkTypename {runMkTypename :: Name -> Name} deriving (Semigroup, Monoid) via (Endo Name) newtype MkRootFieldName = MkRootFieldName {runMkRootFieldName :: Name -> Name} deriving (Semigroup, Monoid) via (Endo Name) ``` The `Monoid` instance allows easy composition of customization operations, piggybacking off of the type of `Endo`maps. This design allows safe co-existence of the two customization algorithms, while avoiding the syntactic overhead of packing and unpacking newtypes. PR-URL: https://github.com/hasura/graphql-engine-mono/pull/2989 GitOrigin-RevId: da3a353a9b003ee40c8d0a1e02872e99d2edd3ca
104 lines
3.6 KiB
Haskell
104 lines
3.6 KiB
Haskell
module Hasura.GraphQL.Namespace
|
|
( RootFieldAlias (..),
|
|
mkUnNamespacedRootFieldAlias,
|
|
mkNamespacedRootFieldAlias,
|
|
RootFieldMap,
|
|
NamespacedField (..),
|
|
namespacedField,
|
|
NamespacedFieldMap,
|
|
flattenNamespaces,
|
|
unflattenNamespaces,
|
|
customizeNamespace,
|
|
)
|
|
where
|
|
|
|
import Data.Aeson qualified as J
|
|
import Data.HashMap.Strict.InsOrd qualified as OMap
|
|
import Data.Text.Extended
|
|
import Hasura.GraphQL.Parser
|
|
import Hasura.GraphQL.Parser qualified as P
|
|
import Hasura.Prelude
|
|
import Language.GraphQL.Draft.Syntax qualified as G
|
|
|
|
data RootFieldAlias = RootFieldAlias
|
|
{ _rfaNamespace :: !(Maybe G.Name),
|
|
_rfaAlias :: !G.Name
|
|
}
|
|
deriving (Show, Eq, Generic)
|
|
|
|
instance Hashable RootFieldAlias
|
|
|
|
instance ToTxt RootFieldAlias where
|
|
toTxt RootFieldAlias {..} = case _rfaNamespace of
|
|
Nothing -> G.unName _rfaAlias
|
|
Just ns -> G.unName ns <> "." <> G.unName _rfaAlias
|
|
|
|
-- | This ToJSON instance is used in responses to the explain API
|
|
-- (via the ToJSON instance for ExplainPlan).
|
|
-- It will use dot separator for namespaces fields, i.e. "namespace.fieldname"
|
|
-- TODO: We need to decide if this dotted notation is what we want to use for explain responses.
|
|
instance J.ToJSON RootFieldAlias where
|
|
toJSON = J.toJSON . toTxt
|
|
|
|
mkUnNamespacedRootFieldAlias :: G.Name -> RootFieldAlias
|
|
mkUnNamespacedRootFieldAlias = RootFieldAlias Nothing
|
|
|
|
mkNamespacedRootFieldAlias :: G.Name -> G.Name -> RootFieldAlias
|
|
mkNamespacedRootFieldAlias = RootFieldAlias . Just
|
|
|
|
type RootFieldMap = InsOrdHashMap RootFieldAlias
|
|
|
|
data NamespacedField a
|
|
= -- | Normal field
|
|
NotNamespaced a
|
|
| -- | Namespace field with other fields nested within
|
|
Namespaced (InsOrdHashMap G.Name a)
|
|
deriving (Eq, Show, Functor)
|
|
|
|
namespacedField :: (a -> b) -> (InsOrdHashMap G.Name a -> b) -> NamespacedField a -> b
|
|
namespacedField f g = \case
|
|
NotNamespaced a -> f a
|
|
Namespaced m -> g m
|
|
|
|
type NamespacedFieldMap a = InsOrdHashMap G.Name (NamespacedField a)
|
|
|
|
flattenNamespaces :: forall a. NamespacedFieldMap a -> RootFieldMap a
|
|
flattenNamespaces = OMap.foldMapWithKey flattenNamespace
|
|
where
|
|
flattenNamespace :: G.Name -> NamespacedField a -> RootFieldMap a
|
|
flattenNamespace fieldName =
|
|
namespacedField
|
|
(OMap.singleton $ mkUnNamespacedRootFieldAlias fieldName)
|
|
(OMap.mapKeys $ mkNamespacedRootFieldAlias fieldName)
|
|
|
|
unflattenNamespaces :: RootFieldMap a -> NamespacedFieldMap a
|
|
unflattenNamespaces = OMap.foldlWithKey' insert mempty
|
|
where
|
|
insert m RootFieldAlias {..} v = case _rfaNamespace of
|
|
Nothing -> OMap.insert _rfaAlias (NotNamespaced v) m
|
|
Just ns -> OMap.insertWith merge ns (Namespaced $ (OMap.singleton _rfaAlias v)) m
|
|
merge (Namespaced m) (Namespaced m') = Namespaced (OMap.union m' m) -- Note: order of arguments to OMap.union to preserve ordering
|
|
merge v _ = v
|
|
|
|
-- | Wrap the field parser results in @NamespacedField@
|
|
customizeNamespace ::
|
|
forall n a.
|
|
(MonadParse n) =>
|
|
Maybe G.Name ->
|
|
(G.Name -> P.ParsedSelection a -> a) ->
|
|
P.MkTypename ->
|
|
[FieldParser n a] ->
|
|
[FieldParser n (NamespacedField a)]
|
|
customizeNamespace (Just namespace) fromParsedSelection mkNamespaceTypename fieldParsers =
|
|
-- Source or remote schema has a namespace field so wrap the parsers
|
|
-- in a new namespace field parser.
|
|
[P.subselection_ namespace Nothing parser]
|
|
where
|
|
parser :: Parser 'Output n (NamespacedField a)
|
|
parser =
|
|
Namespaced . OMap.mapWithKey fromParsedSelection
|
|
<$> P.selectionSet (runMkTypename mkNamespaceTypename namespace) Nothing fieldParsers
|
|
customizeNamespace Nothing _ _ fieldParsers =
|
|
-- No namespace so just wrap the field parser results in @NotNamespaced@.
|
|
fmap NotNamespaced <$> fieldParsers
|