Haskell对日期的持久查询(Yesod)

时间:2016-11-23 14:12:19

标签: sql haskell yesod haskell-persistent

我正在尝试将日期部分添加到博客帖子的URL中,比如说

/blog/2016/11/23/my-blog-post-slug

我不仅要检查slug,还要检查日期部分。这是我到目前为止所得到的:

getBlogPostR :: Int -> Int -> Int -> Slug -> Handler Html
getBlogPostR pathYear pathMonth pathDay pathSlug = do
  Entity _ BlogPost {..} <- runDB $ getBy404 $ UniqueBlogPostSlug pathSlug
  let (year, month, day) = toGregorian $ utctDay blogPostCreatedAt
  if (fromIntegral year /= pathYear && month /= pathMonth && day /= pathDay)
    then notFound
    else
      defaultLayout $ do
        setTitleI blogPostTitle
        $(widgetFile "blog/post")

似乎有点笨重。有没有办法将此年,月,日部分添加为查询过滤参数? (我知道我可以执行原始查询,但这不是我要找的)

[其他信息]

我的模型定义如下:

BlogPost
  uuid Text
  title Text
  slug Text
  markdownContent Text
  createdAt UTCTime
  UniqueBlogPostUuid uuid
  UniqueBlogPostSlug slug
  Primary uuid

1 个答案:

答案 0 :(得分:0)

getBlogPostR :: Slug -> Handler Html
getBlogPostR pathSlug = do
  Entity _ BlogPost {..} <- runDB $ getBy404 $ UniqueBlogPostSlug pathSlug
  mYear <- lookupGetParam "year"
  mMonth <- lookupGetParam "month"
  mDay <- lookupGetParam "day"
  case (,,) <$> mYear <*> mMonth <*> mDay of
    Just (queryYear, queryMonth, queryDay) -> do 
      let (year, month, day) = toGregorian $ utctDay blogPostCreatedAt
      if (fromIntegral year /= queryYear && month /= queryMonth && day /= queryDay)
        then notFound
        else
          defaultLayout $ do
            setTitleI blogPostTitle
            $(widgetFile "blog/post")
    Nothing -> notFound