Add the entry-kind pages and the actual entries to the generated sitemap

This commit is contained in:
Danielle McLean 2017-10-09 15:40:58 +11:00
parent b121d461e2
commit 03cd1487fe
Signed by: 00dani
GPG key ID: 5A5D2D1AFF12EEC5

View file

@ -11,6 +11,9 @@ import Yesod.Sitemap
import Import
import Entry.Kind ( EntryKind, allEntryKinds )
import Widget.Entry ( entryR )
-- These handlers embed files in the executable at compile time to avoid a
-- runtime dependency, and for efficiency.
@ -27,10 +30,29 @@ getRobotsR :: Handler Text
getRobotsR = robots SitemapR
getSitemapR :: Handler TypedContent
getSitemapR = sitemap $ do
yield SitemapUrl
{ sitemapLoc = HomeR
, sitemapLastMod = Nothing
, sitemapChangeFreq = Just Daily
, sitemapPriority = Nothing
}
getSitemapR = do
entries <- runDB $ selectList [] [Desc EntryPublished]
sitemap $ do
yield SitemapUrl
{ sitemapLoc = HomeR
, sitemapLastMod = Nothing
, sitemapChangeFreq = Just Daily
, sitemapPriority = Nothing
}
yieldMany $ kindToSitemapUrl <$> allEntryKinds
yieldMany $ entryToSitemapUrl <$> entries
kindToSitemapUrl :: EntryKind -> SitemapUrl (Route App)
kindToSitemapUrl kind = SitemapUrl
{ sitemapLoc = EntriesR kind
, sitemapLastMod = Nothing
, sitemapChangeFreq = Nothing
, sitemapPriority = Nothing
}
entryToSitemapUrl :: Entity Entry -> SitemapUrl (Route App)
entryToSitemapUrl entry = SitemapUrl
{ sitemapLoc = entryR entry
, sitemapLastMod = Just . entryUpdated . entityVal $ entry
, sitemapChangeFreq = Nothing
, sitemapPriority = Nothing
}