module Yesod.Comments
( addComments
, addCommentsAuth
, module Yesod.Comments.Core
) where
import Yesod
import Yesod.Comments.Core
import Yesod.Comments.Filters (applyFilters)
import Yesod.Helpers.Auth
addComments :: YesodComments m
=> ThreadId
-> GWidget s m ()
addComments tid = do
comments <- lift $ loadComments (Just tid)
cid <- lift $ getNextCommentId comments
((res, form), enctype) <- lift $ runFormMonadPost commentForm
handleForm res tid cid
addStyling
[hamlet|
<div .yesod_comments>
<h4>Add a comment:
<div .yesod_comment_input>
<form enctype="#{enctype}" method="post">^{form}
<p .helptext>Comments are parsed as pandocstyle markdown
$if not $ null comments
<h4>Showing #{toHtml $ helper $ length comments}:
$forall comment <- comments
<div .yesod_comment>^{showComment comment}
|]
addCommentsAuth :: (YesodAuth m, YesodComments m)
=> ThreadId
-> GWidget s m ()
addCommentsAuth tid = do
(isAuthenticated, uid, username, email) <- lift $ do
muid <- maybeAuthId
case muid of
Nothing -> return (False, "", "", "")
Just uid -> do
uname <- displayUser uid
email <- displayEmail uid
return (True, toSinglePiece uid, uname, email)
comments <- lift $ loadComments (Just tid)
cid <- lift $ getNextCommentId comments
((res, form), enctype) <- lift $ runFormMonadPost $ commentFormAuth uid username email
handleForm res tid cid
addStyling
[hamlet|
<div .yesod_comments>
$if isAuthenticated
<h4>Add a comment:
<div .yesod_comment_input>
<form enctype="#{enctype}" method="post">^{form}
<p .helptext>Comments are parsed as pandocstyle markdown
$else
<h4>Please ^{login} to post a comment.
$if not $ null comments
<h4>Showing #{toHtml $ helper $ length comments}:
$forall comment <- comments
<div .yesod_comment>^{showCommentAuth comment}
|]
addStyling :: Yesod m => GWidget s m ()
addStyling = addCassius [cassius|
.yesod_comment_input th
textalign: left
verticalalign: top
.yesod_comment_input textarea
height: 10ex
width: 50ex
.yesod_comment_avatar_input, .yesod_comment_avatar_list
float: left
.yesod_comment_avatar_input
marginright: 5px
.yesod_comment_avatar_list
marginright: 3px
|]
handleForm :: YesodComments m
=> FormResult CommentForm
-> ThreadId
-> CommentId
-> GWidget s m ()
handleForm res tid cid = case res of
FormMissing -> return ()
FormFailure _ -> return ()
FormSuccess cf -> lift $ do
comment <- commentFromForm tid cid cf
matches <- applyFilters commentFilters comment
if matches
then setMessage "comment dropped. matched filters."
else do
storeComment comment
setMessage "comment added."
redirectCurrentRoute
where
redirectCurrentRoute :: Yesod m => GHandler s m ()
redirectCurrentRoute = do
tm <- getRouteToMaster
mr <- getCurrentRoute
case mr of
Just r -> redirect RedirectTemporary $ tm r
Nothing -> notFound
helper :: Int -> String
helper 0 = "no comments"
helper 1 = "1 comment"
helper n = show n ++ " comments"
login :: Yesod m => GWidget s m ()
login = do
lift $ setUltDest'
mroute <- lift $ fmap authRoute getYesod
case mroute of
Just r -> [hamlet|<a href="@{r}">log in|]
Nothing -> [hamlet|log in|]