在Yesod Handler中创建一个带有查询参数的路径

时间:2016-12-18 11:51:44

标签: haskell yesod

我想将分页结果添加到站点地图中。让我们说/ blog,/ blog?page = 1,...

我的路线定义如下:

/blog BlogR GET

页面参数是可选的。如何将/ blog?page = 1添加到站点地图中。站点地图模块需要路线应用。所以我只能链接 BlogR ,但无法弄清楚如何使用参数创建路由。要重定向,只需使用

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

还有模板插值。但我无法弄清楚如何在处理程序中创建 Route App

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

非常感谢!

1 个答案:

答案 0 :(得分:0)

据我所知,您无法在没有大量工作的情况下使用该签名真正定义getPage。假设您正在使用mkYesod生成样板,它已经生成了Route App数据类型(以及关联的renderRoutes函数),但没有提供查询参数的规定。

您最好的选择可能是从使用查询参数切换到更像Yesod的网址,例如/blog/page/1。更好的是,不是使用基于页面的系统,而是将您的URL建立在博客帖子ID号上以启动页面,以便/blog/start/15显示您的博客从15号开始。如果你走这条路线(双关语) ),你自动获得一个永久的URL(这样/blog/start/15总是以相同的博客条目开头),你可以安排一些事情,以便你通常"页面到可预测的起始编号,以方便缓存等。

但是,如果你真的想欺骗yesod-sitemap生成带有查询参数的路由,下面的独立示例可能有所帮助。在此处,getSitemapRYesod.Sitemap.sitemapList的重新实现,它使用getUrlRenderParams代替getUrlRender,允许处理查询参数。

我对管道一无所知,所以我不知道getSitemapR的实施是否特别聪明 - 我只是复制并按摩了yesod-sitemap的代码,直到它是经过类型检查的。

{-# 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