{-# 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 <- Text -> Handler (Maybe Text)
forall (m :: * -> *). MonadHandler m => Text -> m (Maybe Text)
lookupGetParam Text
queryp
  let limit :: Page
limit = Page -> (Page -> Page) -> Maybe Page -> Page
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Page
20 Page -> Page
forall a b. (Integral a, Num b) => a -> b
fromIntegral Maybe Page
limit'
      page :: Page
page  = Page -> (Page -> Page) -> Maybe Page -> Page
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Page
1  Page -> Page
forall a b. (Integral a, Num b) => a -> b
fromIntegral Maybe Page
page'
      mqueryp :: Maybe (Text, Text)
mqueryp = (Text -> (Text, Text)) -> Maybe Text -> Maybe (Text, Text)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text
queryp,) Maybe Text
mquery
      isowner :: Bool
isowner = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
uname Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Text
mauthuname
  (Int
bcount, [Entity Note]
notes) <- YesodDB App (Int, [Entity Note])
-> HandlerFor App (Int, [Entity Note])
forall a. YesodDB App a -> HandlerFor App a
forall site a.
YesodPersist site =>
YesodDB site a -> HandlerFor site a
runDB do
    Entity Key User
userId User
user <- Unique User -> ReaderT SqlBackend (HandlerFor App) (Entity 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
    Bool
-> ReaderT SqlBackend (HandlerFor App) ()
-> ReaderT SqlBackend (HandlerFor App) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
isowner Bool -> Bool -> Bool
&& User -> Bool
userPrivacyLock User
user)
      (Route App -> ReaderT SqlBackend (HandlerFor App) ()
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 <- HandlerFor App YesodRequest
forall (m :: * -> *). MonadHandler m => m YesodRequest
getRequest
  Maybe (Route App)
mroute <- HandlerFor App (Maybe (Route (HandlerSite (HandlerFor App))))
HandlerFor App (Maybe (Route App))
forall (m :: * -> *).
MonadHandler m =>
m (Maybe (Route (HandlerSite m)))
getCurrentRoute
  WidgetFor App () -> Handler Markup
forall site.
Yesod site =>
WidgetFor site () -> HandlerFor site Markup
defaultLayout do
    Route (HandlerSite (WidgetFor App)) -> Text -> WidgetFor App ()
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")
    JavascriptUrl (Route App) -> WidgetFor App ()
forall site a (m :: * -> *).
(ToWidgetBody site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
forall (m :: * -> *).
(MonadWidget m, HandlerSite m ~ App) =>
JavascriptUrl (Route App) -> m ()
toWidgetBody [julius|
        app.userR = "@{UserR unamep}";
        app.dat.notes = #{ toJSON notes } || [];
        app.dat.isowner = #{ isowner };
    |]
    JavascriptUrl (Route App) -> WidgetFor App ()
forall site a (m :: * -> *).
(ToWidget site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
forall (m :: * -> *).
(MonadWidget m, HandlerSite m ~ App) =>
JavascriptUrl (Route App) -> 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 = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
uname Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Text
mauthuname
  Entity Note
note <-
    YesodDB App (Entity Note) -> HandlerFor App (Entity Note)
forall a. YesodDB App a -> HandlerFor App a
forall site a.
YesodPersist site =>
YesodDB site a -> HandlerFor site a
runDB (YesodDB App (Entity Note) -> HandlerFor App (Entity Note))
-> YesodDB App (Entity Note) -> HandlerFor App (Entity Note)
forall a b. (a -> b) -> a -> b
$
    do Entity Key User
userId User
user <- Unique User -> ReaderT SqlBackend (HandlerFor App) (Entity 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 <- ReaderT SqlBackend (HandlerFor App) (Entity Note)
-> (Entity Note
    -> ReaderT SqlBackend (HandlerFor App) (Entity Note))
-> Maybe (Entity Note)
-> ReaderT SqlBackend (HandlerFor App) (Entity Note)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ReaderT SqlBackend (HandlerFor App) (Entity Note)
forall (m :: * -> *) a. MonadHandler m => m a
notFound Entity Note -> ReaderT SqlBackend (HandlerFor App) (Entity Note)
forall a. a -> ReaderT SqlBackend (HandlerFor App) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Entity Note)
mnote
       Bool
-> ReaderT SqlBackend (HandlerFor App) ()
-> ReaderT SqlBackend (HandlerFor App) ()
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 (Bool -> Bool) -> (Entity Note -> Bool) -> Entity Note -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
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 (Note -> Bool) -> (Entity Note -> Note) -> Entity Note -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Entity Note -> Note
forall record. Entity record -> record
entityVal) Entity Note
note))
         (Route App -> ReaderT SqlBackend (HandlerFor App) ()
forall (m :: * -> *) url a.
(MonadHandler m, RedirectUrl (HandlerSite m) url) =>
url -> m a
redirect (Route Auth -> Route App
AuthR Route Auth
LoginR))
       Entity Note -> ReaderT SqlBackend (HandlerFor App) (Entity Note)
