* comment deletion (this doesn't look nice, but nobody except for me sees the admin page so I DON'T CARE :D)

3 files changed, 39 insertions, 2 deletions

diff --git a/src/Blog.hs b/src/Blog.hs
index 2d3fe305bf85..a63d0039eb4c 100644
--- a/src/Blog.hs
+++ b/src/Blog.hs
@@ -266,9 +266,26 @@ editPage (Entry{..}) = adminTemplate "Index" $
                   H.td $ H.textarea ! A.name "mtext" ! A.cols "100" ! A.rows "15" $ toHtml mtext
       H.input ! A.type_ "hidden" ! A.name "eid" ! A.value (toValue $ unEntryId entryId)
       H.input ! A.style "margin-left: 20px" ! A.type_ "submit" ! A.value "Absenden"
+      H.div ! A.class_ "editComments" $ editComments comments entryId
       H.p $ do preEscapedText "<a href=/>Startseite</a> -- Entrylist: <a href=/admin/entrylist/de>DE</a>"
                preEscapedText " & <a href=/admin/entrylist/en>EN</a> -- <a href=#>Backup</a> (NYI)"
 
+editComments :: [Comment] -> EntryId -> Html
+editComments clist eId = H.table $ mapM_ editComment clist
+    where
+        editComment (Comment{..}) = H.tr $ do H.td $ toHtml cauthor
+                                              H.td $ toHtml $ formatTime defaultTimeLocale "%c" cdate
+                                              H.td $ cDeleteLink cdate
+        cDeleteLink cdate = H.a ! A.href (toValue $ "/admin/cdelete/" ++ show eId 
+                                         ++ formatTime defaultTimeLocale "/%s%Q" cdate) $ "Löschen"
+
+commentDeleted :: EntryId -> Html
+commentDeleted eId = adminTemplate "Kommentar gelöscht" $ do
+    H.div $ "Der Kommentar wurde gelöscht."
+    H.br
+    H.a ! A.href (toValue $ "/de/" ++ show eId) $ "Eintrag ansehen | "
+    H.a ! A.href (toValue $ "/admin/edit/" ++ show eId) $ "Eintrag bearbeiten"
+
 -- Error pages
 showError :: BlogError -> BlogLang -> Html
 showError NotFound l = blogTemplate l (T.append ": " $ notFoundTitle l) $ do
diff --git a/src/BlogDB.hs b/src/BlogDB.hs
index ea574c70842b..611a08914a09 100644
--- a/src/BlogDB.hs
+++ b/src/BlogDB.hs
@@ -150,6 +150,14 @@ addComment eId c =
 	   put $ b { blogEntries = IxSet.updateIx eId newEntry blogEntries }
 	   return newEntry
 
+deleteComment :: EntryId -> UTCTime -> Update Blog Entry
+deleteComment eId cDate =
+   do b@Blog{..} <- get
+      let (Just e) = getOne $ blogEntries @= eId
+      let newEntry = e {comments = filter (\c -> cdate c /= cDate) (comments e)}
+      put $ b { blogEntries = IxSet.updateIx eId newEntry blogEntries }
+      return newEntry
+
 updateEntry :: Entry -> Update Blog Entry
 updateEntry e = 
     do b@Blog{..} <- get
@@ -210,6 +218,7 @@ hashString = B64.encode .  SHA.hash . B.pack
 $(makeAcidic ''Blog
     [ 'insertEntry
     , 'addComment
+    , 'deleteComment
     , 'updateEntry
     , 'getEntry
     , 'latestEntries
diff --git a/src/Main.hs b/src/Main.hs
index 203d0af0af85..656c9cfca7ef 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -17,6 +17,7 @@ import           Data.Acid.Local
 import qualified Data.ByteString.Base64 as B64 (encode)
 import           Data.ByteString.Char8 (ByteString, pack, unpack)
 import           Data.Data (Data, Typeable)
+import           Data.Maybe (fromJust)
 import           Data.Monoid (mempty)
 import           Data.Text (Text)
 import qualified Data.Text as T
@@ -29,7 +30,7 @@ import           Options
 import           System.Locale (defaultTimeLocale)
 
 import           Blog
-import           BlogDB hiding (addComment, updateEntry)
+import           BlogDB hiding (addComment, updateEntry, deleteComment)
 import           Locales
 import           RSS
 
@@ -77,7 +78,11 @@ tazBlog acid captchakey = do
               entryList acid EN
          , do guardSession acid
               dirs "admin/edit" $ path $ \(eId :: Integer) -> editEntry acid eId
-         , dirs "admin/updateentry" $ nullDir >> updateEntry acid
+         , do guardSession acid
+              dirs "admin/updateentry" $ nullDir >> updateEntry acid
+         , do guardSession acid
+              dirs "admin/cdelete" $ path $ \(eId :: Integer) -> path $ \(cId :: String) ->
+                deleteComment acid (EntryId eId) cId
          , do dir "admin" $ nullDir
               guardSession acid
               ok $ toResponse $ adminIndex ("tazjin" :: Text)
@@ -223,6 +228,12 @@ updateEntry acid = do
     seeOther (concat $ intersperse' "/" [show $ lang entry, show eId])
              (toResponse ())
 
+deleteComment :: AcidState Blog -> EntryId -> String -> ServerPart Response
+deleteComment acid eId cId = do
+    nEntry <- update' acid (DeleteComment eId cDate)
+    ok $ toResponse $ commentDeleted eId
+  where
+    (cDate :: UTCTime) = fromJust $ parseTime defaultTimeLocale "%s%Q" cId
 
 guardSession :: AcidState Blog -> ServerPartT IO ()
 guardSession acid = do