module Handler.Add where

import Import
import Handler.Archive
import Data.List (nub)
import qualified Data.Text as T (replace)

-- View

getAddViewR :: Handler Html
getAddViewR :: Handler Markup
getAddViewR = do
  Key User
userId <- forall (m :: * -> *).
(MonadHandler m, YesodAuth (HandlerSite m)) =>
m (AuthId (HandlerSite m))
requireAuthId

  Maybe Text
murl <- forall (m :: * -> *). MonadHandler m => Text -> m (Maybe Text)
lookupGetParam Text
"url"
  Maybe (Entity Bookmark, [Entity BookmarkTag])
mBookmarkDb <- forall site a.
YesodPersist site =>
YesodDB site a -> HandlerFor site a
runDB (Key User
-> Maybe Text -> DB (Maybe (Entity Bookmark, [Entity BookmarkTag]))
fetchBookmarkByUrl Key User
userId Maybe Text
murl)
  let mformdb :: Maybe BookmarkForm
mformdb = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Entity Bookmark, [Entity BookmarkTag]) -> BookmarkForm
_toBookmarkForm Maybe (Entity Bookmark, [Entity BookmarkTag])
mBookmarkDb 
  BookmarkForm
formurl <- Handler BookmarkForm
bookmarkFormUrl

  let renderEl :: Text
renderEl = Text
"addForm" :: Text

  WidgetFor App () -> Handler Markup
popupLayout do
    forall site a (m :: * -> *).