forall a. a -> ReaderT SqlBackend (HandlerFor App) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Entity Note
note
  WidgetFor App () -> Handler Markup
forall site.
Yesod site =>
WidgetFor site () -> HandlerFor site Markup
defaultLayout do
    $(widgetFile "note")
    JavascriptUrl (Route App) -> WidgetFor App ()
forall site a (m :: * -> *).
(ToWidgetBody site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
forall (m :: * -> *).
(MonadWidget m, HandlerSite m ~ App) =>
JavascriptUrl (Route App) -> m ()
toWidgetBody [julius|
        app.userR = "@{UserR unamep}";
        app.dat.note = #{ toJSON note } || [];
        app.dat.isowner = #{ isowner };
    |]
    JavascriptUrl (Route App) -> WidgetFor App ()
forall site a (m :: * -> *).
(ToWidget site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
forall (m :: * -> *).
(MonadWidget m, HandlerSite m ~ App) =>
JavascriptUrl (Route App) -> m ()
toWidget [julius|
      PS.renderNote('##{rawJS renderEl}')(app.dat.note)();
    |]

getAddNoteSlimViewR :: Handler Html
getAddNoteSlimViewR :: Handler Markup
getAddNoteSlimViewR = do
  Entity Key User
userId User
user <- HandlerFor App (Entity 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 <- HandlerFor App (Key User)
HandlerFor App (AuthId (HandlerSite (HandlerFor App)))
forall (m :: * -> *).
(MonadHandler m, YesodAuth (HandlerSite m)) =>
m (AuthId (HandlerSite m))
requireAuthId
  Note
note <- IO Note -> HandlerFor App Note
forall a. IO a -> HandlerFor App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Note -> HandlerFor App Note)
-> (NoteForm -> IO Note) -> NoteForm -> HandlerFor App Note
forall b c a. (b -> c) -> (a -> b) -> a -> c
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 (NoteForm -> HandlerFor App Note)
-> HandlerFor App NoteForm -> HandlerFor App Note
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HandlerFor App NoteForm
noteFormUrl
  let renderEl :: Text
renderEl = Text
"note" :: Text
      enote :: Entity Note
enote = Key Note -> Note -> Entity Note
forall record. Key record -> record -> Entity record
Entity (BackendKey SqlBackend -> Key Note
NoteKey BackendKey SqlBackend
0) Note
note
  WidgetFor App () -> Handler Markup
forall site.
Yesod site =>
WidgetFor site () -> HandlerFor site Markup
defaultLayout do
    $(widgetFile "note")
    JavascriptUrl (Route App) -> WidgetFor App ()
forall site a (m :: * -> *).
(ToWidgetBody site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
forall (m :: * -> *).
(MonadWidget m, HandlerSite m ~ App) =>
JavascriptUrl (Route App) -> m ()
toWidgetBody [julius|
        app.userR = "@{UserR unamep}";
        app.noteR = "@{NoteR unamep (noteSlug (entityVal enote))}";
        app.dat.note = #{ toJSON enote } || [];
    |]
    JavascriptUrl (Route App) -> WidgetFor App ()
forall site a (m :: * -> *).
(ToWidget site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
forall (m :: * -> *).
(MonadWidget m, HandlerSite m ~ App) =>
JavascriptUrl (Route App) -> 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 <- HandlerFor App (Key User)
HandlerFor App (AuthId (HandlerSite (HandlerFor App)))
forall (m :: * -> *).
(MonadHandler m, YesodAuth (HandlerSite m)) =>
m (AuthId (HandlerSite m))
requireAuthId
  YesodDB App () -> HandlerFor App ()
forall a. YesodDB App a -> HandlerFor App a
forall site a.
YesodPersist site =>
YesodDB site a -> HandlerFor site a
runDB do
    let k_nid :: Key Note
k_nid = Page -> Key Note
forall record. ToBackendKey SqlBackend record => Page -> Key record
toSqlKey Page
nid
    Note
_ <- Key User -> Key Note -> DBM (HandlerFor App) Note
requireResource Key User
userId Key Note
k_nid
    Key Note -> ReaderT SqlBackend (HandlerFor App) ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m ()
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend) =>
Key record -> ReaderT SqlBackend m ()
delete Key Note
k_nid
  Markup -> Handler Markup
forall a. a -> HandlerFor App a
forall (m :: * -> *) a. Monad m => a -> m a
return Markup
""

postAddNoteR :: Handler Text
postAddNoteR :: Handler Text
postAddNoteR = do
  NoteForm
noteForm <- HandlerFor App NoteForm
forall (m :: * -> *) a. (MonadHandler m, FromJSON a) => m a
requireCheckJsonBody
  NoteForm -> Handler (UpsertResult (Key Note))
_handleFormSuccess NoteForm
noteForm Handler (UpsertResult (Key Note))
-> (UpsertResult (Key Note) -> Handler Text) -> Handler Text
forall a b.
HandlerFor App a -> (a -> HandlerFor App b) -> HandlerFor App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Created Key Note
nid -> Status -> Key Note -> Handler Text
forall (m :: * -> *) c a.
(MonadHandler m, ToJSON c) =>
Status -> c -> m a
sendStatusJSON Status
created201 Key Note
nid
    Updated Key Note
_ -> Status -> () -> Handler Text
forall (m :: * -> *) c a.
(MonadHandler m, ToTypedContent c) =>
Status -> c -> m a
sendResponseStatus Status
noContent204 ()
    Failed String
s -> Status -> String -> Handler Text
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 <- Key Note -> SqlPersistT (HandlerFor App) Note
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 Key User -> Key User -> Bool
forall a. Eq a => a -> a -> Bool
== Note -> Key User
noteUserId Note
nnote
    then Note -> SqlPersistT (HandlerFor App) Note
forall a. a -> ReaderT SqlBackend (HandlerFor App) a
forall (m :: * -> *) a. Monad m => a -> m a
return Note
nnote
    else SqlPersistT (HandlerFor App) Note
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 <- HandlerFor App (Key User)
HandlerFor App (AuthId (HandlerSite (HandlerFor App)))
forall (m :: * -> *).
(MonadHandler m, YesodAuth (HandlerSite m)) =>
m (AuthId (HandlerSite m))
requireAuthId
  Note
note <- IO Note -> HandlerFor App Note
forall a. IO a -> HandlerFor App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Note -> HandlerFor App Note) -> IO Note -> HandlerFor App Note
forall a b. (a -> b) -> a -> b
$ Key User -> NoteForm -> IO Note
_toNote Key User
userId NoteForm
noteForm
  YesodDB App (UpsertResult (Key Note))
-> Handler (UpsertResult (Key Note))
forall a. YesodDB App a -> HandlerFor App a
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
forall record. ToBackendKey SqlBackend record => Page -> Key record
toSqlKey (Page -> Key Note) -> Maybe Page -> Maybe (Key Note)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NoteForm -> Maybe Page
_id NoteForm
noteForm Maybe Page -> (Page -> Maybe Page) -> Maybe Page
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Page
i -> if Page
i Page -> Page -> Bool
forall a. Ord a => a -> a -> Bool
> Page
0 then Page -> Maybe Page
forall a. a -> Maybe a
Just Page
i else Maybe Page
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
(Int -> NoteForm -> ShowS)
-> (NoteForm -> String) -> ([NoteForm] -> ShowS) -> Show NoteForm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NoteForm -> ShowS
showsPrec :: Int -> NoteForm -> ShowS
$cshow :: NoteForm -> String
show :: NoteForm -> String
$cshowList :: [NoteForm] -> ShowS
showList :: [NoteForm] -> ShowS
Show, NoteForm -> NoteForm -> Bool
(NoteForm -> NoteForm -> Bool)
-> (NoteForm -> NoteForm -> Bool) -> Eq NoteForm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NoteForm -> NoteForm -> Bool
== :: NoteForm -> NoteForm -> Bool
$c/= :: NoteForm -> NoteForm -> Bool
/= :: NoteForm -> NoteForm -> Bool
Eq, ReadPrec [NoteForm]
ReadPrec NoteForm
Int -> ReadS NoteForm
ReadS [NoteForm]
(Int -> ReadS NoteForm)
-> ReadS [NoteForm]
-> ReadPrec NoteForm
-> ReadPrec [NoteForm]
-> Read NoteForm
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS NoteForm
readsPrec :: Int -> ReadS NoteForm
$creadList :: ReadS [NoteForm]
readList :: ReadS [NoteForm]
$creadPrec :: ReadPrec NoteForm
readPrec :: ReadPrec NoteForm
$creadListPrec :: ReadPrec [NoteForm]
readListPrec :: ReadPrec [NoteForm]
Read, (forall x. NoteForm -> Rep NoteForm x)
-> (forall x. Rep NoteForm x -> NoteForm) -> Generic NoteForm
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
$cfrom :: forall x. NoteForm -> Rep NoteForm x
from :: forall x. NoteForm -> Rep NoteForm x
$cto :: forall x. Rep NoteForm x -> NoteForm
to :: forall x. Rep NoteForm x -> NoteForm
Generic)

instance FromJSON NoteForm where parseJSON :: Value -> Parser NoteForm
parseJSON = Options -> Value -> Parser NoteForm
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON Options
gNoteFormOptions
instance ToJSON NoteForm where toJSON :: NoteForm -> Value
toJSON = Options -> NoteForm -> Value
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 { A.fieldLabelModifier = drop 1 }

noteFormUrl :: Handler NoteForm
noteFormUrl :: HandlerFor App NoteForm
noteFormUrl = do
  Maybe Text
title <- Text -> Handler (Maybe Text)
forall (m :: * -> *). MonadHandler m => Text -> m (Maybe Text)
lookupGetParam Text
"title"
  Maybe Textarea
description <- Text -> Handler (Maybe Text)
forall (m :: * -> *). MonadHandler m => Text -> m (Maybe Text)
lookupGetParam Text
"description" Handler (Maybe Text)
-> (Maybe Text -> Maybe Textarea)
-> HandlerFor App (Maybe Textarea)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Text -> Textarea) -> Maybe Text -> Maybe Textarea
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Textarea
Textarea
  Maybe Bool
