Merge pull request #3 from yogsototh/public-notes-with-feed

Public notes with feed

config/routes

@@ -8,6 +8,7 @@
 -- notes
 !/#UserNameP/notes NotesR GET
 !/#UserNameP/notes/add AddNoteViewR GET
+!/#UserNameP/notes/feed.xml NotesFeedR GET
 !/#UserNameP/notes/#NtSlug NoteR GET
 !/api/note/add AddNoteR POST
 !/api/note/#Int64 DeleteNoteR DELETE
@@ -18,6 +19,7 @@
 !/#UserNameP/#SharedP UserSharedR GET
 !/#UserNameP/#FilterP UserFilterR GET
 !/#UserNameP/#TagsP UserTagsR GET
+!/#UserNameP/feed.xml UserFeedR GET
 
 -- settings
 /Settings AccountSettingsR GET

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

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

purs/src/Component/NList.purs

@@ -48,19 +48,23 @@ nlist st' =
   render st@{ notes } =
     HH.div_ (map renderNote notes)
     where
-      renderNote bm =
-        div [ id_ (show bm.id) , class_ ("note w-100 mw7 pa1 mb2")] $
+      renderNote note =
+        div [ id_ (show note.id)
+            , class_ ("note w-100 mw7 pa1 mb2"
+                     <> if note.shared then "" else " private")] $
            [ div [ class_ "display" ] $
-             [ a [ href (linkToFilterSingle bm.slug), class_ ("link f5 lh-title")]
-               [ text $ if S.null bm.title then "[no title]" else bm.title ]
+             [ a [ href (linkToFilterSingle note.slug), class_ ("link f5 lh-title")]
+               [ text $ if S.null note.title then "[no title]" else note.title ]
              , br_
-             , div [ class_ "description mt1 mid-gray" ] (toTextarea (S.take 200 bm.text))
-             , a [ class_ "link f7 dib gray w4", title (maybe bm.created snd (mmoment bm)) , href (linkToFilterSingle bm.slug) ]
-               [ text (maybe " " fst (mmoment bm)) ]
+             , div [ class_ "description mt1 mid-gray" ] (toTextarea (S.take 200 note.text))
+             ,  a [ class_ "link f7 dib gray w4"
+                  , title (maybe note.created snd (mmoment note))
+                  , href (linkToFilterSingle note.slug)]
+                [text (maybe " " fst (mmoment note))]
              ]
            ]
 
-  mmoment bm = mmoment8601 bm.created
+  mmoment note = mmoment8601 note.created
   linkToFilterSingle slug = fromNullableStr app.userR <> "/notes/" <> slug
   toTextarea input =
     S.split (Pattern "\n") input

purs/src/Component/NNote.purs

@@ -56,6 +56,7 @@ data EditField
   = Etitle String
   | Etext String
   | EisMarkdown Boolean
+  | Eshared Boolean
 
 _markdown = SProxy :: SProxy "markdown"
 
@@ -99,8 +100,13 @@ nnote st' =
              , if note.isMarkdown
                then div [ class_ "description mt1" ] [ HH.slot _markdown unit Markdown.component note.text absurd ]
                else div [ class_ "description mt1 mid-gray" ] (toTextarea note.text)
-             , div [ class_ "link f7 dib gray w4", title (maybe note.created snd (mmoment note)) ]
-               [ text (maybe " " fst (mmoment note)) ]
+             , div [ class_ "link f7 dib gray w4"]
+                 [ span [title (maybe note.created snd (mmoment note))]
+                   [text (maybe " " fst (mmoment note))]
+                 , text " - "
+                 , span [ class_ ("gray")]
+                   [ text $ if note.shared then "public" else "private" ]
+               ]
              ]
            ]
            <> -- | Render Action Links
@@ -134,9 +140,20 @@ nnote st' =
              , label [ for "edit_ismarkdown" , class_ "mr2" ] [ text "use markdown?" ]
              , br_
             ]
