RSS.hs

{-# LANGUAGE NoImplicitPrelude #-}


{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}


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 version="1.0" encoding="UTF-8"?>
  <rss version="2.0" xmlns:atom="http://www.w3.org/2005/Atom">
    <channel>
      <title>{{ site.name }}</title>
      <description>{{ site.description }}</description>
      <link>{{ site.url }}</link>
      <atom:link href="{{ site.url }}/rss.xml" rel="self" type="application/rss+xml" />
      {% for post in site.posts limit:10 %}
        <item>
          <title>{{ post.title }}</title>
          <description>{{ post.content | xml_escape }}</description>
          <pubDate>{{ post.date | date: "%a, %d %b %Y %H:%M:%S %z" }}</pubDate>
          <link>{{ site.url }}{{ post.url }}</link>
          <guid isPermaLink="true">{{ site.url }}{{ post.url }}</guid>
        </item>
      {% endfor %}
    </channel>
  </rss>

  <link rel="alternate" type="application/rss+xml" title="{{ site.name }}" href="{{ site.url }}/rss.xml">

  -}

-- xml_header
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