isMarkdown <- Text -> Handler (Maybe Text)
forall (m :: * -> *). MonadHandler m => Text -> m (Maybe Text)
lookupGetParam Text
"isMarkdown" Handler (Maybe Text)
-> (Maybe Text -> Maybe Bool) -> HandlerFor App (Maybe Bool)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Text -> Bool) -> Maybe Text -> Maybe Bool
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Bool
forall {a}. (Eq a, IsString a) => a -> Bool
parseChk
  NoteForm -> HandlerFor App NoteForm
forall a. a -> HandlerFor App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NoteForm -> HandlerFor App NoteForm)
-> NoteForm -> HandlerFor App NoteForm
forall a b. (a -> b) -> a -> b
$ NoteForm
    { _id :: Maybe Page
_id = Maybe Page
forall a. Maybe a
Nothing
    , _slug :: Maybe NtSlug
_slug = Maybe NtSlug
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 = Maybe Bool
forall a. Maybe a
Nothing
    , _created :: Maybe UTCTimeStr
_created = Maybe UTCTimeStr
forall a. Maybe a
Nothing
    , _updated :: Maybe UTCTimeStr
_updated = Maybe UTCTimeStr
forall a. Maybe a
Nothing
    }
  where
    parseChk :: a -> Bool
parseChk a
s = a
s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"yes" Bool -> Bool -> Bool
|| a
s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"on" Bool -> Bool -> Bool
|| a
s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"true" Bool -> Bool -> Bool
|| a
s a -> a -> Bool
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
_id :: NoteForm -> Maybe Page
_slug :: NoteForm -> Maybe NtSlug
_title :: NoteForm -> Maybe Text
_text :: NoteForm -> Maybe Textarea
_isMarkdown :: NoteForm -> Maybe Bool
_shared :: NoteForm -> Maybe Bool
_created :: NoteForm -> Maybe UTCTimeStr
_updated :: NoteForm -> Maybe UTCTimeStr
_id :: Maybe Page
_slug :: Maybe NtSlug
_title :: Maybe Text
_text :: Maybe Textarea
_isMarkdown :: Maybe Bool
_shared :: Maybe Bool
_created :: Maybe UTCTimeStr
_updated :: Maybe UTCTimeStr
..} = do
  UTCTime
