Cannot define recursive schema
I discovered this last night while trying to build good tests for https://github.com/jml/graphql-api/pull/92.
I tried to change our example schema by:
- making dog's owner a
Sentient - giving humans two new fields:
-
pets: [Pet] -
catsAndDogs: [CatOrDog]
-
However, this will not compile, since it means the type definition of Dog needs to include the type definition of CatOrDog which needs to include Dog which… is circular.
I don't know what the right answer to this is. Presumably either newtypes, a language extension, or abandoning large chunks of the type-based approach.
Here's a minimal example that doesn't work:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
module Examples.Rec where
import Protolude hiding (Enum)
import GraphQL
import GraphQL.API
import GraphQL.Resolver (Handler)
type Directory = Object "Directory" '[] '[Field "subdirs" Directory]
directory :: Handler IO Directory
directory = pure directory
FWIW, if we can figure out a plausible solution and have something hacky that demonstrates it, I'm OK with releasing without this being fixed.
However, if we can't prove that this is possible, then I'm reluctant to release. It's kind of a make-or-break feature, IMO.
For recursive types I don't think we'll get around newtyping. The following code doesn't work because it doesn't implement resolve correctly (it needs to look through the selection set ss and dispatch accordingly), but it shows how recursion can be implemented in principle:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ScopedTypeVariables, FlexibleInstances, MultiParamTypeClasses #-}
module Examples.Rec where
import Protolude hiding (Enum)
import GraphQL
import GraphQL.API
import GraphQL.Value.ToValue
import GraphQL.Resolver (Handler, HasResolver(..))
newtype Directory = R (Object "Directory" '[] '[Field "subdirs" Directory, Field "x" Text])
instance forall m. Monad m => HasResolver m Directory where
resolve _ ss = (pure . pure . toValue) ("broken" :: Text)
directory :: Handler IO Directory
directory = directory
example :: Text -> IO Response
example = interpretAnonymousQuery @Directory directory
OK. I'm convinced. Removing this from the milestone, but think it should be top priority for next release—writing a file server should be obvious to any newbie.
This turns out to be more tricky than expected. Sticking to the directory example I can't write the following instance because the type family computation is recursive, and therefore will never terminate:
instance forall m. Monad m => HasResolver m Directory where
type Handler m Directory = Handler m Directory :<> Handler m Text
Just to add more context: We also care about mutual recursion as pointed out in the opening comment of this issue. For pure self-recursion we could add a Self combinator that gets transformed into recursive calls at the value level.
Here's a working example though I don't fully understand yet why this specific combination introduce recursion, as I am still calling resolve recursively (but that's probably it). I will try to extract the core of it into a nice interface (we don't need everything in that example).
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators, ScopedTypeVariables, RankNTypes #-}
{-# LANGUAGE DeriveGeneric, UndecidableInstances, StandaloneDeriving #-}
{-# LANGUAGE GADTs, KindSignatures, FlexibleInstances, MultiParamTypeClasses, TypeFamilies #-}
module Examples.Rec where
import Protolude hiding (Enum)
import GraphQL
import GraphQL.API
import GraphQL.Resolver
import Data.Aeson (encode)
newtype RD m = RD (Handler m Directory)
data R = R
type Directory = Object "Directory" '[] '[Field "subdirs" R, Field "name" Text]
instance forall m. (Monad m) => HasResolver m R where
type Handler m R = RD m
resolve (RD rd) = resolve @m @Directory rd
instance HasAnnotatedType R where
getAnnotatedType = getAnnotatedType @Int
directory :: Handler IO Directory
directory = pure (RD directory :<> pure "tom")
run :: Text -> IO Response
run = interpretAnonymousQuery @Directory directory
example :: IO LByteString
example = encode <$> run "{ subdirs { name subdirs { name subdirs { name } }} }"
-- "{\"data\":{\"subdirs\":{\"subdirs\":{\"subdirs\":{\"name\":\"tom\"},\"name\":\"tom\"},\"name\":\"tom\"}}}"
And an example with mutual recursion - the trick is to include a judiciously placed loop-breaker that's an actual data type with a constructor, which is how mutual recursion works in Haskell of course.
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators, ScopedTypeVariables, RankNTypes #-}
{-# LANGUAGE DeriveGeneric, UndecidableInstances, StandaloneDeriving #-}
{-# LANGUAGE GADTs, KindSignatures, FlexibleInstances, MultiParamTypeClasses, TypeFamilies #-}
module Examples.Rec where
import Protolude hiding (Enum)
import GraphQL
import GraphQL.API
import GraphQL.Resolver
import Data.Aeson (encode)
newtype RecIssue m = RecIssue (Handler m (Issue m))
type User m = Object "User" '[] '[Field "issues" (List (RecIssue m)), Field "name" Text]
type Issue m = Object "Issue" '[] '[Field "owner" (User m), Field "title" Text]
instance forall m. (Monad m) => HasResolver m (RecIssue m) where
type Handler m (RecIssue m) = RecIssue m
resolve (RecIssue rd) = resolve @m @(Issue m) rd
instance forall m. HasAnnotatedType (RecIssue m) where
getAnnotatedType = getAnnotatedType @Int
issues :: Handler IO (Issue IO)
issues = pure (user :<> pure "issue-title")
user :: Handler IO (User IO)
user = pure (pure [RecIssue issues] :<> pure "tom")
run :: Text -> IO Response
run = interpretAnonymousQuery @(User IO) user
example :: IO LByteString
example = encode <$> run "{ issues { owner { name } } }"
-- "{\"data\":{\"issues\":[{\"owner\":{\"name\":\"tom\"}}]}}"
Interesting!
Note that HasAnnotatedType returns garbage, but that doesn't matter because we aren't really using that information yet.
If HasAnnotatedType used getAnnotatedType @Directory it'd lead to infinite recursion. In order to break that we need to change the code to recognise cycles by some identifier (e.g. the object name) and then store a pointer. This would imply globally unique object names which I think is something that facebook do.
You mean globally unique type names, right? That's a requirement for a valid schema.
We'll need HasAnnotatedType for introspection.
"Type" is overloaded :). I specifically mean GraphQL types, i.e.:
type X = Object "X" '[] '[...]
^^^ this