{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-} module RSS ( generate ) where import Article (Article(..)) import ArticlesList (ArticlesList(..), getArticles) import qualified ArticlesList (description, path) import Blog (Blog(urls), Renderer, URLs(..)) import Blog.URL (AbsoluteURL, pathOn) import Collection (Collection(..), getAll) import qualified Collection (title) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Reader (ReaderT, asks) import Data.Text (Text) import Data.Map ((!)) import qualified Data.Text.Lazy.IO as TextIO (writeFile) import Data.Time (defaultTimeLocale, formatTime, rfc822DateFormat) import Data.Time.Clock.POSIX (posixSecondsToUTCTime) --import Lucid (Attribute, HtmlT, Term, ToHtml(..), term, renderTextT) import Lucid.Base (makeAttribute) import Markdown (Markdown(..)) import Pretty ((.$)) import System.FilePath.Posix ((), (<.>)) import Text.Blaze.Html (Html) prolog :: Monad m => m Html prolog = toHtmlRaw ("" :: String) version_ :: Text -> Attribute version_ = makeAttribute "version" xmlns_content_ :: Text -> Attribute xmlns_content_ = makeAttribute "xmlns:content" xmlns_atom_ :: Text -> Attribute xmlns_atom_ = makeAttribute "xmlns:atom" rss_ :: Term arg result => arg -> result rss_ = term "rss" channel_ :: Term arg result => arg -> result channel_ = term "channel" title_ :: Term arg result => arg -> result title_ = term "title" link_ :: Term arg result => arg -> result link_ = term "link" description_ :: Term arg result => arg -> result description_ = term "description" item_ :: Term arg result => arg -> result item_ = term "item" pubDate_ :: Term arg result => arg -> result pubDate_ = term "pubDate" articleItem :: Monad m => AbsoluteURL -> Article -> m Html articleItem siteURL (Article (Markdown {path, metadata, title})) = item_ $ do title_ $ toHtml title link_ . toHtml $ pathOn siteURL (path <.> "html") pubDate_ . toHtml . rfc822Date $ metadata ! "date" where rfc822Date = formatTime defaultTimeLocale rfc822DateFormat . posixSecondsToUTCTime . fromIntegral . (read :: String -> Int) feed :: Renderer m => AbsoluteURL -> ArticlesList -> m Html feed siteURL al@(ArticlesList {collection}) = do prolog rss_ [version, content, atom] $ do channel_ $ do title_ . toHtml =<< Collection.title collection link_ . toHtml . pathOn siteURL $ ArticlesList.path al description_ . toHtml =<< ArticlesList.description al mapM_ (articleItem siteURL) =<< getArticles al where version = version_ "2.0" content = xmlns_content_ "http://purl.org/rss/1.0/modules/content/" atom = xmlns_atom_ "http://www.w3.org/2005/Atom" generateCollection :: AbsoluteURL -> Collection -> ReaderT Blog IO () generateCollection siteURL collection = renderTextT (feed siteURL $ ArticlesList {full = False, collection}) >>= liftIO . TextIO.writeFile (basePath collection "rss" <.> "xml") generate :: ReaderT Blog IO () generate = (asks $urls.$rss) >>= maybe (return ()) generateAll where generateAll siteURL = Collection.getAll >>= mapM_ (generateCollection siteURL)