haskell - 在帖子上生成最近帖子列表时如何避免依赖循环？

Question

所以这有效:

create ["archive.html"] $ do
    route idRoute
    compile $ do
        posts <- (myRecentFirst gitTimes) =<< loadAll "posts/**"
        let archiveCtx =
                listField "posts" (postCtx allTags allCategories gitTimes) (return posts) `mappend`
                constField "title" "Archives"            `mappend`
                (postCtx allTags allCategories gitTimes)

        makeItem ""
            >>= loadAndApplyTemplate "templates/archive.html" archiveCtx
            >>= loadAndApplyTemplate "templates/default.html" archiveCtx
            >>= relativizeUrls

在 archive.html 中创建最近帖子的列表；这是沼泽标准，我认为它来自教程之一。除了 postsCtx 之外，它有点复杂，但与这里无关。

但是，我想在普通帖子的侧边栏中放置一些最近帖子的列表。问题是最近的帖子最终取决于它们自己。我尝试将帖子本身从其自己生成的列表中排除，但我找不到这样做的好地方。这是我到目前为止所得到的:

match "posts/**" $ do
    route $ (gsubRoute "posts/" (const "")) `composeRoutes` setExtension "html"
    compile $ do
        recents <- (myRecentFirst gitTimes) =<< loadAll "posts/**"
        let postsContext = postCtx allTags allCategories gitTimes `mappend`
                           -- Show recent posts
                           recentsNotSelfField "recents" (postCtx allTags allCategories gitTimes) (return $ take 3 recents)

        pandocCompilerWithTransform hblogPandocReaderOptions hblogPandocWriterOptions (titleFixer titles)
            >>= loadAndApplyTemplate "templates/post.html"    postsContext
            >>= loadAndApplyTemplate "templates/default.html" postsContext
            >>= relativizeUrls

recentsNotSelfField :: String -> Context a -> Compiler [Item a] -> Context b
recentsNotSelfField key context items = Context $ \k _ i ->
    if k == key then do
        let myId = itemIdentifier i
        strippedItems <- items
        let remains = filter (\x -> (itemIdentifier x) /= myId) strippedItems
        return $ ListField context remains
    else
        CA.empty

recentsNotSelfField 应该生成一个包含除本身之外的所有最近内容的字段，但它似乎不起作用或者是错误的位置，因为:

Initialising...
  Creating store...
  Creating provider...
  Running rules...
Checking for out-of-date items
Compiling
  [ERROR] Hakyll.Core.Runtime.chase: Dependency cycle detected: posts/computing/contact.md depends on posts/computing/contact.md

到目前为止我还被困住了。

编辑:

我看到了Hakyll says "Dependency cycle detected: ..." ，这是 loadPosts 完成的，所以我尝试了这个:

match "posts/**" $ do
    route $ (gsubRoute "posts/" (const "")) `composeRoutes` setExtension "html"
    compile $ do
        myId <- getUnderlying
        recents <- (myRecentFirst gitTimes) =<< loadAll ("posts/**" .&&. complement (fromList [myId]))
        let postsContext = postCtx allTags allCategories gitTimes `mappend`
                           -- Show recent posts
                           listField "recents" (postCtx allTags allCategories gitTimes) (return $ take 3 recents)

        pandocCompilerWithTransform hblogPandocReaderOptions hblogPandocWriterOptions (titleFixer titles)
            >>= loadAndApplyTemplate "templates/post.html"    postsContext
            >>= loadAndApplyTemplate "templates/default.html" postsContext
            >>= relativizeUrls

但这让我很困惑:

[ERROR] Hakyll.Core.Runtime.chase: Dependency cycle detected: posts/computing/contact.md depends on posts/computing/general/ched.md depends on posts/computing/contact.md

，换句话说，我最终得到了两个最近的循环。

Answer 1

编辑:事实证明我在这里描述的方法有一些缺点；请参阅http://rlpowell.name/computing/general/hakyll_recent_posts.html了解问题的最新处理方法。

<小时/>

事实证明该技术位于 https://stackoverflow.com/a/35651294/1461430对我有用，事实上它对我来说比作者说的更好。现在这是我的代码的相关部分:

match "posts/**" $ version "recents" $ do
    route $ (gsubRoute "posts/" (const "")) `composeRoutes` setExtension "html"
    compile $ do
        pandocCompilerWithTransform hblogPandocReaderOptions hblogPandocWriterOptions (titleFixer titles)
            >>= loadAndApplyTemplate "templates/post.html"    (postCtx allTags allCategories gitTimes)
            >>= relativizeUrls

match "posts/**" $ do
    route $ (gsubRoute "posts/" (const "")) `composeRoutes` setExtension "html"
    compile $ do
        myId <- getUnderlying
        recents <- (myRecentFirst gitTimes) =<< loadAll ("posts/**" .&&. hasVersion "recents")
        let postsContext = postCtx allTags allCategories gitTimes `mappend`
                           -- Show recent posts
                           listField "recents" (postCtx allTags allCategories gitTimes) (return $ take 3 recents)

        pandocCompilerWithTransform hblogPandocReaderOptions hblogPandocWriterOptions (titleFixer titles)
            >>= loadAndApplyTemplate "templates/post.html"    postsContext
            >>= loadAndApplyTemplate "templates/default.html" postsContext
            >>= relativizeUrls

我必须将 listField 和最近的内容添加到其他几个使用 templates/default.html 的位置，但这很简单。

我还必须修改一个使用 Identifier 来查找从 git 中提取的时间列表的函数:

-- Pull a file's time out of the list
getGitTimeUTC :: Identifier -> [GitTimes] -> (GitTimes -> UTCTime) -> UTCTime
getGitTimeUTC ident times typeF =
  -- The identifier for the things compiled with the "recents"
  -- version has the identifierVersion "recents", but we don't care
  -- about that since the only reason that exists is to avoid loops,
  -- so we strip it here for our lookup.
  let fixedIdent = ident { identifierVersion = Nothing }
      timeList = filter (\x -> fixedIdent == (gtid x)) times in
    if length timeList /= 1 then
      -- It's not obvious to me how this could occur even in theory; I'd expect it to error out during getGitTimes
      error $ "getGitTimeUTC: Couldn't find the time for " ++ (show fixedIdent) ++ " in GitTimes list " ++ (show times)
    else
      typeF $ head timeList

因此，我没有出现重复的文件，并且在链接到最近使用的文件时也没有出现问题；一切正常。