diff options
| -rw-r--r-- | src/Blog.hs | 17 | ||||
| -rw-r--r-- | src/BlogDB.hs | 9 | ||||
| -rw-r--r-- | src/Main.hs | 15 |
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 |