From bb7f0e6fc2a344409ee78323df970fa10130ccf8 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sun, 23 Oct 2016 03:21:59 +0200 Subject: [PATCH] Fix #14 Eliminated the commentAuthorSlugs in database and getting them by lookup from userId. --- Handler/AdminComments.hs | 3 +++ Handler/AdminMediumSettings.hs | 2 -- Handler/Medium.hs | 37 +++++++++++++++------------------- Handler/MediumSettings.hs | 2 +- Handler/RootFeed.hs | 8 +++++--- README.md | 6 ++++++ config/models | 2 +- eidolon.cabal | 2 +- templates/adminComments.hamlet | 4 ++-- templates/commentReply.hamlet | 2 +- templates/medium.hamlet | 4 ++-- 11 files changed, 38 insertions(+), 34 deletions(-) diff --git a/Handler/AdminComments.hs b/Handler/AdminComments.hs index 64fb529..42fbcc3 100755 --- a/Handler/AdminComments.hs +++ b/Handler/AdminComments.hs @@ -19,6 +19,7 @@ module Handler.AdminComments where import Import import Handler.Commons import Data.Time +import Data.Maybe (fromMaybe) -- import System.Locale getAdminCommentR :: Handler Html @@ -26,6 +27,8 @@ getAdminCommentR = do adminCheck <- loginIsAdmin case adminCheck of Right _ -> do + userEnts <- runDB $ selectList [] [Asc UserId] + let authors = map (\ent -> (entityKey ent, userSlug (entityVal ent))) userEnts media <- runDB $ selectList [] [Desc MediumTime] comments <- runDB $ selectList [CommentParent ==. Nothing] [Desc CommentTime] replies <- runDB $ selectList [CommentParent !=. Nothing] [Desc CommentTime] diff --git a/Handler/AdminMediumSettings.hs b/Handler/AdminMediumSettings.hs index 4db439d..4c44c12 100755 --- a/Handler/AdminMediumSettings.hs +++ b/Handler/AdminMediumSettings.hs @@ -19,8 +19,6 @@ module Handler.AdminMediumSettings where import Import import Handler.Commons import System.FilePath -import System.Directory -import Data.List (tail) import qualified Data.Text as T getAdminMediaR :: Handler Html diff --git a/Handler/Medium.hs b/Handler/Medium.hs index 6a9ef3e..cbdff8f 100755 --- a/Handler/Medium.hs +++ b/Handler/Medium.hs @@ -41,16 +41,12 @@ getMediumR mediumId = do return $ Just $ getUserIdFromText tempUserId Nothing -> return Nothing - userSl <- case userId of - Just uId -> do - u <- runDB $ getJust uId - return $ Just $ userSlug u - Nothing -> - return Nothing let presence = userId == (Just ownerId) || userId == Just (albumOwner album) (commentWidget, enctype) <- generateFormPost $ renderBootstrap3 BootstrapBasicForm $ - commentForm (fromJust userId) (fromJust userSl) mediumId Nothing + commentForm (fromJust userId) mediumId Nothing + userEnts <- runDB $ selectList [] [Asc UserId] + let authors = map (\ent -> (entityKey ent, (userSlug $ entityVal ent))) userEnts comments <- runDB $ selectList [ CommentOrigin ==. mediumId , CommentParent ==. Nothing ] @@ -84,17 +80,17 @@ postMediumR mediumId = do let userSl = userSlug u ((res, _), _) <- runFormPost $ renderBootstrap3 BootstrapBasicForm $ - commentForm userId userSl mediumId Nothing + commentForm userId mediumId Nothing case res of FormSuccess temp -> do runDB $ insert_ temp --send mail to medium owner owner <- runDB $ getJust $ mediumOwner medium link <- ($ MediumR (commentOrigin temp)) <$> getUrlRender - sendMail (userEmail owner) ((commentAuthorSlug temp) `T.append` " commented on your medium") + sendMail (userEmail owner) (userSl `T.append` " commented on your medium") [shamlet|

Hello #{userSlug owner} -

#{commentAuthorSlug temp} commented on your medium: +

#{userSl} commented on your medium:

