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 <- HandlerFor App (Key User)
HandlerFor App (AuthId (HandlerSite (HandlerFor App)))
forall (m :: * -> *).
(MonadHandler m, YesodAuth (HandlerSite m)) =>
m (AuthId (HandlerSite m))
requireAuthId

  Maybe Text
murl <- Text -> HandlerFor App (Maybe Text)
forall (m :: * -> *). MonadHandler m => Text -> m (Maybe Text)
lookupGetParam Text
"url"
  Maybe (Entity Bookmark, [Entity BookmarkTag])
mBookmarkDb <- YesodDB App (Maybe (Entity Bookmark, [Entity BookmarkTag]))
-> HandlerFor App (Maybe (Entity Bookmark, [Entity BookmarkTag]))
forall a. YesodDB App a -> HandlerFor App a
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 = ((Entity Bookmark, [Entity BookmarkTag]) -> BookmarkForm)
-> Maybe (Entity Bookmark, [Entity BookmarkTag])
-> Maybe BookmarkForm
forall a b. (a -> b) -> Maybe a -> Maybe b
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
    WidgetFor App () -> WidgetFor App ()
forall site a (m :: * -> *).
(ToWidget site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
forall (m :: * -> *).
(MonadWidget m, HandlerSite m ~ App) =>
WidgetFor App () -> m ()
toWidget WidgetFor App ()
[whamlet|
      <div id="#{ renderEl }">
    |]
    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.dat.bmark = #{ toJSON (fromMaybe formurl mformdb) }; 
    |]
    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.renderAddForm('##{rawJS renderEl}')(app.dat.bmark)();
    |]

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

-- API

postAddR :: Handler Text
postAddR :: HandlerFor App Text
postAddR = do
  BookmarkForm
bookmarkForm <- Handler BookmarkForm
forall (m :: * -> *) a. (MonadHandler m, FromJSON a) => m a
requireCheckJsonBody
  BookmarkForm -> Handler (UpsertResult (Key Bookmark))
_handleFormSuccess BookmarkForm
bookmarkForm Handler (UpsertResult (Key Bookmark))
-> (UpsertResult (Key Bookmark) -> HandlerFor App Text)
-> HandlerFor App 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 Bookmark
bid -> Status -> Key Bookmark -> HandlerFor App Text
forall (m :: * -> *) c a.
(MonadHandler m, ToJSON c) =>
Status -> c -> m a
sendStatusJSON Status
created201 Key Bookmark
bid
    Updated Key Bookmark
_ -> Status -> () -> HandlerFor App Text
forall (m :: * -> *) c a.
(MonadHandler m, ToTypedContent c) =>
Status -> c -> m a
sendResponseStatus Status
noContent204 ()
    Failed String
s -> Status -> String -> HandlerFor App Text
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) <- HandlerFor App (Key User, User)
HandlerFor App (AuthId App, AuthEntity App)
forall master (m :: * -> *).
(YesodAuthPersist master, Typeable (AuthEntity master),
 MonadHandler m, HandlerSite m ~ master) =>
m (AuthId master, AuthEntity master)
requireAuthPair
  AppSettings
appSettings <- App -> AppSettings
appSettings (App -> AppSettings)
-> HandlerFor App App -> HandlerFor App AppSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HandlerFor App (HandlerSite (HandlerFor App))
HandlerFor App App
forall (m :: * -> *). MonadHandler m => m (HandlerSite m)
getYesod
  case (AppSettings -> Bool
appAllowNonHttpUrlSchemes AppSettings
appSettings, (String -> Maybe Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest (String -> Maybe Request)
-> (BookmarkForm -> String) -> BookmarkForm -> Maybe Request
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
. Text -> String
Text -> [Element Text]
forall mono. MonoFoldable mono => mono -> [Element mono]
unpack (Text -> String)
-> (BookmarkForm -> Text) -> BookmarkForm -> String
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
. BookmarkForm -> Text
_url) BookmarkForm
bookmarkForm) of
    (Bool
False, Maybe Request
Nothing) -> UpsertResult (Key Bookmark)
-> Handler (UpsertResult (Key Bookmark))
forall a. a -> HandlerFor App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UpsertResult (Key Bookmark)
 -> Handler (UpsertResult (Key Bookmark)))
