Eliminated the commentAuthorSlugs in database and getting them by
lookup from userId.
This commit is contained in:
nek0 2016-10-23 03:21:59 +02:00
parent c9efc60fe8
commit bb7f0e6fc2
11 changed files with 38 additions and 34 deletions

View file

@ -19,6 +19,7 @@ module Handler.AdminComments where
import Import import Import
import Handler.Commons import Handler.Commons
import Data.Time import Data.Time
import Data.Maybe (fromMaybe)
-- import System.Locale -- import System.Locale
getAdminCommentR :: Handler Html getAdminCommentR :: Handler Html
@ -26,6 +27,8 @@ getAdminCommentR = do
adminCheck <- loginIsAdmin adminCheck <- loginIsAdmin
case adminCheck of case adminCheck of
Right _ -> do Right _ -> do
userEnts <- runDB $ selectList [] [Asc UserId]
let authors = map (\ent -> (entityKey ent, userSlug (entityVal ent))) userEnts
media <- runDB $ selectList [] [Desc MediumTime] media <- runDB $ selectList [] [Desc MediumTime]
comments <- runDB $ selectList [CommentParent ==. Nothing] [Desc CommentTime] comments <- runDB $ selectList [CommentParent ==. Nothing] [Desc CommentTime]
replies <- runDB $ selectList [CommentParent !=. Nothing] [Desc CommentTime] replies <- runDB $ selectList [CommentParent !=. Nothing] [Desc CommentTime]

View file

@ -19,8 +19,6 @@ module Handler.AdminMediumSettings where
import Import import Import
import Handler.Commons import Handler.Commons
import System.FilePath import System.FilePath
import System.Directory
import Data.List (tail)
import qualified Data.Text as T import qualified Data.Text as T
getAdminMediaR :: Handler Html getAdminMediaR :: Handler Html

View file

