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 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, defaultTimeLocale)
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