{-# OPTIONS_GHC -fno-warn-unused-matches #-}
{-# LANGUAGE TupleSections #-}
module Handler.Notes where

import Import
import Handler.Common (lookupPagingParams)
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 :: UserNameP -> Handler Markup
getNotesR unamep :: UserNameP
unamep@(UserNameP Text
uname) = do
  Maybe Text
mauthuname <- Handler (Maybe Text)
maybeAuthUsername
  (Maybe Page
limit', Maybe Page
page') <- Handler (Maybe Page, Maybe Page)
lookupPagingParams
  let queryp :: Text
queryp = Text
"query"
  Maybe Text
mquery <- forall (m :: * -> *). MonadHandler m => Text -> m (Maybe Text)
lookupGetParam Text
queryp
  let limit :: Page
limit = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Page
20 forall a b. (Integral a, Num b) => a -> b
fromIntegral Maybe Page
limit'
      page :: Page
page  = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Page
1  forall a b. (Integral a, Num b) => a -> b
fromIntegral Maybe Page
page'
      mqueryp :: Maybe (Text, Text)
mqueryp = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text
queryp,) Maybe Text
mquery
      isowner :: Bool
isowner = forall a. a -> Maybe a
Just Text
uname forall a. Eq a => a -> a -> Bool
== Maybe Text
mauthuname
  (Int
bcount, [Entity Note]
notes) <- forall site a.
YesodPersist site =>
YesodDB site a -> HandlerFor site a
runDB do
    Entity Key User
userId User
user <- forall backend val (m :: * -> *).
(PersistUniqueRead backend, PersistRecordBackend val backend,
 MonadIO m) =>
Unique val -> ReaderT backend m (Entity val)
getBy404 (Text -> Unique User
UniqueUserName Text
uname)
    let sharedp :: SharedP
sharedp = if Bool
isowner then SharedP
SharedAll else SharedP
SharedPublic
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
isowner Bool -> Bool -> Bool
&& User -> Bool
userPrivacyLock User
user)
      (forall (m :: * -> *) url a.
(MonadHandler m, RedirectUrl (HandlerSite m) url) =>
url -> m a
redirect (Route Auth -> Route App
AuthR Route Auth
LoginR))
    Key User
-> Maybe Text -> SharedP -> Page -> Page -> DB (Int, [Entity Note])
getNoteList Key User
userId Maybe Text
mquery SharedP
sharedp Page
limit Page
page
  YesodRequest
req <- forall (m :: * -> *). MonadHandler m => m YesodRequest
getRequest
  Maybe (Route App)
mroute <- forall (m :: * -> *).
MonadHandler m =>
m (Maybe (Route (HandlerSite m)))
getCurrentRoute
  forall site.
Yesod site =>
WidgetFor site () -> HandlerFor site Markup
defaultLayout do
    forall (m :: * -> *).
MonadWidget m =>
Route (HandlerSite m) -> Text -> m ()
rssLink (UserNameP -> Route App
NotesFeedR UserNameP
unamep) Text
"feed"
    let pager :: WidgetFor App ()
pager = $(widgetFile "pager")
        search :: WidgetFor App ()
search = $(widgetFile "search")
        renderEl :: Text
renderEl = Text
"notes" :: Text
    $(widgetFile "notes")
    forall site a (m :: * -> *).
(ToWidgetBody site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
toWidgetBody [julius|
        app.userR = "@{UserR unamep}";
        app.dat.notes = #{ toJSON notes } || [];
        app.dat.isowner = #{ isowner };
    |]
    forall site a (m :: * -> *).
(ToWidget site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
toWidget [julius|
      PS.renderNotes('##{rawJS renderEl}')(app.dat.notes)();
    |]

getNoteR :: UserNameP -> NtSlug -> Handler Html
getNoteR :: UserNameP -> NtSlug -> Handler Markup
getNoteR unamep :: UserNameP
unamep@(UserNameP Text
uname) NtSlug
slug = do
  Maybe Text
mauthuname <- Handler (Maybe Text)
maybeAuthUsername
  let renderEl :: Text
renderEl = Text
"note" :: Text
      isowner :: Bool
isowner = forall a. a -> Maybe a
Just Text
uname forall a. Eq a => a -> a -> Bool
== Maybe Text
mauthuname
  Entity Note
note <-
    forall site a.
YesodPersist site =>
YesodDB site a -> HandlerFor site a
runDB forall a b. (a -> b) -> a -> b
$
    do Entity Key User
userId User
user <- forall backend val (m :: * -> *).
(PersistUniqueRead backend, PersistRecordBackend val backend,
 MonadIO m) =>
Unique val -> ReaderT backend m (Entity val)
getBy404 (Text -> Unique User
UniqueUserName Text
uname)
       Maybe (Entity Note)
mnote <- Key User -> NtSlug -> DB (Maybe (Entity Note))
getNote Key User
userId NtSlug
slug
       Entity Note
note <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (m :: * -> *) a. MonadHandler m => m a
notFound forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Entity Note)
mnote
       forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
isowner Bool -> Bool -> Bool
&& (User -> Bool
userPrivacyLock User
user Bool -> Bool -> Bool
|| (Bool -> Bool
not forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Note -> Bool
noteShared forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall record. Entity record -> record
entityVal) Entity Note
note))
         (forall (m :: * -> *) url a.
(MonadHandler m, RedirectUrl (HandlerSite m) url) =>
url -> m a
redirect (Route Auth -> Route App
AuthR Route Auth
LoginR))
       forall (f :: * -> *) a. Applicative f => a -> f a
pure Entity Note
note
  forall site.
Yesod site =>
WidgetFor site () -> HandlerFor site Markup
defaultLayout do
    $(widgetFile "note")
    forall site a (m :: * -> *).
(ToWidgetBody site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
toWidgetBody [julius|
        app.userR = "@{UserR unamep}";
        app.dat.note = #{ toJSON note } || [];
        app.dat.isowner = #{ isowner };
    |]
    forall site a (m :: * -> *).
(ToWidget site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
toWidget [julius|
      PS.renderNote('##{rawJS renderEl}')(app.dat.note)();
    |]

getAddNoteSlimViewR :: Handler Html
getAddNoteSlimViewR :: Handler Markup
getAddNoteSlimViewR = do
  Entity Key User
userId User
user <- forall master val (m :: * -> *).
(YesodAuthPersist master, val ~ AuthEntity master,
 Key val ~ AuthId master, PersistEntity val, Typeable val,
 MonadHandler m, HandlerSite m ~ master) =>
m (Entity val)
requireAuth
  UserNameP -> Handler Markup
getAddNoteViewR (Text -> UserNameP
UserNameP (User -> Text
userName User
user))

getAddNoteViewR :: UserNameP -> Handler Html
getAddNoteViewR :: UserNameP -> Handler Markup
getAddNoteViewR unamep :: UserNameP
unamep@(UserNameP Text
uname) = do
  Key User
userId <- forall (m :: * -> *).
(MonadHandler m, YesodAuth (HandlerSite m)) =>
m (AuthId (HandlerSite m))
requireAuthId
  Note
note <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Key User -> NoteForm -> IO Note
_toNote Key User
userId forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Handler NoteForm
noteFormUrl
  let renderEl :: Text
renderEl = Text
"note" :: Text
      enote :: Entity Note
enote = forall record. Key record -> record -> Entity record
Entity (Page -> Key Note
NoteKey Page
0) Note
note
  forall site.
Yesod site =>
WidgetFor site () -> HandlerFor site Markup
defaultLayout do
    $(widgetFile "note")
    forall site a (m :: * -> *).
(ToWidgetBody site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
toWidgetBody [julius|
        app.userR = "@{UserR unamep}";
        app.noteR = "@{NoteR unamep (noteSlug (entityVal enote))}";
        app.dat.note = #{ toJSON enote } || [];
    |]
    forall site a (m :: * -> *).
(ToWidget site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
toWidget [julius|
      PS.renderNote('##{rawJS renderEl}')(app.dat.note)();
    |]

deleteDeleteNoteR :: Int64 -> Handler Html
deleteDeleteNoteR :: Page -> Handler Markup
deleteDeleteNoteR Page
nid = do
  Key User
userId <- forall (m :: * -> *).
(MonadHandler m, YesodAuth (HandlerSite m)) =>
m (AuthId (HandlerSite m))
requireAuthId
  forall site a.
YesodPersist site =>
YesodDB site a -> HandlerFor site a
runDB do
    let k_nid :: Key Note
k_nid = Page -> Key Note
NoteKey Page
nid
    Note
_ <- Key User -> Key Note -> DBM (HandlerFor App) Note
requireResource Key User
userId Key Note
k_nid
    forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m ()
delete Key Note
k_nid
  forall (m :: * -> *) a. Monad m => a -> m a
return Markup
""

postAddNoteR :: Handler Text
postAddNoteR :: Handler Text
postAddNoteR = do
  NoteForm
noteForm <- forall (m :: * -> *) a. (MonadHandler m, FromJSON a) => m a
requireCheckJsonBody
  NoteForm -> Handler (UpsertResult (Key Note))
_handleFormSuccess NoteForm
noteForm forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Created Key Note
nid -> forall (m :: * -> *) c a.
(MonadHandler m, ToJSON c) =>
Status -> c -> m a
sendStatusJSON Status
created201 Key Note
nid
    Updated Key Note
_ -> forall (m :: * -> *) c a.
(MonadHandler m, ToTypedContent c) =>
Status -> c -> m a
sendResponseStatus Status
noContent204 ()
    Failed String
s -> forall (m :: * -> *) c a.
(MonadHandler m, ToTypedContent c) =>
Status -> c -> m a
sendResponseStatus Status
status400 String
s

requireResource :: UserId -> Key Note -> DBM Handler Note
requireResource :: Key User -> Key Note -> DBM (HandlerFor App) Note
requireResource Key User
userId Key Note
k_nid = do
  Note
nnote <- forall (m :: * -> *) backend val.
(MonadIO m, PersistStoreRead backend,
 PersistRecordBackend val backend) =>
Key val -> ReaderT backend m val
get404 Key Note
k_nid
  if Key User
userId forall a. Eq a => a -> a -> Bool
== Note -> Key User
noteUserId Note
nnote
    then forall (m :: * -> *) a. Monad m => a -> m a
return Note
nnote
    else forall (m :: * -> *) a. MonadHandler m => m a
notFound

_handleFormSuccess :: NoteForm -> Handler (UpsertResult (Key Note))
_handleFormSuccess :: NoteForm -> Handler (UpsertResult (Key Note))
_handleFormSuccess NoteForm
noteForm = do
  Key User
userId <- forall (m :: * -> *).
(MonadHandler m, YesodAuth (HandlerSite m)) =>
m (AuthId (HandlerSite m))
requireAuthId
  Note
note <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Key User -> NoteForm -> IO Note
_toNote Key User
userId NoteForm
noteForm
  forall site a.
YesodPersist site =>
YesodDB site a -> HandlerFor site a
runDB (Key User
-> Maybe (Key Note) -> Note -> DB (UpsertResult (Key Note))
upsertNote Key User
userId Maybe (Key Note)
knid Note
note)
  where
    knid :: Maybe (Key Note)
knid = Page -> Key Note
NoteKey forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NoteForm -> Maybe Page
_id NoteForm
noteForm forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Page
i -> if Page
i forall a. Ord a => a -> a -> Bool
> Page
0 then forall a. a -> Maybe a
Just Page
i else forall a. Maybe a
Nothing)

data NoteForm = NoteForm
  { NoteForm -> Maybe Page
_id :: Maybe Int64
  , NoteForm -> Maybe NtSlug
_slug :: Maybe NtSlug
  , NoteForm -> Maybe Text
_title :: Maybe Text
  , NoteForm -> Maybe Textarea
_text :: Maybe Textarea
  , NoteForm -> Maybe Bool
_isMarkdown :: Maybe Bool
  , NoteForm -> Maybe Bool
_shared :: Maybe Bool
  , NoteForm -> Maybe UTCTimeStr
_created :: Maybe UTCTimeStr
  , NoteForm -> Maybe UTCTimeStr
_updated :: Maybe UTCTimeStr
  } deriving (Int -> NoteForm -> ShowS
[NoteForm] -> ShowS
NoteForm -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NoteForm] -> ShowS
$cshowList :: [NoteForm] -> ShowS
show :: NoteForm -> String
$cshow :: NoteForm -> String
showsPrec :: Int -> NoteForm -> ShowS
$cshowsPrec :: Int -> NoteForm -> ShowS
Show, NoteForm -> NoteForm -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NoteForm -> NoteForm -> Bool
$c/= :: NoteForm -> NoteForm -> Bool
== :: NoteForm -> NoteForm -> Bool
$c== :: NoteForm -> NoteForm -> Bool
Eq, ReadPrec [NoteForm]
ReadPrec NoteForm
Int -> ReadS NoteForm
ReadS [NoteForm]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NoteForm]
$creadListPrec :: ReadPrec [NoteForm]
readPrec :: ReadPrec NoteForm
$creadPrec :: ReadPrec NoteForm
readList :: ReadS [NoteForm]
$creadList :: ReadS [NoteForm]
readsPrec :: Int -> ReadS NoteForm
$creadsPrec :: Int -> ReadS NoteForm
Read, forall x. Rep NoteForm x -> NoteForm
forall x. NoteForm -> Rep NoteForm x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NoteForm x -> NoteForm
$cfrom :: forall x. NoteForm -> Rep NoteForm x
Generic)

instance FromJSON NoteForm where parseJSON :: Value -> Parser NoteForm
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON Options
gNoteFormOptions
instance ToJSON NoteForm where toJSON :: NoteForm -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
A.genericToJSON Options
gNoteFormOptions

gNoteFormOptions :: A.Options
gNoteFormOptions :: Options
gNoteFormOptions = Options
A.defaultOptions { fieldLabelModifier :: ShowS
A.fieldLabelModifier = forall seq. IsSequence seq => Index seq -> seq -> seq
drop Int
1 }

noteFormUrl :: Handler NoteForm
noteFormUrl :: Handler NoteForm
noteFormUrl = do
  Maybe Text
title <- forall (m :: * -> *). MonadHandler m => Text -> m (Maybe Text)
lookupGetParam Text
"title"
  Maybe Textarea
description <- forall (m :: * -> *). MonadHandler m => Text -> m (Maybe Text)
lookupGetParam Text
"description" forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Textarea
Textarea
  Maybe Bool
isMarkdown <- forall (m :: * -> *). MonadHandler m => Text -> m (Maybe Text)
lookupGetParam Text
"isMarkdown" forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. (Eq a, IsString a) => a -> Bool
parseChk
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ NoteForm
    { _id :: Maybe Page
_id = forall a. Maybe a
Nothing
    , _slug :: Maybe NtSlug
_slug = forall a. Maybe a
Nothing
    , _title :: Maybe Text
_title = Maybe Text
title
    , _text :: Maybe Textarea
_text = Maybe Textarea
description
    , _isMarkdown :: Maybe Bool
_isMarkdown = Maybe Bool
isMarkdown
    , _shared :: Maybe Bool
_shared = forall a. Maybe a
Nothing
    , _created :: Maybe UTCTimeStr
_created = forall a. Maybe a
Nothing
    , _updated :: Maybe UTCTimeStr
_updated = forall a. Maybe a
Nothing
    }
  where
    parseChk :: a -> Bool
parseChk a
s = a
s forall a. Eq a => a -> a -> Bool
== a
"yes" Bool -> Bool -> Bool
|| a
s forall a. Eq a => a -> a -> Bool
== a
"on" Bool -> Bool -> Bool
|| a
s forall a. Eq a => a -> a -> Bool
== a
"true" Bool -> Bool -> Bool
|| a
s forall a. Eq a => a -> a -> Bool
== a
"1"

_toNote :: UserId -> NoteForm -> IO Note
_toNote :: Key User -> NoteForm -> IO Note
_toNote Key User
userId NoteForm {Maybe Bool
Maybe Page
Maybe Text
Maybe Textarea
Maybe NtSlug
Maybe UTCTimeStr
_updated :: Maybe UTCTimeStr
_created :: Maybe UTCTimeStr
_shared :: Maybe Bool
_isMarkdown :: Maybe Bool
_text :: Maybe Textarea
_title :: Maybe Text
_slug :: Maybe NtSlug
_id :: Maybe Page
_updated :: NoteForm -> Maybe UTCTimeStr
_created :: NoteForm -> Maybe UTCTimeStr
_shared :: NoteForm -> Maybe Bool
_isMarkdown :: NoteForm -> Maybe Bool
_text :: NoteForm -> Maybe Textarea
_title :: NoteForm -> Maybe Text
_slug :: NoteForm -> Maybe NtSlug
_id :: NoteForm -> Maybe Page
..} = do
  UTCTime
time <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  NtSlug
slug <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO NtSlug
mkNtSlug forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe NtSlug
_slug
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    Note
    { noteUserId :: Key User
noteUserId = Key User
userId
    , noteSlug :: NtSlug
noteSlug = NtSlug
slug
    , noteLength :: Int
noteLength = forall mono. MonoFoldable mono => mono -> Int
length Maybe Textarea
_text
    , noteTitle :: Text
noteTitle = forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
_title
    , noteText :: Text
noteText = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Textarea -> Text
unTextarea Maybe Textarea
_text
    , noteIsMarkdown :: Bool
noteIsMarkdown = forall a. a -> Maybe a
Just Bool
True forall a. Eq a => a -> a -> Bool
== Maybe Bool
_isMarkdown
    , noteShared :: Bool
noteShared = forall a. a -> Maybe a
Just Bool
True forall a. Eq a => a -> a -> Bool
== Maybe Bool
_shared
    , noteCreated :: UTCTime
noteCreated = forall b a. b -> (a -> b) -> Maybe a -> b
maybe UTCTime
time UTCTimeStr -> UTCTime
unUTCTimeStr Maybe UTCTimeStr
_created
    , noteUpdated :: UTCTime
noteUpdated = forall b a. b -> (a -> b) -> Maybe a -> b
maybe UTCTime
time UTCTimeStr -> UTCTime
unUTCTimeStr Maybe UTCTimeStr
_updated
    }

noteToRssEntry :: (Route App -> Text) -> UserNameP -> Entity Note -> FeedEntry Text
noteToRssEntry :: (Route App -> Text) -> UserNameP -> Entity Note -> FeedEntry Text
noteToRssEntry Route App -> Text
render UserNameP
usernamep (Entity Key Note
entryId Note
entry) =
  FeedEntry
  { feedEntryLink :: Text
feedEntryLink = Route App -> Text
render forall a b. (a -> b) -> a -> b
$ UserNameP -> NtSlug -> Route App
NoteR UserNameP
usernamep (Note -> NtSlug
noteSlug Note
entry)
  , feedEntryUpdated :: UTCTime
feedEntryUpdated = Note -> UTCTime
noteUpdated Note
entry
  , feedEntryTitle :: Text
feedEntryTitle = Note -> Text
noteTitle Note
entry
  , feedEntryContent :: Markup
feedEntryContent = forall a. ToMarkup a => a -> Markup
toHtml (Note -> Text
noteText Note
entry)
  , feedEntryEnclosure :: Maybe (EntryEnclosure Text)
feedEntryEnclosure = forall a. Maybe a
Nothing
  , feedEntryCategories :: [EntryCategory]
feedEntryCategories = []
  }

getNotesFeedR :: UserNameP -> Handler RepRss
getNotesFeedR :: UserNameP -> Handler RepRss
getNotesFeedR unamep :: UserNameP
unamep@(UserNameP Text
uname) = do
  Maybe Text
mauthuname <- Handler (Maybe Text)
maybeAuthUsername
  (Maybe Page
limit', Maybe Page
page') <- Handler (Maybe Page, Maybe Page)
lookupPagingParams
  Maybe Text
mquery <- forall (m :: * -> *). MonadHandler m => Text -> m (Maybe Text)
lookupGetParam Text
"query"
  let limit :: Page
limit = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Page
20 forall a b. (Integral a, Num b) => a -> b
fromIntegral Maybe Page
limit'
      page :: Page
page  = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Page
1   forall a b. (Integral a, Num b) => a -> b
fromIntegral Maybe Page
page'
      isowner :: Bool
isowner = forall a. a -> Maybe a
Just Text
uname forall a. Eq a => a -> a -> Bool
== Maybe Text
mauthuname
      sharedp :: SharedP
sharedp = if Bool
isowner then SharedP
SharedAll else SharedP
SharedPublic
  (Int
_, [Entity Note]
notes) <- forall site a.
YesodPersist site =>
YesodDB site a -> HandlerFor site a
runDB do
      Entity Key User
userId User
user <- forall backend val (m :: * -> *).
(PersistUniqueRead backend, PersistRecordBackend val backend,
 MonadIO m) =>
Unique val -> ReaderT backend m (Entity val)
getBy404 (Text -> Unique User
UniqueUserName Text
uname)
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
isowner Bool -> Bool -> Bool
&& User -> Bool
userPrivacyLock User
user)
        (forall (m :: * -> *) url a.
(MonadHandler m, RedirectUrl (HandlerSite m) url) =>
url -> m a
redirect (Route Auth -> Route App
AuthR Route Auth
LoginR))
      Key User
-> Maybe Text -> SharedP -> Page -> Page -> DB (Int, [Entity Note])
getNoteList Key User
userId Maybe Text
mquery SharedP
sharedp Page
limit Page
page
  Route App -> Text
render <- forall (m :: * -> *).
MonadHandler m =>
m (Route (HandlerSite m) -> Text)
getUrlRender
  let (Markup
descr :: Html) = forall a. ToMarkup a => a -> Markup
toHtml forall a b. (a -> b) -> a -> b
$ Text -> Markup
H.text (Text
uname forall a. Semigroup a => a -> a -> a
<> Text
" notes")
      entries :: [FeedEntry Text]
entries = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((Route App -> Text) -> UserNameP -> Entity Note -> FeedEntry Text
noteToRssEntry Route App -> Text
render UserNameP
unamep) [Entity Note]
notes
  UTCTime
updated <- case forall mono.
(MonoFoldable mono, Ord (Element mono)) =>
mono -> Maybe (Element mono)
maximumMay (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map forall url. FeedEntry url -> UTCTime
feedEntryUpdated [FeedEntry Text]
entries) of
                Maybe (Element [UTCTime])
Nothing -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
                Just Element [UTCTime]
m ->  forall (m :: * -> *) a. Monad m => a -> m a
return Element [UTCTime]
m
  (Text
feedLinkSelf, Text
feedLinkHome) <- HandlerFor App (Text, Text)
getFeedLinkSelf
  forall (m :: * -> *). MonadHandler m => Feed Text -> m RepRss
rssFeedText forall a b. (a -> b) -> a -> b
$
    Feed
    { feedTitle :: Text
feedTitle = Text
uname forall a. Semigroup a => a -> a -> a
<> Text
" notes"
    , feedLinkSelf :: Text
feedLinkSelf = Text
feedLinkSelf
    , feedLinkHome :: Text
feedLinkHome = Text
feedLinkHome
    , feedAuthor :: Text
feedAuthor = Text
uname
    , feedDescription :: Markup
feedDescription = Markup
descr
    , feedLanguage :: Text
feedLanguage = Text
"en"
    , feedUpdated :: UTCTime
feedUpdated = UTCTime
updated
    , feedLogo :: Maybe (Text, Text)
feedLogo = forall a. Maybe a
Nothing
    , feedEntries :: [FeedEntry Text]
feedEntries = [FeedEntry Text]
entries
    }
  where
    getFeedLinkSelf :: HandlerFor App (Text, Text)
getFeedLinkSelf = do
      YesodRequest
request <- forall (m :: * -> *). MonadHandler m => m YesodRequest
getRequest
      Route App -> Text
render <- forall (m :: * -> *).
MonadHandler m =>
m (Route (HandlerSite m) -> Text)
getUrlRender
      let rawRequest :: Request
rawRequest = YesodRequest -> Request
reqWaiRequest YesodRequest
request
          feedLinkSelf :: Text
feedLinkSelf = Route App -> Text
render Route App
HomeR forall a. Semigroup a => a -> a -> a
<> (Int -> Text -> Text
T.drop Int
1 (forall textual binary. Utf8 textual binary => binary -> textual
decodeUtf8 (Request -> ByteString
W.rawPathInfo Request
rawRequest forall a. Semigroup a => a -> a -> a
<> Request -> ByteString
W.rawQueryString Request
rawRequest)))
          feedLinkHome :: Text
feedLinkHome = Route App -> Text
render (UserNameP -> Route App
UserR UserNameP
unamep)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
feedLinkSelf, Text
feedLinkHome)