nek0/eidolon
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Fix #14

Browse source 
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
Show stats Download patch file Download diff file Expand all files Collapse all files

3
Handler/AdminComments.hs
View file

@ -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]

2
Handler/AdminMediumSettings.hs
View file

@ -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

37
Handler/Medium.hs
View file

@ -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 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|
<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}>

2
Handler/MediumSettings.hs
View file

@ -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

8
Handler/RootFeed.hs
View file

@ -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
}

6
README.md
View file

@ -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:

2
config/models
View file

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

2
eidolon.cabal
View file

@ -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

4
templates/adminComments.hamlet
View file

@ -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

2
templates/commentReply.hamlet
View file

@ -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>

4
templates/medium.hamlet
View file

@ -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>