From 96f10add650500e22b12859a913f027996a334d7 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Mon, 12 Oct 2015 17:06:43 +0200 Subject: [PATCH] fmapRouter. --- servant-server/src/Servant/Server/Internal/Router.hs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/servant-server/src/Servant/Server/Internal/Router.hs b/servant-server/src/Servant/Server/Internal/Router.hs index f188955e..3c8eb722 100644 --- a/servant-server/src/Servant/Server/Internal/Router.hs +++ b/servant-server/src/Servant/Server/Internal/Router.hs @@ -4,7 +4,7 @@ import Data.Map (Map) import qualified Data.Map as M import Data.Monoid ((<>)) import Data.Text (Text) -import Network.Wai (Request, pathInfo) +import Network.Wai (Request, Response, pathInfo) import Servant.Server.Internal.PathInfo import Servant.Server.Internal.RoutingApplication @@ -21,6 +21,13 @@ data Router = | Choice Router Router -- ^ left-biased choice between two routers +fmapRouter :: (RouteResult Response -> RouteResult Response) -> Router -> Router +fmapRouter f (LeafRouter a) = LeafRouter $ \req cont -> a req (cont . f) +fmapRouter f (StaticRouter m) = StaticRouter (fmapRouter f <$> m) +fmapRouter f (DynamicRouter d) = DynamicRouter (fmapRouter f <$> d) +fmapRouter f (Choice r1 r2) = Choice (fmapRouter f r1) (fmapRouter f r2) +fmapRouter f (WithRequest g) = WithRequest (fmapRouter f . g) + -- | Smart constructor for the choice between routers. -- We currently optimize the following cases: -- @@ -69,4 +76,3 @@ runRouter (Choice r1 r2) request respond = then runRouter r2 request $ \ mResponse2 -> respond (mResponse1 <> mResponse2) else respond mResponse1 -