Refactor: Remove leftover comment functionality

res/blog.lucius

@@ -72,10 +72,6 @@ article a, .entry a {
 	padding-bottom: 20px;
 }
 
-.innerBoxComments {
-	padding-top: 20px;
-}
-
 .cCaptcha {
 	padding: 5px;
 	border: 1px solid #555;
@@ -109,10 +105,6 @@ article a, .entry a {
 	padding-right: 20px;
 }
 
-.commentname {
-	text-align: right;
-}
-
 .notFoundFace {
 	height: 100px;
 	padding-top: 50px;

src/Blog.hs

@@ -285,32 +285,9 @@ editPage (Entry{..}) = adminTemplate "Index" $ [shamlet|
      <textarea name="mtext" cols="100" rows="15">#{mtext}
   <input type="hidden" name="eid" value=#{unEntryId entryId}>
   <input type="submit" style="margin-left:20px;" value="Absenden">
-  <div class="editComments">#{editComments comments entryId}
   <p>^{adminFooter}
 |]
 
-editComments :: [Comment] -> EntryId -> Html
-editComments comments eId = [shamlet|
-<table>
- $forall c <- comments
-  <tr>
-   <td>#{cauthor c}
-   <td>#{cPostTime $ cdate c}
-  <tr>
-   <td><a href=#{cDeleteLink $ cdate c}>Löschen
-|]
- where
-  cPostTime = formatTime defaultTimeLocale "%c"
-  cDeleteLink cd = concat ["/admin/cdelete/", show eId, formatTime defaultTimeLocale "/%s%Q" cd]
-
-commentDeleted :: EntryId -> Html
-commentDeleted eId = adminTemplate "Kommentar gelöscht" $ [shamlet|
-<div>Der Kommentar wurde gelöscht.
-<br>
-<a href=#{append "/de/" $ show' eId}>Eintrag ansehen | #
-<a href=#{append "/admin/edit/" $ show' eId}>Eintrag bearbeiten
-|]
-
 showError :: BlogError -> BlogLang -> Html
 showError NotFound l = blogTemplate l (T.append ": " $ notFoundTitle l) $ [shamlet|
 <div .row .text-center>

src/BlogDB.hs

@@ -6,7 +6,6 @@ import           Data.Acid
 import           Data.Acid.Advanced
 import           Data.Acid.Local
 import           Data.ByteString        (ByteString)
-import           Data.Char              (toLower)
 import           Data.Data              (Data, Typeable)
 import           Data.IxSet             (Indexable (..), IxSet (..), Proxy (..),
                                          getOne, ixFun, ixSet, (@=))
@@ -41,14 +40,6 @@ instance Show BlogLang where
 
 $(deriveSafeCopy 0 'base ''BlogLang)
 
-data Comment = Comment {
-    cdate   :: UTCTime,
-    cauthor :: Text,
-    ctext   :: Text
-} deriving (Eq, Ord, Show, Data, Typeable)
-
-$(deriveSafeCopy 0 'base ''Comment)
-
 data Entry = Entry {
     entryId  :: EntryId,
     lang     :: BlogLang,
@@ -57,8 +48,7 @@ data Entry = Entry {
     btext    :: Text,
     mtext    :: Text,
     edate    :: UTCTime,
-    tags     :: [Text],
+    tags     :: [Text]
-    comments :: [Comment]
 } deriving (Eq, Ord, Show, Data, Typeable)
 
 $(deriveSafeCopy 0 'base ''Entry)
@@ -93,7 +83,6 @@ instance Indexable Entry where
                   , ixFun $ \e -> [ MText $ mtext e]
                   , ixFun $ \e -> [ EDate $ edate e]
                   , ixFun $ \e -> map Tag (tags e)
-                  , ixFun comments
                   ]
 
 data User = User {
@@ -144,22 +133,6 @@ insertEntry e =
        put $ b { blogEntries = IxSet.insert e blogEntries }
        return e
 
-addComment :: EntryId -> Comment -> Update Blog Entry
-addComment eId c =
-	do b@Blog{..} <- get
-	   let (Just e) = getOne $ blogEntries @= eId
-	   let newEntry = e { comments = insert c $ comments e }
-	   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
@@ -219,8 +192,6 @@ hashString = B64.encode .  SHA.hash . B.pack
 
 $(makeAcidic ''Blog
     [ 'insertEntry
-    , 'addComment
-    , 'deleteComment
     , 'updateEntry
     , 'getEntry
     , 'latestEntries

src/Locales.hs

@@ -99,35 +99,6 @@ noticeText :: BlogLang -> Text
 noticeText EN = "site notice"
 noticeText DE = "Impressum"
 
--- comments
-noComments :: BlogLang -> Text
-noComments DE = " Keine Kommentare"
-noComments EN = " No comments yet"
-
-cHead :: BlogLang -> Text
-cHead DE = "Kommentare"
-cHead EN = "Comments"
-
-cwHead :: BlogLang -> Text
-cwHead DE = "Kommentieren:"
-cwHead EN = "Comment:"
-
-cSingle :: BlogLang -> Text
-cSingle DE = "Kommentar:" --input label
-cSingle EN = "Comment:"
-
-cTimeFormat :: BlogLang -> String --formatTime expects a String
-cTimeFormat DE = "[Am %Y-%m-%d um %H:%M Uhr]"
-cTimeFormat EN = "[On %Y-%m-%d at %H:%M]"
-
-cSend :: BlogLang -> Text
-cSend DE = "Absenden"
-cSend EN = "Submit"
-
-cTextPlaceholder :: BlogLang -> Text
-cTextPlaceholder DE = "Kommentartext hier eingeben :]"
-cTextPlaceholder EN = "Enter your comment here :]"
-
 -- RSS Strings
 rssTitle :: BlogLang -> String
 rssTitle DE = "Tazjins Blog"

src/Server.hs

@@ -32,7 +32,7 @@ instance FromReqURI BlogLang where
       _    -> Nothing
 
 tmpPolicy :: BodyPolicy
-tmpPolicy = defaultBodyPolicy "./tmp/" 0 200000 1000
+tmpPolicy = defaultBodyPolicy "/tmp" 0 200000 1000
 
 runBlog :: AcidState Blog -> Int -> String -> IO ()
 runBlog acid port respath =
@@ -62,9 +62,6 @@ tazBlog acid resDir = do
               dirs "admin/edit" $ path $ \(eId :: Integer) -> editEntry acid eId
          , 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)
@@ -144,7 +141,6 @@ postEntry acid = do
                     <*> pure nMtext
                     <*> pure now
                     <*> pure [] -- NYI
-                    <*> pure []
     update' acid (InsertEntry nEntry)
     seeOther ("/" ++ lang ++ "/" ++ show eId) (toResponse())
   where
@@ -181,13 +177,6 @@ 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
     (sId :: Text) <- readCookieValue "session"