-          , input [ type_ InputSubmit , class_ "mr1 pv1 ph2 dark-gray ba b--moon-gray bg-near-white pointer rdim" , value "save" ]
+          , div [ class_ "edit_form_checkboxes mb3"]
+            [ input [ type_ InputCheckbox , class_ "is-markdown pointer" , id_ "edit_shared", name "shared"
+                    , checked (edit_note.shared) , onChecked (editField Eshared) ]
+            , text " "
+            , label [ for "edit_shared" , class_ "mr2" ] [ text "public?" ]
+            , br_
+            ]
+          , input [ type_ InputSubmit
+                  , class_ "mr1 pv1 ph2 dark-gray ba b--moon-gray bg-near-white pointer rdim"
+                  , value "save" ]
           , text " "
-          , input [ type_ InputReset , class_ "pv1 ph2 dark-gray ba b--moon-gray bg-near-white pointer rdim" , value "cancel"
+          , input [ type_ InputReset
+                  , class_ "pv1 ph2 dark-gray ba b--moon-gray bg-near-white pointer rdim"
+                  , value "cancel"
                   , onClick \_ -> Just (NEdit false)
                   ]
           ]
@@ -161,6 +178,7 @@ nnote st' =
       Etitle e -> _ { title = e }
       Etext e -> _ { text = e }
       EisMarkdown e -> _ { isMarkdown = e }
+      Eshared e -> _ { shared = e }
 
   -- | Delete
   handleAction (NDeleteAsk e) = do

purs/src/Model.purs

@@ -34,6 +34,7 @@ type Note =
   , text :: String
   , length :: Int
   , isMarkdown :: Boolean
+  , shared :: Boolean
   , created :: String
   , updated :: String
   }

src/Application.hs

@@ -14,43 +14,37 @@ module Application
   , db
   ) where
 
-import Control.Monad.Logger (liftLoc, runLoggingT)
-import Database.Persist.Sqlite
-       (createSqlitePool, sqlDatabase, sqlPoolSize)
-import Import
-import Yesod.Auth (getAuth)
-import Language.Haskell.TH.Syntax (qLocation)
-import Lens.Micro
-import Network.HTTP.Client.TLS
-import Network.Wai (Middleware)
-import Network.Wai.Middleware.Autohead
-import Network.Wai.Middleware.AcceptOverride
-import Network.Wai.Middleware.Gzip
-import Network.Wai.Middleware.MethodOverride
-import Network.Wai.Handler.Warp
-       (Settings, defaultSettings, defaultShouldDisplayException,
-        runSettings, setHost, setOnException, setPort, getPort)
-import Network.Wai.Middleware.RequestLogger
-       (Destination(Logger), IPAddrSource(..), OutputFormat(..),
-        destination, mkRequestLogger, outputFormat)
-import System.Log.FastLogger
-       (defaultBufSize, newStdoutLoggerSet, toLogStr)
+import           Control.Monad.Logger (liftLoc, runLoggingT)
+import           Database.Persist.Sqlite (createSqlitePool, runSqlPool, sqlDatabase, sqlPoolSize)
+import           Import
+import           Language.Haskell.TH.Syntax (qLocation)
+import           Lens.Micro
+import           Network.HTTP.Client.TLS
+import           Network.Wai (Middleware)
+import           Network.Wai.Handler.Warp (Settings, defaultSettings, defaultShouldDisplayException, runSettings, setHost, setOnException, setPort, getPort)
+import           Network.Wai.Middleware.AcceptOverride
+import           Network.Wai.Middleware.Autohead
+import           Network.Wai.Middleware.Gzip
+import           Network.Wai.Middleware.MethodOverride
+import           Network.Wai.Middleware.RequestLogger (Destination(Logger), IPAddrSource(..), OutputFormat(..), destination, mkRequestLogger, outputFormat)
+import           System.Log.FastLogger (defaultBufSize, newStdoutLoggerSet, toLogStr)
+import           Yesod.Auth (getAuth)
 
 import qualified Control.Monad.Metrics as MM
-import qualified Network.Wai.Metrics   as WM
-import qualified System.Metrics        as EKG
+import qualified Network.Wai.Metrics as WM
+import qualified System.Metrics as EKG
 import qualified System.Remote.Monitoring as EKG
 
 -- Import all relevant handler modules here.
 -- Don't forget to add new modules to your cabal file!
