92ab8ee889
GHC 7 changes the syntax for quasi-quotation. A later patch release (7.0.2) should be adding back backwards-compatibility with the old syntax, but in the meanwhile this (relatively ugly) hack should fix it.
80 lines
2.1 KiB
Haskell
80 lines
2.1 KiB
Haskell
{-# LANGUAGE QuasiQuotes #-}
|
|
{-# LANGUAGE CPP #-}
|
|
---------------------------------------------------------
|
|
--
|
|
-- Module : Yesod.Helpers.Sitemap
|
|
-- Copyright : Michael Snoyman
|
|
-- License : BSD3
|
|
--
|
|
-- Maintainer : Michael Snoyman <michael@snoyman.com>
|
|
-- Stability : Stable
|
|
-- Portability : portable
|
|
--
|
|
-- Generating Google sitemap files.
|
|
--
|
|
---------------------------------------------------------
|
|
|
|
-- | Generates XML sitemap files.
|
|
--
|
|
-- See <http://www.sitemaps.org/>.
|
|
module Yesod.Helpers.Sitemap
|
|
( sitemap
|
|
, robots
|
|
, SitemapUrl (..)
|
|
, SitemapChangeFreq (..)
|
|
) where
|
|
|
|
import Yesod
|
|
import Data.Time (UTCTime)
|
|
|
|
data SitemapChangeFreq = Always
|
|
| Hourly
|
|
| Daily
|
|
| Weekly
|
|
| Monthly
|
|
| Yearly
|
|
| Never
|
|
|
|
showFreq :: SitemapChangeFreq -> String
|
|
showFreq Always = "always"
|
|
showFreq Hourly = "hourly"
|
|
showFreq Daily = "daily"
|
|
showFreq Weekly = "weekly"
|
|
showFreq Monthly = "monthly"
|
|
showFreq Yearly = "yearly"
|
|
showFreq Never = "never"
|
|
|
|
data SitemapUrl url = SitemapUrl
|
|
{ sitemapLoc :: url
|
|
, sitemapLastMod :: UTCTime
|
|
, sitemapChangeFreq :: SitemapChangeFreq
|
|
, priority :: Double
|
|
}
|
|
|
|
template :: [SitemapUrl url] -> Hamlet url
|
|
template urls =
|
|
#if GHC7
|
|
[xhamlet|
|
|
#else
|
|
[$xhamlet|
|
|
#endif
|
|
%urlset!xmlns="http://www.sitemaps.org/schemas/sitemap/0.9"
|
|
$forall urls url
|
|
%url
|
|
%loc @sitemapLoc.url@
|
|
%lastmod $formatW3.sitemapLastMod.url$
|
|
%changefreq $showFreq.sitemapChangeFreq.url$
|
|
%priority $show.priority.url$
|
|
|]
|
|
|
|
sitemap :: [SitemapUrl (Route master)] -> GHandler sub master RepXml
|
|
sitemap = fmap RepXml . hamletToContent . template
|
|
|
|
-- | A basic robots file which just lists the "Sitemap: " line.
|
|
robots :: Route sub -- ^ sitemap url
|
|
-> GHandler sub master RepPlain
|
|
robots smurl = do
|
|
tm <- getRouteToMaster
|
|
render <- getUrlRender
|
|
return $ RepPlain $ toContent $ "Sitemap: " ++ render (tm smurl)
|