Wai Application adpater.

Author: teh

graphql-wai/graphql-wai.cabal

@@ -0,0 +1,53 @@
+-- This file has been generated from package.yaml by hpack version 0.15.0.
+--
+-- see: https://github.com/sol/hpack
+
+name:           graphql-wai
+version:        0.1.0
+synopsis:       A simple wai adapter
+category:       Web
+homepage:       https://github.com/jml/graphql-api#readme
+bug-reports:    https://github.com/jml/graphql-api/issues
+license:        Apache
+build-type:     Simple
+cabal-version:  >= 1.10
+
+source-repository head
+  type: git
+  location: https://github.com/jml/graphql-api
+
+library
+  hs-source-dirs:
+      src
+  default-extensions: NoImplicitPrelude OverloadedStrings RecordWildCards TypeApplications
+  ghc-options: -Wall -fno-warn-redundant-constraints -Werror
+  build-depends:
+      base >= 4.9 && < 5
+    , protolude
+    , exceptions
+    , wai
+    , http-types
+    , graphql-api
+    , aeson
+  exposed-modules:
+      GraphQL.Wai
+  default-language: Haskell2010
+
+test-suite wai-tests
+  type: exitcode-stdio-1.0
+  main-is: Tests.hs
+  hs-source-dirs:
+      tests
+  default-extensions: NoImplicitPrelude OverloadedStrings RecordWildCards TypeApplications
+  ghc-options: -Wall -fno-warn-redundant-constraints -Werror
+  build-depends:
+      base >= 4.9 && < 5
+    , protolude
+    , exceptions
+    , wai
+    , http-types
+    , graphql-api
+    , aeson
+    , wai-extra
+    , graphql-wai
+  default-language: Haskell2010

graphql-wai/package.yaml

@@ -0,0 +1,34 @@
+name: graphql-wai
+version: 0.1.0
+synopsis: A simple wai adapter
+license: Apache
+github: jml/graphql-api
+category: Web
+
+# NB the "redundant constraints" warning is a GHC bug: https://ghc.haskell.org/trac/ghc/ticket/11099
+ghc-options: -Wall -fno-warn-redundant-constraints -Werror
+default-extensions:
+  - NoImplicitPrelude
+  - OverloadedStrings
+  - RecordWildCards
+  - TypeApplications
+
+dependencies:
+  - base >= 4.9 && < 5
+  - protolude
+  - exceptions
+  - wai
+  - http-types
+  - graphql-api
+  - aeson
+
+library:
+  source-dirs: src
+
+tests:
+  wai-tests:
+    main: Tests.hs
+    source-dirs: tests
+    dependencies:
+      - wai-extra
+      - graphql-wai

graphql-wai/src/GraphQL/Wai.hs

@@ -0,0 +1,33 @@
+{-# LANGUAGE ScopedTypeVariables, FlexibleContexts, AllowAmbiguousTypes #-}
+
+module GraphQL.Wai
+  ( toApplication
+  ) where
+
+import Protolude
+
+import GraphQL (interpretAnonymousQuery)
+import GraphQL.Resolver (HasResolver, Handler)
+import Network.Wai (Application, queryString, responseLBS)
+import GraphQL.Value.ToValue (toValue)
+import Network.HTTP.Types.Header (hContentType)
+import Network.HTTP.Types.Status (status200, status400)
+import qualified Data.Aeson as Aeson
+
+
+-- | Adapt a GraphQL handler to a WAI application. This is really just
+-- to illustrate the mechanism, and not production ready at this point
+-- in time.
+--
+-- If you have a 'Cat' type and a corresponding 'catHandler' then you
+-- can use "toApplication @Cat catHandler".
+toApplication :: forall r. (HasResolver IO r) => Handler IO r -> Application
+toApplication handler = app
+  where
+    app req respond =
+      case queryString req of
+        [("query", Just query)] -> do
+          r <- interpretAnonymousQuery @r handler (toS query)
+          let json = Aeson.encode (toValue r)
+          respond $ responseLBS status200 [(hContentType, "application/json")] json
+        _ -> respond $ responseLBS status400 [] "Must provide excatly one query GET argument."

graphql-wai/tests/Tests.hs

@@ -0,0 +1,24 @@
+{-# LANGUAGE DataKinds #-} -- , FlexibleContexts, TypeFamilies, AllowAmbiguousTypes #-}
+module Main where
+
+import Protolude
+
+import Network.Wai.Test
+import GraphQL.API
+import GraphQL.Wai
+import GraphQL.Resolver
+
+type Cat = Object "Cat" '[] '[Field "name" Text]
+
+catHandler :: Handler IO Cat
+catHandler = pure (pure "Felix")
+
+test1 :: Session ()
+test1 = do
+  r <- request $ setPath defaultRequest "/?query={ name }"
+  assertStatus 200 r
+  assertBody "{\"data\":{\"name\":\"Felix\"}}" r
+
+main :: IO ()
+main = do
+  void $ runSession test1 (toApplication @Cat catHandler)

stack.yaml

@@ -3,3 +3,4 @@ resolver: nightly-2017-01-25
 packages:
   - "."
   - "./docs/source/tutorial"
+  - "./graphql-wai"