time <- IO UTCTime -> IO UTCTime
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  NtSlug
slug <- IO NtSlug -> (NtSlug -> IO NtSlug) -> Maybe NtSlug -> IO NtSlug
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO NtSlug
mkNtSlug NtSlug -> IO NtSlug
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe NtSlug
_slug
  Note -> IO Note
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Note -> IO Note) -> Note -> IO Note
forall a b. (a -> b) -> a -> b
$
    Note
    { noteUserId :: Key User
noteUserId = Key User
userId
    , noteSlug :: NtSlug
noteSlug = NtSlug
slug
    , noteLength :: Int
noteLength = Maybe Textarea -> Int
forall mono. MonoFoldable mono => mono -> Int
length Maybe Textarea
_text
    , noteTitle :: Text
noteTitle = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
_title
    , noteText :: Text
noteText = Text -> (Textarea -> Text) -> Maybe Textarea -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Textarea -> Text
unTextarea Maybe Textarea
_text
    , noteIsMarkdown :: Bool
noteIsMarkdown = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Bool
_isMarkdown
    , noteShared :: Bool
noteShared = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Bool
_shared
    , noteCreated :: UTCTime
noteCreated = UTCTime -> (UTCTimeStr -> UTCTime) -> Maybe UTCTimeStr -> UTCTime
forall b a. b -> (a -> b) -> Maybe a -> b
maybe UTCTime
time UTCTimeStr -> UTCTime
unUTCTimeStr Maybe UTCTimeStr
_created
    , noteUpdated :: UTCTime
noteUpdated = UTCTime -> (UTCTimeStr -> UTCTime) -> Maybe UTCTimeStr -> UTCTime
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 (Route App -> Text) -> Route App -> Text
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 = Text -> Markup
forall a. ToMarkup a => a -> Markup
toHtml (Note -> Text
noteText Note
entry)
  , feedEntryEnclosure :: Maybe (EntryEnclosure Text)
feedEntryEnclosure = Maybe (EntryEnclosure Text)
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 <- Text -> Handler (Maybe Text)
forall (m :: * -> *). MonadHandler m => Text -> m (Maybe Text)
lookupGetParam Text
"query"
  let limit :: Page
limit = Page -> (Page -> Page) -> Maybe Page -> Page
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Page
20 Page -> Page
forall a b. (Integral a, Num b) => a -> b
fromIntegral Maybe Page
limit'
      page :: Page
page  = Page -> (Page -> Page) -> Maybe Page -> Page
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Page
1   Page -> Page
forall a b. (Integral a, Num b) => a -> b
fromIntegral Maybe Page
page'
      isowner :: Bool
isowner = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
uname Maybe Text -> Maybe Text -> Bool
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) <- YesodDB App (Int, [Entity Note])
-> HandlerFor App (Int, [Entity Note])
forall a. YesodDB App a -> HandlerFor App a
forall site a.
YesodPersist site =>
YesodDB site a -> HandlerFor site a
runDB do
      Entity Key User
