Create a route with query params in Yesod Handler

Question

I would like to add paginated results to a sitemap. Let's say /blog, /blog?page=1, ...

My route definition looks like this:

/blog BlogR GET

The page parameter is optional. How can I add /blog?page=1 to a sitemap. The sitemap module expects Route App. So I am only able to link BlogR but can not figure out how to create the route with a parameter. For redirecting this is easy by just using

redirect (BlogR, [("page", 1)])  // /blog?page=1

There is interpolation for templates as well. But I can not figure out how to create a Route App inside a handler.

 getPage :: Int -> Route App
 getPage number = ???

Thanks a lot!

Answer 1

As far as I know, you can't really define getPage with that signature without a lot of work. Assuming you're using mkYesod to generate your boilerplate, it's already generated a Route App data type (and associated renderRoutes function) with no provision for supplying query parameters.

Your best bet may be to switch from using query parameters to more Yesod-friendly URLs like /blog/page/1. Better yet, instead of using a page-based system, base your URLs on a blog post ID number to start the page, so that /blog/start/15 shows your blog starting with posting number 15. If you go this route (pun intended), you automatically get a permanent URL (so that /blog/start/15 is always going to start with the same blog entry), and you can arrange things so that you "usually" page to predictable starting numbers to facilitate caching and so on.

But, if you really want to trick yesod-sitemap into generating routes with query parameters, the following standalone example may help. Here, getSitemapR is a reimplementation of Yesod.Sitemap.sitemapList that uses getUrlRenderParams in place of getUrlRender which allows processing of query parameters.

I don't really know anything about conduits, so I don't know if my implementation of getSitemapR is particularly smart -- I just copied and massaged code from yesod-sitemap until it type-checked.

{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE QuasiQuotes           #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeFamilies          #-}
import           Yesod
import           Yesod.Sitemap

import Data.Text (Text)

-- stuff needed for getSitemapR
import Text.XML.Stream.Render (renderBuilder)
import Data.Conduit (($=), yield, Flush(..))
import qualified Data.Conduit.List as CL
import Data.Default (def)

data Blog = Blog

mkYesod "Blog" [parseRoutes|
/blog BlogR GET
/sitemap SitemapR GET
|]

instance Yesod Blog

getBlogR :: Handler Html
getBlogR = do
  page <- lookup "page" . reqGetParams <$> getRequest
  defaultLayout $ case page of
    Nothing -> [whamlet|<p>Top of blog|]
    Just n ->  [whamlet|<p>Page #{n} of blog|]

-- |Sitemap route is app route plus query parameters
data SMRoute = SMRoute (Route Blog) [(Text, Text)]

sitemapRoutes :: [SitemapUrl SMRoute]
sitemapRoutes = map (\u -> SitemapUrl u Nothing Nothing Nothing)
  [ SMRoute BlogR []
  , SMRoute BlogR [("page", "1")]
  , SMRoute BlogR [("page", "2")]
  , SMRoute BlogR [("page", "3")]
  ]    

getSitemapR :: Handler TypedContent
getSitemapR = do
  let urls = mapM_ yield sitemapRoutes
  renderParams <- getUrlRenderParams
  let render (SMRoute r qs) = renderParams r qs
  respondSource typeXml $ do
    yield Flush
    urls $= sitemapConduit render $= renderBuilder def $= CL.map Chunk

main :: IO ()
main = warp 3000 Blog