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

Commit 18c4dbc9 authored by Mitchell Rosen's avatar Mitchell Rosen

fully render comment links in edited flagged comment notification

parent 96695c11
......@@ -2,12 +2,7 @@ module Handler.Utils where
import Import
import Blaze.ByteString.Builder (Builder, toLazyByteString)
import Control.Monad.Reader (MonadReader, ask)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TLE
import Yesod (renderRoute)
import qualified Data.Text as T
-- | Possible values for "mode" post param.
data PostMode
......@@ -28,12 +23,3 @@ lookupGetUTCTimeDefaultNow name = lookupGetParam name >>= \case
Just value -> case reads (T.unpack value) of
[(time,"")] -> return time
_ -> liftIO getCurrentTime
routeToText :: MonadReader App m => Route App -> m Text
routeToText route = do
app <- ask
let (path_pieces, query_params) = renderRoute route
return (b2t (joinPath app "" path_pieces query_params))
where
b2t :: Builder -> Text
b2t = TL.toStrict . TLE.decodeUtf8 . toLazyByteString
......@@ -57,10 +57,11 @@ module Model.Comment
import Import
import Model.Comment.Sql
import Model.Discussion
import Model.Notification
import Model.Tag
import Model.Comment.Sql
import Model.Discussion
import Model.Notification
import Model.Tag
import Model.Utils
import qualified Control.Monad.State as State
import Control.Monad.Writer.Strict (tell)
......@@ -68,6 +69,7 @@ import Data.Default (Default, def)
import Data.Foldable (Foldable)
import qualified Data.Foldable as F
import qualified Data.Map as M
import Data.Maybe (fromJust)
import qualified Data.Set as S
import qualified Data.Text as T
import Data.Tree
......@@ -329,8 +331,8 @@ editCommentDB comment_id text = do
lift (fetchCommentFlaggingDB comment_id) >>= \case
Nothing -> return ()
Just (Entity comment_flagging_id CommentFlagging{..}) -> do
permalink_text <- lift (getUrlRender <*> pure (CommentDirectLinkR comment_id))
let notif_text = Markdown $ "A comment you flagged has been edited and reposted to the site. You can view it [here](" <> permalink_text <> ")."
rendered_route <- lift (makeCommentRouteDB comment_id >>= lift . routeToText . fromJust)
let notif_text = Markdown $ "A comment you flagged has been edited and reposted to the site. You can view it [here](" <> rendered_route <> ")."
lift (deleteCascade comment_flagging_id) -- delete flagging and all flagging reasons with it.
sendNotificationDB_ NotifFlagRepost commentFlaggingFlagger Nothing notif_text
where
......@@ -679,4 +681,3 @@ makeCommentRouteDB comment_id = get comment_id >>= \case
DiscussionOnWikiPage (Entity _ wiki_page) -> do
project <- getJust (wikiPageProject wiki_page)
return (Just (WikiCommentR (projectHandle project) (wikiPageTarget wiki_page) comment_id))
module Model.Utils where
import Import
import Blaze.ByteString.Builder (Builder, toLazyByteString)
import Control.Monad.Reader (MonadReader, ask)
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TLE
import Yesod (renderRoute)
routeToText :: MonadReader App m => Route App -> m Text
routeToText route = do
app <- ask
let (path_pieces, query_params) = renderRoute route
return (b2t (joinPath app "" path_pieces query_params))
where
b2t :: Builder -> Text
b2t = TL.toStrict . TLE.decodeUtf8 . toLazyByteString
......@@ -54,6 +54,7 @@ library
Model.User
Model.User.Internal
Model.User.Sql
Model.Utils
Model.ViewType
Model.Wiki
Model.Wiki.Sql
......
......@@ -4,12 +4,12 @@ module SnowdriftEventHandler
import Import
import Handler.Utils
import Model.Comment
import Model.Discussion
import Model.Notification
import Model.Project
import Model.User
import Model.Utils
import Data.Maybe (fromJust)
import qualified Database.Persist
......
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