module Handler.Add where
import Import
import Handler.Archive
import Data.List (nub)
import qualified Data.Text as T (replace)
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"
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