From 84e0260396f18ad52dfcf0c5c286c3b409e11723 Mon Sep 17 00:00:00 2001 From: Jon Schoning Date: Wed, 3 Aug 2022 18:16:35 -0500 Subject: [PATCH] make RSS feed reflect the filter + search status of the current page (#44) --- config/routes | 6 +++++- src/Handler/Notes.hs | 28 ++++++++++++++++++++-------- src/Handler/User.hs | 43 ++++++++++++++++++++++++++++++++++++------- templates/user.hamlet | 14 ++++++++++++-- 4 files changed, 73 insertions(+), 18 deletions(-) diff --git a/config/routes b/config/routes index 5036c74..531c784 100644 --- a/config/routes +++ b/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 \ No newline at end of file +/docs/search DocsSearchR GET diff --git a/src/Handler/Notes.hs b/src/Handler/Notes.hs index 01f4220..0731cbb 100644 --- a/src/Handler/Notes.hs +++ b/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,21 +192,24 @@ 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" @@ -213,3 +217,11 @@ getNotesFeedR unamep@(UserNameP uname) = do , 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) diff --git a/src/Handler/User.hs b/src/Handler/User.hs index cfa22dd..db4df7d 100644 --- a/src/Handler/User.hs +++ b/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,30 +111,50 @@ 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" @@ -141,3 +162,11 @@ getUserFeedR unamep@(UserNameP uname) = do , 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) diff --git a/templates/user.hamlet b/templates/user.hamlet index 37138b2..08023a9 100644 --- a/templates/user.hamlet +++ b/templates/user.hamlet @@ -32,8 +32,18 @@ $maybe route <- mroute starred
- RSS + $if sharedp == SharedPrivate + RSS + $elseif sharedp == SharedPublic + RSS + $elseif filterp == FilterUnread + RSS + $elseif filterp == FilterUntagged + RSS + $elseif filterp == FilterStarred + RSS + $else + RSS