make RSS feed reflect the filter + search status of the current page (#…

…44)

config/routes

@@ -20,7 +20,11 @@
 !/#UserNameP/#SharedP UserSharedR GET
 !/#UserNameP/#FilterP UserFilterR GET
 !/#UserNameP/#TagsP UserTagsR GET
+
 !/#UserNameP/feed.xml UserFeedR GET
+!/#UserNameP/#SharedP/feed.xml UserFeedSharedR GET
+!/#UserNameP/#FilterP/feed.xml UserFeedFilterR GET
+!/#UserNameP/#TagsP/feed.xml UserFeedTagsR GET
 
 -- settings
 /Settings AccountSettingsR GET
@@ -45,4 +49,4 @@ api/tagcloudmode UserTagCloudModeR POST
 /bm/#Int64/unstar UnstarR POST
 
 -- doc
-/docs/search DocsSearchR GET
+/docs/search DocsSearchR GET

src/Handler/Notes.hs

@@ -8,6 +8,7 @@ import qualified Data.Aeson as A
 import qualified Data.Text as T
 import           Yesod.RssFeed
 import qualified Text.Blaze.Html5 as H
+import qualified Network.Wai.Internal as W
 
 getNotesR :: UserNameP -> Handler Html
 getNotesR unamep@(UserNameP uname) = do
@@ -172,10 +173,10 @@ _toNote userId NoteForm {..} = do
     , noteUpdated = maybe time unUTCTimeStr _updated
     }
 
-noteToRssEntry :: UserNameP -> Entity Note -> FeedEntry (Route App)
-noteToRssEntry usernamep (Entity entryId entry) =
+noteToRssEntry :: (Route App -> Text) -> UserNameP -> Entity Note -> FeedEntry Text
+noteToRssEntry render usernamep (Entity entryId entry) =
   FeedEntry
