Update for servant 0.7

This commit is contained in:
Julian K. Arni 2016-05-13 12:27:26 +02:00
parent e2629d7434
commit afeab8dd11
5 changed files with 86 additions and 22 deletions

1
.gitignore vendored
View file

@ -2,3 +2,4 @@
*cabal.sandbox.config *cabal.sandbox.config
.cabal-sandbox/* .cabal-sandbox/*
*dist/ *dist/
*dist-newstyle/

View file

@ -6,6 +6,7 @@
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE PolyKinds #-}
module Servant.Ekg where module Servant.Ekg where
import Control.Concurrent.MVar import Control.Concurrent.MVar
@ -128,28 +129,14 @@ instance HasEndpoint (sub :: *) => HasEndpoint (QueryParam (h :: Symbol) a :> su
instance HasEndpoint (sub :: *) => HasEndpoint (QueryParams (h :: Symbol) a :> sub) where instance HasEndpoint (sub :: *) => HasEndpoint (QueryParams (h :: Symbol) a :> sub) where
getEndpoint _ = getEndpoint (Proxy :: Proxy sub) getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
instance HasEndpoint (sub :: *) => HasEndpoint (ReqBody a :> sub) where instance HasEndpoint (sub :: *) => HasEndpoint (ReqBody cts a :> sub) where
getEndpoint _ = getEndpoint (Proxy :: Proxy sub) getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
instance HasEndpoint (Get a) where instance ReflectMethod method => HasEndpoint (Verb method status cts a) where
getEndpoint _ req = case pathInfo req of getEndpoint _ req = case pathInfo req of
[] | requestMethod req == "GET" -> Just ([],"GET") [] | requestMethod req == method -> Just ([], method)
_ -> Nothing
instance HasEndpoint (Put a) where
getEndpoint _ req = case pathInfo req of
[] | requestMethod req == "PUT" -> Just ([],"PUT")
_ -> Nothing
instance HasEndpoint (Post a) where
getEndpoint _ req = case pathInfo req of
[] | requestMethod req == "POST" -> Just ([],"POST")
_ -> Nothing
instance HasEndpoint (Delete) where
getEndpoint _ req = case pathInfo req of
[] | requestMethod req == "DELETE" -> Just ([],"DELETE")
_ -> Nothing _ -> Nothing
where method = reflectMethod (Proxy :: Proxy method)
instance HasEndpoint (Raw) where instance HasEndpoint (Raw) where
getEndpoint _ _ = Just ([],"RAW") getEndpoint _ _ = Just ([],"RAW")

View file

@ -19,7 +19,7 @@ library
hs-source-dirs: lib hs-source-dirs: lib
build-depends: base >=4.7 && <4.9 build-depends: base >=4.7 && <4.9
, ekg-core , ekg-core
, servant >=0.2 && <0.3 , servant == 0.7.*
, http-types , http-types
, text , text
, time , time

76
stack.yaml Normal file
View file

@ -0,0 +1,76 @@
# This file was automatically generated by 'stack init'
#
# Some commonly used options have been documented as comments in this file.
# For advanced use and comprehensive documentation of the format, please see:
# http://docs.haskellstack.org/en/stable/yaml_configuration/
# A warning or info to be displayed to the user on config load.
user-message: ! 'Warning (added by new or init): Specified resolver could not satisfy
all dependencies. Some external packages have been added as dependencies.
You can suppress this message by removing it from stack.yaml
'
# Resolver to choose a 'specific' stackage snapshot or a compiler version.
# A snapshot resolver dictates the compiler version and the set of packages
# to be used for project dependencies. For example:
#
# resolver: lts-3.5
# resolver: nightly-2015-09-21
# resolver: ghc-7.10.2
# resolver: ghcjs-0.1.0_ghc-7.10.2
# resolver:
# name: custom-snapshot
# location: "./custom-snapshot.yaml"
resolver: lts-5.16
# User packages to be built.
# Various formats can be used as shown in the example below.
#
# packages:
# - some-directory
# - https://example.com/foo/bar/baz-0.0.2.tar.gz
# - location:
# git: https://github.com/commercialhaskell/stack.git
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
# extra-dep: true
# subdirs:
# - auto-update
# - wai
#
# A package marked 'extra-dep: true' will only be built if demanded by a
# non-dependency (i.e. a user package), and its test suites and benchmarks
# will not be run. This is useful for tweaking upstream packages.
packages:
- '.'
# Dependency packages to be pulled from upstream that are not in the resolver
# (e.g., acme-missiles-0.3)
extra-deps:
- servant-0.7.1
- servant-server-0.7.1
# Override default flag values for local packages and extra-deps
flags: {}
# Extra package databases containing global packages
extra-package-dbs: []
# Control whether we use the GHC we find on the path
# system-ghc: true
#
# Require a specific version of stack, using version ranges
# require-stack-version: -any # Default
# require-stack-version: ">=1.1"
#
# Override the architecture used by stack, especially useful on Windows
# arch: i386
# arch: x86_64
#
# Extra directories used by stack for building
# extra-include-dirs: [/path/to/dir]
# extra-lib-dirs: [/path/to/dir]
#
# Allow a newer minor version of GHC than the snapshot specifies
# compiler-check: newer-minor

View file

@ -31,14 +31,14 @@ instance ToJSON Greet
-- API specification -- API specification
type TestApi = type TestApi =
-- GET /hello/:name?capital={true, false} returns a Greet as JSON -- GET /hello/:name?capital={true, false} returns a Greet as JSON
"hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON] Greet
-- POST /greet with a Greet as JSON in the request body, -- POST /greet with a Greet as JSON in the request body,
-- returns a Greet as JSON -- returns a Greet as JSON
:<|> "greet" :> ReqBody Greet :> Post Greet :<|> "greet" :> ReqBody '[JSON] Greet :> Post '[JSON] Greet
-- DELETE /greet/:greetid -- DELETE /greet/:greetid
:<|> "greet" :> Capture "greetid" Text :> Delete :<|> "greet" :> Capture "greetid" Text :> Delete '[JSON] ()
testApi :: Proxy TestApi testApi :: Proxy TestApi
testApi = Proxy testApi = Proxy