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

import qualified Data.Text as T
import           Handler.Common
import           Import
import qualified Text.Blaze.Html5 as H
import           Yesod.RssFeed
import qualified Data.Map as Map
import qualified Network.Wai.Internal as W

getUserR :: UserNameP -> Handler Html
getUserR :: UserNameP -> Handler Markup
getUserR UserNameP
uname=
  UserNameP -> SharedP -> FilterP -> TagsP -> Handler Markup
_getUser UserNameP
uname SharedP
SharedAll FilterP
FilterAll ([Text] -> TagsP
TagsP [])

getUserSharedR :: UserNameP -> SharedP -> Handler Html
getUserSharedR :: UserNameP -> SharedP -> Handler Markup
getUserSharedR UserNameP
uname SharedP
sharedp =
  UserNameP -> SharedP -> FilterP -> TagsP -> Handler Markup
_getUser UserNameP
uname SharedP
sharedp FilterP
FilterAll ([Text] -> TagsP
TagsP [])

getUserFilterR :: UserNameP -> FilterP -> Handler Html
getUserFilterR :: UserNameP -> FilterP -> Handler Markup
getUserFilterR UserNameP
uname FilterP
filterp =
  UserNameP -> SharedP -> FilterP -> TagsP -> Handler Markup
_getUser UserNameP
uname SharedP
SharedAll FilterP
filterp ([Text] -> TagsP
TagsP [])

getUserTagsR :: UserNameP -> TagsP -> Handler Html
getUserTagsR :: UserNameP -> TagsP -> Handler Markup
getUserTagsR UserNameP
uname = UserNameP -> SharedP -> FilterP -> TagsP -> Handler Markup
_getUser UserNameP
uname SharedP
SharedAll FilterP
FilterAll

_getUser :: UserNameP -> SharedP -> FilterP -> TagsP -> Handler Html
_getUser :: UserNameP -> SharedP -> FilterP -> TagsP -> Handler Markup
_getUser unamep :: UserNameP
unamep@(UserNameP Text
uname) SharedP
sharedp' FilterP
filterp' (TagsP [Text]
pathtags) = do
  Maybe Text
mauthuname <- Handler (Maybe Text)
maybeAuthUsername
  (Maybe Page
limit', Maybe Page
page') <- Handler (Maybe Page, Maybe Page)
lookupPagingParams
  let limit :: Page
limit = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Page
120 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
sharedp' else SharedP
SharedPublic
      filterp :: FilterP
filterp = case FilterP
filterp' of
        FilterSingle BmSlug
_ -> FilterP
filterp'
        FilterP
_ -> if Bool
isowner then FilterP
filterp' else FilterP
FilterAll
      isAll :: Bool
isAll = FilterP
filterp forall a. Eq a => a -> a -> Bool
== FilterP
FilterAll Bool -> Bool -> Bool
&& SharedP
sharedp forall a. Eq a => a -> a -> Bool
== SharedP
SharedAll Bool -> Bool -> Bool
&& forall mono. MonoFoldable mono => mono -> Bool
null [Text]
pathtags
      queryp :: Text
queryp = Text
"query" :: Text
  Maybe Text
mquery <- forall (m :: * -> *). MonadHandler m => Text -> m (Maybe Text)
lookupGetParam Text
queryp
  let mqueryp :: Maybe (Text, Text)
mqueryp = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text
queryp,) Maybe Text
mquery
  (Int
bcount, [(Entity Bookmark, Maybe Text)]
btmarks) <- 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)
       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
