├── .ghci ├── .gitignore ├── .travis.yml ├── LICENSE ├── Setup.hs ├── package.yaml ├── servant-graphql.cabal ├── src └── Servant │ └── GraphQL.hs ├── stack.yaml └── test ├── Doctest.hs └── Spec.hs /.ghci: -------------------------------------------------------------------------------- 1 | :set -isrc -itest -idoctest/ghci-wrapper/src 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /dist/ 2 | /dist-newstyle/ 3 | /.stack-work/ 4 | 5 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | sudo: false 2 | 3 | language: c 4 | 5 | matrix: 6 | include: 7 | - env: CABALVER=1.22 GHCVER=7.10.1 8 | addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.1],sources: [hvr-ghc]}} 9 | - env: CABALVER=1.24 GHCVER=8.0.1 10 | addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}} 11 | 12 | install: 13 | - (mkdir -p $HOME/.local/bin && cd $HOME/.local/bin && wget https://zalora-public.s3.amazonaws.com/tinc && chmod +x tinc) 14 | - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH 15 | - ghc --version 16 | - cabal --version 17 | - travis_retry cabal update 18 | - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config 19 | 20 | script: 21 | - tinc && cabal configure --enable-tests && cabal build && cabal test 22 | - cabal check 23 | 24 | cache: 25 | directories: 26 | - $HOME/.tinc/cache 27 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Julian K. Arni (c) 2015 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Julian K. Arni nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | 32 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /package.yaml: -------------------------------------------------------------------------------- 1 | name: servant-graphql 2 | version: 0.1.0.0 3 | synopsis: 4 | description: Please see README.md 5 | homepage: http://github.com/jkarni/servant-graphql#readme 6 | license: BSD3 7 | license-file: LICENSE 8 | author: Julian K. Arni 9 | maintainer: jkarni@gmail.com 10 | copyright: (c) Julian K. Arni 11 | github: jkarni/servant-graphql 12 | tested-with: GHC == 7.10.2, GHC == 8.0.1 13 | 14 | ghc-options: -Wall 15 | 16 | dependencies: 17 | - base >= 4.7 && < 4.10 18 | - text 19 | - servant 20 | - servant-server 21 | - containers 22 | - aeson 23 | 24 | default-extensions: 25 | - AutoDeriveTypeable 26 | - ConstraintKinds 27 | - DataKinds 28 | - DefaultSignatures 29 | - DeriveFoldable 30 | - DeriveFunctor 31 | - DeriveGeneric 32 | - DeriveTraversable 33 | - FlexibleContexts 34 | - FlexibleInstances 35 | - FunctionalDependencies 36 | - GADTs 37 | - KindSignatures 38 | - MultiParamTypeClasses 39 | - OverloadedStrings 40 | - RankNTypes 41 | - ScopedTypeVariables 42 | - TypeFamilies 43 | - TypeOperators 44 | 45 | library: 46 | source-dirs: src 47 | other-modules: [] 48 | 49 | tests: 50 | spec: 51 | main: Spec.hs 52 | source-dirs: test 53 | dependencies: 54 | - servant-graphql 55 | - hspec > 2 && < 3 56 | - QuickCheck >= 2.8 && < 2.9 57 | doctest: 58 | main: Doctest.hs 59 | source-dirs: test 60 | dependencies: 61 | - doctest >= 0.9 && < 0.12 62 | - Glob >= 0.7 && < 0.8 63 | - yaml == 0.8.* 64 | 65 | -------------------------------------------------------------------------------- /servant-graphql.cabal: -------------------------------------------------------------------------------- 1 | -- This file has been generated from package.yaml by hpack version 0.14.0. 2 | -- 3 | -- see: https://github.com/sol/hpack 4 | 5 | name: servant-graphql 6 | version: 0.1.0.0 7 | description: Please see README.md 8 | homepage: http://github.com/jkarni/servant-graphql#readme 9 | bug-reports: https://github.com/jkarni/servant-graphql/issues 10 | author: Julian K. Arni 11 | maintainer: jkarni@gmail.com 12 | copyright: (c) Julian K. Arni 13 | license: BSD3 14 | license-file: LICENSE 15 | tested-with: GHC == 7.10.2, GHC == 8.0.1 16 | build-type: Simple 17 | cabal-version: >= 1.10 18 | 19 | source-repository head 20 | type: git 21 | location: https://github.com/jkarni/servant-graphql 22 | 23 | library 24 | hs-source-dirs: 25 | src 26 | default-extensions: AutoDeriveTypeable ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators 27 | ghc-options: -Wall 28 | build-depends: 29 | base >= 4.7 && < 4.10 30 | , text 31 | , servant 32 | , servant-server 33 | , containers 34 | , aeson 35 | exposed-modules: 36 | Servant.GraphQL 37 | default-language: Haskell2010 38 | 39 | test-suite doctest 40 | type: exitcode-stdio-1.0 41 | main-is: Doctest.hs 42 | hs-source-dirs: 43 | test 44 | default-extensions: AutoDeriveTypeable ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators 45 | ghc-options: -Wall 46 | build-depends: 47 | base >= 4.7 && < 4.10 48 | , text 49 | , servant 50 | , servant-server 51 | , containers 52 | , aeson 53 | , doctest >= 0.9 && < 0.12 54 | , Glob >= 0.7 && < 0.8 55 | , yaml == 0.8.* 56 | other-modules: 57 | Spec 58 | default-language: Haskell2010 59 | 60 | test-suite spec 61 | type: exitcode-stdio-1.0 62 | main-is: Spec.hs 63 | hs-source-dirs: 64 | test 65 | default-extensions: AutoDeriveTypeable ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators 66 | ghc-options: -Wall 67 | build-depends: 68 | base >= 4.7 && < 4.10 69 | , text 70 | , servant 71 | , servant-server 72 | , containers 73 | , aeson 74 | , servant-graphql 75 | , hspec > 2 && < 3 76 | , QuickCheck >= 2.8 && < 2.9 77 | other-modules: 78 | Doctest 79 | default-language: Haskell2010 80 | -------------------------------------------------------------------------------- /src/Servant/GraphQL.hs: -------------------------------------------------------------------------------- 1 | module Servant.GraphQL where 2 | 3 | import qualified Data.Map as Map 4 | import Data.Aeson 5 | import qualified Data.Text as T 6 | import Servant 7 | 8 | data GraphQL 9 | -- This directly returns a value 10 | = Val (Handler Value) 11 | -- This needs an argument. 12 | | Fn (Value -> GraphQL) 13 | -- This has fields 14 | | Fields (Map.Map T.Text GraphQL) 15 | 16 | newtype Accepts = Accepts [T.Text] 17 | 18 | class HasName a where 19 | hasName :: Proxy a -> T.Text 20 | 21 | class HasGraphQL a where 22 | hasGraphQL :: a -> GraphQL 23 | 24 | instance (HasName a, ToJSON a) => HasGraphQL (Handler a) where 25 | hasGraphQL x = Fields $ Map.fromList [(n, Val $ toJSON <$> x)] 26 | where 27 | n = hasName (Proxy :: Proxy a) 28 | 29 | instance (FromJSON a, HasGraphQL r) => HasGraphQL (a -> r ) where 30 | hasGraphQL fn = Fn $ \x -> hasGraphQL $ fn (forceResult $ fromJSON x) 31 | where 32 | forceResult (Success a) = a 33 | forceResult _ = error "bother later" 34 | 35 | {- 36 | Example: 37 | 38 | { 39 | human(id: "1000") { 40 | name 41 | height 42 | } 43 | } 44 | 45 | Becomes (roughly) 46 | 47 | \g -> case g of 48 | Fields m -> case Map.lookup "human" m of 49 | Fn fn -> case fn 1000 of 50 | Fields m' -> case (Map.lookup "name" m', Map.lookup "height" m' of) 51 | (Val nameE, Val heightE) -> 52 | _ -> badQuery 53 | _ -> badQuery 54 | -} 55 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by 'stack init' 2 | # 3 | # Some commonly used options have been documented as comments in this file. 4 | # For advanced use and comprehensive documentation of the format, please see: 5 | # http://docs.haskellstack.org/en/stable/yaml_configuration/ 6 | 7 | # Resolver to choose a 'specific' stackage snapshot or a compiler version. 8 | # A snapshot resolver dictates the compiler version and the set of packages 9 | # to be used for project dependencies. For example: 10 | # 11 | # resolver: lts-3.5 12 | # resolver: nightly-2015-09-21 13 | # resolver: ghc-7.10.2 14 | # resolver: ghcjs-0.1.0_ghc-7.10.2 15 | # resolver: 16 | # name: custom-snapshot 17 | # location: "./custom-snapshot.yaml" 18 | resolver: lts-7.0 19 | 20 | # User packages to be built. 21 | # Various formats can be used as shown in the example below. 22 | # 23 | # packages: 24 | # - some-directory 25 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 26 | # - location: 27 | # git: https://github.com/commercialhaskell/stack.git 28 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 29 | # - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a 30 | # extra-dep: true 31 | # subdirs: 32 | # - auto-update 33 | # - wai 34 | # 35 | # A package marked 'extra-dep: true' will only be built if demanded by a 36 | # non-dependency (i.e. a user package), and its test suites and benchmarks 37 | # will not be run. This is useful for tweaking upstream packages. 38 | packages: 39 | - '.' 40 | # Dependency packages to be pulled from upstream that are not in the resolver 41 | # (e.g., acme-missiles-0.3) 42 | extra-deps: [] 43 | 44 | # Override default flag values for local packages and extra-deps 45 | flags: {} 46 | 47 | # Extra package databases containing global packages 48 | extra-package-dbs: [] 49 | 50 | # Control whether we use the GHC we find on the path 51 | # system-ghc: true 52 | # 53 | # Require a specific version of stack, using version ranges 54 | # require-stack-version: -any # Default 55 | # require-stack-version: ">=1.1" 56 | # 57 | # Override the architecture used by stack, especially useful on Windows 58 | # arch: i386 59 | # arch: x86_64 60 | # 61 | # Extra directories used by stack for building 62 | # extra-include-dirs: [/path/to/dir] 63 | # extra-lib-dirs: [/path/to/dir] 64 | # 65 | # Allow a newer minor version of GHC than the snapshot specifies 66 | # compiler-check: newer-minor -------------------------------------------------------------------------------- /test/Doctest.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | 3 | -- Runs doctest on all files in "src" dir. Assumes: 4 | -- (a) You are using hpack 5 | -- (b) The top-level "default-extensions" are the only extensions besides the 6 | -- ones in the files. 7 | 8 | import System.FilePath.Glob (glob) 9 | import Test.DocTest (doctest) 10 | import Data.Yaml 11 | 12 | newtype Exts = Exts { getExts :: [String] } 13 | deriving (Eq, Show, Read) 14 | 15 | instance FromJSON Exts where 16 | parseJSON (Object v) = Exts <$> v .: "default-extensions" 17 | parseJSON _ = fail "expecting object" 18 | 19 | main :: IO () 20 | main = do 21 | hpack' <- decodeFile "package.yaml" 22 | hpack <- case hpack' of 23 | Nothing -> return $ Exts [] 24 | Just v -> return v 25 | files <- glob "src/**/*.hs" 26 | doctest $ files ++ fmap ("-X" ++) (getExts hpack) 27 | -------------------------------------------------------------------------------- /test/Spec.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -F -pgmF hspec-discover #-} 2 | --------------------------------------------------------------------------------