Skip to content

Commit 7ea27af

Browse files
authored
Merge pull request #91 from jml/webserver
Wai Application adpater.
2 parents dc89d89 + 2d189f4 commit 7ea27af

File tree

5 files changed

+147
-0
lines changed

5 files changed

+147
-0
lines changed

graphql-wai/graphql-wai.cabal

+53
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,53 @@
1+
-- This file has been generated from package.yaml by hpack version 0.15.0.
2+
--
3+
-- see: https://github.com/sol/hpack
4+
5+
name: graphql-wai
6+
version: 0.1.0
7+
synopsis: A simple wai adapter
8+
category: Web
9+
homepage: https://github.com/jml/graphql-api#readme
10+
bug-reports: https://github.com/jml/graphql-api/issues
11+
license: Apache
12+
build-type: Simple
13+
cabal-version: >= 1.10
14+
15+
source-repository head
16+
type: git
17+
location: https://github.com/jml/graphql-api
18+
19+
library
20+
hs-source-dirs:
21+
src
22+
default-extensions: NoImplicitPrelude OverloadedStrings RecordWildCards TypeApplications
23+
ghc-options: -Wall -fno-warn-redundant-constraints -Werror
24+
build-depends:
25+
base >= 4.9 && < 5
26+
, protolude
27+
, exceptions
28+
, wai
29+
, http-types
30+
, graphql-api
31+
, aeson
32+
exposed-modules:
33+
GraphQL.Wai
34+
default-language: Haskell2010
35+
36+
test-suite wai-tests
37+
type: exitcode-stdio-1.0
38+
main-is: Tests.hs
39+
hs-source-dirs:
40+
tests
41+
default-extensions: NoImplicitPrelude OverloadedStrings RecordWildCards TypeApplications
42+
ghc-options: -Wall -fno-warn-redundant-constraints -Werror
43+
build-depends:
44+
base >= 4.9 && < 5
45+
, protolude
46+
, exceptions
47+
, wai
48+
, http-types
49+
, graphql-api
50+
, aeson
51+
, wai-extra
52+
, graphql-wai
53+
default-language: Haskell2010

graphql-wai/package.yaml

+34
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,34 @@
1+
name: graphql-wai
2+
version: 0.1.0
3+
synopsis: A simple wai adapter
4+
license: Apache
5+
github: jml/graphql-api
6+
category: Web
7+
8+
# NB the "redundant constraints" warning is a GHC bug: https://ghc.haskell.org/trac/ghc/ticket/11099
9+
ghc-options: -Wall -fno-warn-redundant-constraints -Werror
10+
default-extensions:
11+
- NoImplicitPrelude
12+
- OverloadedStrings
13+
- RecordWildCards
14+
- TypeApplications
15+
16+
dependencies:
17+
- base >= 4.9 && < 5
18+
- protolude
19+
- exceptions
20+
- wai
21+
- http-types
22+
- graphql-api
23+
- aeson
24+
25+
library:
26+
source-dirs: src
27+
28+
tests:
29+
wai-tests:
30+
main: Tests.hs
31+
source-dirs: tests
32+
dependencies:
33+
- wai-extra
34+
- graphql-wai

graphql-wai/src/GraphQL/Wai.hs

+35
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,35 @@
1+
{-# LANGUAGE AllowAmbiguousTypes #-}
2+
{-# LANGUAGE FlexibleContexts #-}
3+
{-# LANGUAGE ScopedTypeVariables #-}
4+
5+
module GraphQL.Wai
6+
( toApplication
7+
) where
8+
9+
import Protolude
10+
11+
import GraphQL (interpretAnonymousQuery)
12+
import GraphQL.Resolver (HasResolver, Handler)
13+
import Network.Wai (Application, queryString, responseLBS)
14+
import GraphQL.Value.ToValue (toValue)
15+
import Network.HTTP.Types.Header (hContentType)
16+
import Network.HTTP.Types.Status (status200, status400)
17+
import qualified Data.Aeson as Aeson
18+
19+
20+
-- | Adapt a GraphQL handler to a WAI application. This is really just
21+
-- to illustrate the mechanism, and not production ready at this point
22+
-- in time.
23+
--
24+
-- If you have a 'Cat' type and a corresponding 'catHandler' then you
25+
-- can use "toApplication @Cat catHandler".
26+
toApplication :: forall r. (HasResolver IO r) => Handler IO r -> Application
27+
toApplication handler = app
28+
where
29+
app req respond =
30+
case queryString req of
31+
[("query", Just query)] -> do
32+
r <- interpretAnonymousQuery @r handler (toS query)
33+
let json = Aeson.encode (toValue r)
34+
respond $ responseLBS status200 [(hContentType, "application/json")] json
35+
_ -> respond $ responseLBS status400 [] "Must provide excatly one query GET argument."

graphql-wai/tests/Tests.hs

+24
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,24 @@
1+
{-# LANGUAGE DataKinds #-}
2+
module Main where
3+
4+
import Protolude
5+
6+
import Network.Wai.Test
7+
import GraphQL.API
8+
import GraphQL.Wai
9+
import GraphQL.Resolver
10+
11+
type Cat = Object "Cat" '[] '[Field "name" Text]
12+
13+
catHandler :: Handler IO Cat
14+
catHandler = pure (pure "Felix")
15+
16+
test1 :: Session ()
17+
test1 = do
18+
r <- request $ setPath defaultRequest "/?query={ name }"
19+
assertStatus 200 r
20+
assertBody "{\"data\":{\"name\":\"Felix\"}}" r
21+
22+
main :: IO ()
23+
main = do
24+
void $ runSession test1 (toApplication @Cat catHandler)

stack.yaml

+1
Original file line numberDiff line numberDiff line change
@@ -3,3 +3,4 @@ resolver: nightly-2017-01-25
33
packages:
44
- "."
55
- "./docs/source/tutorial"
6+
- "./graphql-wai"

0 commit comments

Comments
 (0)