userId User
user <- Unique User -> ReaderT SqlBackend (HandlerFor App) (Entity 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)
      Bool
-> ReaderT SqlBackend (HandlerFor App) ()
-> ReaderT SqlBackend (HandlerFor App) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
isowner Bool -> Bool -> Bool
&& User -> Bool
userPrivacyLock User
user)
        (Route App -> ReaderT SqlBackend (HandlerFor App) ()
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 <- HandlerFor App (Route (HandlerSite (HandlerFor App)) -> Text)
HandlerFor App (Route App -> Text)
forall (m :: * -> *).
MonadHandler m =>
m (Route (HandlerSite m) -> Text)
getUrlRender
  let (Markup
descr :: Html) = Markup -> Markup
forall a. ToMarkup a => a -> Markup
toHtml (Markup -> Markup) -> Markup -> Markup
forall a b. (a -> b) -> a -> b
$ Text -> Markup
H.text (Text
uname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" notes")
      entries :: [FeedEntry Text]
entries = (Entity Note -> FeedEntry Text)
-> [Entity Note] -> [FeedEntry Text]
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 [UTCTime] -> Maybe (Element [UTCTime])
forall mono.
(MonoFoldable mono, Ord (Element mono)) =>
mono -> Maybe (Element mono)
maximumMay ((FeedEntry Text -> UTCTime) -> [FeedEntry Text] -> [UTCTime]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map FeedEntry Text -> UTCTime
forall url. FeedEntry url -> UTCTime
feedEntryUpdated [FeedEntry Text]
entries) of
                Maybe (Element [UTCTime])
Nothing -> IO UTCTime -> HandlerFor App UTCTime
forall a. IO a -> HandlerFor App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
                Just Element [UTCTime]
m ->  UTCTime -> HandlerFor App UTCTime
forall a. a -> HandlerFor App a
forall (m :: * -> *) a. Monad m => a -> m a
return UTCTime
Element [UTCTime]
m
  (Text
feedLinkSelf, Text
feedLinkHome) <- HandlerFor App (Text, Text)
getFeedLinkSelf
  Feed Text -> Handler RepRss
forall (m :: * -> *). MonadHandler m => Feed Text -> m RepRss
rssFeedText (Feed Text -> Handler RepRss) -> Feed Text -> Handler RepRss
forall a b. (a -> b) -> a -> b
$
    Feed
    { feedTitle :: Text
feedTitle = Text
uname Text -> Text -> Text
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 = Maybe (Text, Text)
forall a. Maybe a
Nothing
    , feedEntries :: [FeedEntry Text]
feedEntries = [FeedEntry Text]
entries
    }
  where
    getFeedLinkSelf :: HandlerFor App (Text, Text)
getFeedLinkSelf = do
      YesodRequest
request <- HandlerFor App YesodRequest
forall (m :: * -> *). MonadHandler m => m YesodRequest
getRequest
      Route App -> Text
render <- HandlerFor App (Route (HandlerSite (HandlerFor App)) -> Text)
HandlerFor App (Route App -> Text)
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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Int -> Text -> Text
T.drop Int
1 (ByteString -> Text
forall textual binary. Utf8 textual binary => binary -> textual
decodeUtf8 (Request -> ByteString
W.rawPathInfo Request
rawRequest ByteString -> ByteString -> ByteString
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)
      (Text, Text) -> HandlerFor App (Text, Text)
forall a. a -> HandlerFor App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
feedLinkSelf, Text
feedLinkHome)