68 lines
2 KiB
Haskell
68 lines
2 KiB
Haskell
|
module Handler.Add where
|
||
|
|
||
|
import Import
|
||
|
import Handler.Archive
|
||
|
import Data.List (nub)
|
||
|
|
||
|
-- View
|
||
|
|
||
|
getAddViewR :: Handler Html
|
||
|
getAddViewR = do
|
||
|
userId <- requireAuthId
|
||
|
|
||
|
murl <- lookupGetParam "url"
|
||
|
mformdb <- runDB (pure . fmap _toBookmarkForm =<< fetchBookmarkByUrl userId murl)
|
||
|
formurl <- bookmarkFormUrl
|
||
|
|
||
|
let renderEl = "addForm" :: Text
|
||
|
|
||
|
popupLayout $ do
|
||
|
toWidget [whamlet|
|
||
|
<div id="#{ renderEl }">
|
||
|
|]
|
||
|
toWidgetBody [julius|
|
||
|
app.dat.bmark = #{ toJSON (fromMaybe formurl mformdb) };
|
||
|
|]
|
||
|
toWidget [julius|
|
||
|
PS['Main'].renderAddForm('##{rawJS renderEl}')(app.dat.bmark)();
|
||
|
|]
|
||
|
|
||
|
bookmarkFormUrl :: Handler BookmarkForm
|
||
|
bookmarkFormUrl = do
|
||
|
Entity _ user <- requireAuth
|
||
|
BookmarkForm
|
||
|
<$> (lookupGetParam "url" >>= pure . fromMaybe "")
|
||
|
<*> (lookupGetParam "title")
|
||
|
<*> (lookupGetParam "description" >>= pure . fmap Textarea)
|
||
|
<*> (lookupGetParam "tags")
|
||
|
<*> (lookupGetParam "private" >>= pure . fmap parseChk <&> (<|> Just (userPrivateDefault user)))
|
||
|
<*> (lookupGetParam "toread" >>= pure . fmap parseChk)
|
||
|
<*> pure Nothing
|
||
|
<*> pure Nothing
|
||
|
<*> pure Nothing
|
||
|
<*> pure Nothing
|
||
|
<*> pure Nothing
|
||
|
where
|
||
|
parseChk s = s == "yes" || s == "on"
|
||
|
|
||
|
-- API
|
||
|
|
||
|
postAddR :: Handler ()
|
||
|
postAddR = do
|
||
|
bookmarkForm <- requireCheckJsonBody
|
||
|
_handleFormSuccess bookmarkForm >>= \case
|
||
|
(Created, bid) -> sendStatusJSON created201 bid
|
||
|
(Updated, _) -> sendResponseStatus noContent204 ()
|
||
|
|
||
|
_handleFormSuccess :: BookmarkForm -> Handler (UpsertResult, Key Bookmark)
|
||
|
_handleFormSuccess bookmarkForm = do
|
||
|
(userId, user) <- requireAuthPair
|
||
|
bm <- liftIO $ _toBookmark userId bookmarkForm
|
||
|
(res, kbid) <- runDB (upsertBookmark mkbid bm tags)
|
||
|
whenM (shouldArchiveBookmark user kbid) $
|
||
|
void $ async (archiveBookmarkUrl kbid (unpack (bookmarkHref bm)))
|
||
|
pure (res, kbid)
|
||
|
where
|
||
|
mkbid = BookmarkKey <$> _bid bookmarkForm
|
||
|
tags = maybe [] (nub . words) (_tags bookmarkForm)
|