Use Functor class for functor business.
This commit is contained in:
parent
96f10add65
commit
d106ed9c9f
1 changed files with 12 additions and 8 deletions
|
@ -1,3 +1,5 @@
|
||||||
|
{-# LANGUAGE DeriveFunctor #-}
|
||||||
|
|
||||||
module Servant.Server.Internal.Router where
|
module Servant.Server.Internal.Router where
|
||||||
|
|
||||||
import Data.Map (Map)
|
import Data.Map (Map)
|
||||||
|
@ -8,25 +10,27 @@ import Network.Wai (Request, Response,
|
||||||
import Servant.Server.Internal.PathInfo
|
import Servant.Server.Internal.PathInfo
|
||||||
import Servant.Server.Internal.RoutingApplication
|
import Servant.Server.Internal.RoutingApplication
|
||||||
|
|
||||||
|
type Router = Router' RoutingApplication
|
||||||
|
|
||||||
-- | Internal representation of a router.
|
-- | Internal representation of a router.
|
||||||
data Router =
|
data Router' a =
|
||||||
WithRequest (Request -> Router)
|
WithRequest (Request -> Router)
|
||||||
-- ^ current request is passed to the router
|
-- ^ current request is passed to the router
|
||||||
| StaticRouter (Map Text Router)
|
| StaticRouter (Map Text Router)
|
||||||
-- ^ first path component used for lookup and removed afterwards
|
-- ^ first path component used for lookup and removed afterwards
|
||||||
| DynamicRouter (Text -> Router)
|
| DynamicRouter (Text -> Router)
|
||||||
-- ^ first path component used for lookup and removed afterwards
|
-- ^ first path component used for lookup and removed afterwards
|
||||||
| LeafRouter RoutingApplication
|
| LeafRouter a
|
||||||
-- ^ to be used for routes that match an empty path
|
-- ^ to be used for routes that match an empty path
|
||||||
| Choice Router Router
|
| Choice Router Router
|
||||||
-- ^ left-biased choice between two routers
|
-- ^ left-biased choice between two routers
|
||||||
|
deriving Functor
|
||||||
|
|
||||||
fmapRouter :: (RouteResult Response -> RouteResult Response) -> Router -> Router
|
-- | Apply a function to the result of a router in functor style. The result contains the failure
|
||||||
fmapRouter f (LeafRouter a) = LeafRouter $ \req cont -> a req (cont . f)
|
-- cases so one use case is to turn failures into middleware response values with appropriate status
|
||||||
fmapRouter f (StaticRouter m) = StaticRouter (fmapRouter f <$> m)
|
-- codes, message bodies, etc.
|
||||||
fmapRouter f (DynamicRouter d) = DynamicRouter (fmapRouter f <$> d)
|
tweakResponse :: (RouteResult Response -> RouteResult Response) -> Router -> Router
|
||||||
fmapRouter f (Choice r1 r2) = Choice (fmapRouter f r1) (fmapRouter f r2)
|
tweakResponse f = fmap (\a -> \req cont -> a req (cont . f))
|
||||||
fmapRouter f (WithRequest g) = WithRequest (fmapRouter f . g)
|
|
||||||
|
|
||||||
-- | Smart constructor for the choice between routers.
|
-- | Smart constructor for the choice between routers.
|
||||||
-- We currently optimize the following cases:
|
-- We currently optimize the following cases:
|
||||||
|
|
Loading…
Reference in a new issue