Fix #14

Eliminated the commentAuthorSlugs in database and getting them by
lookup from userId.

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]

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

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|
                   <h1>Hello #{userSlug owner}
-                  <p>#{commentAuthorSlug temp} commented on your medium:
+                  <p>#{userSl} commented on your medium:
                   <p>#{commentContent temp}
                   <p>To follow the comment thread follow
                     <a href=#{link}>
@@ -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 :: UserId -> MediumId -> Maybe CommentId -> AForm Handler Comment
-commentForm authorId authorSlug originId parentId = 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|
                   <h1>Hello #{userSlug parAuth}
-                  <p>#{commentAuthorSlug temp} replied to your comment:
+                  <p>#{userSl} replied to your comment:
                   #{commentContent temp}
                   <p>To see the comment thread follow
                     <a href=#{link}>
@@ -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|
                   <h1>Hello #{userSlug owner}
-                  <p>#{commentAuthorSlug temp} commented your medium with:
+                  <p>#{userSl} commented your medium with:
                   #{commentContent temp}
                   <p>To see the comment thread follow
                     <a href=#{link}>

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

Handler/RootFeed.hs

@@ -63,12 +63,14 @@ commentFeedBuilder mId = do
     , feedEntries = es
     }
 
-commentToEntry :: Monad m => Entity Comment -> m (FeedEntry (Route App))
+commentToEntry :: Entity Comment -> Handler (FeedEntry (Route App))
-commentToEntry c =
+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
     }

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:

config/models

@@ -58,7 +58,7 @@ Medium
     deriving Eq Show
 Comment
     author UserId
-    authorSlug Text
+--    authorSlug Text
     origin MediumId
     parent CommentId Maybe
     time UTCTime

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

templates/adminComments.hamlet

@@ -14,7 +14,7 @@ $newline never
       $forall (Entity commentId comment) <- comments
         $if commentOrigin comment == mediumId
           <div .medium .comment>
-            #{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}:
             <hr>
             #{commentContent comment}
             <a href=@{AdminCommentDeleteR commentId}>Delete this comment
@@ -22,7 +22,7 @@ $newline never
           $if commentParent reply == Just commentId
             $if commentOrigin reply == mediumId
               <div .medium .comment .reply>
-                #{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}:
                 <hr>
                 #{commentContent reply}
                 <a href=@{AdminCommentDeleteR replyId}>Delete this comment

templates/commentReply.hamlet

@@ -1,6 +1,6 @@
 <div .item>
   <h4>Reply to comment
-  <strong>#{commentAuthorSlug comment}</strong> posted on #{formatTime defaultTimeLocale "%A %F %H:%M" (commentTime comment)}:
+  <strong>#{parSlug}</strong> posted on #{formatTime defaultTimeLocale "%A %F %H:%M" (commentTime comment)}:
   <hr>
     <p>#{commentContent comment}
   <hr>

templates/medium.hamlet

@@ -38,7 +38,7 @@
   $else
     $forall (Entity commentId comment) <- comments
       <div .medium .comment>
-        <a href=@{ProfileR $ commentAuthor comment}>#{commentAuthorSlug comment}</a> wrote on #{formatTime defaultTimeLocale "%A %F %H:%M" $ commentTime comment}:
+        <a href=@{ProfileR $ commentAuthor comment}>#{fromMaybe "" $ lookup (commentAuthor comment) authors}</a> wrote on #{formatTime defaultTimeLocale "%A %F %H:%M" $ commentTime comment}:
         <hr>
         #{commentContent comment}
         $if userId /= Nothing
@@ -49,7 +49,7 @@
       $forall (Entity replyId reply) <- replies
         $if commentParent reply == Just commentId
           <div .comment .reply .medium>
-            <a href=@{ProfileR $ commentAuthor reply}>#{commentAuthorSlug reply}</a> replied on #{formatTime defaultTimeLocale "%A %F %H:%M" $ commentTime reply}:
+            <a href=@{ProfileR $ commentAuthor reply}>#{fromMaybe "" $ lookup (commentAuthor comment) authors}</a> replied on #{formatTime defaultTimeLocale "%A %F %H:%M" $ commentTime reply}:
             <hr>
             #{commentContent reply}
             <hr>