commit 1bd4e550255c97180b0af10d28733623bd99e89b
Author: Ben Sima <ben@bensima.com>
Date: Thu Nov 27 10:33:26 2025
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
diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs
index 7ca2ec39..49c9ad66 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 140d4bb7..d544e25b 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 =