now possible to comment on media. COmment deletion is WIP

This commit is contained in:
nek0 2014-12-07 03:54:02 +01:00
parent d14c2113f2
commit 71dc85f94b
7 changed files with 154 additions and 5 deletions

View file

@ -2,8 +2,10 @@ module Handler.Medium where
import Import
import Data.Time
import Data.Maybe
import qualified Data.Text as T
import System.Locale
import Yesod.Markdown
getMediumR :: MediumId -> Handler Html
getMediumR mediumId = do
@ -16,15 +18,117 @@ getMediumR mediumId = do
albumId <- return $ mediumAlbum medium
album <- runDB $ getJust albumId
msu <- lookupSession "userId"
presence <- case msu of
userId <- case msu of
Just tempUserId -> do
userId <- return $ getUserIdFromText tempUserId
return (userId == ownerId)
return $ Just $ getUserIdFromText tempUserId
Nothing ->
return False
return Nothing
userSlug <- case userId of
Just uId -> do
u <- runDB $ getJust uId
return $ Just $ userSlug u
Nothing ->
return Nothing
presence <- return $ (userId == (Just ownerId) || userId == Just (albumOwner album))
(commentWidget, enctype) <- generateFormPost $ commentForm userId userSlug mediumId Nothing
comments <- runDB $ selectList [CommentOrigin ==. mediumId, CommentParent ==. Nothing] [Desc CommentTime]
replies <- runDB $ selectList [CommentOrigin ==. mediumId, CommentParent !=. Nothing] [Desc CommentTime]
defaultLayout $ do
setTitle $ toHtml ("Eidolon :: Medium " `T.append` (mediumTitle medium))
$(widgetFile "medium")
Nothing -> do
setMessage "This image does not exist"
redirect $ HomeR
postMediumR :: MediumId -> Handler Html
postMediumR mediumId = do
tempMedium <- runDB $ get mediumId
case tempMedium of
Just medium -> do
msu <- lookupSession "userId"
case msu of
Just tempUserId -> do
userId <- return $ Just $ getUserIdFromText tempUserId
u <- runDB $ getJust $ fromJust userId
userSl <- return $ Just $ userSlug u
((res, commentiwdget), enctype) <- runFormPost $ commentForm userId userSl mediumId Nothing
case res of
FormSuccess temp -> do
cId <- runDB $ insert temp
setMessage "Your Comment has been posted"
redirect $ MediumR mediumId
_ -> do
setMessage "There has been an error whith your comment"
redirect $ MediumR mediumId
Nothing -> do
setMessage "You need to be looged in to comment on media"
redirect LoginR
Nothing -> do
setMessage "This image does not exist"
redirect $ HomeR
commentForm :: Maybe UserId -> Maybe Text -> MediumId -> Maybe CommentId -> Form Comment
commentForm authorId authorSlug originId parentId = renderDivs $ Comment
<$> pure authorId
<*> pure authorSlug
<*> pure originId
<*> pure parentId
<*> lift (liftIO getCurrentTime)
<*> areq markdownField "Comment this medium" Nothing
getCommentReplyR :: CommentId -> Handler Html
getCommentReplyR commentId = do
tempComment <- runDB $ get commentId
case tempComment of
Just comment -> do
msu <- lookupSession "userId"
case msu of
Just tempUserId -> do
userId <- return $ Just $ getUserIdFromText tempUserId
u <- runDB $ getJust $ fromJust userId
userSl <- return $ Just $ userSlug u
mediumId <- return $ commentOrigin comment
(replyWidget, enctype) <- generateFormPost $ commentForm userId userSl mediumId (Just commentId)
defaultLayout $ do
setTitle "Eidolon :: Reply to comment"
$(widgetFile "commentReply")
Nothing -> do
setMessage "You need to be logged in to comment on media"
redirect $ LoginR
Nothing -> do
setMessage "This comment does not Exist"
redirect $ HomeR
postCommentReplyR :: CommentId -> Handler Html
postCommentReplyR commentId = do
tempComment <- runDB $ get commentId
case tempComment of
Just comment -> do
msu <- lookupSession "userId"
case msu of
Just tempUserId -> do
userId <- return $ Just $ getUserIdFromText tempUserId
u <- runDB $ getJust $ fromJust userId
userSl <- return $ Just $ userSlug u
mediumId <- return $ commentOrigin comment
((res, commentWidget), enctype) <- runFormPost $ commentForm userId userSl mediumId (Just commentId)
case res of
FormSuccess temp -> do
cId <- runDB $ insert temp
setMessage "Your reply has been posted"
redirect $ MediumR mediumId
_ -> do
setMessage "There has been an error with your reply"
redirect $ CommentReplyR commentId
Nothing -> do
setMessage "You need to be logged in to post replies"
redirect $ LoginR
Nothing -> do
setMessage "This comment does not exist!"
redirect $ HomeR
getCommentDeleteR :: CommentId -> Handler Html
getCommentDeleteR commentId = error "Not yet implemented"
postCommentDeleteR :: CommentId -> Handler Html
postCommentDeleteR commentId = error "Not yet implemented"

