mirror of
https://github.com/commercialhaskell/stackage-server.git
synced 2026-01-12 04:08:29 +01:00
92 lines
2.2 KiB
Haskell
92 lines
2.2 KiB
Haskell
module Handler.Sitemap (getSitemapR) where
|
|
|
|
import Import
|
|
import Yesod.Sitemap
|
|
import Data.List (nub)
|
|
|
|
type Sitemap = Source Handler (SitemapUrl (Route App))
|
|
|
|
|
|
getSitemapR :: Handler TypedContent
|
|
getSitemapR = sitemap $ do
|
|
priority 1.0 $ HomeR
|
|
|
|
priority 0.9 $ LtsR []
|
|
priority 0.8 $ NightlyR []
|
|
|
|
priority 0.7 $ AllSnapshotsR
|
|
priority 0.7 $ PackageListR
|
|
|
|
priority 0.6 $ TagListR
|
|
priority 0.6 $ AuthorsR
|
|
priority 0.6 $ InstallR
|
|
priority 0.6 $ OlderReleasesR
|
|
|
|
url PackageCountsR
|
|
|
|
selectAll >>= ltsSitemaps
|
|
selectAll >>= mapM_ snapshotSitemap
|
|
selectAll >>= mapM_ packageMetadataSitemap
|
|
selectAll >>= mapM_ tagSitemap
|
|
|
|
|
|
selectAll :: (PersistEntity val, PersistEntityBackend val ~ YesodPersistBackend App)
|
|
=> ConduitM () (SitemapUrl (Route App)) Handler [val]
|
|
selectAll = lift $ runDB $ fmap (map entityVal) $ selectList [] []
|
|
|
|
ltsSitemaps :: [Lts] -> Sitemap
|
|
ltsSitemaps ltss = do
|
|
ltsMajorSitemap ltss
|
|
mapM_ ltsSitemap ltss
|
|
|
|
ltsMajorSitemap :: [Lts] -> Sitemap
|
|
ltsMajorSitemap ltss = mapM_ go majorVersions
|
|
where
|
|
majorVersions = nub $ map ltsMajor ltss
|
|
go ver = priority 0.55 $ LtsR [pack (show ver)]
|
|
|
|
ltsSitemap :: Lts -> Sitemap
|
|
ltsSitemap lts = url $ LtsR [slug]
|
|
where
|
|
slug = show' (ltsMajor lts) <> "." <> show' (ltsMinor lts)
|
|
show' = pack . show
|
|
|
|
snapshotSitemap :: Stackage -> Sitemap
|
|
snapshotSitemap s = do
|
|
url' StackageHomeR
|
|
url' StackageMetadataR
|
|
url' StackageCabalConfigR
|
|
url' StackageIndexR
|
|
url' SnapshotPackagesR
|
|
url' DocsR
|
|
url' HoogleR
|
|
where
|
|
url' = url . SnapshotR (stackageSlug s)
|
|
|
|
packageMetadataSitemap :: Metadata -> Sitemap
|
|
packageMetadataSitemap m = do
|
|
url' PackageR
|
|
url' PackageSnapshotsR
|
|
where
|
|
url' floc = url $ floc $ metadataName m
|
|
|
|
tagSitemap :: Tag -> Sitemap
|
|
tagSitemap t = url $ TagR $ tagTag t
|
|
|
|
|
|
priority :: Double -> Route App -> Sitemap
|
|
priority p loc = yield $ SitemapUrl
|
|
{ sitemapLoc = loc
|
|
, sitemapLastMod = Nothing
|
|
, sitemapChangeFreq = Nothing
|
|
, sitemapPriority = Just p
|
|
}
|
|
|
|
url :: Route App -> Sitemap
|
|
url loc = yield $ SitemapUrl
|
|
{ sitemapLoc = loc
|
|
, sitemapLastMod = Nothing
|
|
, sitemapChangeFreq = Nothing
|
|
, sitemapPriority = Nothing
|
|
}
|