@ -41,16 +41,12 @@ getMediumR mediumId = do
return $ Just $ getUserIdFromText tempUserId return $ Just $ getUserIdFromText tempUserId
Nothing -> Nothing ->
return 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) let presence = userId == (Just ownerId) || userId == Just (albumOwner album)
(commentWidget, enctype) <- generateFormPost $ (commentWidget, enctype) <- generateFormPost $
renderBootstrap3 BootstrapBasicForm $ 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 comments <- runDB $ selectList
[ CommentOrigin ==. mediumId [ CommentOrigin ==. mediumId
, CommentParent ==. Nothing ] , CommentParent ==. Nothing ]
@ -84,17 +80,17 @@ postMediumR mediumId = do
let userSl = userSlug u let userSl = userSlug u
((res, _), _) <- runFormPost $ ((res, _), _) <- runFormPost $
renderBootstrap3 BootstrapBasicForm $ renderBootstrap3 BootstrapBasicForm $
commentForm userId userSl mediumId Nothing commentForm userId mediumId Nothing
case res of case res of
FormSuccess temp -> do FormSuccess temp -> do
runDB $ insert_ temp runDB $ insert_ temp
--send mail to medium owner --send mail to medium owner
owner <- runDB $ getJust $ mediumOwner medium owner <- runDB $ getJust $ mediumOwner medium
link <- ($ MediumR (commentOrigin temp)) <$> getUrlRender 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| [shamlet|
<h1>Hello #{userSlug owner} <h1>Hello #{userSlug owner}
<p>#{commentAuthorSlug temp} commented on your medium: <p>#{userSl} commented on your medium:
<p>#{commentContent temp} <p>#{commentContent temp}
<p>To follow the comment thread follow <p>To follow the comment thread follow
<a href=#{link}> <a href=#{link}>
@ -113,10 +109,9 @@ postMediumR mediumId = do
setMessage "This image does not exist" setMessage "This image does not exist"
redirect HomeR 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 authorId
<*> pure authorSlug
<*> pure originId <*> pure originId
<*> pure parentId <*> pure parentId
<*> lift (liftIO getCurrentTime) <*> lift (liftIO getCurrentTime)
@ -132,12 +127,12 @@ getCommentReplyR commentId = do
case msu of case msu of
Just tempUserId -> do Just tempUserId -> do
let userId = getUserIdFromText tempUserId let userId = getUserIdFromText tempUserId
u <- runDB $ getJust userId
let userSl = userSlug u
let mediumId = commentOrigin comment let mediumId = commentOrigin comment
parAuth <- runDB $ get $ commentAuthor comment
let parSlug = fromMaybe "" $ userSlug <$> parAuth
(replyWidget, enctype) <- generateFormPost $ (replyWidget, enctype) <- generateFormPost $
renderBootstrap3 BootstrapBasicForm $ renderBootstrap3 BootstrapBasicForm $
commentForm userId userSl mediumId (Just commentId) commentForm userId mediumId (Just commentId)
defaultLayout $ do defaultLayout $ do
setTitle "Eidolon :: Reply to comment" setTitle "Eidolon :: Reply to comment"
$(widgetFile "commentReply") $(widgetFile "commentReply")
@ -162,7 +157,7 @@ postCommentReplyR commentId = do
let mediumId = commentOrigin comment let mediumId = commentOrigin comment
((res, _), _) <- runFormPost $ ((res, _), _) <- runFormPost $
renderBootstrap3 BootstrapBasicForm $ renderBootstrap3 BootstrapBasicForm $
commentForm userId userSl mediumId (Just commentId) commentForm userId mediumId (Just commentId)
case res of case res of
FormSuccess temp -> do FormSuccess temp -> do
runDB $ insert_ temp runDB $ insert_ temp
@ -170,10 +165,10 @@ postCommentReplyR commentId = do
parent <- runDB $ getJust $ fromJust $ commentParent temp parent <- runDB $ getJust $ fromJust $ commentParent temp
parAuth <- runDB $ getJust $ commentAuthor parent parAuth <- runDB $ getJust $ commentAuthor parent
link <- ($ MediumR (commentOrigin temp)) <$> getUrlRender 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| [shamlet|
<h1>Hello #{userSlug parAuth} <h1>Hello #{userSlug parAuth}
<p>#{commentAuthorSlug temp} replied to your comment: <p>#{userSl} replied to your comment:
#{commentContent temp} #{commentContent temp}
<p>To see the comment thread follow <p>To see the comment thread follow
<a href=#{link}> <a href=#{link}>
@ -183,10 +178,10 @@ postCommentReplyR commentId = do
--send mail to medium owner --send mail to medium owner
medium <- runDB $ getJust mediumId medium <- runDB $ getJust mediumId
owner <- runDB $ getJust $ mediumOwner medium 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| [shamlet|
<h1>Hello #{userSlug owner} <h1>Hello #{userSlug owner}
<p>#{commentAuthorSlug temp} commented your medium with: <p>#{userSl} commented your medium with:
#{commentContent temp} #{commentContent temp}
<p>To see the comment thread follow <p>To see the comment thread follow
<a href=#{link}> <a href=#{link}>

View file

@ -149,7 +149,7 @@ postMediumMoveR mId = do
redirect $ MediumR mId redirect $ MediumR mId
_ -> do _ -> do
setMessage "Error moving image" setMessage "Error moving image"
redirect $ mediumR mId redirect $ MediumR mId
Left (err, route) -> do Left (err, route) -> do
setMessage err setMessage err
redirect route redirect route

View file

@ -63,12 +63,14 @@ commentFeedBuilder mId = do
, feedEntries = es , 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 return FeedEntry
{ feedEntryLink = MediumR (commentOrigin $ entityVal c) { feedEntryLink = MediumR (commentOrigin $ entityVal c)
, feedEntryUpdated = (commentTime $ 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}|] , feedEntryContent = [shamlet|#{commentContent $ entityVal c}|]
, feedEntryEnclosure = Nothing , feedEntryEnclosure = Nothing
} }

View file

@ -138,6 +138,12 @@ location.
in the project directory and run `cabal exec -- runghc in the project directory and run `cabal exec -- runghc
Migrations/0.0.7-0.1.0.0/Migration.hs` 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: ##Acknowledgements:
* This software uses the web Framework "Yesod" by Michael Snoyman. See more at: * This software uses the web Framework "Yesod" by Michael Snoyman. See more at:

View file

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

View file

@ -1,5 +1,5 @@
name: eidolon name: eidolon
version: 0.1.2.4 version: 0.1.3.0
synopsis: Image gallery in Yesod synopsis: Image gallery in Yesod
homepage: https://eidolon.nek0.eu homepage: https://eidolon.nek0.eu
license: AGPL-3 license: AGPL-3

View file

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

View file

@ -1,6 +1,6 @@
<div .item> <div .item>
<h4>Reply to comment <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> <hr>
<p>#{commentContent comment} <p>#{commentContent comment}
<hr> <hr>

View file

@ -38,7 +38,7 @@
$else $else
$forall (Entity commentId comment) <- comments $forall (Entity commentId comment) <- comments
<div .medium .comment> <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> <hr>
#{commentContent comment} #{commentContent comment}
$if userId /= Nothing $if userId /= Nothing
@ -49,7 +49,7 @@
$forall (Entity replyId reply) <- replies $forall (Entity replyId reply) <- replies
$if commentParent reply == Just commentId $if commentParent reply == Just commentId
<div .comment .reply .medium> <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> <hr>
#{commentContent reply} #{commentContent reply}
<hr> <hr>