refactoring comments. Why did I even have that maybe in?

This commit is contained in:
nek0 2015-09-26 11:14:49 +02:00
parent 47ba729abd
commit 3aad76bfcf
6 changed files with 26 additions and 27 deletions

View file

@ -18,7 +18,6 @@ module Handler.AdminComments where
import Import import Import
import Handler.Commons import Handler.Commons
import Data.Maybe
import Data.Time import Data.Time
-- import System.Locale -- import System.Locale

View file

@ -47,7 +47,7 @@ getMediumR mediumId = do
Nothing -> Nothing ->
return Nothing return Nothing
let presence = userId == (Just ownerId) || userId == Just (albumOwner album) let presence = userId == (Just ownerId) || userId == Just (albumOwner album)
(commentWidget, enctype) <- generateFormPost $ commentForm userId userSl mediumId Nothing (commentWidget, enctype) <- generateFormPost $ commentForm (fromJust userId) (fromJust userSl) mediumId Nothing
comments <- runDB $ selectList comments <- runDB $ selectList
[ CommentOrigin ==. mediumId [ CommentOrigin ==. mediumId
, CommentParent ==. Nothing ] , CommentParent ==. Nothing ]
@ -76,18 +76,18 @@ postMediumR mediumId = do
Just tempUserId -> do Just tempUserId -> do
let userId = getUserIdFromText tempUserId let userId = getUserIdFromText tempUserId
u <- runDB $ getJust userId u <- runDB $ getJust userId
let userSl = Just $ userSlug u let userSl = userSlug u
((res, _), _) <- runFormPost $ commentForm (Just userId) userSl mediumId Nothing ((res, _), _) <- runFormPost $ commentForm userId userSl mediumId Nothing
case res of case res of
FormSuccess temp -> do FormSuccess temp -> do
_ <- runDB $ insert temp _ <- runDB $ insert temp
--send mail to medium owner --send mail to medium owner
owner <- runDB $ getJust $ mediumOwner medium owner <- runDB $ getJust $ mediumOwner medium
link <- ($ MediumR (commentOrigin temp)) <$> getUrlRender link <- ($ MediumR (commentOrigin temp)) <$> getUrlRender
sendMail (userEmail owner) ((fromJust $ commentAuthorSlug temp) `T.append` " commented on your medium") sendMail (userEmail owner) ((commentAuthorSlug temp) `T.append` " commented on your medium")
[shamlet| [shamlet|
<h1>Hello #{userSlug owner} <h1>Hello #{userSlug owner}
<p>#{fromJust $ commentAuthorSlug temp} commented on your medium: <p>#{commentAuthorSlug temp} commented on your medium:
<p>#{commentContent temp} <p>#{commentContent temp}
<p>To follow the comment thread follow <p>To follow the comment thread follow
<a href=#{link}> <a href=#{link}>
@ -106,7 +106,7 @@ postMediumR mediumId = do
setMessage "This image does not exist" setMessage "This image does not exist"
redirect HomeR redirect HomeR
commentForm :: Maybe UserId -> Maybe Text -> MediumId -> Maybe CommentId -> Form Comment commentForm :: UserId -> Text -> MediumId -> Maybe CommentId -> Form Comment
commentForm authorId authorSlug originId parentId = renderDivs $ Comment commentForm authorId authorSlug originId parentId = renderDivs $ Comment
<$> pure authorId <$> pure authorId
<*> pure authorSlug <*> pure authorSlug
@ -125,9 +125,9 @@ getCommentReplyR commentId = do
Just tempUserId -> do Just tempUserId -> do
let userId = getUserIdFromText tempUserId let userId = getUserIdFromText tempUserId
u <- runDB $ getJust userId u <- runDB $ getJust userId
let userSl = Just $ userSlug u let userSl = userSlug u
let mediumId = commentOrigin comment let mediumId = commentOrigin comment
(replyWidget, enctype) <- generateFormPost $ commentForm (Just userId) userSl mediumId (Just commentId) (replyWidget, enctype) <- generateFormPost $ commentForm userId userSl mediumId (Just commentId)
formLayout $ do formLayout $ do
setTitle "Eidolon :: Reply to comment" setTitle "Eidolon :: Reply to comment"
$(widgetFile "commentReply") $(widgetFile "commentReply")
@ -148,20 +148,20 @@ postCommentReplyR commentId = do
Just tempUserId -> do Just tempUserId -> do
let userId = getUserIdFromText tempUserId let userId = getUserIdFromText tempUserId
u <- runDB $ getJust userId u <- runDB $ getJust userId
let userSl = Just $ userSlug u let userSl = userSlug u
let mediumId = commentOrigin comment let mediumId = commentOrigin comment
((res, _), _) <- runFormPost $ commentForm (Just userId) userSl mediumId (Just commentId) ((res, _), _) <- runFormPost $ commentForm userId userSl mediumId (Just commentId)
case res of case res of
FormSuccess temp -> do FormSuccess temp -> do
_ <- runDB $ insert temp _ <- runDB $ insert temp
--send mail to parent author --send mail to parent author
parent <- runDB $ getJust $ fromJust $ commentParent temp parent <- runDB $ getJust $ fromJust $ commentParent temp
parAuth <- runDB $ getJust $ fromJust $ commentAuthor parent parAuth <- runDB $ getJust $ commentAuthor parent
link <- ($ MediumR (commentOrigin temp)) <$> getUrlRender link <- ($ MediumR (commentOrigin temp)) <$> getUrlRender
sendMail (userEmail parAuth) ((fromJust $ commentAuthorSlug temp) `T.append` " replied to your comment") sendMail (userEmail parAuth) ((commentAuthorSlug temp) `T.append` " replied to your comment")
[shamlet| [shamlet|
<h1>Hello #{userSlug parAuth} <h1>Hello #{userSlug parAuth}
<p>#{fromJust $ commentAuthorSlug temp} replied to your comment: <p>#{commentAuthorSlug temp} replied to your comment:
#{commentContent temp} #{commentContent temp}
<p>To see the comment thread follow <p>To see the comment thread follow
<a href=#{link}> <a href=#{link}>
@ -171,10 +171,10 @@ postCommentReplyR commentId = do
--send mail to medium owner --send mail to medium owner
medium <- runDB $ getJust mediumId medium <- runDB $ getJust mediumId
owner <- runDB $ getJust $ mediumOwner medium owner <- runDB $ getJust $ mediumOwner medium
sendMail (userEmail owner) ((fromJust $ commentAuthorSlug temp) `T.append` " commented on your medium") sendMail (userEmail owner) ((commentAuthorSlug temp) `T.append` " commented on your medium")
[shamlet| [shamlet|
<h1>Hello #{userSlug owner} <h1>Hello #{userSlug owner}
<p>#{fromJust $ commentAuthorSlug temp} commented your medium with: <p>#{commentAuthorSlug temp} commented your medium with:
#{commentContent temp} #{commentContent temp}
<p>To see the comment thread follow <p>To see the comment thread follow
<a href=#{link}> <a href=#{link}>
@ -203,7 +203,7 @@ getCommentDeleteR commentId = do
Just tempUserId -> do Just tempUserId -> do
let userId = getUserIdFromText tempUserId let userId = getUserIdFromText tempUserId
if if
Just userId == commentAuthor comment Just userId == Just (commentAuthor comment)
then do then do
formLayout $ do formLayout $ do
setTitle "Eidolon :: Delete comment" setTitle "Eidolon :: Delete comment"
@ -228,7 +228,7 @@ postCommentDeleteR commentId = do
Just tempUserId -> do Just tempUserId -> do
let userId = getUserIdFromText tempUserId let userId = getUserIdFromText tempUserId
if if
Just userId == commentAuthor comment Just userId == Just (commentAuthor comment)
then do then do
confirm <- lookupPostParam "confirm" confirm <- lookupPostParam "confirm"
case confirm of case confirm of

View file

@ -55,8 +55,8 @@ Medium
album AlbumId album AlbumId
deriving Eq Show deriving Eq Show
Comment Comment
author UserId Maybe author UserId
authorSlug Text Maybe authorSlug Text
origin MediumId origin MediumId
parent CommentId Maybe parent CommentId Maybe
time UTCTime time UTCTime

View file

@ -16,7 +16,7 @@ $else
$forall (Entity commentId comment) <- comments $forall (Entity commentId comment) <- comments
$if commentOrigin comment == mediumId $if commentOrigin comment == mediumId
<article class="comment"> <article class="comment">
#{fromJust $ commentAuthorSlug comment} wrote on #{formatTime defaultTimeLocale "%A %F %H:%M" $ commentTime comment}: #{commentAuthorSlug comment} wrote on #{formatTime defaultTimeLocale "%A %F %H:%M" $ commentTime comment}:
<hr> <hr>
#{commentContent comment} #{commentContent comment}
<a href=@{AdminCommentDeleteR commentId}>Delete this comment <a href=@{AdminCommentDeleteR commentId}>Delete this comment
@ -24,7 +24,7 @@ $else
$if commentParent reply == Just commentId $if commentParent reply == Just commentId
$if commentOrigin reply == mediumId $if commentOrigin reply == mediumId
<article class="comment reply"> <article class="comment reply">
#{fromJust $ commentAuthorSlug comment} wrote on #{formatTime defaultTimeLocale "%A %F %H:%M" $ commentTime comment}: #{commentAuthorSlug comment} wrote on #{formatTime defaultTimeLocale "%A %F %H:%M" $ commentTime comment}:
<hr> <hr>
#{commentContent reply} #{commentContent reply}
<a href=@{AdminCommentDeleteR replyId}>Delete this comment <a href=@{AdminCommentDeleteR replyId}>Delete this comment

View file

@ -1,7 +1,7 @@
<div id="header" class="item" data-width="600"> <div id="header" class="item" data-width="600">
<div class="inner"> <div class="inner">
<h4>Reply to comment <h4>Reply to comment
<strong>#{fromJust $ commentAuthorSlug comment}</strong> posted on #{formatTime defaultTimeLocale "%A %F %H:%M" (commentTime comment)}: <strong>#{commentAuthorSlug comment}</strong> posted on #{formatTime defaultTimeLocale "%A %F %H:%M" (commentTime comment)}:
<hr> <hr>
<p>#{commentContent comment} <p>#{commentContent comment}
<hr> <hr>

View file

@ -38,22 +38,22 @@
$forall (Entity commentId comment) <- comments $forall (Entity commentId comment) <- comments
<article class="comment" data-width="300"> <article class="comment" data-width="300">
<a href=@{ProfileR $ fromJust $ commentAuthor comment}>#{fromJust $ commentAuthorSlug comment}</a> wrote on #{formatTime defaultTimeLocale "%A %F %H:%M" $ commentTime comment}: <a href=@{ProfileR $ commentAuthor comment}>#{commentAuthorSlug comment}</a> wrote on #{formatTime defaultTimeLocale "%A %F %H:%M" $ commentTime comment}:
<hr> <hr>
#{commentContent comment} #{commentContent comment}
$if userId /= Nothing $if userId /= Nothing
<hr> <hr>
<a href=@{CommentReplyR commentId}>Reply to this comment <a href=@{CommentReplyR commentId}>Reply to this comment
$if userId == (commentAuthor comment) $if userId == (Just $ commentAuthor comment)
<a href=@{CommentDeleteR commentId}>Delete this comment <a href=@{CommentDeleteR commentId}>Delete this comment
$forall (Entity replyId reply) <- replies $forall (Entity replyId reply) <- replies
$if commentParent reply == Just commentId $if commentParent reply == Just commentId
<article class="comment reply"> <article class="comment reply">
<a href=@{ProfileR $ fromJust $ commentAuthor reply}>#{fromJust $ commentAuthorSlug reply}</a> replied on #{formatTime defaultTimeLocale "%A %F %H:%M" $ commentTime reply}: <a href=@{ProfileR $ commentAuthor reply}>#{commentAuthorSlug reply}</a> replied on #{formatTime defaultTimeLocale "%A %F %H:%M" $ commentTime reply}:
<hr> <hr>
#{commentContent reply} #{commentContent reply}
<hr> <hr>
$if userId == (commentAuthor comment) $if userId == (Just $ commentAuthor comment)
<a href=@{CommentDeleteR replyId}>Delete this comment <a href=@{CommentDeleteR replyId}>Delete this comment
$if userId /= Nothing $if userId /= Nothing