-import Handler.Common
-import Handler.Home
-import Handler.User
-import Handler.AccountSettings
-import Handler.Add
-import Handler.Edit
-import Handler.Notes
-import Handler.Docs
+import           Handler.Common
+import           Handler.Home
+import           Handler.User
+import           Handler.AccountSettings
+import           Handler.Add
+import           Handler.Edit
+import           Handler.Notes
+import           Handler.Docs
 
 mkYesodDispatch "App" resourcesApp
 
@@ -74,9 +68,9 @@ makeFoundation appSettings = do
     createSqlitePool
       (sqlDatabase (appDatabaseConf appSettings))
       (sqlPoolSize (appDatabaseConf appSettings))
-  -- runLoggingT
-  --   (runSqlPool runMigrations pool)
-  --   logFunc
+  runLoggingT
+    (runSqlPool runMigrations pool)
+    logFunc
   return (mkFoundation pool)
 
 makeApplication :: App -> IO Application

src/Handler/Notes.hs

@@ -5,23 +5,27 @@ import Import
 import Handler.Common (lookupPagingParams)
 import qualified Data.Aeson as A
 import qualified Data.Text as T
+import           Yesod.RssFeed
+import           Text.Blaze.Html (toHtml)
+import qualified Text.Blaze.Html5 as H
 
 getNotesR :: UserNameP -> Handler Html
 getNotesR unamep@(UserNameP uname) = do
-  void requireAuthId
+  muserid <- maybeAuthId
   (limit', page') <- lookupPagingParams
   let queryp = "query" :: Text
   mquery <- lookupGetParam queryp
   let limit = maybe 20 fromIntegral limit'
       page  = maybe 1   fromIntegral page'
       mqueryp = fmap (\q -> (queryp, q)) mquery
-  (bcount, notes) <- 
-    runDB $
-    do Entity userId _ <- getBy404 (UniqueUserName uname)
-       getNoteList userId mquery limit page
+  (bcount, notes) <- runDB $ do
+    Entity userId _ <- getBy404 (UniqueUserName uname)
+    let sharedp = if muserid == Just userId then SharedAll else SharedPublic
+    getNoteList userId mquery sharedp limit page
   req <- getRequest
   mroute <- getCurrentRoute
   defaultLayout $ do
+    rssLink (NotesFeedR unamep) "feed"
     let pager = $(widgetFile "pager")
         search = $(widgetFile "search")
         renderEl = "notes" :: Text
@@ -36,7 +40,6 @@ getNotesR unamep@(UserNameP uname) = do
 
 getNoteR :: UserNameP -> NtSlug -> Handler Html
 getNoteR unamep@(UserNameP uname) slug = do
-  void requireAuthId
   let renderEl = "note" :: Text
   note <-
     runDB $
@@ -57,7 +60,7 @@ getAddNoteViewR :: UserNameP -> Handler Html
 getAddNoteViewR unamep@(UserNameP uname) = do
   userId <- requireAuthId
   let renderEl = "note" :: Text
-  note <- liftIO $ Entity (NoteKey 0) <$> _toNote userId (NoteForm Nothing Nothing Nothing Nothing Nothing Nothing Nothing)
+  note <- liftIO $ Entity (NoteKey 0) <$> _toNote userId (NoteForm Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing)
   defaultLayout $ do
     $(widgetFile "note")
     toWidgetBody [julius|
@@ -106,6 +109,7 @@ data NoteForm = NoteForm
   , _title :: Maybe Text
   , _text :: Maybe Textarea
   , _isMarkdown :: Maybe Bool
+  , _shared :: Maybe Bool
   , _created :: Maybe UTCTimeStr
   , _updated :: Maybe UTCTimeStr
   } deriving (Show, Eq, Read, Generic)
@@ -128,5 +132,40 @@ _toNote userId NoteForm {..} = do
       (fromMaybe "" _title)
       (maybe "" unTextarea _text)
       (fromMaybe False _isMarkdown)
+      (fromMaybe False _shared)
       (fromMaybe time (fmap unUTCTimeStr _created))
       (fromMaybe time (fmap unUTCTimeStr _updated))
