{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
-- | Common handler functions.
module Handler.Common where

import Data.FileEmbed (embedFile)
import Database.Esqueleto ( (^.) )
import qualified Database.Esqueleto as E
import Yesod.Sitemap

import Import

import Model.Entry.Kind ( allEntryKinds )
import Widget.Entry ( entryR )

-- 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")

getKeybaseR :: Handler TypedContent
getKeybaseR = return $ TypedContent typePlain
                     $ toContent $(embedFile "config/keybase.txt")

getRobotsR :: Handler Text
getRobotsR = robots SitemapR

getSitemapR :: Handler TypedContent
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]
    sitemap $ do
        yield SitemapUrl
            { sitemapLoc = HomeR
            , sitemapLastMod = Nothing
            , sitemapChangeFreq = Just Daily
            , sitemapPriority = Nothing
            }
        yieldMany $ sitemapUrl . CategoryR . E.unValue <$> categories
        yieldMany $ sitemapUrl . EntriesR <$> allEntryKinds
        yieldMany $ entryToSitemapUrl <$> entries

sitemapUrl :: a -> SitemapUrl a
sitemapUrl loc = SitemapUrl
    { sitemapLoc = loc
    , sitemapLastMod = Nothing
    , sitemapChangeFreq = Nothing
    , sitemapPriority = Nothing
    }

entryToSitemapUrl :: Entity Entry -> SitemapUrl (Route App)
entryToSitemapUrl entry = (sitemapUrl $ entryR entry)
    { sitemapLastMod = Just . entryUpdated . entityVal $ entry
    }