2017-10-02 03:07:09 -04:00
|
|
|
{-# LANGUAGE NoImplicitPrelude #-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
|
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
|
|
-- | Common handler functions.
|
|
|
|
module Handler.Common where
|
|
|
|
|
|
|
|
import Data.FileEmbed (embedFile)
|
2017-10-04 18:16:26 -04:00
|
|
|
import Yesod.Sitemap
|
|
|
|
|
2017-10-02 03:07:09 -04:00
|
|
|
import Import
|
|
|
|
|
2017-10-10 21:44:33 -04:00
|
|
|
import Model.Entry.Kind ( EntryKind, allEntryKinds )
|
2017-10-09 00:40:58 -04:00
|
|
|
import Widget.Entry ( entryR )
|
|
|
|
|
2017-10-02 03:07:09 -04:00
|
|
|
-- These handlers embed files in the executable at compile time to avoid a
|
|
|
|
-- runtime dependency, and for efficiency.
|
|
|
|
|
|
|
|
getFaviconR :: Handler TypedContent
|
|
|
|
getFaviconR = do cacheSeconds $ 60 * 60 * 24 * 30 -- cache for a month
|
|
|
|
return $ TypedContent "image/x-icon"
|
|
|
|
$ toContent $(embedFile "config/favicon.ico")
|
|
|
|
|
2017-10-03 05:41:26 -04:00
|
|
|
getKeybaseR :: Handler TypedContent
|
|
|
|
getKeybaseR = return $ TypedContent typePlain
|
|
|
|
$ toContent $(embedFile "config/keybase.txt")
|
|
|
|
|
2017-10-04 18:16:26 -04:00
|
|
|
getRobotsR :: Handler Text
|
|
|
|
getRobotsR = robots SitemapR
|
|
|
|
|
|
|
|
getSitemapR :: Handler TypedContent
|
2017-10-09 00:40:58 -04:00
|
|
|
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
|
|
|
|
}
|