graphql/tests/Schemas/HeroSchema.hs
2022-01-07 08:31:47 +01:00

71 lines
2.6 KiB
Haskell

{- This Source Code Form is subject to the terms of the Mozilla Public License,
v. 2.0. If a copy of the MPL was not distributed with this file, You can
obtain one at https://mozilla.org/MPL/2.0/. -}
{-# LANGUAGE OverloadedStrings #-}
module Schemas.HeroSchema (heroSchema) where
import Control.Exception (Exception(..), SomeException)
import Control.Monad.Catch (throwM)
import Language.GraphQL.Error (ResolverException (..))
import qualified Language.GraphQL.Type.In as In
import qualified Language.GraphQL.Type as Type
import Language.GraphQL.Type.Schema (schemaWithTypes)
import qualified Data.HashMap.Strict as HashMap
import Data.Typeable (cast)
import qualified Language.GraphQL.Type.Out as Out
data HeroException = HeroException
deriving Show
instance Exception HeroException where
toException = toException. ResolverException
fromException e = do
ResolverException resolverException <- fromException e
cast resolverException
heroSchema :: Type.Schema (Either SomeException)
heroSchema =
schemaWithTypes Nothing queryType Nothing Nothing [] mempty
type ObjectType = Out.ObjectType (Either SomeException)
queryType :: ObjectType
queryType = Out.ObjectType "Query" Nothing []
$ HashMap.fromList
[ ("hero", Out.ValueResolver heroField heroResolver)
]
where
heroField = Out.Field Nothing (Out.NamedObjectType heroType)
$ HashMap.singleton "id"
$ In.Argument Nothing (In.NamedScalarType Type.id) Nothing
heroResolver = pure $ Type.Object mempty
stringField :: Out.Field (Either SomeException)
stringField = Out.Field Nothing (Out.NonNullScalarType Type.string) HashMap.empty
heroType :: ObjectType
heroType = Out.ObjectType "Hero" Nothing [] $ HashMap.fromList resolvers
where
resolvers =
[ ("id", Out.ValueResolver stringField (pure $ Type.String "4111"))
, ("name", Out.ValueResolver stringField (pure $ Type.String "R2D2"))
, ("friends", Out.ValueResolver friendsField (pure $ Type.List [luke]))
]
friendsField = Out.Field Nothing (Out.ListType $ Out.NonNullObjectType lukeType) HashMap.empty
-- This list values are ignored because of current realisation (types and resolvers are the same entity)
-- The values from lukeType will be used
luke = Type.Object $ HashMap.fromList
[ ("id", "dfdfdf")
, ("name", "dfdfdff")
]
lukeType :: ObjectType
lukeType = Out.ObjectType "Luke" Nothing [] $ HashMap.fromList resolvers
where
resolvers =
[ ("id", Out.ValueResolver stringField (pure $ Type.String "1000"))
, ("name", Out.ValueResolver stringField (throwM HeroException))
]