View file

@ -1,6 +1,7 @@
module Model where
import Yesod
import Yesod.Markdown (Markdown)
import Data.Text (Text)
import Database.Persist.Quasi
import Database.Persist

View file

@ -33,5 +33,13 @@ Medium
tags Texts
album AlbumId
deriving Eq Show
Comment
author UserId Maybe
authorSlug Text Maybe
origin MediumId
parent CommentId Maybe
time UTCTime
content Markdown
deriving Show
-- By default this file is used in Model.hs (which is imported by Foundation.hs)

View file

@ -13,12 +13,14 @@
/upload UploadR GET POST
/newalbum NewAlbumR GET POST
/album/#AlbumId AlbumR GET
/medium/#MediumId MediumR GET
/medium/#MediumId MediumR GET POST
/album/#AlbumId/upload DirectUploadR GET POST
/album/#AlbumId/settings AlbumSettingsR GET POST
/album/#AlbumId/delete AlbumDeleteR GET POST
/medium/#MediumId/settings MediumSettingsR GET POST
/medium/#MediumId/delete MediumDeleteR GET POST
/comment/#CommentId/reply CommentReplyR GET POST
/comment/#CommentId/delcom CommentDeleteR GET POST
/reactivate ReactivateR GET POST
/profile/#UserId/settings ProfileSettingsR GET POST
/profile/#UserId/delete ProfileDeleteR GET POST

View file

@ -101,6 +101,7 @@ library
, crypto-api
, imagemagick
, resourcet
, yesod-markdown >= 0.8
executable eidolon
if flag(library-only)

View file

@ -0,0 +1,9 @@
<h4>Reply to comment
<strong>#{fromJust $ commentAuthorSlug comment}</strong> posted on #{formatTime defaultTimeLocale "%A %F %H:%M" (commentTime comment)}:
<hr>
<p>#{markdownToHtml $ commentContent comment}
<hr>
<form method=post enctype=#{enctype}>
^{replyWidget}
<div>
<input type=submit value="Post reply">

View file

@ -24,3 +24,27 @@ by <a href=@{UserR ownerName}>#{ownerName}</a> from album <a href=@{AlbumR album
<a href=@{TagR tag}>#{tag}
$if presence == True
<a href=@{MediumSettingsR mediumId}>Change medium settings
$if null comments
<p>There are no Comments yet
$else
$forall (Entity commentId comment) <- comments
<pre>
<a href=@{ProfileR $ fromJust $ commentAuthor comment}>#{fromJust $ commentAuthorSlug comment}</a> wrote on #{formatTime defaultTimeLocale "%A %F %H:%M" $ commentTime comment}:
<hr>
#{commentContent comment}
$if userId /= Nothing
<hr>
<a href=@{CommentReplyR commentId}>Reply to this comment
$forall (Entity replyId reply) <- replies
$if commentParent reply == Just commentId
<pre class="reply">
<a href=@{ProfileR $ fromJust $ commentAuthor reply}>#{fromJust $ commentAuthorSlug reply}</a> wrote on #{formatTime defaultTimeLocale "%A %F %H:%M" $ commentTime reply}:
<hr>
#{commentContent reply}
$if userId /= Nothing
<form method=post enctype=#{enctype}>
^{commentWidget}
<div>
<input type=submit value="Post comment">