In the previous example we used template haskell to automatically derive a mapping between the url type and the url string. This is very convenient early in the development process when the routes are changing a lot. But the resulting urls are not very attractive. One solution is to write the mappings from the url type to the url string by hand.

One approach would be to write one function to show the urls, and another function that uses parsec to parse the urls. But having to say them same thing twice is really annoying and error prone. What we really want is a way to write the mapping once, and automatically exact a parser and printer from the specification.

Fortunately, Sjoerd Visscher and Martijn van Steenbergen figured out exactly how to do that and published a proof of concept library know as Zwaluw. With permission, I have refactored their original library into two separate libraries: boomerang and web-routes-boomerang.

The technique behind Zwaluw and Boomerang is very cool and interesting to understand. But in this tutorial we will skip the theory and get right to practice.

In order to run this demo you will need to install web-routes, web-routes-boomerang and web-routes-happstack from hackage. + +

In this example, we will simply modify the previous example to show how easy it is use a different method for defining the mapping between the url type and the url string. We will also add a few new routes to demonstrate some features of using boomerang.

The first thing to notice is that we hide id and (.) from the Prelude and import the versions from Control.Category instead.

+ +> {-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, TemplateHaskell #-} +> module Main where +> +> import Prelude hiding (head, id, (.)) +> import Control.Category (Category(id, (.))) +> +> import Control.Monad (msum) +> import Data.Data (Data, Typeable) +> import Data.Monoid (mconcat) +> import Happstack.Server (Response, ServerPartT, ok, toResponse, simpleHTTP, nullConf, seeOther, dir, notFound, seeOther) +> import Text.Blaze.Html4.Strict ((!), html, head, body, title, p, toHtml, toValue, ol, li, a) +> import Text.Blaze.Html4.Strict.Attributes (href) +> import Text.Boomerang.TH (derivePrinterParsers) +> import Web.Routes ( PathInfo(..), RouteT, showURL +> , runRouteT, Site(..), setDefault, mkSitePI) +> import Web.Routes.TH (derivePathInfo) +> import Web.Routes.Happstack (implSite) +> import Web.Routes.Boomerang +> + +

Next we have our Sitemap types again. The Sitemap is similar to the previous example, except it also includes UserOverview and UserDetail.

+ +> newtype ArticleId +> = ArticleId { unArticleId :: Int } +> deriving (Eq, Ord, Enum, Read, Show, Data, Typeable, PathInfo) +> +> data Sitemap +> = Home +> | Article ArticleId +> | UserOverview +> | UserDetail Int String +> deriving (Eq, Ord, Read, Show, Data, Typeable) +> + +

+ +> $(derivePrinterParsers ''Sitemap) +> + +

That will create new combinators corresponding to the constructors +for Sitemap. They will be named, rHome, rArticle, rUserOverview, and rUserDetail.

+ +> sitemap :: Router Sitemap +> sitemap = +> ( rHome +> <> rArticle . (lit "article" articleId) +> <> lit "users" . users +> ) +> where +> users = rUserOverview +> <> rUserDetail int . lit "-" . anyString +> +> articleId :: Router ArticleId +> articleId = +> xmaph ArticleId (Just . unArticleId) int + +

+ + + + + + + + + + +

url		type
/	<=>	Home
/article/int	<=>	Article int
/users	<=>	UserOverview
/users/int-string	<=>	UserDetail int string

By examining the mapping table and comparing it to the code, you should be able to get an intuitive feel for how boomerang works. The key boomerang features we see are:

The sitemap function looks like an ordinary parser. But, what makes it is exciting is that it also defines the pretty-printer at the same time.

Next we need a function that maps a route to the handlers. This is the same exact function we used in the previous example extended with the additional routes:

+ +> route :: Sitemap -> RouteT Sitemap (ServerPartT IO) Response +> route url = +> case url of +> Home -> homePage +> (Article articleId) -> articlePage articleId +> UserOverview -> userOverviewPage +> (UserDetail uid name) -> userDetailPage uid name +> + +

Next, we have the handler functions. These are also exactly the same as the previous example, plus the new routes:

+ +> homePage :: RouteT Sitemap (ServerPartT IO) Response +> homePage = +> do articles <- mapM mkArticle [(ArticleId 1) .. (ArticleId 10)] +> userOverview <- showURL UserOverview +> ok $ toResponse $ +> html $ do +> head $ title $ (toHtml "Welcome Home!") +> body $ do +> a ! href (toValue userOverview) $ toHtml "User Overview" +> ol $ mconcat articles +> where +> mkArticle articleId = +> do url <- showURL (Article articleId) +> return $ li $ a ! href (toValue url) $ +> toHtml $ "Article " ++ (show $ unArticleId articleId) +> + +

+ +> articlePage :: ArticleId -> RouteT Sitemap (ServerPartT IO) Response +> articlePage (ArticleId articleId) = +> do homeURL <- showURL Home +> ok $ toResponse $ +> html $ do +> head $ title $ (toHtml $ "Article " ++ show articleId) +> body $ do +> p $ toHtml $ "You are now reading article " ++ show articleId +> p $ do toHtml "Click " +> a ! href (toValue homeURL) $ toHtml "here" +> toHtml " to return home." +> + +

+ +> userOverviewPage :: RouteT Sitemap (ServerPartT IO) Response +> userOverviewPage = +> do users <- mapM mkUser [1 .. 10] +> ok $ toResponse $ +> html $ do +> head $ title $ (toHtml "Our Users") +> body $ do +> ol $ mconcat users +> where +> mkUser userId = +> do url <- showURL (UserDetail userId ("user " ++ show userId)) +> return $ li $ a ! href (toValue url) $ +> toHtml $ "User " ++ (show $ userId) +> + +

+ +> userDetailPage :: Int -> String -> RouteT Sitemap (ServerPartT IO) Response +> userDetailPage userId userName = +> do homeURL <- showURL Home +> ok $ toResponse $ +> html $ do +> head $ title $ (toHtml $ "User " ++ userName) +> body $ do +> p $ toHtml $ "You are now view user detail page for " ++ userName +> p $ do toHtml "Click " +> a ! href (toValue homeURL) $ toHtml "here" +> toHtml " to return home." +> + +

Creating the Site type is similar to the previous example. We still use runRouteT to unwrap the RouteT layer. But now we use boomerangSite to convert the route function into a Site:

+ +> site :: Site Sitemap (ServerPartT IO Response) +> site = +> setDefault Home $ boomerangSite (runRouteT route) sitemap +> + +

The route function is essentially the same in this example and the previous example. The difference is in how we generate the formatPathSegments and parsePathSegments functions. In the previous example, we used mkSitePI, which leveraged the PathInfo instances. Here we use boomerangSite which uses the sitemap mapping we defined above.

The practical result is that you can start by using derivePathInfo so you don't have to think about how the urls will look. Later, once the routes have settled down, you can then easily switch to using boomerang to create your route mapping.

+ +> main :: IO () +> main = simpleHTTP nullConf $ +> msum [ dir "favicon.ico" $ notFound (toResponse ()) +> , implSite "http://localhost:8000" "/route/" site +> , seeOther "/route/" (toResponse ()) +> ] +> + +

Web Routes Boomerang