Mosaico RSS link tags to category/tag feed pages

apps/mosaico/src/Main.purs

@@ -50,6 +50,7 @@ import Mosaico.Frontpage.Models (Hook(..)) as Frontpage
 import Mosaico.Header.Menu as Menu
 import Mosaico.Feed (ArticleFeed(..), ArticleFeedType(..), mkArticleFeed)
 import Mosaico.Paper (mosaicoPaper)
+import Mosaico.RSS as RSS
 import Mosaico.Search as Search
 import MosaicoServer (MainContent, MainContentType(..))
 import MosaicoServer as MosaicoServer
@@ -332,7 +333,9 @@ frontpage env { guards: { credentials } } = do
  , "categoryStructure" /\ (JSON.stringify $ encodeJson env.categoryStructure)
  ] <> userVar user
  <> mkArticleFeed (CategoryFeed frontpageCategoryLabel) (Cache.getContent articles)
- appendMosaico (Cache.getContent mosaicoString) htmlTemplate >>= appendHead (mkWindowVariables windowVars)
+ appendMosaico (Cache.getContent mosaicoString) htmlTemplate >>=
+ appendHead (mkWindowVariables windowVars
+ <> RSS.string (RSS.category mosaicoPaper frontpageCategoryLabel))
  now <- liftEffect nowDateTime
  pure $ Cache.addHeader now (isJust user) mosaicoString $ maybeInvalidateAuth user $ htmlContent $ Response.ok $ StringBody $ renderTemplateHtml html
  where
