Add support for Atom and RSS content feeds - this info is available through mf2 anyway so Atom and RSS are kinda redundant, but we'll include them anyway

config/routes

@@ -7,6 +7,8 @@
 /sitemap.xml SitemapR GET
 
 / HomeR GET
+/feed FeedR GET
+!/#EntryKind/feed FeedKindR GET
 
 !/#EntryKind EntriesR GET
 !/#EntryKind/#EntryId EntryNoSlugR GET

package.yaml

@@ -53,6 +53,7 @@ dependencies:
 - slug >=0.1 && <0.2
 - split >=0.2 && <0.3
 - yesod-auth-hashdb >=1.6.2 && <1.7
+- yesod-newsfeed >=1.6 && <1.7
 - yesod-sitemap >=1.4 && <1.5
 
 # The library contains all of our application code. The executable

src/Application.hs

@@ -50,6 +50,7 @@ import System.Log.FastLogger                (defaultBufSize, newStdoutLoggerSet,
 -- Don't forget to add new modules to your cabal file!
 import Handler.Common
 import Handler.Entries
+import Handler.Feed
 import Handler.Home
 
 -- This line actually creates our YesodDispatch instance. It is the second half

src/Handler/Entries.hs

@@ -5,6 +5,7 @@ module Handler.Entries where
 import Import
 
 import Web.Slug ( Slug )
+import Yesod.AtomFeed ( atomLink )
 
 import qualified Entry.Kind as K
 import Widget.Entry ( entryR, hEntry )
@@ -15,6 +16,7 @@ getEntriesR kind = do
     entries <- runDB $ selectList [EntryKind ==. kind] [Desc EntryPublished]
     defaultLayout $ do
         setTitle . toHtml . K.pluralise $ kind
+        FeedKindR kind `atomLink` K.pluralise kind
         $(widgetFile "entries")
 
 checkMatching :: K.EntryKind -> Slug -> Entry -> Bool

src/Handler/Feed.hs

@@ -0,0 +1,53 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Handler.Feed where
+
+import Import
+
+import Data.Time.Clock.POSIX ( posixSecondsToUTCTime )
+import Widget.Entry ( entryR )
+
+import qualified Data.Text as T
+import qualified Entry.Kind as K
+
+getFeedR :: Handler TypedContent
+getFeedR = do
+    entries <- runDB $ selectList [] [Desc EntryPublished]
+    newsFeed $ toFeed entries
+
+getFeedKindR :: K.EntryKind -> Handler TypedContent
+getFeedKindR kind = do
+    entries <- runDB $ selectList [EntryKind ==. kind] [Desc EntryPublished]
+    let basicFeed = toFeed entries
+    newsFeed $ basicFeed
+        { feedTitle = T.concat [K.pluralise kind, " ~ ", feedTitle basicFeed]
+        , feedDescription = toHtml $ T.concat ["feed of all ", K.pluralise kind]
+        , feedLinkSelf = FeedKindR kind
+        , feedLinkHome = EntriesR kind
+        }
+
+toFeed :: [Entity Entry] -> Feed (Route App)
+toFeed entries@(latestEntry:_) = (toFeed [])
+    { feedEntries = toFeedEntry <$> entries
+    , feedUpdated = entryUpdated $ entityVal latestEntry
+    }
+toFeed [] = Feed
+    { feedTitle = fromMaybe "" . appTitle $ compileTimeAppSettings
+    , feedLinkSelf = FeedR
+    , feedLinkHome = HomeR
+    , feedAuthor = ""
+    , feedDescription = "sitewide feed of all entries"
+    , feedLanguage = "en-au"
+    , feedUpdated = posixSecondsToUTCTime 0
+    , feedLogo = Nothing
+    , feedEntries = []
+    }
+
+toFeedEntry :: Entity Entry -> FeedEntry (Route App)
+toFeedEntry entry = FeedEntry
+    { feedEntryLink = entryR entry
+    , feedEntryUpdated = entryUpdated $ entityVal entry
+    , feedEntryTitle = entryName $ entityVal entry
+    , feedEntryContent = toHtml . entryContent . entityVal $ entry
+    , feedEntryEnclosure = Nothing
+    }

src/Handler/Home.hs

@@ -6,6 +6,9 @@
 module Handler.Home where
 
 import Import
+
+import Yesod.AtomFeed ( atomLink )
+
 import Widget.Card ( hCard )
 import Widget.Feed ( hFeed )
 
@@ -16,7 +19,9 @@ getHomeR = do
     entries <- runDB $ selectList [EntryAuthorId ==. userId] [Desc EntryPublished]
     defaultLayout $ do
         case maybeTitle of
-          Just title -> setTitle $ toHtml title
+          Just title -> do
+              setTitle $ toHtml title
+              atomLink FeedR title
           Nothing -> return ()
         toWidgetHead
             [hamlet|