00dani/lebd
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

Put category listings back into the sitemap.xml

Browse source
This commit is contained in:
Danielle McLean 2017-10-16 14:56:01 +11:00
parent 1364a2e36b
commit a880e66c31
Signed by: 00dani
GPG key ID: 5A5D2D1AFF12EEC5
1 changed files with 13 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
src/Handler/Common.hs
View file

@ -7,6 +7,8 @@
module Handler.Common where module Handler.Common where
import Data.FileEmbed (embedFile) import Data.FileEmbed (embedFile)
import Database.Esqueleto ( (^.) )
import qualified Database.Esqueleto as E
import Yesod.Sitemap import Yesod.Sitemap
import Import import Import
@ -31,6 +33,9 @@ getRobotsR = robots SitemapR
getSitemapR :: Handler TypedContent getSitemapR :: Handler TypedContent
getSitemapR = do getSitemapR = do
categories <- runDB . E.select . E.distinct . E.from $ \ec -> do
E.orderBy [E.asc $ ec ^. EntryCategoryCategory]
return $ ec ^. EntryCategoryCategory
entries <- runDB $ selectList [] [Desc EntryPublished] entries <- runDB $ selectList [] [Desc EntryPublished]
sitemap $ do sitemap $ do
yield SitemapUrl yield SitemapUrl
@ -39,20 +44,19 @@ getSitemapR = do
, sitemapChangeFreq = Just Daily , sitemapChangeFreq = Just Daily
, sitemapPriority = Nothing , sitemapPriority = Nothing
} }
yieldMany $ kindToSitemapUrl <$> allEntryKinds yieldMany $ sitemapUrl . CategoryR . E.unValue <$> categories
yieldMany $ sitemapUrl . EntriesR <$> allEntryKinds
yieldMany $ entryToSitemapUrl <$> entries yieldMany $ entryToSitemapUrl <$> entries
kindToSitemapUrl :: EntryKind -> SitemapUrl (Route App) sitemapUrl :: a -> SitemapUrl a
kindToSitemapUrl kind = SitemapUrl sitemapUrl loc = SitemapUrl
{ sitemapLoc = EntriesR kind { sitemapLoc = loc
, sitemapLastMod = Nothing , sitemapLastMod = Nothing
, sitemapChangeFreq = Nothing , sitemapChangeFreq = Nothing
, sitemapPriority = Nothing , sitemapPriority = Nothing
} }
entryToSitemapUrl :: Entity Entry -> SitemapUrl (Route App) entryToSitemapUrl :: Entity Entry -> SitemapUrl (Route App)
entryToSitemapUrl entry = SitemapUrl entryToSitemapUrl entry = (sitemapUrl $ entryR entry)
{ sitemapLoc = entryR entry { sitemapLastMod = Just . entryUpdated . entityVal $ entry
, sitemapLastMod = Just . entryUpdated . entityVal $ entry
, sitemapChangeFreq = Nothing
, sitemapPriority = Nothing
} }