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

Commit bdd8f107 authored by David L. L. Thomas's avatar David L. L. Thomas

Ticket title markup with numbers. Needs styling.

parent e9fdcb27
......@@ -9,8 +9,11 @@ import Text.Regex.TDFA
import Text.Regex.TDFA.ByteString
import Yesod.Markdown (markdownToHtml, Markdown (..))
fixLinks :: Text -> Text -> Text
fixLinks project' line' =
-- TODO: we should probably put together some standard sets of these transforms for use in various places, rather than assembling ad-hoc
fixLinks :: Text -> Text -> Handler Text
fixLinks project' line' = do
let Right pattern = compile defaultCompOpt defaultExecOpt "(\\[[^]]*\\])\\(([a-z]+:)?([a-z0-9-]+)\\)"
project = encodeUtf8 project'
parse _ (Left err) = error err
......@@ -27,7 +30,7 @@ fixLinks project' line' =
parse _ (Right (Just _)) = error "strange match"
line = encodeUtf8 line'
in decodeUtf8 $ parse line (regexec pattern line)
return $ decodeUtf8 $ parse line (regexec pattern line)
linkTickets :: Text -> Handler Text
......@@ -73,24 +76,23 @@ linkTickets line' = do
line = encodeUtf8 line'
in fmap decodeUtf8 $ parse line (regexec pattern line)
renderMarkdown :: Text -> Markdown -> Handler Html
renderMarkdown :: Markdown -> Handler Html
renderMarkdown = renderMarkdownWith return
renderMarkdownWith :: (Text -> Handler Text) -> Text -> Markdown -> Handler Html
renderMarkdownWith transform project (Markdown markdown) = do
renderMarkdownWith :: (Text -> Handler Text) -> Markdown -> Handler Html
renderMarkdownWith transform (Markdown markdown) = do
let ls = T.lines markdown
ls' <- mapM (transform <=< linkTickets . fixLinks project) ls
ls' <- mapM (transform <=< linkTickets) ls
return $ markdownToHtml $ Markdown $ T.unlines ls'
markdownWidget :: Text -> Markdown -> Widget
markdownWidget :: Markdown -> Widget
markdownWidget = markdownWidgetWith return
markdownWidgetWith :: (Text -> Handler Text) -> Text -> Markdown -> Widget
markdownWidgetWith transform project markdown = do
rendered <- handlerToWidget $ renderMarkdownWith transform project markdown
markdownWidgetWith :: (Text -> Handler Text) -> Markdown -> Widget
markdownWidgetWith transform markdown = do
rendered <- handlerToWidget $ renderMarkdownWith transform markdown
toWidget rendered
......@@ -33,6 +33,7 @@ import Model.Comment.ActionPermissions
import Model.Comment.Routes
import Model.Tag
import Model.User
import Model.Markdown
import View.User
import Widgets.Markdown
import Widgets.Tag
......@@ -357,7 +358,7 @@ commentWidget (Entity comment_id comment)
earlier_closures
user
mclosure
_ -- mticket
mticket
mflag
is_preview
inner_widget = do
......@@ -374,18 +375,14 @@ commentWidget (Entity comment_id comment)
M.lookup comment_id <$>
(fetchCommentCommentTagsDB comment_id >>= buildAnnotatedCommentTagsDB mviewer_id)
{-
let ticket_str = case mticket of
Just (Entity (Key (PersistInt64 tid)) _) -> T.pack $ show tid
_ -> "???"
-- error about ambiguity about monad type in this, needs to be adjusted to
-- fit the idea that comments aren't necessarily on wiki pages
prettyTicketLine line =
let pretty title = "<div class='ticket-title'>SD-" <> ticket_str <> ": " <> title <> "</div>"
in return $ maybe line pretty $ T.stripPrefix "ticket: " line
commentTextTransform = prettyTicketLine
-}
$(widgetFile "comment")
......@@ -31,7 +31,7 @@ renderProject maybe_project_id project pledges pledge = do
users = fromIntegral $ length pledges
shares = sum pledges
project_value = share_value $* fromIntegral shares
description = markdownWidget (projectHandle project) $ projectDescription project
description = markdownWidgetWith (fixLinks $ projectHandle project) $ projectDescription project
maybe_shares = pledgeShares . entityVal <$> pledge
......@@ -76,7 +76,7 @@ renderBlogPost project_handle blog_post = do
let (Markdown top_content) = projectBlogTopContent blog_post
(Markdown bottom_content) = maybe (Markdown "") ("***\n" <>) $ projectBlogBottomContent blog_post
title = projectBlogTitle blog_post
content = markdownWidget project_handle $ Markdown $ T.snoc top_content '\n' <> bottom_content
content = markdownWidgetWith (fixLinks project_handle) $ Markdown $ T.snoc top_content '\n' <> bottom_content
$(widgetFile "blog_post")
......
......@@ -108,7 +108,6 @@ previewUserForm User{..} = renderBootstrap3 $
renderUser :: Maybe UserId -> UserId -> User -> Map (Entity Project) (Set Role) -> Widget
renderUser mviewer_id user_id user projects_and_roles = do
let user_entity = Entity user_id user
project_handle = error "bad link - no default project on user pages" -- TODO turn this into a caught exception
should_show_est_form <- handlerToWidget (canCurUserMakeEligible user_id)
mest_form_and_enctype <-
......
......@@ -81,7 +81,7 @@
#{flag_markdown}
<i>Please edit to address these concerns and repost.
#{commentText comment}
^{markdownWidgetWith commentTextTransform (commentText comment)}
<div>
$forall tag <- tags
......
^{markdownWidget "snowdrift" (wikiEditContent page)}
^{markdownWidget (wikiEditContent page)}
......@@ -9,7 +9,7 @@ $forall Entity _ post <- posts
^{renderTime $ projectBlogTime post}
<p>
^{markdownWidget project_handle $ projectBlogTopContent post}
^{markdownWidgetWith (fixLinks project_handle) $ projectBlogTopContent post}
<hr>
......
......@@ -18,7 +18,7 @@
<div .col-md-6>
$maybe blurb <- userBlurb user
^{markdownWidget project_handle blurb}
^{markdownWidget blurb}
$nothing
&nbsp;
......@@ -50,7 +50,7 @@
$maybe statement <- userStatement user
<h3>Personal Statement
<div .well .well-sm .scroll .capped>
^{markdownWidget project_handle statement}
^{markdownWidget statement}
$maybe (est_form, est_form_enctype) <- mest_form_and_enctype
<div .row>
......
......@@ -11,6 +11,6 @@ $forall Entity user_id user <- members
<img .headshot src="@{StaticR img_placeholder_png}">
<div .blurb .col-sm-9>
$maybe blurb <- userBlurb user
^{markdownWidget project_handle blurb}
^{markdownWidgetWith (fixLinks project_handle) blurb}
$nothing
&nbsp;
......@@ -10,5 +10,5 @@
<span .badge>
#{comment_count}
^{markdownWidget project_handle (wikiPageContent page)}
^{markdownWidgetWith (fixLinks project_handle) (wikiPageContent page)}
......@@ -14,4 +14,4 @@
<div .page-tool>
<a href="@{WikiDiscussionR project_handle target}">view discussion
^{markdownWidget project_handle (wikiEditContent edit)}
^{markdownWidgetWith (fixLinks project_handle) (wikiEditContent edit)}
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