From 71dc85f94bdd0932de628fb0eb79ef339286c210 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sun, 7 Dec 2014 03:54:02 +0100 Subject: [PATCH] now possible to comment on media. COmment deletion is WIP --- Handler/Medium.hs | 112 ++++++++++++++++++++++++++++++++-- Model.hs | 1 + config/models | 8 +++ config/routes | 4 +- eidolon.cabal | 1 + templates/commentReply.hamlet | 9 +++ templates/medium.hamlet | 24 ++++++++ 7 files changed, 154 insertions(+), 5 deletions(-) create mode 100644 templates/commentReply.hamlet diff --git a/Handler/Medium.hs b/Handler/Medium.hs index a6fa909..86f05ea 100644 --- a/Handler/Medium.hs +++ b/Handler/Medium.hs @@ -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" diff --git a/Model.hs b/Model.hs index 7ddec37..e87f53d 100644 --- a/Model.hs +++ b/Model.hs @@ -1,6 +1,7 @@ module Model where import Yesod +import Yesod.Markdown (Markdown) import Data.Text (Text) import Database.Persist.Quasi import Database.Persist diff --git a/config/models b/config/models index b1579d0..483a817 100644 --- a/config/models +++ b/config/models @@ -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) diff --git a/config/routes b/config/routes index cfb8ade..7a1e9e6 100644 --- a/config/routes +++ b/config/routes @@ -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 diff --git a/eidolon.cabal b/eidolon.cabal index 8c34cf4..297c6f9 100644 --- a/eidolon.cabal +++ b/eidolon.cabal @@ -101,6 +101,7 @@ library , crypto-api , imagemagick , resourcet + , yesod-markdown >= 0.8 executable eidolon if flag(library-only) diff --git a/templates/commentReply.hamlet b/templates/commentReply.hamlet new file mode 100644 index 0000000..1b36323 --- /dev/null +++ b/templates/commentReply.hamlet @@ -0,0 +1,9 @@ +

Reply to comment +#{fromJust $ commentAuthorSlug comment} posted on #{formatTime defaultTimeLocale "%A %F %H:%M" (commentTime comment)}: +
+

#{markdownToHtml $ commentContent comment} +


+
+ ^{replyWidget} +
+ diff --git a/templates/medium.hamlet b/templates/medium.hamlet index 01f0d4f..331fc30 100644 --- a/templates/medium.hamlet +++ b/templates/medium.hamlet @@ -24,3 +24,27 @@ by #{ownerName} from album #{tag} $if presence == True Change medium settings + +$if null comments +

There are no Comments yet +$else + $forall (Entity commentId comment) <- comments +

+      #{fromJust $ commentAuthorSlug comment} wrote on #{formatTime defaultTimeLocale "%A %F %H:%M" $ commentTime comment}:
+      
+ #{commentContent comment} + $if userId /= Nothing +
+ Reply to this comment + $forall (Entity replyId reply) <- replies + $if commentParent reply == Just commentId +
+          #{fromJust $ commentAuthorSlug reply} wrote on #{formatTime defaultTimeLocale "%A %F %H:%M" $ commentTime reply}:
+          
+ #{commentContent reply} + +$if userId /= Nothing + + ^{commentWidget} +
+