-> SharedP
-> FilterP
-> [Text]
-> Maybe Text
-> Page
-> Page
-> DB (Int, [(Entity Bookmark, Maybe Text)])
bookmarksTagsQuery Key User
userId SharedP
sharedp FilterP
filterp [Text]
pathtags Maybe Text
mquery Page
limit Page
page
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
bcount forall a. Eq a => a -> a -> Bool
== Int
0) (case FilterP
filterp of FilterSingle BmSlug
_ -> forall (m :: * -> *) a. MonadHandler m => m a
notFound; FilterP
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  Maybe (Route App)
mroute <- forall (m :: * -> *).
MonadHandler m =>
m (Maybe (Route (HandlerSite m)))
getCurrentRoute
  TagCloudMode
tagCloudMode <- forall (m :: * -> *).
MonadHandler m =>
Bool -> [Text] -> m TagCloudMode
getTagCloudMode Bool
isowner [Text]
pathtags
  YesodRequest
req <- forall (m :: * -> *). MonadHandler m => m YesodRequest
getRequest
  forall site.
Yesod site =>
WidgetFor site () -> HandlerFor site Markup
defaultLayout do
    let pager :: WidgetFor App ()
pager = $(widgetFile "pager")
        search :: WidgetFor App ()
search = $(widgetFile "search")
        renderEl :: Text
renderEl = Text
"bookmarks" :: Text
        tagCloudRenderEl :: Text
tagCloudRenderEl = Text
"tagCloud" :: Text
    forall (m :: * -> *).
MonadWidget m =>
Route (HandlerSite m) -> Text -> m ()
rssLink (UserNameP -> Route App
UserFeedR UserNameP
unamep) Text
"feed"
    $(widgetFile "user")
    forall site a (m :: * -> *).
(ToWidgetBody site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
toWidgetBody [julius|
        app.dat.bmarks = #{ toJSON $ toBookmarkFormList btmarks } || [];
        app.dat.isowner = #{ isowner };
        app.userR = "@{UserR unamep}";
        app.tagCloudMode = #{ toJSON $ tagCloudMode } || {};
    |]
    forall site a (m :: * -> *).
(ToWidget site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
toWidget [julius|
      setTimeout(() => {
        PS.renderBookmarks('##{rawJS renderEl}')(app.dat.bmarks)();
      }, 0);
      setTimeout(() => {
        PS.renderTagCloud('##{rawJS tagCloudRenderEl}')(app.tagCloudMode)();
      }, 0);
    |]

-- Form

postUserTagCloudR :: Handler ()
postUserTagCloudR :: HandlerFor App ()
postUserTagCloudR = do
  Key User
userId <- forall (m :: * -> *).
(MonadHandler m, YesodAuth (HandlerSite m)) =>
m (AuthId (HandlerSite m))
requireAuthId
  TagCloudMode
mode <- forall (m :: * -> *) a. (MonadHandler m, FromJSON a) => m a
requireCheckJsonBody
  TagCloudMode -> HandlerFor App ()
_updateTagCloudMode TagCloudMode
mode
  [(Text, Int)]
tc <- forall site a.
YesodPersist site =>
YesodDB site a -> HandlerFor site a
runDB forall a b. (a -> b) -> a -> b
$ case TagCloudMode
mode of
    TagCloudModeTop Bool
_ Int
n -> Key User -> Int -> DB [(Text, Int)]
tagCountTop Key User
userId Int
n
    TagCloudModeLowerBound Bool
_ Int
n -> Key User -> Int -> DB [(Text, Int)]
tagCountLowerBound Key User
userId Int
n
    TagCloudModeRelated Bool
_ [Text]
tags ->  Key User -> [Text] -> DB [(Text, Int)]
tagCountRelated Key User
userId [Text]
tags
    TagCloudMode
TagCloudModeNone -> forall (m :: * -> *) a. MonadHandler m => m a
notFound
  forall (m :: * -> *) c a.
(MonadHandler m, ToJSON c) =>
Status -> c -> m a
sendStatusJSON Status
ok200 (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text, Int)]
tc :: Map.Map Text Int)

postUserTagCloudModeR :: Handler ()
postUserTagCloudModeR :: HandlerFor App ()
postUserTagCloudModeR = do
  Key User
userId <- forall (m :: * -> *).
(MonadHandler m, YesodAuth (HandlerSite m)) =>
m (AuthId (HandlerSite m))
requireAuthId
  TagCloudMode
mode <- forall (m :: * -> *) a. (MonadHandler m, FromJSON a) => m a
requireCheckJsonBody
  TagCloudMode -> HandlerFor App ()
_updateTagCloudMode TagCloudMode
mode

_updateTagCloudMode :: TagCloudMode -> Handler ()
_updateTagCloudMode :: TagCloudMode -> HandlerFor App ()
_updateTagCloudMode TagCloudMode
mode =
  case TagCloudMode
mode of
    TagCloudModeTop Bool
_ Int
_ -> forall (m :: * -> *). MonadHandler m => TagCloudMode -> m ()
setTagCloudMode TagCloudMode
mode
    TagCloudModeLowerBound Bool
_ Int
_ -> forall (m :: * -> *). MonadHandler m => TagCloudMode -> m ()
setTagCloudMode TagCloudMode
mode
    TagCloudModeRelated Bool
_ [Text]
_ -> forall (m :: * -> *). MonadHandler m => TagCloudMode -> m ()
setTagCloudMode TagCloudMode
mode
    TagCloudMode
TagCloudModeNone -> forall (m :: * -> *) a. MonadHandler m => m a
notFound

bookmarkToRssEntry :: (Entity Bookmark, Maybe Text) -> FeedEntry Text
bookmarkToRssEntry :: (Entity Bookmark, Maybe Text) -> FeedEntry Text
bookmarkToRssEntry (Entity Key Bookmark
entryId Bookmark
entry, Maybe Text
tags) =
  FeedEntry
  { feedEntryLink :: Text
feedEntryLink = Bookmark -> Text
bookmarkHref Bookmark
entry
  , feedEntryUpdated :: UTCTime
feedEntryUpdated = Bookmark -> UTCTime
bookmarkTime Bookmark
entry
  , feedEntryTitle :: Text
feedEntryTitle = Bookmark -> Text
bookmarkDescription Bookmark
entry
  , feedEntryContent :: Markup
feedEntryContent = forall a. ToMarkup a => a -> Markup
toHtml (Bookmark -> Text
bookmarkExtended Bookmark
entry)
  , feedEntryCategories :: [EntryCategory]
feedEntryCategories = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Maybe Text -> Maybe Text -> Text -> EntryCategory
EntryCategory forall a. Maybe a
Nothing forall a. Maybe a
Nothing) (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall t. Textual t => t -> [t]
words Maybe Text
tags)
  , feedEntryEnclosure :: Maybe (EntryEnclosure Text)
feedEntryEnclosure = forall a. Maybe a
Nothing
  }

