Merge branch 'master' of git+ssh://github/yogsototh/inmanis

* 'master' of git+ssh://github/yogsototh/inmanis:
  added the ability to delete comments
  Added delete without logic

Handler/Comment.hs

@@ -1,6 +1,7 @@
 module Handler.Comment (
   getCommentR
 , postCommentR
+, deleteCommentR
 , putCommentR
 , getCommentVoteR
 , postCommentVoteR
@@ -13,6 +14,28 @@ import Data.Text (pack)
 getCommentR :: CommentId -> Handler RepHtml
 getCommentR _ = error "Not yet implemented: getCommentR"
 
+isCommentCreator commentId f =
+  testLogged $ \userId -> do
+    maybeComment <- runDB $ get commentId
+    case maybeComment of
+      Nothing -> errorPageJson "The comment doesn't exists"
+      Just comment ->
+            case commentCreator comment of
+              Nothing -> errorPageJson "You are not the creator of this comment"
+              Just creatorOfComment -> do
+                case creatorOfComment == userId of
+                    False -> errorPageJson "You are not the creator of this comment"
+                    True -> f userId comment
+
+deleteCommentR :: CommentId -> Handler RepHtmlJson
+deleteCommentR commentId = isCommentCreator commentId $ \userId comment -> do
+  _ <- runDB $ update commentId [CommentCreator =. Nothing,
+                                 CommentContent =. deletedTextarea]
+  redirect $ EntryR (commentEntry comment)
+  where
+    deletedTextarea = Textarea { unTextarea = "deleted" }
+
+
 -- |The comment data needed for creating a comment
 data CommentRequest = CommentRequest { textComment   :: Textarea }
 
@@ -27,15 +50,18 @@ postCommentR commentId = do
     case maybeComment of
       Nothing -> errorPageJson "The comment doesn't exists"
       Just comment ->
-            case commentCreator comment == userId of
-              False -> errorPageJson "You are not the creator of this comment"
-              True -> do
-                ((res,_),_) <- runFormPost commentForm
-                case res of
-                  FormSuccess commentRequest -> do
-                    _ <- runDB $ update commentId [CommentContent =. textComment commentRequest]
-                    redirect $ EntryR (commentEntry comment)
-                  _ -> errorPageJson "Please correct your comment form"
+            case commentCreator comment of
+              Nothing -> errorPageJson "You are not the creator of this comment"
+              Just creatorOfComment -> do
+                case creatorOfComment == userId of
+                  False -> errorPageJson "You are not the creator of this comment"
+                  True -> do
+                    ((res,_),_) <- runFormPost commentForm
+                    case res of
+                      FormSuccess commentRequest -> do
+                        _ <- runDB $ update commentId [CommentContent =. textComment commentRequest]
+                        redirect $ EntryR (commentEntry comment)
+                      _ -> errorPageJson "Please correct your comment form"
 
 putCommentR :: CommentId -> Handler RepHtml
 putCommentR _ = error "Not yet implemented: putCommentR"

Handler/Entry.hs

@@ -31,7 +31,7 @@ postCommentsR entryId =
       case res of
         FormSuccess commentRequest -> do
           time <- liftIO getCurrentTime
-          let newComment = Comment entryId userId Nothing time (textComment commentRequest) 1 0 1
+          let newComment = Comment entryId (Just userId) Nothing time (textComment commentRequest) 1 0 1
           commentId <- runDB $ insert newComment
           _ <- runDB $ insert $ VoteComment userId commentId 1
           redirect $ EntryR entryId
@@ -88,6 +88,13 @@ showCommentTree tree creators widget enctype voteComments=
       <div .actions>
         <span .edit flipshow="#edit#{showId commentId}">edit
         \ - #
+        <span class="delete action" flipshow="#destroyComment#{showId commentId}">
+          delete
+        <span #destroyComment#{showId commentId} .action .hide>
+          /
+          <span .destroy .action .red url="@{CommentR commentId}">
+              destroy
+        \ - #
         <span .reply flipshow="##{showId commentId}">reply
       <div .hide #edit#{showId commentId}>
         <form method=post action=@{CommentR commentId} enctype=#{enctype}>
@@ -110,7 +117,7 @@ creatorOfEntity :: CommentId -> [(CommentId,[Entity User])] -> Text
 creatorOfEntity entityId creators =
   maybe "Anonymous Coward" entUserIdent (lookup entityId creators)
     where
-      entUserIdent [] = "No name"
+      entUserIdent [] = "Anonymous Coward"
       entUserIdent ((Entity _ creator):_) = userIdent creator
 
 -- |The `EntryRequest` correspond to the data needed
@@ -158,7 +165,9 @@ getEntryR entryId = do
       maybeCreator <- get (entryCreator entry)
       creators <- do
             let getUserCreatorIdent (Entity commentId comment) = do
-                  creators <- selectList [UserId ==. commentCreator comment][LimitTo 1]
+                  creators <- case commentCreator comment of
+                                Nothing -> return []
+                                Just creator -> selectList [UserId ==. creator][LimitTo 1]
                   return (commentId, creators)
             mapM getUserCreatorIdent comments
       return (entry, comments, maybeCreator,creators)
@@ -317,7 +326,7 @@ postReplyCommentR entryId commentId =
     case res of
       FormSuccess commentRequest -> do
         time <- liftIO getCurrentTime
-        let newComment = Comment entryId userId (Just commentId) time (textComment commentRequest) 1 0 1
+        let newComment = Comment entryId (Just userId) (Just commentId) time (textComment commentRequest) 1 0 1
         commentId <- runDB $ insert newComment
         voteId <- runDB $ insert $ VoteComment userId commentId 1
         redirect $ EntryR entryId

config/models

@@ -32,7 +32,7 @@ VoteComment
     deriving Show
 Comment
     entry   EntryId
-    creator UserId
+    creator UserId Maybe
     replyTo CommentId Maybe
     created UTCTime default=CURRENT_TIME
     content Textarea

config/routes

@@ -9,6 +9,6 @@
 /entry/#EntryId                             EntryR          GET POST DELETE
 
 /entry/#EntryId/comment                     CommentsR           POST
-/comment/#CommentId                         CommentR        GET POST
+/comment/#CommentId                         CommentR        GET POST DELETE
 /entry/#EntryId/comment/#CommentId/reply    ReplyCommentR       POST
 /comment/#CommentId/vote                    CommentVoteR    GET POST