-> UpsertResult (Key Bookmark)
-> Handler (UpsertResult (Key Bookmark))
forall a b. (a -> b) -> a -> b
$ String -> UpsertResult (Key Bookmark)
forall a. String -> UpsertResult a
Failed String
"Invalid URL"
    (Bool
_, Maybe Request
_) -> do
      let mkbid :: Maybe (Key Bookmark)
mkbid = Int64 -> Key Bookmark
forall record.
ToBackendKey SqlBackend record =>
Int64 -> Key record
toSqlKey (Int64 -> Key Bookmark) -> Maybe Int64 -> Maybe (Key Bookmark)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BookmarkForm -> Maybe Int64
_bid BookmarkForm
bookmarkForm
          tags :: [Text]
tags = [Text] -> (Text -> [Text]) -> Maybe Text -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ([Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
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
. Text -> [Text]
forall t. Textual t => t -> [t]
words (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
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
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"," Text
" ") (BookmarkForm -> Maybe Text
_tags BookmarkForm
bookmarkForm)
      Bookmark
bm <- IO Bookmark -> HandlerFor App Bookmark
forall a. IO a -> HandlerFor App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bookmark -> HandlerFor App Bookmark)
-> IO Bookmark -> HandlerFor App Bookmark
forall a b. (a -> b) -> a -> b
$ Key User -> BookmarkForm -> IO Bookmark
_toBookmark Key User
userId BookmarkForm
bookmarkForm
      UpsertResult (Key Bookmark)
res <- YesodDB App (UpsertResult (Key Bookmark))
-> Handler (UpsertResult (Key Bookmark))
forall a. YesodDB App a -> HandlerFor App a
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)
      Maybe (Key Bookmark)
-> (Element (Maybe (Key Bookmark)) -> HandlerFor App ())
-> HandlerFor App ()
forall mono (m :: * -> *).
(MonoFoldable mono, Applicative m) =>
mono -> (Element mono -> m ()) -> m ()
forM_ (UpsertResult (Key Bookmark) -> Maybe (Key Bookmark)
forall a. UpsertResult a -> Maybe a
maybeUpsertResult UpsertResult (Key Bookmark)
res) ((Element (Maybe (Key Bookmark)) -> HandlerFor App ())
 -> HandlerFor App ())
-> (Element (Maybe (Key Bookmark)) -> HandlerFor App ())
-> HandlerFor App ()
forall a b. (a -> b) -> a -> b
$ \Element (Maybe (Key Bookmark))
kbid ->
        HandlerFor App Bool -> HandlerFor App () -> HandlerFor App ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (User -> Key Bookmark -> HandlerFor App Bool
shouldArchiveBookmark User
user Element (Maybe (Key Bookmark))
Key Bookmark
kbid) (HandlerFor App () -> HandlerFor App ())
-> HandlerFor App () -> HandlerFor App ()
forall a b. (a -> b) -> a -> b
$
        HandlerFor App (Async ()) -> HandlerFor App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (HandlerFor App (Async ()) -> HandlerFor App ())
-> HandlerFor App (Async ()) -> HandlerFor App ()
forall a b. (a -> b) -> a -> b
$ HandlerFor App () -> HandlerFor App (Async ())
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async (Key Bookmark -> String -> HandlerFor App ()
archiveBookmarkUrl Element (Maybe (Key Bookmark))
Key Bookmark
kbid (Text -> [Element Text]
forall mono. MonoFoldable mono => mono -> [Element mono]
unpack (Bookmark -> Text
bookmarkHref Bookmark
bm)))
      UpsertResult (Key Bookmark)
-> Handler (UpsertResult (Key Bookmark))
forall a. a -> HandlerFor App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UpsertResult (Key Bookmark)
res

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