mirror of
https://github.com/haskell-servant/servant-ekg.git
synced 2024-11-26 21:19:43 +01:00
Add comprehensive combinator support
This commit is contained in:
parent
ddb47d7d5e
commit
05665e6b02
3 changed files with 28 additions and 4 deletions
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue