Haskell Snacks: Integrating Yesod and Morpheus GraphQL

I found myself with a need to integrate Yesod with Morpheus GraphQL, something that wasn't immediately intuitive and didn't have an easily Googleable answer. This is how I got it to cooperate. Morpheus provides examples for Scotty and Servant integration, but Scotty wasn't full-featured enough for my needs, and I'm not familair with Servant. Yesod to the rescue! But, you'll find that the syntax shown in the Scotty and Servant examples for declaring your GraphQL API, will not cooperate with Yesod. Here's how it is in the simplest Scotty example from the Morpheus docs:

-- Definition of GraphQL API
gqlApi :: ByteString -> IO ByteString
gqlApi = interpreter rootResolver

-- Hooking it up to Scotty handler
main :: IO ()
main = scotty 3000 $ post "/api" $ raw =<< (liftIO . gqlApi =<< body)

You might think you can snag the liftIO . gqlApi =<< body, stick it in a Yesod handler unchanged, and pass in the POST request body. Sadly, you'd be wrong— Yesod expects different types.

Thanks to a single GitHub issue courtesy tuxagon, I discovered the correct syntax, and it's really quite simple. All you have to do is change the type signature:

-- Type signature changed from ByteString to GQLRequest/Response
graphqlApi :: GQLRequest -> IO GQLResponse
graphqlApi =
  interpreter rootResolver

-- Now it works like you'd expect
postGraphqlR :: Handler Value
postGraphqlR = do
  body <- requireCheckJsonBody :: Handler GQLRequest
  result <- (liftIO . graphqlApi) body
  returnJson result

Now, suppose you want to use the App syntax from Morpheus. So instead of using interpreter, your Morpheus GraphQL code now looks like this:

app :: App APIEvent IO
app = deriveApp rootResolver

We can still stitch this into a Yesod handler! The key is in the definition of interpreter:

interpreter ::
  (MapAPI a b, RootResolverConstraint m e query mut sub) =>
  RootResolver m e query mut sub ->
  a ->
  m b
interpreter = runApp . deriveApp

Hey, interpreter is just using deriveApp under the hood, just like app does! What we must do in our Yesod handler is apply runApp to app. Then we'll have the same GraphQL API as we did before. All it takes is one little where clause:

app :: App APIEvent IO
app = deriveApp rootResolver

postGraphqlR :: Handler Value
postGraphqlR = do
  body <- requireCheckJsonBody :: Handler GQLRequest
  result <- (liftIO . graphqlApi) body
  returnJson result
  where graphqlApi = runApp app :: GQLRequest -> IO GQLResponse

Things get a bit more complex once we need WebSockets support... But that's a challenge for another day!✌️