(Ab)using do notation for a Wai DSL

Recently I was thinking it would be nice to have something like Rack’s URLMap for Wai. If you haven’t come across it, it lets you combine Rack applications easily, based on the request path info or host. For example, if you wanted to have a bug tracking application under “/bugs”, and a helpdesk application under “/helpdesk”, and your main website under “/”, you might have:

Rack :: URLMap . new do map "/bugs" do run BugTrackingApp end map "/helpdesk" do run HelpdeskApp end map "/" do run MainSiteApp end end

This URLMap can then become a single Rack application.

The first question is how we are going to represent this data structure in Haskell. Intuitively, it seems sensible that a request should start top of the block, trying to match requests, and work its way downwards. A Data.Map certainly won’t do, since the order we get the keys out will probably not be the same as the order they went in. Using the Ruby example above, this could mean that a request meant for either of the applications on the sub-URIs might end up being sent to the main site – not good.

So we need an ordered lookup list, mapping request paths to Wai Applications. This is what I used:

type Path = [ Text ] type UrlMap = [( Path , Application )]

Strict text makes things easier for us, since all we need to do to get the request path as a list of strict Text values is call pathInfo on it. The UrlMap type is also convenient because there is already a Prelude function which can do the lookup for us: lookup ; which takes a key and a lookup list, and possibly returns the value associated with that key (that is, Eq a => a -> [(a,b)] -> Maybe b ).

If we want to use do notation, we need a monad to store this data. It should be able to append information to a data structure which can then be extracted by running the computation. Sounds like a job for the Writer monad, from Control.Monad.Writer :

type UrlMapM = Writer UrlMap ()

We don’t care about the result of the computation, just the value that was built up over the course of it, so we use unit () as the second type argument.

We don’t want the users of our URL mapper to have to know the implementation details, so let’s provide some functions to abstract them away.

mount :: Path -> Application -> UrlMapM mount prefix app = tell [( prefix , app )] runUrlMapM :: UrlMapM -> UrlMap runUrlMapM = execWriter

So now we can do this:

urlMapM :: UrlMapM urlMapM = do mount [ "bugs" ] bugTrackingApp mount [ "helpdesk" ] helpdeskApp mount [] mainSiteApp urlmap :: UrlMap urlmap = runUrlMapM urlMapM

Now to turn an UrlMap into an Application . When we’re trying to match a request with an application, we should work our way down the list, seeing if the path an application is mounted under is a prefix of the request path; if so, the prefix should be removed, and the request should be sent to that application.

try :: Eq a => [ a ] -- ^ Path info of request -> [([ a ], b )] -- ^ The UrlMap -> Maybe ([ a ], b ) -- ^ A pair consisting of the remainder of the path -- after removing the matching prefix and the -- relevant application, or Nothing. try xs tuples = foldl go Nothing tuples where go ( Just x ) _ = Just x go _ ( prefix , y ) = fmap ( \ xs' -> ( xs' , y )) $ stripPrefix prefix xs

stripPrefix from Data.List takes two lists, and, if the first is a prefix of the second, removes the prefix from the second and returns it as a Just value. If not, it returns Nothing.

Here I’m using the Functor instance for Maybe ; if stripPrefix returns a Just value, then fmap will apply the lambda function to the value inside the Just . If it returns Nothing , then fmap will just return Nothing .

Now we just need to combine this function with a Wai Request and an UrlMap :

toApplication :: UrlMap -> Application toApplication urlmap = \ req -> case try ( pathInfo req ) urlmap of Just ( newPath , app ) -> app $ req { pathInfo = newPath , rawPathInfo = makeRaw newPath } Nothing -> return $ responseLBS status500 [( "content-type" , "text/plain" )] ( "WaiUrlMapper: no routes matched. Consider using " <> "an empty path for the last mapping in the 'do' block.

" ) where makeRaw :: [ Text ] -> B . ByteString makeRaw = ( "/" ` B . append `) . T . encodeUtf8 . T . intercalate "/"

One more nice helper function:

mapUrls :: UrlMapM -> Application mapUrls = toApplication . runUrlMapM

I’m not sure if it’s absolutely necessary to modify both the pathInfo and the rawPathInfo , but it seems safer to do so.

Here’s the full code which I’m now using. It has a couple of additions: namely, a ToApplication typeclass so that you can mount another UrlMapM under a request path, and also a couple of extra helper functions which are just little wrappers around mount .