src/External/Servant/API/GraphQL/Server.hs

srcExternalServantAPIGraphQLServer.hs

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}

module External.Servant.API.GraphQL.Server
  ( withGraphQL
  , server
  ) where

import Data.Maybe
  ( fromMaybe
  )
import Data.Text
  ( Text
  )
import qualified Data.Map as Map
  ( empty
  )
import External.Servant.API.GraphQL.API
  ( GraphQLAPI
  )
import External.Servant.API.GraphQL.PostBody
  ( PostBody
    (..)
  )
import GraphQL
  ( interpretQuery
  , Response
  , VariableValues
  )
import GraphQL.API
  ( HasObjectDefinition
  )
import GraphQL.Resolver
  ( HasResolver
  )
import qualified GraphQL.Resolver as GraphQL
  ( Handler
  )
import GraphQL.Value
  ( Name
  )
import Servant
  ( (:<|>)
    ( (:<|>)
    )
  , Handler
  , Server
  )

-- | Add a GraphQL Server to a given Server.
withGraphQL :: forall api b. (HasResolver Handler api, HasObjectDefinition api) =>
               b -> GraphQL.Handler Handler api -> Server GraphQLAPI :<|> b
withGraphQL s h = server @api h :<|> s

-- | Standalone GraphQL Server.
server :: forall api. (HasResolver Handler api, HasObjectDefinition api) =>
          GraphQL.Handler Handler api -> Server GraphQLAPI
server h = getHandler @api h :<|> postJSONHandler @api h :<|> postGraphQLHandler @api h

getHandler :: forall api. (HasResolver Handler api, HasObjectDefinition api) =>
              GraphQL.Handler Handler api -> Text -> Maybe VariableValues -> Maybe Name -> Handler Response
getHandler h query variables operationName =
    interpretQuery @api h query operationName (fromMaybe Map.empty variables)

postJSONHandler :: forall api. (HasResolver Handler api, HasObjectDefinition api) =>
                   GraphQL.Handler Handler api -> PostBody -> Handler Response
postJSONHandler h PostBody {..} =
    interpretQuery @api h query operationName variables

postGraphQLHandler :: forall api. (HasResolver Handler api, HasObjectDefinition api) =>
                      GraphQL.Handler Handler api -> Text -> Handler Response
postGraphQLHandler h query =
    interpretQuery @api h query Nothing Map.empty