module Web.Geek.RSS (rss) where
import Air.Data.Record.SimpleLabel hiding (get)
import Air.Env hiding (head, div)
import Air.Extra hiding (date)
import Air.TH (here)
import qualified Web.Geek.Type as Geek
import Data.Text (Text)
import Text.HTML.Moe2 hiding ((/), text)
import Text.HTML.Moe2.Type (MoeUnit)
import Data.ByteString (ByteString)
import qualified Data.Text as T
import Data.Maybe
import Control.Monad (forM_)
import System.Locale (defaultTimeLocale)
import Data.Time (formatTime)
import Data.Char (isSpace)
xml_header :: MoeUnit
xml_header = no_escape_no_indent_str "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"
text :: T.Text -> MoeUnit
text = T.unpack > str
rss :: Geek.Config -> [Geek.Post] -> Maybe Text -> ByteString
rss _config _posts _maybe_tag = l2s render_bytestring do
let drop_tail_slash xs = xs.reverse.dropWhile (is '/').reverse
site_link = _config.Geek.rss_site_link.T.unpack.drop_tail_slash
site_link_with_prefix =
(
[
site_link
, _config.Geek.rss_site_root_prefix.T.unpack.drop_tail_slash.reverse.drop_tail_slash
]
).reject (all isSpace).join "/"
xml_header
element "rss" ! [attr "version" "2.0", attr "xmlns:atom" "http://www.w3.org/2005/Atom"] do
element "channel" do
title do
text _config.Geek.rss_site_title
element "description" do
text _config.Geek.rss_site_description
element "link" do
str site_link
element "atom:link" ! [href (site_link + "/rss.xml"), attr "rel" "self", _type "application/rss+xml"]
return ()
forM_ _posts \_post ->
element "item" do
title do
text _post.Geek.title
element "description" do
text _post.Geek.body.Geek.unHTMLText
element "pubDate" do
let pub_date_format_string = "%a, %d %b %Y %H:%M:%S %z"
str _post.Geek.date.fromMaybe def.formatTime defaultTimeLocale pub_date_format_string
let post_link = site_link_with_prefix + "/" + _post.Geek.link.Geek.unURIEscapedText.T.unpack
element "link" do
str post_link
element "guid" ! [attr "isPermaLink" "true"] do
str post_link