-  { feedEntryLink = NoteR usernamep (noteSlug entry)
+  { feedEntryLink = render $ NoteR usernamep (noteSlug entry)
   , feedEntryUpdated = noteUpdated entry
   , feedEntryTitle = noteTitle entry
   , feedEntryContent = toHtml (noteText entry)
@@ -191,25 +192,36 @@ getNotesFeedR unamep@(UserNameP uname) = do
   let limit = maybe 20 fromIntegral limit'
       page  = maybe 1   fromIntegral page'
       isowner = Just uname == mauthuname
+      sharedp = if isowner then SharedAll else SharedPublic
   (_, notes) <- runDB do
       Entity userId user <- getBy404 (UniqueUserName uname)
       when (not isowner && userPrivacyLock user)
         (redirect (AuthR LoginR))
-      getNoteList userId mquery SharedPublic limit page
+      getNoteList userId mquery sharedp limit page
+  render <- getUrlRender
   let (descr :: Html) = toHtml $ H.text (uname <> " notes")
-      entries = map (noteToRssEntry unamep) notes
+      entries = map (noteToRssEntry render unamep) notes
   updated <- case maximumMay (map feedEntryUpdated entries) of
                 Nothing -> liftIO getCurrentTime
                 Just m ->  return m
-  rssFeed $
+  (feedLinkSelf, feedLinkHome) <- getFeedLinkSelf
+  rssFeedText $
     Feed
     { feedTitle = uname <> " notes"
-    , feedLinkSelf = NotesFeedR unamep
-    , feedLinkHome = NotesR unamep
+    , feedLinkSelf = feedLinkSelf
+    , feedLinkHome = feedLinkHome
     , feedAuthor = uname
     , feedDescription = descr
     , feedLanguage = "en"
     , feedUpdated = updated
     , feedLogo = Nothing
     , feedEntries = entries
     }
+  where
+    getFeedLinkSelf = do
+      request <- getRequest
+      render <- getUrlRender
+      let rawRequest = reqWaiRequest request
+          feedLinkSelf = render HomeR <> (T.drop 1 (decodeUtf8 (W.rawPathInfo rawRequest <> W.rawQueryString rawRequest)))
+          feedLinkHome = render (UserR unamep)
+      pure (feedLinkSelf, feedLinkHome)

src/Handler/User.hs

@@ -8,9 +8,10 @@ import           Import
 import qualified Text.Blaze.Html5 as H
 import           Yesod.RssFeed
 import qualified Data.Map as Map
+import qualified Network.Wai.Internal as W
 
 getUserR :: UserNameP -> Handler Html
-getUserR uname@(UserNameP name) =
+getUserR uname=
   _getUser uname SharedAll FilterAll (TagsP [])
 
 getUserSharedR :: UserNameP -> SharedP -> Handler Html
@@ -110,34 +111,62 @@ bookmarkToRssEntry (Entity entryId entry, tags) =
   }
 
 getUserFeedR :: UserNameP -> Handler RepRss
-getUserFeedR unamep@(UserNameP uname) = do
+getUserFeedR unamep = do
+  _getUserFeed unamep SharedAll FilterAll (TagsP [])
+
+getUserFeedSharedR :: UserNameP -> SharedP -> Handler RepRss
+getUserFeedSharedR uname sharedp =
+  _getUserFeed uname sharedp FilterAll (TagsP [])
+
+getUserFeedFilterR :: UserNameP -> FilterP -> Handler RepRss
+getUserFeedFilterR uname filterp =
+  _getUserFeed uname SharedAll filterp (TagsP [])
+
+getUserFeedTagsR :: UserNameP -> TagsP -> Handler RepRss
+getUserFeedTagsR uname = _getUserFeed uname SharedAll FilterAll
+
+_getUserFeed :: UserNameP -> SharedP -> FilterP -> TagsP -> Handler RepRss
+_getUserFeed unamep@(UserNameP uname) sharedp' filterp' (TagsP pathtags) = do
   mauthuname <- maybeAuthUsername
   (limit', page') <- lookupPagingParams
   let limit = maybe 120 fromIntegral limit'
       page  = maybe 1   fromIntegral page'
-      queryp = "query" :: Text
       isowner = Just uname == mauthuname
+      sharedp = if isowner then sharedp' else SharedPublic
+      filterp = case filterp' of
+        FilterSingle _ -> filterp'
+        _ -> if isowner then filterp' else FilterAll
+      -- isAll = filterp == FilterAll && sharedp == SharedAll && null pathtags
+      queryp = "query" :: Text
   mquery <- lookupGetParam queryp
   (_, btmarks) <- runDB $ do
        Entity userId user <- getBy404 (UniqueUserName uname)
        when (not isowner && userPrivacyLock user)
          (redirect (AuthR LoginR))
-       bookmarksTagsQuery userId SharedPublic FilterAll [] mquery limit page
+       bookmarksTagsQuery userId sharedp filterp pathtags mquery limit page
   let (descr :: Html) = toHtml $ H.text ("Bookmarks saved by " <> uname)
       entries = map bookmarkToRssEntry btmarks
   updated <- case maximumMay (map feedEntryUpdated entries) of
                 Nothing -> liftIO getCurrentTime
                 Just m ->  return m
-  render <- getUrlRender
+  (feedLinkSelf, feedLinkHome) <- getFeedLinkSelf
   rssFeedText $
     Feed
     { feedTitle = "espial " <> uname
-    , feedLinkSelf = render (UserFeedR unamep)
-    , feedLinkHome = render (UserR unamep)
+    , feedLinkSelf = feedLinkSelf
+    , feedLinkHome = feedLinkHome
     , feedAuthor = uname
     , feedDescription = descr
     , feedLanguage = "en"
     , feedUpdated = updated
     , feedLogo = Nothing
     , feedEntries = entries
     }
+  where
+    getFeedLinkSelf = do
+      request <- getRequest
+      render <- getUrlRender
+      let rawRequest = reqWaiRequest request
+          feedLinkSelf = render HomeR <> (T.drop 1 (decodeUtf8 (W.rawPathInfo rawRequest <> W.rawQueryString rawRequest)))
+          feedLinkHome = render (UserR unamep)
+      pure (feedLinkSelf, feedLinkHome)

templates/user.hamlet

@@ -32,8 +32,18 @@ $maybe route <- mroute
             <a .link.silver.hover-blue :filterp == FilterStarred:.nav-active 
                href="@{UserFilterR unamep FilterStarred}">starred
         <div .fr.f6.pr3.dib.mb2>
-            <a .link.gold.hover-orange
-               href="@{UserFeedR unamep}">RSS
+          $if sharedp == SharedPrivate
+            <a .link.gold.hover-orange href="@?{(UserFeedSharedR unamep SharedPrivate, catMaybes [mqueryp])}">RSS
+          $elseif sharedp == SharedPublic
+            <a .link.gold.hover-orange href="@?{(UserFeedSharedR unamep SharedPublic, catMaybes [mqueryp])}">RSS
+          $elseif filterp == FilterUnread
+            <a .link.gold.hover-orange href="@?{(UserFeedFilterR unamep FilterUnread, catMaybes [mqueryp])}">RSS
+          $elseif filterp == FilterUntagged
+            <a .link.gold.hover-orange href="@?{(UserFeedFilterR unamep FilterUntagged, catMaybes [mqueryp])}">RSS
+          $elseif filterp == FilterStarred
+            <a .link.gold.hover-orange href="@?{(UserFeedFilterR unamep FilterStarred, catMaybes [mqueryp])}">RSS
+          $else
+            <a .link.gold.hover-orange href="@?{(UserFeedR unamep, catMaybes [mqueryp])}">RSS
 
       <div .cf>