Add comprehensive combinator support

This commit is contained in:
Julian K. Arni 2016-05-13 17:54:18 +02:00
parent ddb47d7d5e
commit 05665e6b02
3 changed files with 28 additions and 4 deletions

View file

@ -131,9 +131,27 @@ 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 (QueryFlag h :> sub) where
getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
instance HasEndpoint (sub :: *) => HasEndpoint (ReqBody cts a :> sub) where
getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
instance HasEndpoint (sub :: *) => HasEndpoint (RemoteHost :> sub) where
getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
instance HasEndpoint (sub :: *) => HasEndpoint (IsSecure :> sub) where
getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
instance HasEndpoint (sub :: *) => HasEndpoint (HttpVersion :> sub) where
getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
instance HasEndpoint (sub :: *) => HasEndpoint (Vault :> sub) where
getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
instance HasEndpoint (sub :: *) => HasEndpoint (WithNamedContext x y sub) where
getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
instance ReflectMethod method => HasEndpoint (Verb method status cts a) where
getEndpoint _ req = case pathInfo req of
[] | requestMethod req == method -> Just ([], method)

View file

@ -40,6 +40,7 @@ test-suite spec
, servant-ekg
, servant-server
, servant-client
, servant
, http-client
, text
, wai
@ -52,6 +53,7 @@ executable bench
hs-source-dirs: bench
main-is: Main.hs
ghc-options: -Wall -threaded -O2
default-language: Haskell2010
build-depends: base == 4.*
, aeson
, ekg

View file

@ -21,6 +21,7 @@ import Network.Wai
import Network.Wai.Handler.Warp
import Servant
import Servant.Client
import Servant.API.Internal.Test.ComprehensiveAPI (comprehensiveAPI)
import System.Metrics
import qualified System.Metrics.Counter as Counter
import Test.Hspec
@ -33,18 +34,21 @@ import Servant.Ekg
spec :: Spec
spec = describe "servant-ekg" $ do
let getEp :<|> postEp :<|> deleteEp = client testApi
let getEp :<|> _postEp :<|> _deleteEp = client testApi
it "collects GET data" $ do
it "collects number of request" $ do
withApp $ \port mvar -> do
mgr <- newManager defaultManagerSettings
result <- runExceptT $ getEp "name" Nothing mgr (BaseUrl Http "localhost" port "")
_result <- runExceptT $ getEp "name" Nothing mgr (BaseUrl Http "localhost" port "")
m <- readMVar mvar
print $ H.keys m
case H.lookup "hello.:name.GET" m of
Nothing -> fail "Expected some value"
Just v -> Counter.read (metersC2XX v) `shouldReturn` 1
it "is comprehensive" $ do
let _typeLevelTest = monitorEndpoints comprehensiveAPI undefined undefined undefined
True `shouldBe` True
-- * Example