diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/morpheus-graphql-server.cabal b/morpheus-graphql-server.cabal --- a/morpheus-graphql-server.cabal +++ b/morpheus-graphql-server.cabal @@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.38.1. +-- This file has been generated from package.yaml by hpack version 0.36.1. -- -- see: https://github.com/sol/hpack name: morpheus-graphql-server -version: 0.28.4 +version: 0.28.5 synopsis: Morpheus GraphQL description: Build GraphQL APIs with your favourite functional language! category: web, graphql @@ -20,6 +20,7 @@ extra-source-files: README.md changelog.md + src/Data/Morpheus/Server/Playground/index.html data-files: test/Feature/Collision/category-collision-fail/query.gql test/Feature/Collision/category-collision-success/query.gql @@ -356,14 +357,15 @@ src ghc-options: -Wall build-depends: - aeson >=1.4.4 && <3.0.0 + aeson >=1.3.1.1 && <3.0.0 , base >=4.7.0 && <5.0.0 , bytestring >=0.10.4 && <1.0.0 , containers >=0.4.2.1 && <1.0.0 + , file-embed >=0.0.10 && <1.0.0 , morpheus-graphql-app >=0.28.0 && <0.29.0 , morpheus-graphql-core >=0.28.0 && <0.29.0 , mtl >=2.0.0 && <3.0.0 - , relude >=0.3.0 && <2.0.0 + , relude >=0.1.1 && <2.0.0 , template-haskell >=2.0.0 && <3.0.0 , text >=1.2.3 && <3.0.0 , transformers >=0.3.0 && <1.0.0 @@ -410,7 +412,7 @@ test ghc-options: -Wall build-depends: - aeson >=1.4.4 && <3.0.0 + aeson >=1.3.1.1 && <3.0.0 , base >=4.7.0 && <5.0.0 , bytestring >=0.10.4 && <1.0.0 , containers >=0.4.2.1 && <1.0.0 @@ -421,7 +423,7 @@ , morpheus-graphql-subscriptions >=0.28.0 && <0.29.0 , morpheus-graphql-tests >=0.28.0 && <0.29.0 , mtl >=2.0.0 && <3.0.0 - , relude >=0.3.0 && <2.0.0 + , relude >=0.1.1 && <2.0.0 , tasty >=0.1.0 && <2.0.0 , tasty-hunit >=0.1.0 && <1.0.0 , template-haskell >=2.0.0 && <3.0.0 diff --git a/src/Data/Morpheus/Server/Deriving/Internal/Type.hs b/src/Data/Morpheus/Server/Deriving/Internal/Type.hs --- a/src/Data/Morpheus/Server/Deriving/Internal/Type.hs +++ b/src/Data/Morpheus/Server/Deriving/Internal/Type.hs @@ -210,8 +210,8 @@ GQLResult (TypeDefinition cat CONST) toTypeDefinition ctx proxy content = do dirs <- serializeDirectives ctx (getTypeDirectives ctx proxy) - pure - $ TypeDefinition + pure $ + TypeDefinition (visitTypeDescription ctx proxy Nothing) (useTypename ctx proxy) dirs diff --git a/src/Data/Morpheus/Server/Playground.hs b/src/Data/Morpheus/Server/Playground.hs --- a/src/Data/Morpheus/Server/Playground.hs +++ b/src/Data/Morpheus/Server/Playground.hs @@ -1,72 +1,12 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TemplateHaskell #-} module Data.Morpheus.Server.Playground ( httpPlayground, ) where -import Data.ByteString.Lazy.Char8 (ByteString) -import Data.Functor (fmap) -import Data.Semigroup ((<>)) -import Prelude - ( mconcat, - (.), - ) - -link :: ByteString -> ByteString -> ByteString -link rel href = " rel <> "\" href=\"" <> href <> "\" />" - -meta :: [(ByteString, ByteString)] -> ByteString -meta attr = t "meta" attr [] - -tag :: ByteString -> [ByteString] -> ByteString -tag tagName = t tagName [] - -t :: ByteString -> [(ByteString, ByteString)] -> [ByteString] -> ByteString -t tagName attr children = - "<" <> tagName <> " " <> mconcat (fmap renderAttr attr) <> " >" <> mconcat children <> " tagName <> ">" - where - renderAttr (name, value) = name <> "=\"" <> value <> "\" " - -script :: [(ByteString, ByteString)] -> [ByteString] -> ByteString -script = t "script" - -html :: [ByteString] -> ByteString -html = docType . t "html" [] - -docType :: ByteString -> ByteString -docType x = "" <> x +import Data.ByteString.Lazy.Char8 (ByteString, fromStrict) +import Data.FileEmbed (embedFile, makeRelativeToProject) httpPlayground :: ByteString -httpPlayground = - html - [ tag - "head" - [ meta [("charset", "utf-8")], - meta - [ ("name", "viewport"), - ("content", "user-scalable=no, initial-scale=1.0, minimum-scale=1.0, maximum-scale=1.0, minimal-ui") - ], - tag "title" ["GraphQL Playground"], - link "stylesheet" "//cdn.jsdelivr.net/npm/graphql-playground-react/build/static/css/index.css", - link "shortcut icon" "//cdn.jsdelivr.net/npm/graphql-playground-react/build/favicon.png", - script - [("src", "//cdn.jsdelivr.net/npm/graphql-playground-react/build/static/js/middleware.js")] - [] - ], - tag - "body" - [ t "div" [("id", "root")] [], - script - [] - [ " window.addEventListener('load', (_) => \ - \ GraphQLPlayground.init(document.getElementById('root'), {}) \ - \ );" - ] - ] - ] +httpPlayground = fromStrict $(embedFile =<< makeRelativeToProject "src/Data/Morpheus/Server/Playground/index.html") diff --git a/src/Data/Morpheus/Server/Playground/index.html b/src/Data/Morpheus/Server/Playground/index.html new file mode 100644 --- /dev/null +++ b/src/Data/Morpheus/Server/Playground/index.html @@ -0,0 +1,123 @@ + + + + + + GraphiQL Explorer + + + + + + + +
+
+
+ + diff --git a/src/Data/Morpheus/Server/Resolvers.hs b/src/Data/Morpheus/Server/Resolvers.hs --- a/src/Data/Morpheus/Server/Resolvers.hs +++ b/src/Data/Morpheus/Server/Resolvers.hs @@ -68,7 +68,8 @@ event (query :: (Type -> Type) -> Type) (mutation :: (Type -> Type) -> Type) - (subscription :: (Type -> Type) -> Type) = RootResolver + (subscription :: (Type -> Type) -> Type) + = RootResolver { queryResolver :: query (Resolver QUERY event m), mutationResolver :: mutation (Resolver MUTATION event m), subscriptionResolver :: subscription (Resolver SUBSCRIPTION event m) diff --git a/test/Feature/Collision/CategoryCollisionFail.hs b/test/Feature/Collision/CategoryCollisionFail.hs --- a/test/Feature/Collision/CategoryCollisionFail.hs +++ b/test/Feature/Collision/CategoryCollisionFail.hs @@ -47,8 +47,8 @@ { queryResolver = Query { deity = - const - $ pure + const $ + pure Deity { name = "Morpheus", diff --git a/test/Feature/Collision/CategoryCollisionSuccess.hs b/test/Feature/Collision/CategoryCollisionSuccess.hs --- a/test/Feature/Collision/CategoryCollisionSuccess.hs +++ b/test/Feature/Collision/CategoryCollisionSuccess.hs @@ -59,8 +59,8 @@ { queryResolver = Query { deity = - const - $ pure + const $ + pure Deity { name = "Morpheus", diff --git a/test/Feature/NamedResolvers/EntitiesApp.hs b/test/Feature/NamedResolvers/EntitiesApp.hs --- a/test/Feature/NamedResolvers/EntitiesApp.hs +++ b/test/Feature/NamedResolvers/EntitiesApp.hs @@ -46,13 +46,13 @@ instance ResolveNamed m (Query (NamedResolverT m)) where type Dep (Query (NamedResolverT m)) = () resolveBatched = - ignoreBatching - $ const - $ pure - Query - { entities = resolve (pure allEntities), - entity = \(Arg uid) -> resolve (pure uid) - } + ignoreBatching $ + const $ + pure + Query + { entities = resolve (pure allEntities), + entity = \(Arg uid) -> resolve (pure uid) + } entitiesApp :: App () IO entitiesApp = deriveApp (NamedResolvers :: NamedResolvers IO () Query Undefined Undefined) diff --git a/test/Feature/NamedResolvers/RealmsApp.hs b/test/Feature/NamedResolvers/RealmsApp.hs --- a/test/Feature/NamedResolvers/RealmsApp.hs +++ b/test/Feature/NamedResolvers/RealmsApp.hs @@ -41,8 +41,8 @@ getRealm :: (Monad m) => ID -> m (Maybe (Realm (NamedResolverT m))) getRealm uid | uid `elem` allRealms = - pure - $ Just + pure $ + Just Realm { name = resolve (getRealmName uid), owner = resolve (getOwner uid), @@ -67,13 +67,13 @@ instance ResolveNamed m (Query (NamedResolverT m)) where type Dep (Query (NamedResolverT m)) = () resolveBatched = - ignoreBatching - $ const - $ pure - Query - { realm = \(Arg arg) -> resolve (pure arg), - realms = resolve (pure allRealms) - } + ignoreBatching $ + const $ + pure + Query + { realm = \(Arg arg) -> resolve (pure arg), + realms = resolve (pure allRealms) + } realmsApp :: App () IO realmsApp =