+
+noteToRssEntry :: UserNameP -> Entity Note -> FeedEntry (Route App)
+noteToRssEntry usernamep (Entity entryId entry) =
+  FeedEntry { feedEntryLink = NoteR usernamep (noteSlug entry)
+            , feedEntryUpdated = (noteUpdated entry)
+            , feedEntryTitle = (noteTitle entry)
+            , feedEntryContent =  (toHtml (noteText entry))
+            , feedEntryEnclosure = Nothing
+            }
+
+getNotesFeedR :: UserNameP -> Handler RepRss
+getNotesFeedR unamep@(UserNameP uname) = do
+  (limit', page') <- lookupPagingParams
+  let queryp = "query" :: Text
+  mquery <- lookupGetParam queryp
+  let limit = maybe 20 fromIntegral limit'
+      page  = maybe 1   fromIntegral page'
+  (bcount, notes) <- runDB $ do
+      Entity userId _ <- getBy404 (UniqueUserName uname)
+      getNoteList userId mquery SharedPublic limit page
+  let (descr :: Html) = toHtml $ H.text (uname <> " notes")
+  let entries = map (noteToRssEntry unamep) notes
+  updated <- case maximumMay (map feedEntryUpdated entries) of
+                Nothing -> liftIO $ getCurrentTime
+                Just m ->  return m
+  rssFeed $ Feed (uname <> " notes")
+    (NotesFeedR unamep)
+    (NotesR unamep)
+    uname
+    descr
+    "en"
+    updated
+    Nothing
+    entries

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
@@ -51,6 +54,7 @@ _getUser unamep@(UserNameP uname) sharedp' filterp' (TagsP pathtags) = 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 } || [];
@@ -60,3 +64,42 @@ _getUser unamep@(UserNameP uname) sharedp' filterp' (TagsP pathtags) = do
     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

src/Model.hs

@@ -72,6 +72,7 @@ Note json
   title Text
   text Text
   isMarkdown Bool
+  shared Bool default=False
   created UTCTime
   updated UTCTime
   deriving Show Eq Typeable Ord
@@ -272,8 +273,8 @@ getNote :: Key User -> NtSlug -> DB (Maybe (Entity Note))
 getNote userKey slug =
   selectFirst [NoteUserId ==. userKey, NoteSlug ==. slug] []
 
-getNoteList :: Key User -> Maybe Text -> Limit -> Page -> DB (Int, [Entity Note])
-getNoteList key mquery limit' page =
+getNoteList :: Key User -> Maybe Text -> SharedP -> Limit -> Page -> DB (Int, [Entity Note])
+getNoteList key mquery sharedp limit' page =
   (,) -- total count
   <$> fmap (sum . fmap E.unValue)
       (select $
@@ -292,6 +293,10 @@ getNoteList key mquery limit' page =
       where_ $ (b ^. NoteUserId E.==. val key)
       -- search
       sequenceA_ (parseSearchQuery (toLikeExpr b) =<< mquery)
+      case sharedp of
+        SharedAll -> pure ()
+        SharedPublic ->  where_ (b ^. NoteShared E.==. val True)
+        SharedPrivate -> where_ (b ^. NoteShared E.==. val False)
 
     toLikeExpr :: E.SqlExpr (Entity Note) -> Text -> E.SqlExpr (E.Value Bool)
     toLikeExpr b term = fromRight p_allFields (P.parseOnly p_onefield term)
@@ -415,6 +420,7 @@ fileNoteToNote user (FileNote {..} ) = do
       fileNoteTitle
       fileNoteText
       False
+      False
       fileNoteCreatedAt
       fileNoteUpdatedAt
 

templates/notes.hamlet

@@ -2,6 +2,10 @@
   <div .w-100.mw8.center>
     <div .fr.nt1 style="margin-bottom:.7rem">
       ^{search}
+    <div .di>
+      <div .fr.f6.pr3.dib.mb2>
+          <a .link.gold.hover-orange
+             href="@{NotesFeedR unamep}">RSS
 
     <span .db .mb3>#{T.append "" (maybe "You have" (const "Found") mquery)} #{bcount} notes:
 

templates/user.hamlet

@@ -31,6 +31,9 @@ $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
   
       <div .cf>