(ToWidget site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
toWidget [whamlet|
      <div id="#{ renderEl }">
    |]
    forall site a (m :: * -> *).
(ToWidgetBody site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
toWidgetBody [julius|
      app.dat.bmark = #{ toJSON (fromMaybe formurl mformdb) }; 
    |]
    forall site a (m :: * -> *).
(ToWidget site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
toWidget [julius|
      PS.renderAddForm('##{rawJS renderEl}')(app.dat.bmark)();
    |]

bookmarkFormUrl :: Handler BookmarkForm
bookmarkFormUrl :: Handler BookmarkForm
bookmarkFormUrl = do
  Entity Key User
_ 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
  Text
url <- forall (m :: * -> *). MonadHandler m => Text -> m (Maybe Text)
lookupGetParam Text
"url" forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall a. a -> Maybe a -> a
fromMaybe Text
""
  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 Text
tags <- forall (m :: * -> *). MonadHandler m => Text -> m (Maybe Text)
lookupGetParam Text
"tags"
  Maybe Bool
private <- forall (m :: * -> *). MonadHandler m => Text -> m (Maybe Text)
lookupGetParam Text
"private" 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 b. Functor f => f a -> (a -> b) -> f b
<&> (forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Maybe a
Just (User -> Bool
userPrivateDefault User
user))
  Maybe Bool
toread <- forall (m :: * -> *). MonadHandler m => Text -> m (Maybe Text)
lookupGetParam Text
"toread" 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
$
    BookmarkForm
    { _url :: Text
_url = Text
url
    , _title :: Maybe Text
_title = Maybe Text
title
    , _description :: Maybe Textarea
_description = Maybe Textarea
description
    , _tags :: Maybe Text
_tags = Maybe Text
tags
    , _private :: Maybe Bool
_private = Maybe Bool
private
    , _toread :: Maybe Bool
_toread = Maybe Bool
toread
    , _bid :: Maybe Int64
_bid = forall a. Maybe a
Nothing
    , _slug :: Maybe BmSlug
_slug = forall a. Maybe a
Nothing
    , _selected :: Maybe Bool
_selected = forall a. Maybe a
Nothing
    , _time :: Maybe UTCTimeStr
_time = forall a. Maybe a
Nothing
    , _archiveUrl :: Maybe Text
_archiveUrl = 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"

-- API

postAddR :: Handler Text
postAddR :: HandlerFor App Text
postAddR = do
  BookmarkForm
bookmarkForm <- forall (m :: * -> *) a. (MonadHandler m, FromJSON a) => m a
requireCheckJsonBody
  BookmarkForm -> Handler (UpsertResult (Key Bookmark))
_handleFormSuccess BookmarkForm
bookmarkForm forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Created Key Bookmark
bid -> forall (m :: * -> *) c a.
(MonadHandler m, ToJSON c) =>
Status -> c -> m a
sendStatusJSON Status
created201 Key Bookmark
bid
    Updated Key Bookmark
_ -> 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

_handleFormSuccess :: BookmarkForm -> Handler (UpsertResult (Key Bookmark))
_handleFormSuccess :: BookmarkForm -> Handler (UpsertResult (Key Bookmark))
_handleFormSuccess BookmarkForm
bookmarkForm = do
  (Key User
userId, User
user) <- forall master (m :: * -> *).
(YesodAuthPersist master, Typeable (AuthEntity master),
 MonadHandler m, HandlerSite m ~ master) =>
m (AuthId master, AuthEntity master)
requireAuthPair
  AppSettings
appSettings <- App -> AppSettings
appSettings forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadHandler m => m (HandlerSite m)
getYesod
  case (AppSettings -> Bool
appAllowNonHttpUrlSchemes AppSettings
appSettings, (forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> [Element mono]
unpack forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BookmarkForm -> Text
_url) BookmarkForm
bookmarkForm) of
    (Bool
False, Maybe Request
Nothing) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. String -> UpsertResult a
Failed String
"Invalid URL"
    (Bool
_, Maybe Request
_) -> do
      let mkbid :: Maybe (Key Bookmark)
mkbid = Int64 -> Key Bookmark
BookmarkKey forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BookmarkForm -> Maybe Int64
_bid BookmarkForm
bookmarkForm
          tags :: [Text]
tags = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall a. Eq a => [a] -> [a]
nub forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall t. Textual t => t -> [t]
words forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Text -> Text -> Text
T.replace Text
"," Text
" ") (BookmarkForm -> Maybe Text
_tags BookmarkForm
bookmarkForm)
      Bookmark
bm <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Key User -> BookmarkForm -> IO Bookmark
_toBookmark Key User
userId BookmarkForm
bookmarkForm
      UpsertResult (Key Bookmark)
res <- forall site a.
YesodPersist site =>
YesodDB site a -> HandlerFor site a
runDB (Key User
-> Maybe (Key Bookmark)
-> Bookmark
-> [Text]
-> DB (UpsertResult (Key Bookmark))
upsertBookmark Key User
userId Maybe (Key Bookmark)
mkbid Bookmark
bm [Text]
tags)
      forall mono (m :: * -> *).
(MonoFoldable mono, Applicative m) =>
mono -> (Element mono -> m ()) -> m ()
forM_ (forall a. UpsertResult a -> Maybe a
maybeUpsertResult UpsertResult (Key Bookmark)
res) forall a b. (a -> b) -> a -> b
$ \Element (Maybe (Key Bookmark))
kbid ->
        forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (User -> Key Bookmark -> Handler Bool
shouldArchiveBookmark User
user Element (Maybe (Key Bookmark))
kbid) forall a b. (a -> b) -> a -> b
$
        forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async (Key Bookmark -> String -> HandlerFor App ()
archiveBookmarkUrl Element (Maybe (Key Bookmark))
kbid (forall mono. MonoFoldable mono => mono -> [Element mono]
unpack (Bookmark -> Text
bookmarkHref Bookmark
bm)))
      forall (f :: * -> *) a. Applicative f => a -> f a
pure UpsertResult (Key Bookmark)
res

postLookupTitleR :: Handler ()
postLookupTitleR :: HandlerFor App ()
postLookupTitleR = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (m :: * -> *).
(MonadHandler m, YesodAuth (HandlerSite m)) =>
m (AuthId (HandlerSite m))
requireAuthId
  BookmarkForm
bookmarkForm <- (forall (m :: * -> *) a. (MonadHandler m, FromJSON a) => m a
requireCheckJsonBody :: Handler BookmarkForm)
  String -> Handler (Either String Text)
fetchPageTitle (forall mono. MonoFoldable mono => mono -> [Element mono]
unpack (BookmarkForm -> Text
_url BookmarkForm
bookmarkForm)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left String
_ -> forall (m :: * -> *) c a.
(MonadHandler m, ToTypedContent c) =>
Status -> c -> m a
sendResponseStatus Status
noContent204 ()
    Right Text
title -> forall (m :: * -> *) c a.
(MonadHandler m, ToTypedContent c) =>
Status -> c -> m a
sendResponseStatus Status
ok200 Text
title