#{commentContent temp}

To follow the comment thread follow @@ -113,10 +109,9 @@ postMediumR mediumId = do setMessage "This image does not exist" redirect HomeR -commentForm :: UserId -> Text -> MediumId -> Maybe CommentId -> AForm Handler Comment -commentForm authorId authorSlug originId parentId = Comment +commentForm :: UserId -> MediumId -> Maybe CommentId -> AForm Handler Comment +commentForm authorId originId parentId = Comment <$> pure authorId - <*> pure authorSlug <*> pure originId <*> pure parentId <*> lift (liftIO getCurrentTime) @@ -132,12 +127,12 @@ getCommentReplyR commentId = do case msu of Just tempUserId -> do let userId = getUserIdFromText tempUserId - u <- runDB $ getJust userId - let userSl = userSlug u let mediumId = commentOrigin comment + parAuth <- runDB $ get $ commentAuthor comment + let parSlug = fromMaybe "" $ userSlug <$> parAuth (replyWidget, enctype) <- generateFormPost $ renderBootstrap3 BootstrapBasicForm $ - commentForm userId userSl mediumId (Just commentId) + commentForm userId mediumId (Just commentId) defaultLayout $ do setTitle "Eidolon :: Reply to comment" $(widgetFile "commentReply") @@ -162,7 +157,7 @@ postCommentReplyR commentId = do let mediumId = commentOrigin comment ((res, _), _) <- runFormPost $ renderBootstrap3 BootstrapBasicForm $ - commentForm userId userSl mediumId (Just commentId) + commentForm userId mediumId (Just commentId) case res of FormSuccess temp -> do runDB $ insert_ temp @@ -170,10 +165,10 @@ postCommentReplyR commentId = do parent <- runDB $ getJust $ fromJust $ commentParent temp parAuth <- runDB $ getJust $ commentAuthor parent link <- ($ MediumR (commentOrigin temp)) <$> getUrlRender - sendMail (userEmail parAuth) ((commentAuthorSlug temp) `T.append` " replied to your comment") + sendMail (userEmail parAuth) (userSl `T.append` " replied to your comment") [shamlet|

Hello #{userSlug parAuth} -

#{commentAuthorSlug temp} replied to your comment: +

#{userSl} replied to your comment: #{commentContent temp}

To see the comment thread follow @@ -183,10 +178,10 @@ postCommentReplyR commentId = do --send mail to medium owner medium <- runDB $ getJust mediumId owner <- runDB $ getJust $ mediumOwner medium - sendMail (userEmail owner) ((commentAuthorSlug temp) `T.append` " commented on your medium") + sendMail (userEmail owner) (userSl `T.append` " commented on your medium") [shamlet|

Hello #{userSlug owner} -

#{commentAuthorSlug temp} commented your medium with: +

#{userSl} commented your medium with: #{commentContent temp}

To see the comment thread follow diff --git a/Handler/MediumSettings.hs b/Handler/MediumSettings.hs index 702448f..8a87bc0 100755 --- a/Handler/MediumSettings.hs +++ b/Handler/MediumSettings.hs @@ -149,7 +149,7 @@ postMediumMoveR mId = do redirect $ MediumR mId _ -> do setMessage "Error moving image" - redirect $ mediumR mId + redirect $ MediumR mId Left (err, route) -> do setMessage err redirect route diff --git a/Handler/RootFeed.hs b/Handler/RootFeed.hs index 656b241..8b3e070 100755 --- a/Handler/RootFeed.hs +++ b/Handler/RootFeed.hs @@ -63,12 +63,14 @@ commentFeedBuilder mId = do , feedEntries = es } -commentToEntry :: Monad m => Entity Comment -> m (FeedEntry (Route App)) -commentToEntry c = +commentToEntry :: Entity Comment -> Handler (FeedEntry (Route App)) +commentToEntry c = do + author <- runDB $ get $ commentAuthor $ entityVal c + let slug = fromMaybe "" $ userSlug <$> author return FeedEntry { feedEntryLink = MediumR (commentOrigin $ entityVal c) , feedEntryUpdated = (commentTime $ entityVal c) - , feedEntryTitle = LT.toStrict $ [stext|#{commentAuthorSlug $ entityVal c} wrote:|] + , feedEntryTitle = LT.toStrict $ [stext|#{slug} wrote:|] , feedEntryContent = [shamlet|#{commentContent $ entityVal c}|] , feedEntryEnclosure = Nothing } diff --git a/README.md b/README.md index 93a9331..ca9941d 100755 --- a/README.md +++ b/README.md @@ -138,6 +138,12 @@ location. in the project directory and run `cabal exec -- runghc Migrations/0.0.7-0.1.0.0/Migration.hs` +###0.1.2.4-0.1.3.0 +* Stop Eidolon +* Log into your database and issue this command: +`ALTER TABLE "comment" DROP COLUMN "author_slug";` +* Start Eidolon + ##Acknowledgements: * This software uses the web Framework "Yesod" by Michael Snoyman. See more at: diff --git a/config/models b/config/models index 31a513b..efdf8ce 100755 --- a/config/models +++ b/config/models @@ -58,7 +58,7 @@ Medium deriving Eq Show Comment author UserId - authorSlug Text +-- authorSlug Text origin MediumId parent CommentId Maybe time UTCTime diff --git a/eidolon.cabal b/eidolon.cabal index 080ab8d..2199e23 100755 --- a/eidolon.cabal +++ b/eidolon.cabal @@ -1,5 +1,5 @@ name: eidolon -version: 0.1.2.4 +version: 0.1.3.0 synopsis: Image gallery in Yesod homepage: https://eidolon.nek0.eu license: AGPL-3 diff --git a/templates/adminComments.hamlet b/templates/adminComments.hamlet index ccda012..2b6509d 100755 --- a/templates/adminComments.hamlet +++ b/templates/adminComments.hamlet @@ -14,7 +14,7 @@ $newline never $forall (Entity commentId comment) <- comments $if commentOrigin comment == mediumId

- #{commentAuthorSlug comment} wrote on #{formatTime defaultTimeLocale "%A %F %H:%M" $ commentTime comment}: + #{fromMaybe "" $ lookup (commentAuthor comment) authors} wrote on #{formatTime defaultTimeLocale "%A %F %H:%M" $ commentTime comment}:
#{commentContent comment}
Delete this comment @@ -22,7 +22,7 @@ $newline never $if commentParent reply == Just commentId $if commentOrigin reply == mediumId
- #{commentAuthorSlug comment} wrote on #{formatTime defaultTimeLocale "%A %F %H:%M" $ commentTime comment}: + #{fromMaybe "" $ lookup (commentAuthor comment) authors} wrote on #{formatTime defaultTimeLocale "%A %F %H:%M" $ commentTime comment}:
#{commentContent reply}
Delete this comment diff --git a/templates/commentReply.hamlet b/templates/commentReply.hamlet index 228c451..1451491 100755 --- a/templates/commentReply.hamlet +++ b/templates/commentReply.hamlet @@ -1,6 +1,6 @@

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

#{commentContent comment}


diff --git a/templates/medium.hamlet b/templates/medium.hamlet index 1ba2f09..8cd7bf6 100755 --- a/templates/medium.hamlet +++ b/templates/medium.hamlet @@ -38,7 +38,7 @@ $else $forall (Entity commentId comment) <- comments
- #{commentAuthorSlug comment} wrote on #{formatTime defaultTimeLocale "%A %F %H:%M" $ commentTime comment}: + #{fromMaybe "" $ lookup (commentAuthor comment) authors} wrote on #{formatTime defaultTimeLocale "%A %F %H:%M" $ commentTime comment}:
#{commentContent comment} $if userId /= Nothing @@ -49,7 +49,7 @@ $forall (Entity replyId reply) <- replies $if commentParent reply == Just commentId
- #{commentAuthorSlug reply} replied on #{formatTime defaultTimeLocale "%A %F %H:%M" $ commentTime reply}: + #{fromMaybe "" $ lookup (commentAuthor comment) authors} replied on #{formatTime defaultTimeLocale "%A %F %H:%M" $ commentTime reply}:
#{commentContent reply}