gdritter repos new-inf-blog / master src / Inf / Feed.hs
master

Tree @master (Download .tar.gz)

Feed.hs @masterraw · history · blame

{-# LANGUAGE OverloadedStrings #-}

module Inf.Feed (renderFeed) where

import           Control.Monad (forM)
import qualified Data.ByteString.Lazy as LBS
import qualified Text.Atom.Feed as Atom
import qualified Text.Atom.Feed.Export as Atom
import qualified Text.XML as XML

import qualified Inf.Templates as Template
import           Inf.Types

renderFeed :: [Post] -> IO LBS.ByteString
renderFeed posts = do
  renderedPosts <- forM posts $ \p -> do
    content <- Template.markdown (postContents p)
    pure p { postContents = content }
  let Right el = XML.fromXMLElement (Atom.xmlFeed (mkFeed renderedPosts))
      doc = XML.Document (XML.Prologue [] Nothing []) el []
  pure (XML.renderLBS XML.def doc)

author :: Atom.Person
author = Atom.Person
  { Atom.personName = "Getty Ritter"
  , Atom.personURI = Just "https://gdritter.com/"
  , Atom.personEmail = Nothing
  , Atom.personOther = []
  }

mkFeed :: [Post] -> Atom.Feed
mkFeed posts = let postsRev = reverse posts in Atom.Feed
  { Atom.feedId = "https://blog.infinitenegativeutility.com/"
  , Atom.feedTitle = Atom.TextString "Infinite Negative Utility"
  , Atom.feedUpdated = postDateT (head postsRev)
  , Atom.feedAuthors = [author]
  , Atom.feedCategories = []
  , Atom.feedContributors = [author]
  , Atom.feedGenerator = Nothing
  , Atom.feedIcon = Nothing
  , Atom.feedLinks = []
  , Atom.feedLogo = Nothing
  , Atom.feedRights = Nothing
  , Atom.feedSubtitle = Nothing
  , Atom.feedEntries = map mkEntry postsRev
  , Atom.feedAttrs = []
  , Atom.feedOther = []
  }

mkEntry :: Post -> Atom.Entry
mkEntry p = Atom.Entry
  { Atom.entryId           = postURL p
  , Atom.entryTitle        = Atom.TextString (postTitle p)
  , Atom.entryUpdated      = (postDateT p)
  , Atom.entryAuthors      = [author]
  , Atom.entryCategories   = []
  , Atom.entryContent      = Just (Atom.HTMLContent (postContents p))
  , Atom.entryContributor  = [author]
  , Atom.entryLinks        = [ Atom.nullLink (postURL p) ]
  , Atom.entryPublished    = Just (postDateT p)
  , Atom.entryRights       = Nothing
  , Atom.entrySource       = Nothing
  , Atom.entrySummary      = Nothing
  , Atom.entryInReplyTo    = Nothing
  , Atom.entryInReplyTotal = Nothing
  , Atom.entryAttrs        = []
  , Atom.entryOther        = []
  }