@@ -431,7 +434,8 @@ tagList env { params: { tag }, guards: { credentials } } = do
  , "categoryStructure" /\ (JSON.stringify $ encodeJson env.categoryStructure)
  ] <> userVar user
  <> mkArticleFeed (TagFeed tag') (ArticleList (Cache.getContent articles))
- appendMosaico (Cache.getContent mosaicoString) htmlTemplate >>= appendHead (mkWindowVariables windowVars)
+ appendMosaico (Cache.getContent mosaicoString) htmlTemplate >>=
+ appendHead (mkWindowVariables windowVars <> RSS.string (RSS.tag mosaicoPaper tag'))
  now <- liftEffect nowDateTime
  pure $ Cache.addHeader now (isJust user) mosaicoString $ maybeInvalidateAuth user $ htmlContent $ Response.ok $ StringBody $ renderTemplateHtml html
  where
@@ -569,10 +573,11 @@ debugList env { params: { uuid }, guards: { credentials } } = do
 
 categoryPage :: Env -> { params :: { categoryName :: String }, guards :: { category :: Category, credentials :: Maybe UserAuth } } -> Aff (Response ResponseBody)
 categoryPage env { params: { categoryName }, guards: { credentials } } = do
+ let label = CategoryLabel categoryName
  { user, articles, mostReadArticles } <- sequential $
  { user: _, articles: _, mostReadArticles: _ }
  <$> maybe (pure Nothing) (parallel <<< getUser) credentials
- <*> parallel (Cache.getFrontpage env.cache $ CategoryLabel categoryName)
+ <*> parallel (Cache.getFrontpage env.cache label)
  <*> parallel (Cache.getMostRead env.cache)
  let htmlTemplate = cloneTemplate env.htmlTemplate
  mosaicoString = renderContent user <$> articles <*> mostReadArticles
@@ -582,7 +587,9 @@ categoryPage env { params: { categoryName }, guards: { credentials } } = do
  , "categoryStructure" /\ (JSON.stringify $ encodeJson env.categoryStructure)
  ] <> userVar user
  <> mkArticleFeed (CategoryFeed $ CategoryLabel categoryName) (ArticleList $ Cache.getContent articles)
- appendMosaico (Cache.getContent mosaicoString) htmlTemplate >>= appendHead (mkWindowVariables windowVars)
+ appendMosaico (Cache.getContent mosaicoString) htmlTemplate >>=
+ appendHead (mkWindowVariables windowVars
+ <> RSS.string (RSS.category mosaicoPaper label))
  now <- liftEffect nowDateTime
  pure $ Cache.addHeader now (isJust user) mosaicoString $
  maybeInvalidateAuth user $ htmlContent $ Response.ok $ StringBody $ renderTemplateHtml html

apps/mosaico/src/Mosaico.purs

@@ -51,6 +51,7 @@ import Mosaico.LoginModal as LoginModal
 import Mosaico.MostReadList as MostReadList
 import Mosaico.Paper (mosaicoPaper)
 import Mosaico.Routes as Routes
+import Mosaico.RSS as RSS
 import Mosaico.Search as Search
 import Mosaico.StaticPage (StaticPageResponse(..), fetchStaticPage, getInitialStaticPageContent, getInitialStaticPageScript)
 import Mosaico.Webview as Webview
@@ -198,7 +199,8 @@ mosaicoComponent initialValues props = React.do
  SearchFeed q -> Just <<< ArticleList <$> Lettera.search 0 20 mosaicoPaper q
  stamp <- liftEffect Now.nowDateTime
  foldMap (\feed -> liftEffect $ setState \s -> s { frontpageFeeds = HashMap.insert feedName { stamp, feed } s.frontpageFeeds }) maybeFeed
- setFrontpage feedName =
+ setFrontpage feedName = do
+ RSS.setFeed mosaicoPaper feedName
  case HashMap.lookup feedName state.frontpageFeeds of
  Nothing -> Aff.launchAff_ $ loadFeed feedName
  Just { stamp } -> do
@@ -239,6 +241,12 @@ mosaicoComponent initialValues props = React.do
  _ -> mempty
  Routes.DebugPage _ -> pure unit
 
+ case state.route of
+ Routes.Frontpage -> pure unit
+ Routes.TagPage _ -> pure unit
+ Routes.CategoryPage _ -> pure unit
+ _ -> RSS.delete
+
  case props.mostReadArticles of
  Just mostReads
  | not $ null mostReads -> liftEffect $ setState \s -> s { mostReadArticles = mostReads }

apps/mosaico/src/Mosaico/RSS.js

@@ -0,0 +1,14 @@
+exports.delete = function() {
+ const el = document.querySelector('link[type="application/rss+xml"][rel="alternate"]');
+ if (el) {
+ el.remove();
+ }
+}
+
+exports.inject = function(content) {
+ const head = document.querySelector('head');
+ // Highly unusual to not have it but let's play safe
+ if (head) {
+ head.append(content);
+ }
+}

apps/mosaico/src/Mosaico/RSS.purs

@@ -0,0 +1,56 @@
+module Mosaico.RSS where
+
+import Prelude
+
+import Data.Maybe (Maybe(..))
+import Data.Newtype (unwrap)
+import Data.String (Pattern(..), Replacement(..), replaceAll)
+import Effect (Effect)
+import KSF.Paper as Paper
+import Lettera as Lettera
+import Lettera.Models(CategoryLabel, Tag)
+import Mosaico.Feed (ArticleFeedType(..))
+
+foreign import delete :: Effect Unit
+foreign import inject :: String -> Effect Unit
+
+type Feed =
+ { title :: String
+ , url :: String
+ }
+
+encodeQuotes :: String -> String
+encodeQuotes = replaceAll (Pattern "'") (Replacement "\\'")
+
+category :: Paper.Paper -> CategoryLabel -> Feed
+category paper cat =
+ { title: "RSS-flöde för " <> unwrap cat
+ , url: Lettera.letteraBaseUrl <> Lettera.letteraFrontPageUrl
+ <> "&paper=" <> Paper.toString paper
+ <> "&category=" <> show cat
+ }
+
+tag :: Paper.Paper -> Tag -> Feed
+tag paper t =
+ { title: "RSS-flöde för " <> unwrap t
+ , url: Lettera.letteraBaseUrl <> Lettera.letteraTagUrl <> Lettera.encodeURIComponent (unwrap t)
+ <> "&paper=" <> Paper.toString paper
+ }
+
+string :: Feed -> String
+string { title, url } =
+ "<link rel='alternate' type='application/rss+xml' title='"
+ <> encodeQuotes(title)
+ <> "' href='" <> url <> "'/>"
+
+setFeed :: Paper.Paper -> ArticleFeedType -> Effect Unit
+setFeed paper feedType = do
+ let maybeFeed = case feedType of
+ CategoryFeed label -> Just $ category paper label
+ TagFeed t -> Just $ tag paper t
+ _ -> Nothing
+ delete
+ case maybeFeed of
+ Just feed -> do
+ inject $ string feed
+ Nothing -> pure unit