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

Skip to content

GitLab

Commit 8f9f7d0b authored by David L. L. Thomas's avatar David L. L. Thomas
Browse files
Options

Merge branch 'mitchellwrosen-master'

parents a7b30ed7 2b6b1204
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 1005 additions and 620 deletions
Handler/Comment.hs
View file @ 8f9f7d0b
This diff is collapsed.
Handler/Discussion.hs
View file @ 8f9f7d0b
......@@ -9,6 +9,6 @@ import Model.Discussion
-- "root comment getter", by looking for a "state=open" or "state=closed" GET param.
getDiscussion :: ((DiscussionId -> ExprCommentCond -> DB [Entity Comment]) -> Handler Html) -> Handler Html
getDiscussion callback = lookupGetParam "state" >>= \case
Just "closed" -> callback fetchDiscussionClosedRootCommentsDB
Just "closed" -> callback fetchDiscussionClosedOrRetractedRootCommentsDB
-- Not "closed"? Just accept anything else as meaning "open".
_ -> callback fetchDiscussionRootCommentsDB
Handler/Project.hs
View file @ 8f9f7d0b
......@@ -13,6 +13,7 @@ import Model.Application
import Model.Comment
import Model.Comment.ActionPermissions
import Model.Comment.HandlerInfo
import Model.Comment.Mods
import Model.Comment.Sql
import Model.Currency
import Model.Discussion
......@@ -116,8 +117,8 @@ checkProjectCommentActionPermission
project_handle
comment@(Entity comment_id _) = do
action_permissions <-
lookupErr "checkWikiPageCommentActionPermission: comment id not found in map" comment_id
<$> makeProjectCommentActionPermissionsMap (Just user) project_handle [comment]
lookupErr "checkProjectCommentActionPermission: comment id not found in map" comment_id
<$> makeProjectCommentActionPermissionsMap (Just user) project_handle def [comment]
unless (can_perform_action action_permissions)
(permissionDenied "You don't have permission to perform this action.")
......@@ -180,6 +181,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")
-------------------------------------------------------------------------------
--
......@@ -434,7 +440,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
......@@ -448,7 +454,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
......@@ -458,6 +464,34 @@ postApproveProjectCommentR project_handle comment_id = do
postApproveComment user_id comment_id comment
redirect (ProjectCommentR project_handle comment_id)
--------------------------------------------------------------------------------
-- /c/#CommentId/claim
getClaimProjectCommentR :: Text -> CommentId -> Handler Html
getClaimProjectCommentR project_handle comment_id = do
(widget, _) <-
makeProjectCommentActionWidget
makeClaimCommentWidget
project_handle
comment_id
def
getMaxDepth
defaultLayout (projectDiscussionPage project_handle widget)
postClaimProjectCommentR :: Text -> CommentId -> Handler Html
postClaimProjectCommentR project_handle comment_id = do
(user, (Entity project_id _), comment) <- checkCommentRequireAuth project_handle comment_id
checkProjectCommentActionPermission can_claim user project_handle (Entity comment_id comment)
postClaimComment
user
comment_id
comment
(projectCommentHandlerInfo (Just user) project_id project_handle)
>>= \case
Nothing -> redirect (ProjectCommentR project_handle comment_id)
Just (widget, form) -> defaultLayout $ previewWidget form "claim" (projectDiscussionPage project_handle widget)
--------------------------------------------------------------------------------
-- /c/#CommentId/close
......@@ -470,7 +504,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
......@@ -484,7 +519,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
......@@ -498,7 +533,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
......@@ -522,7 +557,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
......@@ -535,7 +570,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, form) -> defaultLayout $ previewWidget form "post" (projectDiscussionPage project_handle widget)
--------------------------------------------------------------------------------
-- /c/#CommentId/flag
......@@ -549,7 +584,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
......@@ -562,7 +597,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, form) -> defaultLayout $ previewWidget form "flag" (projectDiscussionPage project_handle widget)
--------------------------------------------------------------------------------
-- /c/#CommentId/reply
......@@ -576,7 +611,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
......@@ -587,9 +622,9 @@ postReplyProjectCommentR project_handle parent_id = do
(Just parent_id)
user
(projectDiscussion project)
(makeProjectCommentActionPermissionsMap (Just user) project_handle) >>= \case
(makeProjectCommentActionPermissionsMap (Just user) project_handle def) >>= \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
......@@ -603,7 +638,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
......@@ -623,7 +658,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
......@@ -637,7 +672,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
......@@ -677,6 +712,34 @@ getProjectCommentAddTagR project_handle comment_id = do
checkProjectCommentActionPermission can_add_tag user project_handle (Entity comment_id comment)
getProjectCommentAddTag comment_id project_id user_id
--------------------------------------------------------------------------------
-- /c/#CommentId/unclaim
getUnclaimProjectCommentR :: Text -> CommentId -> Handler Html
getUnclaimProjectCommentR project_handle comment_id = do
(widget, _) <-
makeProjectCommentActionWidget
makeUnclaimCommentWidget
project_handle
comment_id
def
getMaxDepth
defaultLayout (projectDiscussionPage project_handle widget)
postUnclaimProjectCommentR :: Text -> CommentId -> Handler Html
postUnclaimProjectCommentR project_handle comment_id = do
(user, (Entity project_id _), comment) <- checkCommentRequireAuth project_handle comment_id
checkProjectCommentActionPermission can_unclaim user project_handle (Entity comment_id comment)
postUnclaimComment
user
comment_id
comment
(projectCommentHandlerInfo (Just user) project_id project_handle)
>>= \case
Nothing -> redirect (ProjectCommentR project_handle comment_id)
Just (widget, form) -> defaultLayout $ previewWidget form "unclaim" (projectDiscussionPage project_handle widget)
--------------------------------------------------------------------------------
-- /contact
......@@ -732,7 +795,7 @@ getProjectDiscussion project_handle get_root_comments = do
project_handle
root_comments
def
(getMaxDepthDefault 0)
getMaxDepth
False
mempty
......@@ -754,7 +817,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
......@@ -765,9 +828,9 @@ postNewProjectDiscussionR project_handle = do
Nothing
user
projectDiscussion
(makeProjectCommentActionPermissionsMap (Just user) project_handle) >>= \case
(makeProjectCommentActionPermissionsMap (Just user) project_handle def) >>= \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
......@@ -806,7 +869,8 @@ getProjectFeedR project_handle = do
(project, comments, rethreads, wiki_pages, wiki_edits, new_pledges,
updated_pledges, deleted_pledges, discussion_map, wiki_page_map, user_map,
earlier_closures_map, closure_map, ticket_map, flag_map) <- runYDB $ do
earlier_closures_map, earlier_retracts_map, closure_map, retract_map,
ticket_map, claim_map, flag_map) <- runYDB $ do
Entity project_id project <- getBy404 (UniqueProjectHandle project_handle)
......@@ -840,16 +904,20 @@ getProjectFeedR project_handle = do
user_map <- entitiesMap <$> fetchUsersInDB user_ids
earlier_closures_map <- fetchCommentsAncestorClosuresDB comment_ids
closure_map <- makeClosureMapDB comment_ids
ticket_map <- makeTicketMapDB comment_ids
flag_map <- makeFlagMapDB comment_ids
earlier_retracts_map <- fetchCommentsAncestorRetractsDB comment_ids
closure_map <- makeCommentClosingMapDB comment_ids
retract_map <- makeCommentRetractingMapDB comment_ids
ticket_map <- makeTicketMapDB comment_ids
claim_map <- makeClaimedTicketMapDB comment_ids
flag_map <- makeFlagMapDB comment_ids
return (project, comments, rethreads, wiki_pages, wiki_edits,
new_pledges, updated_pledges, deleted_pledges, discussion_map,
wiki_page_map, user_map, earlier_closures_map, closure_map,
ticket_map, flag_map)
wiki_page_map, user_map, earlier_closures_map,
earlier_retracts_map, closure_map, retract_map, ticket_map,
claim_map, flag_map)
action_permissions_map <- makeProjectCommentActionPermissionsMap muser project_handle comments
action_permissions_map <- makeProjectCommentActionPermissionsMap muser project_handle def comments
let all_unsorted_events = mconcat
[ map (onEntity ECommentPosted) comments
......
Handler/Wiki.hs
View file @ 8f9f7d0b
......@@ -222,7 +222,7 @@ getWikiDiscussionR' project_handle target get_root_comments = do
(wikiPageTarget page)
root_comments
def
(getMaxDepthDefault 0)
getMaxDepth
False
mempty
......@@ -255,7 +255,7 @@ postNewWikiDiscussionR project_handle target = do
Nothing
user
wikiPageDiscussion
(makeProjectCommentActionPermissionsMap (Just user) project_handle) >>= \case
(makeProjectCommentActionPermissionsMap (Just user) project_handle def) >>= \case
Left comment_id -> redirect (WikiCommentR project_handle target comment_id)
Right (widget, form) -> defaultLayout $ previewWidget form "post" ($(widgetFile "wiki_discussion_wrapper"))
......
Handler/Wiki/Comment.hs
View file @ 8f9f7d0b
......@@ -9,6 +9,7 @@ import Handler.Project (checkProjectCommentActionPermission)
import Model.Comment
import Model.Comment.ActionPermissions
import Model.Comment.HandlerInfo
import Model.Comment.Mods
import Model.Comment.Sql
import Model.User
import Widgets.Preview
......@@ -121,6 +122,11 @@ makeWikiPageCommentActionWidget make_comment_action_widget project_handle target
get_max_depth
False
wikiDiscussionPage :: Text -> Text -> Widget -> Widget
wikiDiscussionPage project_handle target widget = do
$(widgetFile "wiki_discussion_wrapper")
toWidget $(cassiusFile "templates/comment.cassius")
--------------------------------------------------------------------------------
-- /
......@@ -144,9 +150,37 @@ getWikiCommentR project_handle target comment_id = do
Just (Entity user_id _) ->
runDB (userMaybeViewProjectCommentsDB user_id project_id (map entityKey (Tree.flatten comment_tree)))
defaultLayout $ do
$(widgetFile "wiki_discussion_wrapper")
toWidget $(cassiusFile "templates/comment.cassius")
defaultLayout (wikiDiscussionPage project_handle target widget)
--------------------------------------------------------------------------------
-- /claim
getClaimWikiCommentR :: Text -> Text -> CommentId -> Handler Html
getClaimWikiCommentR project_handle target comment_id = do
(widget, _) <-
makeWikiPageCommentActionWidget
makeClaimCommentWidget
project_handle
target
comment_id
def
getMaxDepth
defaultLayout (wikiDiscussionPage project_handle target widget)
postClaimWikiCommentR :: Text -> Text -> CommentId -> Handler Html
postClaimWikiCommentR project_handle target comment_id = do
(user, (Entity project_id _), _, comment) <- checkCommentPageRequireAuth project_handle target comment_id
checkProjectCommentActionPermission can_claim user project_handle (Entity comment_id comment)
postClaimComment
user
comment_id
comment
(wikiPageCommentHandlerInfo (Just user) project_id project_handle target)
>>= \case
Nothing -> redirect (WikiCommentR project_handle target comment_id)
Just (widget, form) -> defaultLayout $ previewWidget form "claim" (wikiDiscussionPage project_handle target widget)
--------------------------------------------------------------------------------
-- /close
......@@ -161,9 +195,7 @@ getCloseWikiCommentR project_handle target comment_id = do
comment_id
def
getMaxDepth
defaultLayout $ do
$(widgetFile "wiki_discussion_wrapper")
toWidget $(cassiusFile "templates/comment.cassius")
defaultLayout (wikiDiscussionPage project_handle target widget)
postCloseWikiCommentR :: Text -> Text -> CommentId -> Handler Html
postCloseWikiCommentR project_handle target comment_id = do
......@@ -177,7 +209,7 @@ postCloseWikiCommentR project_handle target comment_id = do
(wikiPageCommentHandlerInfo (Just user) project_id project_handle target)
>>= \case
Nothing -> redirect (WikiCommentR project_handle target comment_id)
Just (widget, form) -> defaultLayout $ previewWidget form "close" ($(widgetFile "wiki_discussion_wrapper"))
Just (widget, form) -> defaultLayout $ previewWidget form "close" (wikiDiscussionPage project_handle target widget)
--------------------------------------------------------------------------------
-- /delete
......@@ -192,9 +224,7 @@ getDeleteWikiCommentR project_handle target comment_id = do
comment_id
def
getMaxDepth
defaultLayout $ do
$(widgetFile "wiki_discussion_wrapper")
toWidget $(cassiusFile "templates/comment.cassius")
defaultLayout (wikiDiscussionPage project_handle target widget)
postDeleteWikiCommentR :: Text -> Text -> CommentId -> Handler Html
postDeleteWikiCommentR project_handle target comment_id = do
......@@ -219,9 +249,7 @@ getEditWikiCommentR project_handle target comment_id = do
comment_id
def
getMaxDepth
defaultLayout $ do
$(widgetFile "wiki_discussion_wrapper")
toWidget $(cassiusFile "templates/comment.cassius")
defaultLayout (wikiDiscussionPage project_handle target widget)
postEditWikiCommentR :: Text -> Text -> CommentId -> Handler Html
postEditWikiCommentR project_handle target comment_id = do
......@@ -234,7 +262,7 @@ postEditWikiCommentR project_handle target comment_id = do
(wikiPageCommentHandlerInfo (Just user) project_id project_handle target)
>>= \case
Nothing -> redirect (WikiCommentR project_handle target comment_id) -- Edit made.
Just widget -> defaultLayout $(widgetFile "wiki_discussion_wrapper") -- Previewing edit.
Just (widget, form) -> defaultLayout $ previewWidget form "post" (wikiDiscussionPage project_handle target widget)
--------------------------------------------------------------------------------
-- /flag
......@@ -249,9 +277,7 @@ getFlagWikiCommentR project_handle target comment_id = do
comment_id
def
getMaxDepth
defaultLayout $ do
$(widgetFile "wiki_discussion_wrapper")
toWidget $(cassiusFile "templates/comment.cassius")
defaultLayout (wikiDiscussionPage project_handle target widget)
postFlagWikiCommentR :: Text -> Text -> CommentId -> Handler Html
postFlagWikiCommentR project_handle target comment_id = do
......@@ -264,7 +290,7 @@ postFlagWikiCommentR project_handle target comment_id = do
(wikiPageCommentHandlerInfo (Just user) project_id project_handle target)
>>= \case
Nothing -> redirect (WikiDiscussionR project_handle target)
Just widget -> defaultLayout $(widgetFile "wiki_discussion_wrapper")
Just (widget, form) -> defaultLayout $ previewWidget form "flag" (wikiDiscussionPage project_handle target widget)
--------------------------------------------------------------------------------
-- /moderate TODO: rename to /approve
......@@ -279,9 +305,7 @@ getApproveWikiCommentR project_handle target comment_id = do
comment_id
def
getMaxDepth
defaultLayout $ do
$(widgetFile "wiki_discussion_wrapper")
toWidget $(cassiusFile "templates/comment.cassius")
defaultLayout (wikiDiscussionPage project_handle target widget)
postApproveWikiCommentR :: Text -> Text -> CommentId -> Handler Html
postApproveWikiCommentR project_handle target comment_id = do
......@@ -304,9 +328,7 @@ getReplyWikiCommentR project_handle target comment_id = do
comment_id
def
getMaxDepth
defaultLayout $ do
$(widgetFile "wiki_discussion_wrapper")
toWidget $(cassiusFile "templates/comment.cassius")
defaultLayout (wikiDiscussionPage project_handle target widget)
postReplyWikiCommentR :: Text -> Text -> CommentId -> Handler Html
postReplyWikiCommentR project_handle target parent_id = do
......@@ -317,9 +339,9 @@ postReplyWikiCommentR project_handle target parent_id = do
(Just parent_id)
user
(wikiPageDiscussion page)
(makeProjectCommentActionPermissionsMap (Just user) project_handle) >>= \case
(makeProjectCommentActionPermissionsMap (Just user) project_handle def) >>= \case
Left _ -> redirect (WikiCommentR project_handle target parent_id)
Right (widget, form) -> defaultLayout $ previewWidget form "post" ($(widgetFile "wiki_discussion_wrapper"))
Right (widget, form) -> defaultLayout $ previewWidget form "post" (wikiDiscussionPage project_handle target widget)
--------------------------------------------------------------------------------
-- /rethread
......@@ -334,9 +356,7 @@ getRethreadWikiCommentR project_handle target comment_id = do
comment_id
def
getMaxDepth
defaultLayout $ do
$(widgetFile "wiki_discussion_wrapper")
toWidget $(cassiusFile "templates/comment.cassius")
defaultLayout (wikiDiscussionPage project_handle target widget)
postRethreadWikiCommentR :: Text -> Text -> CommentId -> Handler Html
postRethreadWikiCommentR project_handle target comment_id = do
......@@ -357,9 +377,7 @@ getRetractWikiCommentR project_handle target comment_id = do
comment_id
def
getMaxDepth
defaultLayout $ do
$(widgetFile "wiki_discussion_wrapper")
toWidget $(cassiusFile "templates/comment.cassius")
defaultLayout (wikiDiscussionPage project_handle target widget)
postRetractWikiCommentR :: Text -> Text -> CommentId -> Handler Html
postRetractWikiCommentR project_handle target comment_id = do
......@@ -373,7 +391,7 @@ postRetractWikiCommentR project_handle target comment_id = do
(wikiPageCommentHandlerInfo (Just user) project_id project_handle target)
>>= \case
Nothing -> redirect (WikiCommentR project_handle target comment_id)
Just (widget, form) -> defaultLayout $ previewWidget form "retract" ($(widgetFile "wiki_discussion_wrapper"))
Just (widget, form) -> defaultLayout $ previewWidget form "retract" (wikiDiscussionPage project_handle target widget)
--------------------------------------------------------------------------------
-- /tags
......@@ -413,6 +431,37 @@ getWikiCommentAddTagR project_handle target comment_id = do
checkProjectCommentActionPermission can_add_tag user project_handle (Entity comment_id comment)
getProjectCommentAddTag comment_id project_id user_id
--------------------------------------------------------------------------------
-- /unclaim
getUnclaimWikiCommentR :: Text -> Text -> CommentId -> Handler Html
getUnclaimWikiCommentR project_handle target comment_id = do
(widget, _) <-
makeWikiPageCommentActionWidget
makeUnclaimCommentWidget
project_handle
target
comment_id
def
getMaxDepth
defaultLayout (wikiDiscussionPage project_handle target widget)
postUnclaimWikiCommentR :: Text -> Text -> CommentId -> Handler Html
postUnclaimWikiCommentR project_handle target comment_id = do
(user, (Entity project_id _), _, comment) <- checkCommentPageRequireAuth project_handle target comment_id
checkProjectCommentActionPermission can_unclaim user project_handle (Entity comment_id comment)
postUnclaimComment
user
comment_id
comment
(wikiPageCommentHandlerInfo (Just user) project_id project_handle target)
>>= \case
Nothing -> redirect (WikiCommentR project_handle target comment_id)
Just (widget, form) -> defaultLayout $ previewWidget form "unclaim" (wikiDiscussionPage project_handle target widget)
--------------------------------------------------------------------------------
-- DEPRECATED
......
Import.hs
View file @ 8f9f7d0b
......@@ -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 = 3600 -- 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
......
Model.hs
View file @ 8f9f7d0b
......@@ -2,7 +2,7 @@
module Model where
import Model.Comment.Internal (ClosureType, FlagReason, Visibility)
import Model.Comment.Internal (FlagReason, Visibility)
import Model.Currency (Milray)
import Model.Established.Internal (Established(..))
import Model.Markdown.Diff (MarkdownDiff)
......
Model/CollapseState.hs
View file @ 8f9f7d0b
......@@ -7,12 +7,14 @@ import Model.CollapseState.Internal