getUserFeedR :: UserNameP -> Handler RepRss
getUserFeedR :: UserNameP -> Handler RepRss
getUserFeedR UserNameP
unamep = do
  UserNameP -> SharedP -> FilterP -> TagsP -> Handler RepRss
_getUserFeed UserNameP
unamep SharedP
SharedAll FilterP
FilterAll ([Text] -> TagsP
TagsP [])

getUserFeedSharedR :: UserNameP -> SharedP -> Handler RepRss
getUserFeedSharedR :: UserNameP -> SharedP -> Handler RepRss
getUserFeedSharedR UserNameP
uname SharedP
sharedp =
  UserNameP -> SharedP -> FilterP -> TagsP -> Handler RepRss
_getUserFeed UserNameP
uname SharedP
sharedp FilterP
FilterAll ([Text] -> TagsP
TagsP [])

getUserFeedFilterR :: UserNameP -> FilterP -> Handler RepRss
getUserFeedFilterR :: UserNameP -> FilterP -> Handler RepRss
getUserFeedFilterR UserNameP
uname FilterP
filterp =
  UserNameP -> SharedP -> FilterP -> TagsP -> Handler RepRss
_getUserFeed UserNameP
uname SharedP
SharedAll FilterP
filterp ([Text] -> TagsP
TagsP [])

getUserFeedTagsR :: UserNameP -> TagsP -> Handler RepRss
getUserFeedTagsR :: UserNameP -> TagsP -> Handler RepRss
getUserFeedTagsR UserNameP
uname = UserNameP -> SharedP -> FilterP -> TagsP -> Handler RepRss
_getUserFeed UserNameP
uname SharedP
SharedAll FilterP
FilterAll

_getUserFeed :: UserNameP -> SharedP -> FilterP -> TagsP -> Handler RepRss
_getUserFeed :: UserNameP -> SharedP -> FilterP -> TagsP -> Handler RepRss
_getUserFeed unamep :: UserNameP
unamep@(UserNameP Text
uname) SharedP
sharedp' FilterP
filterp' (TagsP [Text]
pathtags) = do
  Maybe Text
mauthuname <- Handler (Maybe Text)
maybeAuthUsername
  (Maybe Page
limit', Maybe Page
page') <- Handler (Maybe Page, Maybe Page)
lookupPagingParams
  let limit :: Page
limit = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Page
120 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
sharedp' else SharedP
SharedPublic
      filterp :: FilterP
filterp = case FilterP
filterp' of
        FilterSingle BmSlug
_ -> FilterP
filterp'
        FilterP
_ -> if Bool
isowner then FilterP
filterp' else FilterP
FilterAll
      -- isAll = filterp == FilterAll && sharedp == SharedAll && null pathtags
      queryp :: Text
queryp = Text
"query" :: Text
  Maybe Text
mquery <- forall (m :: * -> *). MonadHandler m => Text -> m (Maybe Text)
lookupGetParam Text
queryp
  (Int
_, [(Entity Bookmark, Maybe Text)]
btmarks) <- 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)
       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
-> SharedP
-> FilterP
-> [Text]
-> Maybe Text
-> Page
-> Page
-> DB (Int, [(Entity Bookmark, Maybe Text)])
bookmarksTagsQuery Key User
userId SharedP
sharedp FilterP
filterp [Text]
pathtags Maybe Text
mquery Page
limit Page
page
  let (Markup
descr :: Html) = forall a. ToMarkup a => a -> Markup
toHtml forall a b. (a -> b) -> a -> b
$ Text -> Markup
H.text (Text
"Bookmarks saved by " forall a. Semigroup a => a -> a -> a
<> Text
uname)
      entries :: [FeedEntry Text]
entries = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Entity Bookmark, Maybe Text) -> FeedEntry Text
bookmarkToRssEntry [(Entity Bookmark, Maybe Text)]
btmarks
  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
"espial " forall a. Semigroup a => a -> a -> a
<> Text
uname
    , 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)