diff --git a/config/routes b/config/routes index 0fbfa95..f5dc6b3 100644 --- a/config/routes +++ b/config/routes @@ -18,6 +18,7 @@ !/#UserNameP/#SharedP UserSharedR GET !/#UserNameP/#FilterP UserFilterR GET !/#UserNameP/#TagsP UserTagsR GET +!/#UserNameP/feed.xml UserFeedR GET -- settings /Settings AccountSettingsR GET diff --git a/espial.cabal b/espial.cabal index ef00a65..2de2b58 100644 --- a/espial.cabal +++ b/espial.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: ac9856c342ac9d7c05b18be91fb062e098dbf3575b2fbe7293f69df2d5b76cce +-- hash: da944088abb7ae887d67efd710c100bdbd5587072c6ddcfdc5d05392e7509d85 name: espial version: 0.0.8 @@ -128,6 +128,7 @@ library , attoparsec , base >=4.8.2.0 && <4.9 || >=4.9.1.0 && <5 , bcrypt >=0.0.8 + , blaze-html >=0.9 && <1.0 , bytestring >=0.9 && <0.11 , case-insensitive , classy-prelude >=1.4 && <1.6 @@ -179,6 +180,7 @@ library , yesod-auth >=1.6 && <1.7 , yesod-core >=1.6 && <1.7 , yesod-form >=1.6 && <1.7 + , yesod-newsfeed >=1.6 && <1.7 , yesod-static >=1.6 && <1.7 if (flag(dev)) || (flag(library-only)) ghc-options: -Wall -fwarn-tabs -O0 @@ -201,6 +203,7 @@ executable espial , attoparsec , base >=4.8.2.0 && <4.9 || >=4.9.1.0 && <5 , bcrypt >=0.0.8 + , blaze-html >=0.9 && <1.0 , bytestring >=0.9 && <0.11 , case-insensitive , classy-prelude >=1.4 && <1.6 @@ -253,6 +256,7 @@ executable espial , yesod-auth >=1.6 && <1.7 , yesod-core >=1.6 && <1.7 , yesod-form >=1.6 && <1.7 + , yesod-newsfeed >=1.6 && <1.7 , yesod-static >=1.6 && <1.7 if flag(library-only) buildable: False @@ -271,6 +275,7 @@ executable migration , attoparsec , base >=4.8.2.0 && <4.9 || >=4.9.1.0 && <5 , bcrypt >=0.0.8 + , blaze-html >=0.9 && <1.0 , bytestring >=0.9 && <0.11 , case-insensitive , classy-prelude >=1.4 && <1.6 @@ -324,6 +329,7 @@ executable migration , yesod-auth >=1.6 && <1.7 , yesod-core >=1.6 && <1.7 , yesod-form >=1.6 && <1.7 + , yesod-newsfeed >=1.6 && <1.7 , yesod-static >=1.6 && <1.7 if flag(library-only) buildable: False @@ -346,6 +352,7 @@ test-suite test , attoparsec , base >=4.8.2.0 && <4.9 || >=4.9.1.0 && <5 , bcrypt >=0.0.8 + , blaze-html >=0.9 && <1.0 , bytestring >=0.9 && <0.11 , case-insensitive , classy-prelude >=1.4 && <1.6 @@ -399,6 +406,7 @@ test-suite test , yesod-auth >=1.6 && <1.7 , yesod-core >=1.6 && <1.7 , yesod-form >=1.6 && <1.7 + , yesod-newsfeed >=1.6 && <1.7 , yesod-static >=1.6 && <1.7 , yesod-test default-language: Haskell2010 diff --git a/package.yaml b/package.yaml index 12c19af..bd9cce5 100644 --- a/package.yaml +++ b/package.yaml @@ -86,6 +86,7 @@ dependencies: - yesod-auth >=1.6 && <1.7 - yesod-static >=1.6 && <1.7 - yesod-form >=1.6 && <1.7 +- yesod-newsfeed >= 1.6 && < 1.7 - classy-prelude >=1.4 && <1.6 - classy-prelude-conduit >=1.4 && <1.6 - classy-prelude-yesod >=1.4 && <1.6 @@ -93,6 +94,7 @@ dependencies: - text >=0.11 && <2.0 - persistent >=2.8 && <2.10 # - persistent-postgresql >=2.8 && <2.9 +- blaze-html >= 0.9 && < 1.0 - persistent-template >=2.5 && <2.9 - template-haskell - shakespeare >=2.0 && <2.1 diff --git a/src/Handler/User.hs b/src/Handler/User.hs index 0027fda..7c4d438 100644 --- a/src/Handler/User.hs +++ b/src/Handler/User.hs @@ -1,9 +1,12 @@ {-# OPTIONS_GHC -fno-warn-unused-matches #-} module Handler.User where -import Import import qualified Data.Text as T -import Handler.Common (lookupPagingParams) +import Handler.Common (lookupPagingParams) +import Import +import Text.Blaze.Html (toHtml) +import qualified Text.Blaze.Html5 as H +import Yesod.RssFeed getUserR :: UserNameP -> Handler Html getUserR uname@(UserNameP name) = do @@ -35,7 +38,7 @@ _getUser unamep@(UserNameP uname) sharedp' filterp' (TagsP pathtags) = do isAll = filterp == FilterAll && sharedp == SharedAll && pathtags == [] queryp = "query" :: Text mquery <- lookupGetParam queryp - let mqueryp = fmap (\q -> (queryp, q)) mquery + let mqueryp = fmap (\q -> (queryp, q)) mquery (bcount, bmarks, alltags) <- runDB $ do Entity userId user <- getBy404 (UniqueUserName uname) @@ -45,18 +48,58 @@ _getUser unamep@(UserNameP uname) sharedp' filterp' (TagsP pathtags) = do tg <- tagsQuery bm pure (cnt, bm, tg) when (bcount == 0) (case filterp of FilterSingle _ -> notFound; _ -> pure ()) - mroute <- getCurrentRoute + mroute <- getCurrentRoute req <- getRequest defaultLayout $ do let pager = $(widgetFile "pager") search = $(widgetFile "search") renderEl = "bookmarks" :: Text + rssLink (UserFeedR unamep) "feed" $(widgetFile "user") toWidgetBody [julius| - app.dat.bmarks = #{ toJSON $ toBookmarkFormList bmarks alltags } || []; + app.dat.bmarks = #{ toJSON $ toBookmarkFormList bmarks alltags } || []; app.dat.isowner = #{ isowner }; app.userR = "@{UserR unamep}"; |] toWidget [julius| PS['Main'].renderBookmarks('##{rawJS renderEl}')(app.dat.bmarks)(); |] + +bookmarkToRssEntry :: Entity Bookmark -> FeedEntry Text +bookmarkToRssEntry (Entity entryId entry) = + FeedEntry { feedEntryLink = (bookmarkHref entry) + , feedEntryUpdated = (bookmarkTime entry) + , feedEntryTitle = (bookmarkDescription entry) + , feedEntryContent = (toHtml (bookmarkExtended entry)) + , feedEntryEnclosure = Nothing + } + +getUserFeedR :: UserNameP -> Handler RepRss +getUserFeedR unamep@(UserNameP uname) = do + mauthuname <- maybeAuthUsername + (limit', page') <- lookupPagingParams + let limit = maybe 120 fromIntegral limit' + page = maybe 1 fromIntegral page' + queryp = "query" :: Text + mquery <- lookupGetParam queryp + (bcount, bmarks, alltags) <- + runDB $ + do Entity userId user <- getBy404 (UniqueUserName uname) + (cnt, bm) <- bookmarksQuery userId SharedPublic FilterAll [] mquery limit page + tg <- tagsQuery bm + pure (cnt, bm, tg) + let (descr :: Html) = toHtml $ H.text ("Bookmarks saved by " <> uname) + let entries = map bookmarkToRssEntry bmarks + updated <- case maximumMay (map feedEntryUpdated entries) of + Nothing -> liftIO $ getCurrentTime + Just m -> return m + render <- getUrlRender + rssFeedText $ Feed ("espial " <> uname) + (render (UserFeedR unamep)) + (render (UserR unamep)) + uname + descr + "en" + updated + Nothing + entries diff --git a/templates/user.hamlet b/templates/user.hamlet index 264a06d..9357f85 100644 --- a/templates/user.hamlet +++ b/templates/user.hamlet @@ -31,6 +31,9 @@ $maybe route <- mroute ‧ starred +
+ RSS