Cannot define recursive schema

[jml]

Cannot define recursive schema

[teh]

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

[jml]

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.

[jml]

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.

[teh]

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

[teh]

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

[teh]

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.

[teh]

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\"}}}"

[teh]

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\"}}]}}"

[jml]

Interesting!

[teh]

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.

[jml]

You mean globally unique type names, right? That's a requirement for a valid schema.

We'll need HasAnnotatedType for introspection.

[teh]

"Type" is overloaded :). I specifically mean GraphQL types, i.e.:

type X = Object "X" '[] '[...]
                ^^^ this