diff --git a/.gitignore b/.gitignore index b68c698..08b3fb3 100644 --- a/.gitignore +++ b/.gitignore @@ -2,3 +2,4 @@ *cabal.sandbox.config .cabal-sandbox/* *dist/ +*dist-newstyle/ diff --git a/lib/Servant/Ekg.hs b/lib/Servant/Ekg.hs index fe63a02..40a70f9 100644 --- a/lib/Servant/Ekg.hs +++ b/lib/Servant/Ekg.hs @@ -6,6 +6,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE PolyKinds #-} module Servant.Ekg where 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 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) -instance HasEndpoint (Get a) where +instance ReflectMethod method => HasEndpoint (Verb method status cts a) where getEndpoint _ req = case pathInfo req of - [] | requestMethod req == "GET" -> Just ([],"GET") - _ -> 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") + [] | requestMethod req == method -> Just ([], method) _ -> Nothing + where method = reflectMethod (Proxy :: Proxy method) instance HasEndpoint (Raw) where getEndpoint _ _ = Just ([],"RAW") diff --git a/servant-ekg.cabal b/servant-ekg.cabal index 7768d6f..32b7cab 100644 --- a/servant-ekg.cabal +++ b/servant-ekg.cabal @@ -19,7 +19,7 @@ library hs-source-dirs: lib build-depends: base >=4.7 && <4.9 , ekg-core - , servant >=0.2 && <0.3 + , servant == 0.7.* , http-types , text , time diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..89e083b --- /dev/null +++ b/stack.yaml @@ -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 diff --git a/test/test.hs b/test/test.hs index 4963a51..0a0ab3a 100644 --- a/test/test.hs +++ b/test/test.hs @@ -31,14 +31,14 @@ instance ToJSON Greet -- API specification type TestApi = -- 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, -- returns a Greet as JSON - :<|> "greet" :> ReqBody Greet :> Post Greet + :<|> "greet" :> ReqBody '[JSON] Greet :> Post '[JSON] Greet -- DELETE /greet/:greetid - :<|> "greet" :> Capture "greetid" Text :> Delete + :<|> "greet" :> Capture "greetid" Text :> Delete '[JSON] () testApi :: Proxy TestApi testApi = Proxy