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 instance HasEndpoint (sub :: *) => HasEndpoint (QueryParams (h :: Symbol) a :> sub) where
getEndpoint _ = getEndpoint (Proxy :: Proxy sub) 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 instance HasEndpoint (sub :: *) => HasEndpoint (ReqBody cts a :> sub) where
getEndpoint _ = getEndpoint (Proxy :: Proxy sub) 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 instance ReflectMethod method => HasEndpoint (Verb method status cts a) where
getEndpoint _ req = case pathInfo req of getEndpoint _ req = case pathInfo req of
[] | requestMethod req == method -> Just ([], method) [] | requestMethod req == method -> Just ([], method)

View file

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

View file

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