DRY Kleisli wrappers with lens

Posted on

Problem

This currently does what I intend:

import Control.Arrow (Kleisli, runKleisli)
import Control.Applicative (WrappedArrow(WrapArrow))
import Control.Lens.Traversal (preview)

nested :: Request -> Maybe Response
nested = runKleisli . unwrapArrow
       $ WrapArrow (Kleisli (preview (prefixed "/name") >=> app1))
     <|> WrapArrow (Kleisli (preview (prefixed "/surname") >=> app2))

  where
    prefixed :: Text -> Prism' Request Request
    prefixed = _

    app1,app2 :: Request -> Maybe Response
    app1 = _
    app2 = _

The idea here is to implement a kind of nested HTTP routing. Given the already existing applications app1 and app2, I want to reroute the incoming Request to either of those applications based on whether the path of the Request is prefixed with "/name" or "/surname". The prefixed Prism' strips such prefix from the Request path if present, otherwise it fails.

However I’d like to get rid, somehow, of WrapArrow, Kleisli and preview, and possibly, runKleisli . unwrapArrow. I suspect that this can be done with Control.Lens.Wrapped or Data.Profuntor but I still can’t see exactly how.

I wouldn’t like to a add an extra dependency for this case but I’m currently using lens in my project, so anything from lens or its dependencies is welcome.

Solution

I came out with this:

nested :: Request -> Maybe Response
nested = nest [ (prefixed "/name", app1)
              , (prefixed "/surname", app2)
              ]

  where
    nest xs request =
        getAlt $ foldMap (Alt . ((p,a) -> reroute p a request)) xs

    reroute p app = preview p >=> app

Alt is only available in base-4.8.0.0, however it shouldn’t be difficult to implement your own Alt.

Leave a Reply

Your email address will not be published. Required fields are marked *