We are no longer offering accounts on this server. Consider https://gitlab.freedesktop.org/ as a place to host projects.

Commit e69e31ce authored by Mitchell Rosen's avatar Mitchell Rosen

comment css/html changes

parent edc020b9
......@@ -180,6 +180,11 @@ makeProjectCommentActionWidget make_comment_action_widget project_handle comment
get_max_depth
False
projectDiscussionPage :: Text -> Widget -> Widget
projectDiscussionPage project_handle widget = do
$(widgetFile "project_discussion_wrapper")
toWidget $(cassiusFile "templates/comment.cassius")
-------------------------------------------------------------------------------
--
......@@ -440,7 +445,7 @@ getProjectCommentR project_handle comment_id = do
Just (Entity user_id _) ->
runDB (userMaybeViewProjectCommentsDB user_id project_id (map entityKey (Tree.flatten comment_tree)))
defaultLayout $(widgetFile "project_discussion_wrapper")
defaultLayout (projectDiscussionPage project_handle widget)
--------------------------------------------------------------------------------
-- /c/#CommentId/approve
......@@ -454,7 +459,7 @@ getApproveProjectCommentR project_handle comment_id = do
comment_id
def
getMaxDepth
defaultLayout $(widgetFile "project_discussion_wrapper")
defaultLayout (projectDiscussionPage project_handle widget)
postApproveProjectCommentR :: Text -> CommentId -> Handler Html
postApproveProjectCommentR project_handle comment_id = do
......@@ -476,9 +481,7 @@ getClaimProjectCommentR project_handle comment_id = do
comment_id
def
getMaxDepth
defaultLayout $ do
$(widgetFile "project_discussion_wrapper")
-- toWidget $(cassiusFile "templates/comment.cassius") -- TODO(mitchell): need this?
defaultLayout (projectDiscussionPage project_handle widget)
postClaimProjectCommentR :: Text -> CommentId -> Handler Html
postClaimProjectCommentR project_handle comment_id = do
......@@ -492,7 +495,7 @@ postClaimProjectCommentR project_handle comment_id = do
(projectCommentHandlerInfo (Just user) project_id project_handle)
>>= \case
Nothing -> redirect (ProjectCommentR project_handle comment_id)
Just (widget, form) -> defaultLayout $ previewWidget form "claim" ($(widgetFile "project_discussion_wrapper"))
Just (widget, form) -> defaultLayout $ previewWidget form "claim" (projectDiscussionPage project_handle widget)
--------------------------------------------------------------------------------
-- /c/#CommentId/close
......@@ -506,7 +509,8 @@ getCloseProjectCommentR project_handle comment_id = do
comment_id
def
getMaxDepth
defaultLayout $(widgetFile "project_discussion_wrapper")
defaultLayout (projectDiscussionPage project_handle widget)
postCloseProjectCommentR :: Text -> CommentId -> Handler Html
postCloseProjectCommentR project_handle comment_id = do
......@@ -520,7 +524,7 @@ postCloseProjectCommentR project_handle comment_id = do
(projectCommentHandlerInfo (Just user) project_id project_handle)
>>= \case
Nothing -> redirect (ProjectCommentR project_handle comment_id)
Just (widget, form) -> defaultLayout $ previewWidget form "close" ($(widgetFile "project_discussion_wrapper"))
Just (widget, form) -> defaultLayout $ previewWidget form "close" (projectDiscussionPage project_handle widget)
--------------------------------------------------------------------------------
-- /c/#CommentId/delete
......@@ -534,7 +538,7 @@ getDeleteProjectCommentR project_handle comment_id = do
comment_id
def
getMaxDepth
defaultLayout $(widgetFile "project_discussion_wrapper")
defaultLayout (projectDiscussionPage project_handle widget)
postDeleteProjectCommentR :: Text -> CommentId -> Handler Html
postDeleteProjectCommentR project_handle comment_id = do
......@@ -558,7 +562,7 @@ getEditProjectCommentR project_handle comment_id = do
comment_id
def
getMaxDepth
defaultLayout $(widgetFile "project_discussion_wrapper")
defaultLayout (projectDiscussionPage project_handle widget)
postEditProjectCommentR :: Text -> CommentId -> Handler Html
postEditProjectCommentR project_handle comment_id = do
......@@ -571,7 +575,7 @@ postEditProjectCommentR project_handle comment_id = do
(projectCommentHandlerInfo (Just user) project_id project_handle)
>>= \case
Nothing -> redirect (ProjectCommentR project_handle comment_id) -- Edit made.
Just widget -> defaultLayout $(widgetFile "project_discussion_wrapper") -- Previewing edit.
Just widget -> defaultLayout (projectDiscussionPage project_handle widget)
--------------------------------------------------------------------------------
-- /c/#CommentId/flag
......@@ -585,7 +589,7 @@ getFlagProjectCommentR project_handle comment_id = do
comment_id
def
getMaxDepth
defaultLayout $(widgetFile "project_discussion_wrapper")
defaultLayout (projectDiscussionPage project_handle widget)
postFlagProjectCommentR :: Text -> CommentId -> Handler Html
postFlagProjectCommentR project_handle comment_id = do
......@@ -598,7 +602,7 @@ postFlagProjectCommentR project_handle comment_id = do
(projectCommentHandlerInfo (Just user) project_id project_handle)
>>= \case
Nothing -> redirect (ProjectDiscussionR project_handle)
Just widget -> defaultLayout $(widgetFile "project_discussion_wrapper")
Just widget -> defaultLayout (projectDiscussionPage project_handle widget)
--------------------------------------------------------------------------------
-- /c/#CommentId/reply
......@@ -612,7 +616,7 @@ getReplyProjectCommentR project_handle parent_id = do
parent_id
def
getMaxDepth
defaultLayout $(widgetFile "project_discussion_wrapper")
defaultLayout (projectDiscussionPage project_handle widget)
postReplyProjectCommentR :: Text -> CommentId -> Handler Html
postReplyProjectCommentR project_handle parent_id = do
......@@ -625,7 +629,7 @@ postReplyProjectCommentR project_handle parent_id = do
(projectDiscussion project)
(makeProjectCommentActionPermissionsMap (Just user) project_handle) >>= \case
Left _ -> redirect (ProjectCommentR project_handle parent_id)
Right (widget, form) -> defaultLayout $ previewWidget form "post" ($(widgetFile "project_discussion_wrapper"))
Right (widget, form) -> defaultLayout $ previewWidget form "post" (projectDiscussionPage project_handle widget)
--------------------------------------------------------------------------------
-- /c/#CommentId/rethread
......@@ -639,7 +643,7 @@ getRethreadProjectCommentR project_handle comment_id = do
comment_id
def
getMaxDepth
defaultLayout $(widgetFile "project_discussion_wrapper")
defaultLayout (projectDiscussionPage project_handle widget)
postRethreadProjectCommentR :: Text -> CommentId -> Handler Html
postRethreadProjectCommentR project_handle comment_id = do
......@@ -659,7 +663,7 @@ getRetractProjectCommentR project_handle comment_id = do
comment_id
def
getMaxDepth
defaultLayout $(widgetFile "project_discussion_wrapper")
defaultLayout (projectDiscussionPage project_handle widget)
postRetractProjectCommentR :: Text -> CommentId -> Handler Html
postRetractProjectCommentR project_handle comment_id = do
......@@ -673,7 +677,7 @@ postRetractProjectCommentR project_handle comment_id = do
(projectCommentHandlerInfo (Just user) project_id project_handle)
>>= \case
Nothing -> redirect (ProjectCommentR project_handle comment_id)
Just (widget, form) -> defaultLayout $ previewWidget form "retract" ($(widgetFile "project_discussion_wrapper"))
Just (widget, form) -> defaultLayout $ previewWidget form "retract" (projectDiscussionPage project_handle widget)
--------------------------------------------------------------------------------
-- /c/#CommentId/tags
......@@ -796,7 +800,7 @@ getNewProjectDiscussionR :: Text -> Handler Html
getNewProjectDiscussionR project_handle = do
void requireAuth
let widget = commentNewTopicFormWidget
defaultLayout $(widgetFile "project_discussion_wrapper")
defaultLayout (projectDiscussionPage project_handle widget)
postNewProjectDiscussionR :: Text -> Handler Html
postNewProjectDiscussionR project_handle = do
......@@ -809,7 +813,7 @@ postNewProjectDiscussionR project_handle = do
projectDiscussion
(makeProjectCommentActionPermissionsMap (Just user) project_handle) >>= \case
Left comment_id -> redirect (ProjectCommentR project_handle comment_id)
Right (widget, form) -> defaultLayout $ previewWidget form "post" ($(widgetFile "project_discussion_wrapper"))
Right (widget, form) -> defaultLayout $ previewWidget form "post" (projectDiscussionPage project_handle widget)
--------------------------------------------------------------------------------
-- /edit
......
......@@ -25,7 +25,6 @@ import Data.Text as Import (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Data.Time.Clock as Import (UTCTime, diffUTCTime, getCurrentTime)
import Data.Time.Units
import Data.Typeable (Typeable)
import Database.Esqueleto as Import hiding (on, valList)
import qualified Database.Esqueleto
......@@ -73,22 +72,30 @@ instance Count ShareCount where getCount (ShareCount c) = c
newtype Color = Color Int deriving (Typeable, Num)
-- from http://stackoverflow.com/questions/8066850/why-doesnt-haskells-prelude-read-return-a-maybe
readMaybe :: (Read a) => String -> Maybe a
readMaybe s = case [x | (x,t) <- reads s, ("","") <- lex t] of
[x] -> Just x
_ -> Nothing
age :: UTCTime -> UTCTime -> String
age a b = let s = round $ toRational $ diffUTCTime a b
f (t :: Second)
| t > convertUnit (1 :: Fortnight) = show (convertUnit t :: Fortnight)
| t > convertUnit (1 :: Week) = show (convertUnit t :: Week)
| t > convertUnit (1 :: Day) = show (convertUnit t :: Day)
| t > convertUnit (1 :: Hour) = show (convertUnit t :: Hour)
| otherwise = show (convertUnit t :: Minute)
in f s
readMaybe :: (Read a) => String -> Maybe a
readMaybe s = case [x | (x,t) <- reads s, ("","") <- lex t] of
[x] -> Just x
_ -> Nothing
showDiffTime :: UTCTime -> UTCTime -> String
showDiffTime x y =
let secs_ago = round (diffUTCTime x y)
in if | secs_ago < secsPerHour -> go secs_ago secsPerMinute "m"
| secs_ago < secsPerDay -> go secs_ago secsPerHour "h"
| secs_ago < secsPerWeek -> go secs_ago secsPerDay "d"
| secs_ago < secsPerMonth -> go secs_ago secsPerWeek "wk"
| secs_ago < secsPerYear -> go secs_ago secsPerMonth "mo"
| otherwise -> go secs_ago secsPerYear "yr"
where
go secs_ago divisor suffix = show (secs_ago `div` divisor) ++ suffix
secsPerMinute, secsPerHour, secsPerDay, secsPerWeek, secsPerMonth, secsPerYear :: Integer
secsPerMinute = 60
secsPerHour = 360 -- 60*60
secsPerDay = 86400 -- 60*60*24
secsPerWeek = 604800 -- 60*60*24*7
secsPerMonth = 2592000 -- 60*60*24*30
secsPerYear = 31536000 -- 60*60*24*365
entitiesMap :: [Entity t] -> Map (Key t) t
entitiesMap = foldr (\(Entity k v) -> M.insert k v) mempty
......
......@@ -76,14 +76,14 @@ makeProjectCommentActionPermissionsMap (Just (Entity viewer_id viewer)) project_
{ can_add_tag = viewer_is_established
, can_approve = viewer_is_mod && not (commentIsApproved comment)
, can_claim = M.member comment_id ticket_map && M.notMember comment_id claimed_map
, can_close = viewer_can_close && M.notMember comment_id closure_map
, can_close = viewer_can_close && M.notMember comment_id closure_map && commentIsApproved comment
, can_delete = viewer_id == user_id && S.notMember comment_id comments_with_children
, can_edit = userCanEditComment viewer_id comment
, can_establish = viewer_is_mod && userIsUnestablished user
, can_flag = viewer_is_established && viewer_id /= user_id && M.notMember comment_id flag_map
, can_reply = True
, can_reply = commentIsApproved comment
, can_rethread = viewer_is_mod || viewer_id == user_id
, can_retract = viewer_id == user_id
, can_retract = viewer_id == user_id && commentIsApproved comment
, can_unclaim = maybe False
(\(Entity _ t) -> ticketClaimingUser t == viewer_id)
(M.lookup comment_id claimed_map)
......
......@@ -124,6 +124,7 @@ library
GeneralizedNewtypeDeriving
LambdaCase
MultiParamTypeClasses
MultiWayIf
NoImplicitPrelude
NoMonomorphismRestriction
QuasiQuotes
......
......@@ -43,11 +43,11 @@ import Widgets.Markdown
import Widgets.Tag
import Widgets.Time
import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Text as T
import Data.Tree (Forest, Tree(..))
import qualified Data.Tree as Tree
import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Text as T
import Data.Tree (Forest, Tree(..))
import qualified Data.Tree as Tree
disabledCommentForm :: Form Markdown
disabledCommentForm = renderBootstrap3 $ areq snowdriftMarkdownField ("Reply" { fsAttrs = [("disabled",""), ("class","form-control")] }) Nothing
......@@ -124,7 +124,7 @@ approveCommentFormWidget :: Widget
approveCommentFormWidget =
[whamlet|
<form method="POST">
<button type="submit" name="mode" value="post">approve post
<button type="submit" name="mode" value="post">approve
|]
claimCommentForm :: Maybe (Maybe Text) -> Form (Maybe Text)
......@@ -348,6 +348,8 @@ commentTreeWidget'
-- The reason this can't be made more modular is the HTML for nested comments
-- requires us to render the entire tree (can't close the parent comment's div
-- before the children comments).
--
-- Note this widget has NO CSS.
commentWidget :: Entity Comment -- ^ Comment.
-> Maybe UserId -- ^ Viewer.
-> CommentRoutes -- ^ Comment routes.
......@@ -398,4 +400,4 @@ commentWidget (Entity comment_id comment)
commentTextTransform = prettyTicketLine
-}
$(widgetFile "comment")
$(whamletFile "templates/comment.hamlet")
module View.Discussion where
import Model.Comment.Internal
discussionCommentTree :: CommentMods -- ^ Comment structure modifications.
-> CommentActionPermissions
-> MaxDepth
-> Bool -- ^ Is preview?
-> Widget -- ^ Widget to display under root comment.
-> CommentId -- ^ Root comment id.
-> Handler (Widget, Tree (Entity Comment))
......@@ -18,6 +18,6 @@ renderTime time = do
toWidget [hamlet|
<span title="#{render time}">
#{age now time}&nbsp;ago
#{showDiffTime now time}&nbsp;ago
|]
......@@ -2,10 +2,10 @@
padding : 0 .8em 0.3em 1em
margin-top : 1.8em
border-bottom-left-radius: 1em
font-size : 15px
font-size : 0.8em
.comment p, .comment ul, .comment ol, .comment h1, .comment h2, .comment h3, .comment h4, .comment h5, .comment h6
margin : .5em 0
margin : 0
.comment figure
text-align : left
......@@ -20,11 +20,24 @@
font-size : 14px
margin : 1em
.comment-head, .comment-action
margin-right : 1em
margin-bottom : 0.5em
.comment-date span
color : gray
font-style : italic
.comment-head-item, .comment-action
display : inline-block
padding : 2px 5px
font-size : small
.comment-actions
margin-bottom : 1em
.comment-action a, .comment-action a:visited
color : gray
margin-right : 1px
.awaiting-approval
color : green
font-style : italic
.top_level
border-left : solid black 0.2em
......@@ -76,4 +89,3 @@
.preview a
pointer-events: none
<div .comment :is_unapproved:.unapproved :is_top_level:.top_level :is_even_depth:.even_depth :is_odd_depth:.odd_depth>
<div>
<div .comment-head>
<div .comment-head>
<div .comment-head-item>
$maybe author_avatar <- userAvatar user
<a href="@{UserR user_id}">
<img .small_avatar src="#{author_avatar}"> #
<a href="@{UserR user_id}">
#{userDisplayName (Entity user_id user)}
<div .comment-head>
$maybe approved_ts <- commentApprovedTs comment
^{renderTime approved_ts}
$nothing
^{renderTime $ commentCreatedTs comment}
<div .comment-head :is_preview:.preview>
<div .comment-head-item .comment-date>
^{renderTime (fromMaybe (commentCreatedTs comment) (commentApprovedTs comment))}
<div .comment-head-item :is_preview:.preview>
|
<div .comment-head :is_preview:.preview>
<div .comment-head-item :is_preview:.preview>
<a href="@{comment_route_permalink comment_id}">
permalink
$maybe parent_id <- commentParent comment
<div .comment-head :is_preview:.preview>
<div .comment-head-item :is_preview:.preview>
|
<div .comment-head :is_preview:.preview>
<div .comment-head-item :is_preview:.preview>
<a href="@{comment_route_permalink parent_id}">
parent
<div :is_preview:.preview>
$if can_edit
<div .comment-action>
<a href="@{comment_route_edit comment_id}">
edit
$if can_delete
<div .comment-action>
<a href="@{comment_route_delete comment_id}">
delete
$if can_retract
<div .comment-action>
<a href="@{comment_route_retract comment_id}" style="color: darkred">
retract
$forall closure <- earlier_closures
$case commentClosureType closure
$of Retracted
......@@ -81,61 +62,76 @@
#{flag_markdown}
<i>Please edit to address these concerns and repost.
$if is_unapproved
<div .awaiting-approval>
<span .glyphicon .glyphicon-arrow-right>
awaiting moderator approval
#{commentText comment}
<div>
$forall tag <- tags
^{tagWidget tag}
<div :is_preview:.preview>
<div :is_preview:.preview .comment-actions>
$if can_approve
<div .comment-action>
<a href="@{comment_route_approve comment_id}">
approve
$if can_claim
<div .comment-action>
<a href="@{comment_route_claim comment_id}">
claim
$if can_close
<div .comment-action>
<a href="@{comment_route_close comment_id}" style="color: goldenrod">
<a href="@{comment_route_close comment_id}">
close
$if can_rethread
$if can_delete
<div .comment-action>
<a href="@{comment_route_rethread comment_id}">
rethread
<a href="@{comment_route_delete comment_id}">
delete
$if can_add_tag
$if can_edit
<div .comment-action>
<a href="@{comment_route_add_tag comment_id}">
tag
<a href="@{comment_route_edit comment_id}">
edit
$if can_establish
<div .comment-action>
<a href="@{UserR user_id}">
establish user
$if can_flag
<div .comment-action>
<a href="@{comment_route_flag comment_id}">
flag
$if can_claim
$if can_reply
<div .comment-action>
<a href="@{comment_route_claim comment_id}">
claim
<a href="@{comment_route_reply comment_id}">
reply
$if can_unclaim
$if can_rethread
<div .comment-action>
<a href="@{comment_route_unclaim comment_id}">
unclaim
<a href="@{comment_route_rethread comment_id}">
rethread
$if can_reply
$if can_retract
<div .comment-action>
<a href="@{comment_route_reply comment_id}">
reply
<a href="@{comment_route_retract comment_id}">
retract
<div :is_preview:.preview>
$if can_approve
$if can_add_tag
<div .comment-action>
<a href="@{comment_route_approve comment_id}" style="color: green">
approve
<a href="@{comment_route_add_tag comment_id}">
tag
$if can_establish
$if can_unclaim
<div .comment-action>
<a href="@{UserR user_id}" style="color: green">
establish user
$if can_retract
$if is_unapproved
<i style="color: green">comment awaiting moderator approval
<a href="@{comment_route_unclaim comment_id}">
unclaim
^{inner_widget}
......@@ -63,7 +63,7 @@ $else
<th>Code
$forall Entity _ invite <- outstanding_invites
<tr>
<td>#{age now (inviteCreatedTs invite)}&nbsp;ago
<td>#{showDiffTime now (inviteCreatedTs invite)}&nbsp;ago
$with user_id <- inviteUser invite
<td>
<a href="@{UserR user_id}">
......@@ -87,7 +87,7 @@ $else
<th>Code
$forall Entity _ invite <- redeemed_invites
<tr>
<td>#{age now (fromMaybe now (inviteRedeemedTs invite))}&nbsp;ago
<td>#{showDiffTime now (fromMaybe now (inviteRedeemedTs invite))}&nbsp;ago
<td>#{format_user (inviteRedeemedBy invite)}
$with user_id <- inviteUser invite
<td>
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment