servant-server 0.11.0.1 → 0.12
raw patch · 11 files changed
+192/−96 lines, 11 filesdep ~hspec-waidep ~http-typesdep ~servant
Dependency ranges changed: hspec-wai, http-types, servant
Files
- CHANGELOG.md +12/−0
- servant-server.cabal +4/−3
- src/Servant/Server.hs +28/−40
- src/Servant/Server/Experimental/Auth.hs +4/−3
- src/Servant/Server/Internal.hs +79/−41
- test/Servant/ArbitraryMonadServerSpec.hs +9/−7
- test/Servant/HoistSpec.hs +38/−0
- test/Servant/Server/Internal/ContextSpec.hs +2/−2
- test/Servant/Server/Internal/RoutingApplicationSpec.hs +3/−0
- test/Servant/Server/UsingContextSpec/TestCombinators.hs +8/−0
- test/Servant/ServerSpec.hs +5/−0
CHANGELOG.md view
@@ -1,3 +1,15 @@+[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-server/CHANGELOG.md)+[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)++0.12+----++### Breaking changes++* Added `hoistServer` member to the `HasServer` class, which is `HasServer`+ specific `enter`.+ ([#804](https://github.com/haskell-servant/servant/pull/804))+ 0.11 ----
servant-server.cabal view
@@ -1,5 +1,5 @@ name: servant-server-version: 0.11.0.1+version: 0.12 synopsis: A family of combinators for defining webservices APIs and serving them description: A family of combinators for defining webservices APIs and serving them@@ -18,7 +18,7 @@ author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com copyright: 2014-2016 Zalora South East Asia Pte Ltd, Servant Contributors-category: Servant Web+category: Servant, Web build-type: Custom cabal-version: >=1.10 tested-with:@@ -70,7 +70,7 @@ , mtl >= 2 && < 2.3 , network >= 2.6 && < 2.7 , safe >= 0.3 && < 0.4- , servant == 0.11.*+ , servant == 0.12.* , split >= 0.2 && < 0.3 , string-conversions >= 0.3 && < 0.5 , system-filepath >= 0.4 && < 0.5@@ -122,6 +122,7 @@ Servant.Server.StreamingSpec Servant.Server.UsingContextSpec Servant.Server.UsingContextSpec.TestCombinators+ Servant.HoistSpec Servant.ServerSpec Servant.Utils.StaticFilesSpec build-tool-depends:
src/Servant/Server.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} -- | This module lets you implement 'Server's for defined APIs. You'll@@ -26,24 +27,10 @@ , layout , layoutWithContext - -- * Enter- -- $enterDoc+ -- * Enter / hoisting server+ , hoistServer - -- ** Basic functions and datatypes- , enter- , (:~>)(..)- -- ** `Nat` utilities- , liftNat- , runReaderTNat- , evalStateTLNat- , evalStateTSNat- , logWriterTLNat- , logWriterTSNat -- ** Functions based on <https://hackage.haskell.org/package/mmorph mmorph>- , hoistNat- , embedNat- , squashNat- , generalizeNat , tweakResponse -- * Context@@ -106,12 +93,11 @@ ) where -import Data.Proxy (Proxy)+import Data.Proxy (Proxy (..)) import Data.Tagged (Tagged (..)) import Data.Text (Text) import Network.Wai (Application) import Servant.Server.Internal-import Servant.Utils.Enter -- * Implementing Servers@@ -145,6 +131,30 @@ serveWithContext p context server = toApplication (runRouter (route p context (emptyDelayed (Route server)))) +-- | Hoist server implementation.+--+-- Sometimes our cherished `Handler` monad isn't quite the type you'd like for+-- your handlers. Maybe you want to thread some configuration in a @Reader@+-- monad. Or have your types ensure that your handlers don't do any IO. Use+-- `hoistServer` (a successor of now deprecated @enter@).+--+-- With `hoistServer`, you can provide a function,+-- to convert any number of endpoints from one type constructor to+-- another. For example+--+-- /Note:/ 'Server' 'Raw' can also be entered. It will be retagged.+--+-- >>> import Control.Monad.Reader+-- >>> type ReaderAPI = "ep1" :> Get '[JSON] Int :<|> "ep2" :> Get '[JSON] String :<|> Raw :<|> EmptyAPI+-- >>> let readerApi = Proxy :: Proxy ReaderAPI+-- >>> let readerServer = return 1797 :<|> ask :<|> Tagged (error "raw server") :<|> emptyServer :: ServerT ReaderAPI (Reader String)+-- >>> let nt x = return (runReader x "hi")+-- >>> let mainServer = hoistServer readerApi nt readerServer :: Server ReaderAPI+--+hoistServer :: (HasServer api '[]) => Proxy api+ -> (forall x. m x -> n x) -> ServerT api m -> ServerT api n+hoistServer p = hoistServerWithContext p (Proxy :: Proxy '[])+ -- | The function 'layout' produces a textual description of the internal -- router layout for debugging purposes. Note that the router layout is -- determined just by the API, not by the handlers.@@ -204,28 +214,6 @@ => Proxy api -> Context context -> Text layoutWithContext p context = routerLayout (route p context (emptyDelayed (FailFatal err501)))---- Documentation---- $enterDoc--- Sometimes our cherished `ExceptT` monad isn't quite the type you'd like for--- your handlers. Maybe you want to thread some configuration in a @Reader@--- monad. Or have your types ensure that your handlers don't do any IO. Enter--- `enter`.------ With `enter`, you can provide a function, wrapped in the `(:~>)` / `NT`--- newtype, to convert any number of endpoints from one type constructor to--- another. For example------ /Note:/ 'Server' 'Raw' can also be entered. It will be retagged.------ >>> import Control.Monad.Reader--- >>> import qualified Control.Category as C--- >>> type ReaderAPI = "ep1" :> Get '[JSON] Int :<|> "ep2" :> Get '[JSON] String :<|> Raw :<|> EmptyAPI--- >>> let readerServer = return 1797 :<|> ask :<|> Tagged (error "raw server") :<|> emptyServer :: ServerT ReaderAPI (Reader String)--- >>> let nt = generalizeNat C.. (runReaderTNat "hi") :: Reader String :~> Handler--- >>> let mainServer = enter nt readerServer :: Server ReaderAPI--- -- $setup -- >>> :set -XDataKinds
src/Servant/Server/Experimental/Auth.hs view
@@ -21,9 +21,8 @@ import Servant ((:>)) import Servant.API.Experimental.Auth import Servant.Server.Internal (HasContextEntry,- HasServer, ServerT,- getContextEntry,- route)+ HasServer (..),+ getContextEntry) import Servant.Server.Internal.RoutingApplication (addAuthCheck, delayedFailFatal, DelayedIO,@@ -57,6 +56,8 @@ type ServerT (AuthProtect tag :> api) m = AuthServerData (AuthProtect tag) -> ServerT api m++ hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s route Proxy context subserver = route (Proxy :: Proxy api) context (subserver `addAuthCheck` withRequest authCheck)
src/Servant/Server/Internal.hs view
@@ -8,7 +8,9 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} @@ -33,14 +35,14 @@ import Data.Either (partitionEithers) import Data.String (fromString) import Data.String.Conversions (cs, (<>))-import Data.Tagged (Tagged(..), untag)+import Data.Tagged (Tagged(..), retag, untag) import qualified Data.Text as T import Data.Typeable import GHC.TypeLits (KnownNat, KnownSymbol, natVal, symbolVal) import Network.HTTP.Types hiding (Header, ResponseHeaders) import Network.Socket (SockAddr)-import Network.Wai (Application, Request, Response,+import Network.Wai (Application, Request, httpVersion, isSecure, lazyRequestBody, rawQueryString, remoteHost,@@ -58,7 +60,8 @@ IsSecure(..), Header, QueryFlag, QueryParam, QueryParams, Raw, RemoteHost, ReqBody, Vault,- WithNamedContext)+ WithNamedContext,+ Description, Summary) import Servant.API.ContentTypes (AcceptHeader (..), AllCTRender (..), AllCTUnrender (..),@@ -84,6 +87,13 @@ -> Delayed env (Server api) -> Router env + hoistServerWithContext+ :: Proxy api+ -> Proxy context+ -> (forall x. m x -> n x)+ -> ServerT api m+ -> ServerT api n+ type Server api = ServerT api Handler -- * Instances@@ -108,6 +118,11 @@ where pa = Proxy :: Proxy a pb = Proxy :: Proxy b + -- | This is better than 'enter', as it's tailor made for 'HasServer'.+ hoistServerWithContext _ pc nt (a :<|> b) =+ hoistServerWithContext (Proxy :: Proxy a) pc nt a :<|>+ hoistServerWithContext (Proxy :: Proxy b) pc nt b+ -- | If you use 'Capture' in one of the endpoints for your API, -- this automatically requires your server-side handler to be a function -- that takes an argument of the type specified by the 'Capture'.@@ -131,6 +146,8 @@ type ServerT (Capture capture a :> api) m = a -> ServerT api m + hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s+ route Proxy context d = CaptureRouter $ route (Proxy :: Proxy api)@@ -157,15 +174,17 @@ -- > server = getSourceFile -- > where getSourceFile :: [Text] -> Handler Book -- > getSourceFile pathSegments = ...-instance (KnownSymbol capture, FromHttpApiData a, HasServer sublayout context)- => HasServer (CaptureAll capture a :> sublayout) context where+instance (KnownSymbol capture, FromHttpApiData a, HasServer api context)+ => HasServer (CaptureAll capture a :> api) context where - type ServerT (CaptureAll capture a :> sublayout) m =- [a] -> ServerT sublayout m+ type ServerT (CaptureAll capture a :> api) m =+ [a] -> ServerT api m + hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s+ route Proxy context d = CaptureAllRouter $- route (Proxy :: Proxy sublayout)+ route (Proxy :: Proxy api) context (addCapture d $ \ txts -> case parseUrlPieces txts of Left _ -> delayedFail err400@@ -179,16 +198,6 @@ allowedMethod :: Method -> Request -> Bool allowedMethod method request = allowedMethodHead method request || requestMethod request == method -processMethodRouter :: Maybe (BL.ByteString, BL.ByteString) -> Status -> Method- -> Maybe [(HeaderName, B.ByteString)]- -> Request -> RouteResult Response-processMethodRouter handleA status method headers request = case handleA of- Nothing -> FailFatal err406 -- this should not happen (checked before), so we make it fatal if it does- Just (contentT, body) -> Route $ responseLBS status hdrs bdy- where- bdy = if allowedMethodHead method request then "" else body- hdrs = (hContentType, cs contentT) : (fromMaybe [] headers)- methodCheck :: Method -> Request -> DelayedIO () methodCheck method request | allowedMethod method request = return ()@@ -207,41 +216,32 @@ | otherwise = delayedFail err406 methodRouter :: (AllCTRender ctypes a)- => Method -> Proxy ctypes -> Status- -> Delayed env (Handler a)+ => (b -> ([(HeaderName, B.ByteString)], a))+ -> Method -> Proxy ctypes -> Status+ -> Delayed env (Handler b) -> Router env-methodRouter method proxy status action = leafRouter route'+methodRouter splitHeaders method proxy status action = leafRouter route' where route' env request respond = let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request in runAction (action `addMethodCheck` methodCheck method request `addAcceptCheck` acceptCheck proxy accH ) env request respond $ \ output -> do- let handleA = handleAcceptH proxy (AcceptHeader accH) output- processMethodRouter handleA status method Nothing request--methodRouterHeaders :: (GetHeaders (Headers h v), AllCTRender ctypes v)- => Method -> Proxy ctypes -> Status- -> Delayed env (Handler (Headers h v))- -> Router env-methodRouterHeaders method proxy status action = leafRouter route'- where- route' env request respond =- let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request- in runAction (action `addMethodCheck` methodCheck method request- `addAcceptCheck` acceptCheck proxy accH- ) env request respond $ \ output -> do- let headers = getHeaders output- handleA = handleAcceptH proxy (AcceptHeader accH) (getResponse output)- processMethodRouter handleA status method (Just headers) request+ let (headers, b) = splitHeaders output+ case handleAcceptH proxy (AcceptHeader accH) b of+ Nothing -> FailFatal err406 -- this should not happen (checked before), so we make it fatal if it does+ Just (contentT, body) ->+ let bdy = if allowedMethodHead method request then "" else body+ in Route $ responseLBS status ((hContentType, cs contentT) : headers) bdy instance OVERLAPPABLE_ ( AllCTRender ctypes a, ReflectMethod method, KnownNat status ) => HasServer (Verb method status ctypes a) context where type ServerT (Verb method status ctypes a) m = m a+ hoistServerWithContext _ _ nt s = nt s - route Proxy _ = methodRouter method (Proxy :: Proxy ctypes) status+ route Proxy _ = methodRouter ([],) method (Proxy :: Proxy ctypes) status where method = reflectMethod (Proxy :: Proxy method) status = toEnum . fromInteger $ natVal (Proxy :: Proxy status) @@ -251,8 +251,9 @@ ) => HasServer (Verb method status ctypes (Headers h a)) context where type ServerT (Verb method status ctypes (Headers h a)) m = m (Headers h a)+ hoistServerWithContext _ _ nt s = nt s - route Proxy _ = methodRouterHeaders method (Proxy :: Proxy ctypes) status+ route Proxy _ = methodRouter (\x -> (getHeaders x, getResponse x)) method (Proxy :: Proxy ctypes) status where method = reflectMethod (Proxy :: Proxy method) status = toEnum . fromInteger $ natVal (Proxy :: Proxy status) @@ -282,6 +283,8 @@ type ServerT (Header sym a :> api) m = Maybe a -> ServerT api m + hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s+ route Proxy context subserver = route (Proxy :: Proxy api) context $ subserver `addHeaderCheck` withRequest headerCheck where@@ -325,6 +328,8 @@ type ServerT (QueryParam sym a :> api) m = Maybe a -> ServerT api m + hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s+ route Proxy context subserver = let querytext req = parseQueryText $ rawQueryString req parseParam req =@@ -370,6 +375,8 @@ type ServerT (QueryParams sym a :> api) m = [a] -> ServerT api m + hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s+ route Proxy context subserver = route (Proxy :: Proxy api) context $ subserver `addParameterCheck` withRequest paramsCheck where@@ -410,6 +417,8 @@ type ServerT (QueryFlag sym :> api) m = Bool -> ServerT api m + hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s+ route Proxy context subserver = let querytext r = parseQueryText $ rawQueryString r param r = case lookup paramname (querytext r) of@@ -433,6 +442,8 @@ type ServerT Raw m = Tagged m Application + hoistServerWithContext _ _ _ = retag+ route Proxy _ rawApplication = RawRouter $ \ env request respond -> runResourceT $ do -- note: a Raw application doesn't register any cleanup -- but for the sake of consistency, we nonetheless run@@ -472,6 +483,8 @@ type ServerT (ReqBody list a :> api) m = a -> ServerT api m + hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s+ route Proxy context subserver = route (Proxy :: Proxy api) context $ addBodyCheck subserver ctCheck bodyCheck@@ -506,33 +519,52 @@ (cs (symbolVal proxyPath)) (route (Proxy :: Proxy api) context subserver) where proxyPath = Proxy :: Proxy path+ hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt s instance HasServer api context => HasServer (RemoteHost :> api) context where type ServerT (RemoteHost :> api) m = SockAddr -> ServerT api m route Proxy context subserver = route (Proxy :: Proxy api) context (passToServer subserver remoteHost)+ hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s instance HasServer api context => HasServer (IsSecure :> api) context where type ServerT (IsSecure :> api) m = IsSecure -> ServerT api m route Proxy context subserver = route (Proxy :: Proxy api) context (passToServer subserver secure)- where secure req = if isSecure req then Secure else NotSecure + hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s+ instance HasServer api context => HasServer (Vault :> api) context where type ServerT (Vault :> api) m = Vault -> ServerT api m route Proxy context subserver = route (Proxy :: Proxy api) context (passToServer subserver vault)+ hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s instance HasServer api context => HasServer (HttpVersion :> api) context where type ServerT (HttpVersion :> api) m = HttpVersion -> ServerT api m route Proxy context subserver = route (Proxy :: Proxy api) context (passToServer subserver httpVersion)+ hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s +-- | Ignore @'Summary'@ in server handlers.+instance HasServer api ctx => HasServer (Summary desc :> api) ctx where+ type ServerT (Summary desc :> api) m = ServerT api m++ route _ = route (Proxy :: Proxy api)+ hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt s++-- | Ignore @'Description'@ in server handlers.+instance HasServer api ctx => HasServer (Description desc :> api) ctx where+ type ServerT (Description desc :> api) m = ServerT api m++ route _ = route (Proxy :: Proxy api)+ hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt s+ -- | Singleton type representing a server that serves an empty API. data EmptyServer = EmptyServer deriving (Typeable, Eq, Show, Bounded, Enum) @@ -551,6 +583,8 @@ route Proxy _ _ = StaticRouter mempty mempty + hoistServerWithContext _ _ _ = retag+ -- | Basic Authentication instance ( KnownSymbol realm , HasServer api context@@ -567,6 +601,8 @@ basicAuthContext = getContextEntry context authCheck = withRequest $ \ req -> runBasicAuth req realm basicAuthContext + hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s+ -- * helpers ct_wildcard :: B.ByteString@@ -591,3 +627,5 @@ subContext :: Context subContext subContext = descendIntoNamedContext (Proxy :: Proxy name) context++ hoistServerWithContext _ _ nt s = hoistServerWithContext (Proxy :: Proxy subApi) (Proxy :: Proxy subContext) nt s
test/Servant/ArbitraryMonadServerSpec.hs view
@@ -3,9 +3,8 @@ {-# LANGUAGE TypeOperators #-} module Servant.ArbitraryMonadServerSpec where -import qualified Control.Category as C import Control.Monad.Reader-import Data.Functor.Identity+import Data.Functor.Identity import Data.Proxy import Servant.API import Servant.Server@@ -28,23 +27,26 @@ readerAPI :: Proxy ReaderAPI readerAPI = Proxy +identityAPI :: Proxy IdentityAPI+identityAPI = Proxy+ combinedAPI :: Proxy CombinedAPI combinedAPI = Proxy readerServer' :: ServerT ReaderAPI (Reader String) readerServer' = return 1797 :<|> ask -fReader :: Reader String :~> Handler-fReader = generalizeNat C.. (runReaderTNat "hi")+fReader :: Reader String a -> Handler a+fReader x = return (runReader x "hi") readerServer :: Server ReaderAPI-readerServer = enter fReader readerServer'+readerServer = hoistServer readerAPI fReader readerServer' combinedReaderServer' :: ServerT CombinedAPI (Reader String)-combinedReaderServer' = readerServer' :<|> enter (generalizeNat :: Identity :~> Reader String) (return True)+combinedReaderServer' = readerServer' :<|> hoistServer identityAPI (return . runIdentity) (return True) combinedReaderServer :: Server CombinedAPI-combinedReaderServer = enter fReader combinedReaderServer'+combinedReaderServer = hoistServer combinedAPI fReader combinedReaderServer' enterSpec :: Spec enterSpec = describe "Enter" $ do
+ test/Servant/HoistSpec.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+module Servant.HoistSpec where++import Test.Hspec (Spec)++import Servant++-------------------------------------------------------------------------------+-- https://github.com/haskell-servant/servant/issues/734+-------------------------------------------------------------------------------++-- This didn't fail if executed in GHCi; cannot have as a doctest.++newtype App a = App a++type API = Get '[JSON] Int+ :<|> ReqBody '[JSON] String :> Get '[JSON] Bool++api :: Proxy API+api = Proxy++server :: App Int :<|> (String -> App Bool)+server = undefined++-- Natural transformation still seems to need an explicit type.+f :: App a -> App a+f = id++server' :: App Int :<|> (String -> App Bool)+server' = hoistServer api f server++-------------------------------------------------------------------------------+-- Spec+-------------------------------------------------------------------------------++spec :: Spec+spec = return ()
test/Servant/Server/Internal/ContextSpec.hs view
@@ -36,8 +36,8 @@ show (Just cxt) `shouldBe` "Just ('a' :. True :. EmptyContext)" it "works with operators" $ do- let cxt = ((1 :: Integer) :. 'a' :. EmptyContext) :<|> ('b' :. True :. EmptyContext)- show cxt `shouldBe` "(1 :. 'a' :. EmptyContext) :<|> ('b' :. True :. EmptyContext)"+ let cxt = (1 :: Integer) :. 'a' :. EmptyContext :<|> 'b' :. True :. EmptyContext+ show cxt `shouldBe` "1 :. 'a' :. EmptyContext :<|> 'b' :. True :. EmptyContext" describe "descendIntoNamedContext" $ do let cxt :: Context [Char, NamedContext "sub" '[Char]]
test/Servant/Server/Internal/RoutingApplicationSpec.hs view
@@ -88,6 +88,9 @@ instance (KnownSymbol sym, HasServer api ctx) => HasServer (Res sym :> api) ctx where type ServerT (Res sym :> api) m = IORef (TestResource String) -> ServerT api m++ hoistServerWithContext _ nc nt s = hoistServerWithContext (Proxy :: Proxy api) nc nt . s+ route Proxy ctx server = route (Proxy :: Proxy api) ctx $ addBodyCheck server (return ()) check where
test/Servant/Server/UsingContextSpec/TestCombinators.hs view
@@ -29,6 +29,8 @@ type ServerT (ExtractFromContext :> subApi) m = String -> ServerT subApi m + hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy subApi) pc nt . s+ route Proxy context delayed = route subProxy context (fmap inject delayed) where@@ -45,6 +47,9 @@ type ServerT (InjectIntoContext :> subApi) m = ServerT subApi m + hoistServerWithContext _ _ nt s =+ hoistServerWithContext (Proxy :: Proxy subApi) (Proxy :: Proxy (String ': context)) nt s+ route Proxy context delayed = route subProxy newContext delayed where@@ -60,6 +65,9 @@ type ServerT (NamedContextWithBirdface name subContext :> subApi) m = ServerT subApi m++ hoistServerWithContext _ _ nt s =+ hoistServerWithContext (Proxy :: Proxy subApi) (Proxy :: Proxy subContext) nt s route Proxy context delayed = route subProxy subContext delayed
test/Servant/ServerSpec.hs view
@@ -10,6 +10,11 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-}+#if __GLASGOW_HASKELL__ >= 800+{-# OPTIONS_GHC -freduction-depth=100 #-}+#else+{-# OPTIONS_GHC -fcontext-stack=100 #-}+#endif module Servant.ServerSpec where