From 1bd4e550255c97180b0af10d28733623bd99e89b Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Thu, 27 Nov 2025 10:33:26 -0500 Subject: Render epic descriptions as markdown in web UI Successfully implemented markdown rendering for epic descriptions in the 1. **[Omni/Jr/Web.hs](file:///home/ben/omni/Omni/Jr/Web.hs#L380-L391)**: - "Design" header instead of "Description" - Markdown rendering via `renderMarkdown` function - Full-width `.markdown-content` wrapper 2. **[Omni/Jr/Web.hs](file:///home/ben/omni/Omni/Jr/Web.hs#L667-L779)**: - Headers (`#`, `##`, `###`) - Lists (`-` or `*`) - Code blocks (` ``` `) - Inline code (`` ` ``) - Bold text (`**`) 3. **[Omni/Jr/Web/Style.hs](file:///home/ben/omni/Omni/Jr/Web/Style.hs#L - `.markdown-content` with good typography - Headers with appropriate sizing/spacing - Code blocks and inline code - Lists with proper indentation - Dark mode support Task-Id: t-150.1 --- Omni/Jr/Web.hs | 120 ++++++++++++++++++++++++++++++++++++++++++++++++++- Omni/Jr/Web/Style.hs | 51 ++++++++++++++++++++++ 2 files changed, 169 insertions(+), 2 deletions(-) diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs index 7ca2ec3..49c9ad6 100644 --- a/Omni/Jr/Web.hs +++ b/Omni/Jr/Web.hs @@ -381,8 +381,13 @@ instance Lucid.ToHtml TaskDetailPage where Nothing -> pure () Just desc -> Lucid.div_ [Lucid.class_ "detail-section"] <| do - Lucid.h3_ "Description" - Lucid.pre_ [Lucid.class_ "description"] (Lucid.toHtml desc) + case TaskCore.taskType task of + TaskCore.Epic -> do + Lucid.h3_ "Design" + Lucid.div_ [Lucid.class_ "markdown-content"] (renderMarkdown desc) + _ -> do + Lucid.h3_ "Description" + Lucid.pre_ [Lucid.class_ "description"] (Lucid.toHtml desc) let children = filter (maybe False (TaskCore.matchesId (TaskCore.taskId task)) <. TaskCore.taskParent) allTasks unless (null children) <| do @@ -660,6 +665,117 @@ instance Lucid.ToHtml StatsPage where "" Lucid.span_ [Lucid.class_ "stats-count"] (Lucid.toHtml (tshow count)) +-- | Simple markdown renderer for epic descriptions +-- Supports: headers (#, ##, ###), lists (- or *), code blocks (```), inline code (`) +renderMarkdown :: (Monad m) => Text -> Lucid.HtmlT m () +renderMarkdown input = renderBlocks (parseBlocks (Text.lines input)) + +data MarkdownBlock + = MdHeader Int Text + | MdParagraph [Text] + | MdCodeBlock [Text] + | MdList [Text] + deriving (Show, Eq) + +parseBlocks :: [Text] -> [MarkdownBlock] +parseBlocks [] = [] +parseBlocks lns = case lns of + (l : rest) + | "```" `Text.isPrefixOf` l -> + let (codeLines, afterCode) = List.span (not <. Text.isPrefixOf "```") rest + remaining = List.drop 1 afterCode + in MdCodeBlock codeLines : parseBlocks remaining + | "### " `Text.isPrefixOf` l -> + MdHeader 3 (Text.drop 4 l) : parseBlocks rest + | "## " `Text.isPrefixOf` l -> + MdHeader 2 (Text.drop 3 l) : parseBlocks rest + | "# " `Text.isPrefixOf` l -> + MdHeader 1 (Text.drop 2 l) : parseBlocks rest + | isListItem l -> + let (listLines, afterList) = List.span isListItem lns + in MdList (map stripListPrefix listLines) : parseBlocks afterList + | Text.null (Text.strip l) -> + parseBlocks rest + | otherwise -> + let (paraLines, afterPara) = List.span isParagraphLine lns + in MdParagraph paraLines : parseBlocks afterPara + where + isListItem t = + let stripped = Text.stripStart t + in "- " `Text.isPrefixOf` stripped || "* " `Text.isPrefixOf` stripped + stripListPrefix t = + let stripped = Text.stripStart t + in Text.drop 2 stripped + isParagraphLine t = + not (Text.null (Text.strip t)) + && not ("```" `Text.isPrefixOf` t) + && not ("#" `Text.isPrefixOf` t) + && not (isListItem t) + +renderBlocks :: (Monad m) => [MarkdownBlock] -> Lucid.HtmlT m () +renderBlocks = traverse_ renderBlock + +renderBlock :: (Monad m) => MarkdownBlock -> Lucid.HtmlT m () +renderBlock block = case block of + MdHeader 1 txt -> Lucid.h2_ [Lucid.class_ "md-h1"] (renderInline txt) + MdHeader 2 txt -> Lucid.h3_ [Lucid.class_ "md-h2"] (renderInline txt) + MdHeader 3 txt -> Lucid.h4_ [Lucid.class_ "md-h3"] (renderInline txt) + MdHeader _ txt -> Lucid.h4_ (renderInline txt) + MdParagraph lns -> Lucid.p_ [Lucid.class_ "md-para"] (renderInline (Text.unlines lns)) + MdCodeBlock lns -> Lucid.pre_ [Lucid.class_ "md-code"] (Lucid.code_ (Lucid.toHtml (Text.unlines lns))) + MdList items -> Lucid.ul_ [Lucid.class_ "md-list"] (traverse_ renderListItem items) + +renderListItem :: (Monad m) => Text -> Lucid.HtmlT m () +renderListItem txt = Lucid.li_ (renderInline txt) + +-- | Render inline markdown (backtick code, bold, italic) +renderInline :: (Monad m) => Text -> Lucid.HtmlT m () +renderInline txt = renderInlineParts (parseInline txt) + +data InlinePart = PlainText Text | InlineCode Text | BoldText Text + deriving (Show, Eq) + +parseInline :: Text -> [InlinePart] +parseInline t + | Text.null t = [] + | otherwise = case Text.breakOn "`" t of + (before, rest) + | Text.null rest -> parseBold before + | otherwise -> + let afterTick = Text.drop 1 rest + in case Text.breakOn "`" afterTick of + (code, rest2) + | Text.null rest2 -> + parseBold before ++ [PlainText ("`" <> afterTick)] + | otherwise -> + parseBold before ++ [InlineCode code] ++ parseInline (Text.drop 1 rest2) + +parseBold :: Text -> [InlinePart] +parseBold t + | Text.null t = [] + | otherwise = case Text.breakOn "**" t of + (before, rest) + | Text.null rest -> [PlainText before | not (Text.null before)] + | otherwise -> + let afterBold = Text.drop 2 rest + in case Text.breakOn "**" afterBold of + (boldText, rest2) + | Text.null rest2 -> + [PlainText before | not (Text.null before)] ++ [PlainText ("**" <> afterBold)] + | otherwise -> + [PlainText before | not (Text.null before)] + ++ [BoldText boldText] + ++ parseBold (Text.drop 2 rest2) + +renderInlineParts :: (Monad m) => [InlinePart] -> Lucid.HtmlT m () +renderInlineParts = traverse_ renderInlinePart + +renderInlinePart :: (Monad m) => InlinePart -> Lucid.HtmlT m () +renderInlinePart part = case part of + PlainText txt -> Lucid.toHtml txt + InlineCode txt -> Lucid.code_ [Lucid.class_ "md-inline-code"] (Lucid.toHtml txt) + BoldText txt -> Lucid.strong_ (Lucid.toHtml txt) + api :: Proxy API api = Proxy diff --git a/Omni/Jr/Web/Style.hs b/Omni/Jr/Web/Style.hs index 140d4bb..d544e25 100644 --- a/Omni/Jr/Web/Style.hs +++ b/Omni/Jr/Web/Style.hs @@ -29,6 +29,7 @@ stylesheet = do buttonStyles formStyles activityTimelineStyles + markdownStyles responsiveStyles darkModeStyles @@ -563,6 +564,51 @@ activityTimelineStyles = do borderColor "#ef4444" color "#ef4444" +markdownStyles :: Css +markdownStyles = do + ".markdown-content" ? do + width (pct 100) + lineHeight (em 1.6) + fontSize (px 14) + color "#374151" + ".md-h1" ? do + fontSize (px 18) + fontWeight bold + margin (em 1) (px 0) (em 0.5) (px 0) + paddingBottom (em 0.3) + borderBottom (px 1) solid "#e5e7eb" + ".md-h2" ? do + fontSize (px 16) + fontWeight (weight 600) + margin (em 0.8) (px 0) (em 0.4) (px 0) + ".md-h3" ? do + fontSize (px 14) + fontWeight (weight 600) + margin (em 0.6) (px 0) (em 0.3) (px 0) + ".md-para" ? do + margin (em 0.5) (px 0) (em 0.5) (px 0) + ".md-code" ? do + fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace] + fontSize (px 12) + backgroundColor "#1e1e1e" + color "#d4d4d4" + padding (px 10) (px 12) (px 10) (px 12) + borderRadius (px 4) (px 4) (px 4) (px 4) + overflow auto + whiteSpace preWrap + margin (em 0.5) (px 0) (em 0.5) (px 0) + ".md-list" ? do + margin (em 0.5) (px 0) (em 0.5) (px 0) + paddingLeft (px 24) + (".md-list" ** li) ? do + margin (px 4) (px 0) (px 4) (px 0) + ".md-inline-code" ? do + fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace] + fontSize (em 0.9) + backgroundColor "#f3f4f6" + padding (px 1) (px 4) (px 1) (px 4) + borderRadius (px 2) (px 2) (px 2) (px 2) + responsiveStyles :: Css responsiveStyles = do query Media.screen [Media.maxWidth (px 600)] <| do @@ -682,6 +728,11 @@ darkModeStyles = ".activity-message" ? color "#d1d5db" (".activity-metadata" |> "summary") ? color "#9ca3af" ".metadata-json" ? backgroundColor "#374151" + ".markdown-content" ? color "#d1d5db" + ".md-h1" ? borderBottomColor "#374151" + ".md-inline-code" ? do + backgroundColor "#374151" + color "#f3f4f6" prefersDark :: Stylesheet.Feature prefersDark = -- cgit v1.2.3