Merge pull request #3 from yogsototh/public-notes-with-feed
Public notes with feed
This commit is contained in:
commit
1721fe2544
16 changed files with 211 additions and 87 deletions
|
@ -8,6 +8,7 @@
|
||||||
-- notes
|
-- notes
|
||||||
!/#UserNameP/notes NotesR GET
|
!/#UserNameP/notes NotesR GET
|
||||||
!/#UserNameP/notes/add AddNoteViewR GET
|
!/#UserNameP/notes/add AddNoteViewR GET
|
||||||
|
!/#UserNameP/notes/feed.xml NotesFeedR GET
|
||||||
!/#UserNameP/notes/#NtSlug NoteR GET
|
!/#UserNameP/notes/#NtSlug NoteR GET
|
||||||
!/api/note/add AddNoteR POST
|
!/api/note/add AddNoteR POST
|
||||||
!/api/note/#Int64 DeleteNoteR DELETE
|
!/api/note/#Int64 DeleteNoteR DELETE
|
||||||
|
@ -18,6 +19,7 @@
|
||||||
!/#UserNameP/#SharedP UserSharedR GET
|
!/#UserNameP/#SharedP UserSharedR GET
|
||||||
!/#UserNameP/#FilterP UserFilterR GET
|
!/#UserNameP/#FilterP UserFilterR GET
|
||||||
!/#UserNameP/#TagsP UserTagsR GET
|
!/#UserNameP/#TagsP UserTagsR GET
|
||||||
|
!/#UserNameP/feed.xml UserFeedR GET
|
||||||
|
|
||||||
-- settings
|
-- settings
|
||||||
/Settings AccountSettingsR GET
|
/Settings AccountSettingsR GET
|
||||||
|
|
10
espial.cabal
10
espial.cabal
|
@ -4,7 +4,7 @@ cabal-version: 1.12
|
||||||
--
|
--
|
||||||
-- see: https://github.com/sol/hpack
|
-- see: https://github.com/sol/hpack
|
||||||
--
|
--
|
||||||
-- hash: ac9856c342ac9d7c05b18be91fb062e098dbf3575b2fbe7293f69df2d5b76cce
|
-- hash: da944088abb7ae887d67efd710c100bdbd5587072c6ddcfdc5d05392e7509d85
|
||||||
|
|
||||||
name: espial
|
name: espial
|
||||||
version: 0.0.8
|
version: 0.0.8
|
||||||
|
@ -128,6 +128,7 @@ library
|
||||||
, attoparsec
|
, attoparsec
|
||||||
, base >=4.8.2.0 && <4.9 || >=4.9.1.0 && <5
|
, base >=4.8.2.0 && <4.9 || >=4.9.1.0 && <5
|
||||||
, bcrypt >=0.0.8
|
, bcrypt >=0.0.8
|
||||||
|
, blaze-html >=0.9 && <1.0
|
||||||
, bytestring >=0.9 && <0.11
|
, bytestring >=0.9 && <0.11
|
||||||
, case-insensitive
|
, case-insensitive
|
||||||
, classy-prelude >=1.4 && <1.6
|
, classy-prelude >=1.4 && <1.6
|
||||||
|
@ -179,6 +180,7 @@ library
|
||||||
, yesod-auth >=1.6 && <1.7
|
, yesod-auth >=1.6 && <1.7
|
||||||
, yesod-core >=1.6 && <1.7
|
, yesod-core >=1.6 && <1.7
|
||||||
, yesod-form >=1.6 && <1.7
|
, yesod-form >=1.6 && <1.7
|
||||||
|
, yesod-newsfeed >=1.6 && <1.7
|
||||||
, yesod-static >=1.6 && <1.7
|
, yesod-static >=1.6 && <1.7
|
||||||
if (flag(dev)) || (flag(library-only))
|
if (flag(dev)) || (flag(library-only))
|
||||||
ghc-options: -Wall -fwarn-tabs -O0
|
ghc-options: -Wall -fwarn-tabs -O0
|
||||||
|
@ -201,6 +203,7 @@ executable espial
|
||||||
, attoparsec
|
, attoparsec
|
||||||
, base >=4.8.2.0 && <4.9 || >=4.9.1.0 && <5
|
, base >=4.8.2.0 && <4.9 || >=4.9.1.0 && <5
|
||||||
, bcrypt >=0.0.8
|
, bcrypt >=0.0.8
|
||||||
|
, blaze-html >=0.9 && <1.0
|
||||||
, bytestring >=0.9 && <0.11
|
, bytestring >=0.9 && <0.11
|
||||||
, case-insensitive
|
, case-insensitive
|
||||||
, classy-prelude >=1.4 && <1.6
|
, classy-prelude >=1.4 && <1.6
|
||||||
|
@ -253,6 +256,7 @@ executable espial
|
||||||
, yesod-auth >=1.6 && <1.7
|
, yesod-auth >=1.6 && <1.7
|
||||||
, yesod-core >=1.6 && <1.7
|
, yesod-core >=1.6 && <1.7
|
||||||
, yesod-form >=1.6 && <1.7
|
, yesod-form >=1.6 && <1.7
|
||||||
|
, yesod-newsfeed >=1.6 && <1.7
|
||||||
, yesod-static >=1.6 && <1.7
|
, yesod-static >=1.6 && <1.7
|
||||||
if flag(library-only)
|
if flag(library-only)
|
||||||
buildable: False
|
buildable: False
|
||||||
|
@ -271,6 +275,7 @@ executable migration
|
||||||
, attoparsec
|
, attoparsec
|
||||||
, base >=4.8.2.0 && <4.9 || >=4.9.1.0 && <5
|
, base >=4.8.2.0 && <4.9 || >=4.9.1.0 && <5
|
||||||
, bcrypt >=0.0.8
|
, bcrypt >=0.0.8
|
||||||
|
, blaze-html >=0.9 && <1.0
|
||||||
, bytestring >=0.9 && <0.11
|
, bytestring >=0.9 && <0.11
|
||||||
, case-insensitive
|
, case-insensitive
|
||||||
, classy-prelude >=1.4 && <1.6
|
, classy-prelude >=1.4 && <1.6
|
||||||
|
@ -324,6 +329,7 @@ executable migration
|
||||||
, yesod-auth >=1.6 && <1.7
|
, yesod-auth >=1.6 && <1.7
|
||||||
, yesod-core >=1.6 && <1.7
|
, yesod-core >=1.6 && <1.7
|
||||||
, yesod-form >=1.6 && <1.7
|
, yesod-form >=1.6 && <1.7
|
||||||
|
, yesod-newsfeed >=1.6 && <1.7
|
||||||
, yesod-static >=1.6 && <1.7
|
, yesod-static >=1.6 && <1.7
|
||||||
if flag(library-only)
|
if flag(library-only)
|
||||||
buildable: False
|
buildable: False
|
||||||
|
@ -346,6 +352,7 @@ test-suite test
|
||||||
, attoparsec
|
, attoparsec
|
||||||
, base >=4.8.2.0 && <4.9 || >=4.9.1.0 && <5
|
, base >=4.8.2.0 && <4.9 || >=4.9.1.0 && <5
|
||||||
, bcrypt >=0.0.8
|
, bcrypt >=0.0.8
|
||||||
|
, blaze-html >=0.9 && <1.0
|
||||||
, bytestring >=0.9 && <0.11
|
, bytestring >=0.9 && <0.11
|
||||||
, case-insensitive
|
, case-insensitive
|
||||||
, classy-prelude >=1.4 && <1.6
|
, classy-prelude >=1.4 && <1.6
|
||||||
|
@ -399,6 +406,7 @@ test-suite test
|
||||||
, yesod-auth >=1.6 && <1.7
|
, yesod-auth >=1.6 && <1.7
|
||||||
, yesod-core >=1.6 && <1.7
|
, yesod-core >=1.6 && <1.7
|
||||||
, yesod-form >=1.6 && <1.7
|
, yesod-form >=1.6 && <1.7
|
||||||
|
, yesod-newsfeed >=1.6 && <1.7
|
||||||
, yesod-static >=1.6 && <1.7
|
, yesod-static >=1.6 && <1.7
|
||||||
, yesod-test
|
, yesod-test
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
|
@ -86,6 +86,7 @@ dependencies:
|
||||||
- yesod-auth >=1.6 && <1.7
|
- yesod-auth >=1.6 && <1.7
|
||||||
- yesod-static >=1.6 && <1.7
|
- yesod-static >=1.6 && <1.7
|
||||||
- yesod-form >=1.6 && <1.7
|
- yesod-form >=1.6 && <1.7
|
||||||
|
- yesod-newsfeed >= 1.6 && < 1.7
|
||||||
- classy-prelude >=1.4 && <1.6
|
- classy-prelude >=1.4 && <1.6
|
||||||
- classy-prelude-conduit >=1.4 && <1.6
|
- classy-prelude-conduit >=1.4 && <1.6
|
||||||
- classy-prelude-yesod >=1.4 && <1.6
|
- classy-prelude-yesod >=1.4 && <1.6
|
||||||
|
@ -93,6 +94,7 @@ dependencies:
|
||||||
- text >=0.11 && <2.0
|
- text >=0.11 && <2.0
|
||||||
- persistent >=2.8 && <2.10
|
- persistent >=2.8 && <2.10
|
||||||
# - persistent-postgresql >=2.8 && <2.9
|
# - persistent-postgresql >=2.8 && <2.9
|
||||||
|
- blaze-html >= 0.9 && < 1.0
|
||||||
- persistent-template >=2.5 && <2.9
|
- persistent-template >=2.5 && <2.9
|
||||||
- template-haskell
|
- template-haskell
|
||||||
- shakespeare >=2.0 && <2.1
|
- shakespeare >=2.0 && <2.1
|
||||||
|
|
|
@ -48,19 +48,23 @@ nlist st' =
|
||||||
render st@{ notes } =
|
render st@{ notes } =
|
||||||
HH.div_ (map renderNote notes)
|
HH.div_ (map renderNote notes)
|
||||||
where
|
where
|
||||||
renderNote bm =
|
renderNote note =
|
||||||
div [ id_ (show bm.id) , class_ ("note w-100 mw7 pa1 mb2")] $
|
div [ id_ (show note.id)
|
||||||
|
, class_ ("note w-100 mw7 pa1 mb2"
|
||||||
|
<> if note.shared then "" else " private")] $
|
||||||
[ div [ class_ "display" ] $
|
[ div [ class_ "display" ] $
|
||||||
[ a [ href (linkToFilterSingle bm.slug), class_ ("link f5 lh-title")]
|
[ a [ href (linkToFilterSingle note.slug), class_ ("link f5 lh-title")]
|
||||||
[ text $ if S.null bm.title then "[no title]" else bm.title ]
|
[ text $ if S.null note.title then "[no title]" else note.title ]
|
||||||
, br_
|
, br_
|
||||||
, div [ class_ "description mt1 mid-gray" ] (toTextarea (S.take 200 bm.text))
|
, div [ class_ "description mt1 mid-gray" ] (toTextarea (S.take 200 note.text))
|
||||||
, a [ class_ "link f7 dib gray w4", title (maybe bm.created snd (mmoment bm)) , href (linkToFilterSingle bm.slug) ]
|
, a [ class_ "link f7 dib gray w4"
|
||||||
[ text (maybe " " fst (mmoment bm)) ]
|
, 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
|
linkToFilterSingle slug = fromNullableStr app.userR <> "/notes/" <> slug
|
||||||
toTextarea input =
|
toTextarea input =
|
||||||
S.split (Pattern "\n") input
|
S.split (Pattern "\n") input
|
||||||
|
|
|
@ -56,6 +56,7 @@ data EditField
|
||||||
= Etitle String
|
= Etitle String
|
||||||
| Etext String
|
| Etext String
|
||||||
| EisMarkdown Boolean
|
| EisMarkdown Boolean
|
||||||
|
| Eshared Boolean
|
||||||
|
|
||||||
_markdown = SProxy :: SProxy "markdown"
|
_markdown = SProxy :: SProxy "markdown"
|
||||||
|
|
||||||
|
@ -99,8 +100,13 @@ nnote st' =
|
||||||
, if note.isMarkdown
|
, if note.isMarkdown
|
||||||
then div [ class_ "description mt1" ] [ HH.slot _markdown unit Markdown.component note.text absurd ]
|
then div [ class_ "description mt1" ] [ HH.slot _markdown unit Markdown.component note.text absurd ]
|
||||||
else div [ class_ "description mt1 mid-gray" ] (toTextarea note.text)
|
else div [ class_ "description mt1 mid-gray" ] (toTextarea note.text)
|
||||||
, div [ class_ "link f7 dib gray w4", title (maybe note.created snd (mmoment note)) ]
|
, div [ class_ "link f7 dib gray w4"]
|
||||||
[ text (maybe " " fst (mmoment note)) ]
|
[ 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
|
<> -- | Render Action Links
|
||||||
|
@ -134,9 +140,20 @@ nnote st' =
|
||||||
, label [ for "edit_ismarkdown" , class_ "mr2" ] [ text "use markdown?" ]
|
, label [ for "edit_ismarkdown" , class_ "mr2" ] [ text "use markdown?" ]
|
||||||
, br_
|
, 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 " "
|
, text " "
|
||||||
, input [ type_ InputReset , class_ "pv1 ph2 dark-gray ba b--moon-gray bg-near-white pointer rdim" , value "cancel"
|
, 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"
|
||||||
, onClick \_ -> Just (NEdit false)
|
, onClick \_ -> Just (NEdit false)
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
|
@ -161,6 +178,7 @@ nnote st' =
|
||||||
Etitle e -> _ { title = e }
|
Etitle e -> _ { title = e }
|
||||||
Etext e -> _ { text = e }
|
Etext e -> _ { text = e }
|
||||||
EisMarkdown e -> _ { isMarkdown = e }
|
EisMarkdown e -> _ { isMarkdown = e }
|
||||||
|
Eshared e -> _ { shared = e }
|
||||||
|
|
||||||
-- | Delete
|
-- | Delete
|
||||||
handleAction (NDeleteAsk e) = do
|
handleAction (NDeleteAsk e) = do
|
||||||
|
|
|
@ -34,6 +34,7 @@ type Note =
|
||||||
, text :: String
|
, text :: String
|
||||||
, length :: Int
|
, length :: Int
|
||||||
, isMarkdown :: Boolean
|
, isMarkdown :: Boolean
|
||||||
|
, shared :: Boolean
|
||||||
, created :: String
|
, created :: String
|
||||||
, updated :: String
|
, updated :: String
|
||||||
}
|
}
|
||||||
|
|
|
@ -15,26 +15,20 @@ module Application
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.Logger (liftLoc, runLoggingT)
|
import Control.Monad.Logger (liftLoc, runLoggingT)
|
||||||
import Database.Persist.Sqlite
|
import Database.Persist.Sqlite (createSqlitePool, runSqlPool, sqlDatabase, sqlPoolSize)
|
||||||
(createSqlitePool, sqlDatabase, sqlPoolSize)
|
|
||||||
import Import
|
import Import
|
||||||
import Yesod.Auth (getAuth)
|
|
||||||
import Language.Haskell.TH.Syntax (qLocation)
|
import Language.Haskell.TH.Syntax (qLocation)
|
||||||
import Lens.Micro
|
import Lens.Micro
|
||||||
import Network.HTTP.Client.TLS
|
import Network.HTTP.Client.TLS
|
||||||
import Network.Wai (Middleware)
|
import Network.Wai (Middleware)
|
||||||
import Network.Wai.Middleware.Autohead
|
import Network.Wai.Handler.Warp (Settings, defaultSettings, defaultShouldDisplayException, runSettings, setHost, setOnException, setPort, getPort)
|
||||||
import Network.Wai.Middleware.AcceptOverride
|
import Network.Wai.Middleware.AcceptOverride
|
||||||
|
import Network.Wai.Middleware.Autohead
|
||||||
import Network.Wai.Middleware.Gzip
|
import Network.Wai.Middleware.Gzip
|
||||||
import Network.Wai.Middleware.MethodOverride
|
import Network.Wai.Middleware.MethodOverride
|
||||||
import Network.Wai.Handler.Warp
|
import Network.Wai.Middleware.RequestLogger (Destination(Logger), IPAddrSource(..), OutputFormat(..), destination, mkRequestLogger, outputFormat)
|
||||||
(Settings, defaultSettings, defaultShouldDisplayException,
|
import System.Log.FastLogger (defaultBufSize, newStdoutLoggerSet, toLogStr)
|
||||||
runSettings, setHost, setOnException, setPort, getPort)
|
import Yesod.Auth (getAuth)
|
||||||
import Network.Wai.Middleware.RequestLogger
|
|
||||||
(Destination(Logger), IPAddrSource(..), OutputFormat(..),
|
|
||||||
destination, mkRequestLogger, outputFormat)
|
|
||||||
import System.Log.FastLogger
|
|
||||||
(defaultBufSize, newStdoutLoggerSet, toLogStr)
|
|
||||||
|
|
||||||
import qualified Control.Monad.Metrics as MM
|
import qualified Control.Monad.Metrics as MM
|
||||||
import qualified Network.Wai.Metrics as WM
|
import qualified Network.Wai.Metrics as WM
|
||||||
|
@ -74,9 +68,9 @@ makeFoundation appSettings = do
|
||||||
createSqlitePool
|
createSqlitePool
|
||||||
(sqlDatabase (appDatabaseConf appSettings))
|
(sqlDatabase (appDatabaseConf appSettings))
|
||||||
(sqlPoolSize (appDatabaseConf appSettings))
|
(sqlPoolSize (appDatabaseConf appSettings))
|
||||||
-- runLoggingT
|
runLoggingT
|
||||||
-- (runSqlPool runMigrations pool)
|
(runSqlPool runMigrations pool)
|
||||||
-- logFunc
|
logFunc
|
||||||
return (mkFoundation pool)
|
return (mkFoundation pool)
|
||||||
|
|
||||||
makeApplication :: App -> IO Application
|
makeApplication :: App -> IO Application
|
||||||
|
|
|
@ -5,23 +5,27 @@ import Import
|
||||||
import Handler.Common (lookupPagingParams)
|
import Handler.Common (lookupPagingParams)
|
||||||
import qualified Data.Aeson as A
|
import qualified Data.Aeson as A
|
||||||
import qualified Data.Text as T
|
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 :: UserNameP -> Handler Html
|
||||||
getNotesR unamep@(UserNameP uname) = do
|
getNotesR unamep@(UserNameP uname) = do
|
||||||
void requireAuthId
|
muserid <- maybeAuthId
|
||||||
(limit', page') <- lookupPagingParams
|
(limit', page') <- lookupPagingParams
|
||||||
let queryp = "query" :: Text
|
let queryp = "query" :: Text
|
||||||
mquery <- lookupGetParam queryp
|
mquery <- lookupGetParam queryp
|
||||||
let limit = maybe 20 fromIntegral limit'
|
let limit = maybe 20 fromIntegral limit'
|
||||||
page = maybe 1 fromIntegral page'
|
page = maybe 1 fromIntegral page'
|
||||||
mqueryp = fmap (\q -> (queryp, q)) mquery
|
mqueryp = fmap (\q -> (queryp, q)) mquery
|
||||||
(bcount, notes) <-
|
(bcount, notes) <- runDB $ do
|
||||||
runDB $
|
Entity userId _ <- getBy404 (UniqueUserName uname)
|
||||||
do Entity userId _ <- getBy404 (UniqueUserName uname)
|
let sharedp = if muserid == Just userId then SharedAll else SharedPublic
|
||||||
getNoteList userId mquery limit page
|
getNoteList userId mquery sharedp limit page
|
||||||
req <- getRequest
|
req <- getRequest
|
||||||
mroute <- getCurrentRoute
|
mroute <- getCurrentRoute
|
||||||
defaultLayout $ do
|
defaultLayout $ do
|
||||||
|
rssLink (NotesFeedR unamep) "feed"
|
||||||
let pager = $(widgetFile "pager")
|
let pager = $(widgetFile "pager")
|
||||||
search = $(widgetFile "search")
|
search = $(widgetFile "search")
|
||||||
renderEl = "notes" :: Text
|
renderEl = "notes" :: Text
|
||||||
|
@ -36,7 +40,6 @@ getNotesR unamep@(UserNameP uname) = do
|
||||||
|
|
||||||
getNoteR :: UserNameP -> NtSlug -> Handler Html
|
getNoteR :: UserNameP -> NtSlug -> Handler Html
|
||||||
getNoteR unamep@(UserNameP uname) slug = do
|
getNoteR unamep@(UserNameP uname) slug = do
|
||||||
void requireAuthId
|
|
||||||
let renderEl = "note" :: Text
|
let renderEl = "note" :: Text
|
||||||
note <-
|
note <-
|
||||||
runDB $
|
runDB $
|
||||||
|
@ -57,7 +60,7 @@ getAddNoteViewR :: UserNameP -> Handler Html
|
||||||
getAddNoteViewR unamep@(UserNameP uname) = do
|
getAddNoteViewR unamep@(UserNameP uname) = do
|
||||||
userId <- requireAuthId
|
userId <- requireAuthId
|
||||||
let renderEl = "note" :: Text
|
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
|
defaultLayout $ do
|
||||||
$(widgetFile "note")
|
$(widgetFile "note")
|
||||||
toWidgetBody [julius|
|
toWidgetBody [julius|
|
||||||
|
@ -106,6 +109,7 @@ data NoteForm = NoteForm
|
||||||
, _title :: Maybe Text
|
, _title :: Maybe Text
|
||||||
, _text :: Maybe Textarea
|
, _text :: Maybe Textarea
|
||||||
, _isMarkdown :: Maybe Bool
|
, _isMarkdown :: Maybe Bool
|
||||||
|
, _shared :: Maybe Bool
|
||||||
, _created :: Maybe UTCTimeStr
|
, _created :: Maybe UTCTimeStr
|
||||||
, _updated :: Maybe UTCTimeStr
|
, _updated :: Maybe UTCTimeStr
|
||||||
} deriving (Show, Eq, Read, Generic)
|
} deriving (Show, Eq, Read, Generic)
|
||||||
|
@ -128,5 +132,40 @@ _toNote userId NoteForm {..} = do
|
||||||
(fromMaybe "" _title)
|
(fromMaybe "" _title)
|
||||||
(maybe "" unTextarea _text)
|
(maybe "" unTextarea _text)
|
||||||
(fromMaybe False _isMarkdown)
|
(fromMaybe False _isMarkdown)
|
||||||
|
(fromMaybe False _shared)
|
||||||
(fromMaybe time (fmap unUTCTimeStr _created))
|
(fromMaybe time (fmap unUTCTimeStr _created))
|
||||||
(fromMaybe time (fmap unUTCTimeStr _updated))
|
(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
|
||||||
|
|
|
@ -1,9 +1,12 @@
|
||||||
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
|
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
|
||||||
module Handler.User where
|
module Handler.User where
|
||||||
|
|
||||||
import Import
|
|
||||||
import qualified Data.Text as T
|
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 :: UserNameP -> Handler Html
|
||||||
getUserR uname@(UserNameP name) = do
|
getUserR uname@(UserNameP name) = do
|
||||||
|
@ -51,6 +54,7 @@ _getUser unamep@(UserNameP uname) sharedp' filterp' (TagsP pathtags) = do
|
||||||
let pager = $(widgetFile "pager")
|
let pager = $(widgetFile "pager")
|
||||||
search = $(widgetFile "search")
|
search = $(widgetFile "search")
|
||||||
renderEl = "bookmarks" :: Text
|
renderEl = "bookmarks" :: Text
|
||||||
|
rssLink (UserFeedR unamep) "feed"
|
||||||
$(widgetFile "user")
|
$(widgetFile "user")
|
||||||
toWidgetBody [julius|
|
toWidgetBody [julius|
|
||||||
app.dat.bmarks = #{ toJSON $ toBookmarkFormList bmarks alltags } || [];
|
app.dat.bmarks = #{ toJSON $ toBookmarkFormList bmarks alltags } || [];
|
||||||
|
@ -60,3 +64,42 @@ _getUser unamep@(UserNameP uname) sharedp' filterp' (TagsP pathtags) = do
|
||||||
toWidget [julius|
|
toWidget [julius|
|
||||||
PS['Main'].renderBookmarks('##{rawJS renderEl}')(app.dat.bmarks)();
|
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
|
||||||
|
|
10
src/Model.hs
10
src/Model.hs
|
@ -72,6 +72,7 @@ Note json
|
||||||
title Text
|
title Text
|
||||||
text Text
|
text Text
|
||||||
isMarkdown Bool
|
isMarkdown Bool
|
||||||
|
shared Bool default=False
|
||||||
created UTCTime
|
created UTCTime
|
||||||
updated UTCTime
|
updated UTCTime
|
||||||
deriving Show Eq Typeable Ord
|
deriving Show Eq Typeable Ord
|
||||||
|
@ -272,8 +273,8 @@ getNote :: Key User -> NtSlug -> DB (Maybe (Entity Note))
|
||||||
getNote userKey slug =
|
getNote userKey slug =
|
||||||
selectFirst [NoteUserId ==. userKey, NoteSlug ==. slug] []
|
selectFirst [NoteUserId ==. userKey, NoteSlug ==. slug] []
|
||||||
|
|
||||||
getNoteList :: Key User -> Maybe Text -> Limit -> Page -> DB (Int, [Entity Note])
|
getNoteList :: Key User -> Maybe Text -> SharedP -> Limit -> Page -> DB (Int, [Entity Note])
|
||||||
getNoteList key mquery limit' page =
|
getNoteList key mquery sharedp limit' page =
|
||||||
(,) -- total count
|
(,) -- total count
|
||||||
<$> fmap (sum . fmap E.unValue)
|
<$> fmap (sum . fmap E.unValue)
|
||||||
(select $
|
(select $
|
||||||
|
@ -292,6 +293,10 @@ getNoteList key mquery limit' page =
|
||||||
where_ $ (b ^. NoteUserId E.==. val key)
|
where_ $ (b ^. NoteUserId E.==. val key)
|
||||||
-- search
|
-- search
|
||||||
sequenceA_ (parseSearchQuery (toLikeExpr b) =<< mquery)
|
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 :: E.SqlExpr (Entity Note) -> Text -> E.SqlExpr (E.Value Bool)
|
||||||
toLikeExpr b term = fromRight p_allFields (P.parseOnly p_onefield term)
|
toLikeExpr b term = fromRight p_allFields (P.parseOnly p_onefield term)
|
||||||
|
@ -415,6 +420,7 @@ fileNoteToNote user (FileNote {..} ) = do
|
||||||
fileNoteTitle
|
fileNoteTitle
|
||||||
fileNoteText
|
fileNoteText
|
||||||
False
|
False
|
||||||
|
False
|
||||||
fileNoteCreatedAt
|
fileNoteCreatedAt
|
||||||
fileNoteUpdatedAt
|
fileNoteUpdatedAt
|
||||||
|
|
||||||
|
|
4
static/js/app.min.js
vendored
4
static/js/app.min.js
vendored
File diff suppressed because one or more lines are too long
Binary file not shown.
File diff suppressed because one or more lines are too long
Binary file not shown.
|
@ -2,6 +2,10 @@
|
||||||
<div .w-100.mw8.center>
|
<div .w-100.mw8.center>
|
||||||
<div .fr.nt1 style="margin-bottom:.7rem">
|
<div .fr.nt1 style="margin-bottom:.7rem">
|
||||||
^{search}
|
^{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:
|
<span .db .mb3>#{T.append "" (maybe "You have" (const "Found") mquery)} #{bcount} notes:
|
||||||
|
|
||||||
|
|
|
@ -31,6 +31,9 @@ $maybe route <- mroute
|
||||||
‧
|
‧
|
||||||
<a .link.silver.hover-blue :filterp == FilterStarred:.nav-active
|
<a .link.silver.hover-blue :filterp == FilterStarred:.nav-active
|
||||||
href="@{UserFilterR unamep FilterStarred}">starred
|
href="@{UserFilterR unamep FilterStarred}">starred
|
||||||
|
<div .fr.f6.pr3.dib.mb2>
|
||||||
|
<a .link.gold.hover-orange
|
||||||
|
href="@{UserFeedR unamep}">RSS
|
||||||
|
|
||||||
<div .cf>
|
<div .cf>
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue