From 37eb564cd25fd46a6aebc637263a4059e710046b Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Tue, 1 Sep 2026 16:01:29 +0000 Subject: [PATCH] core: markdown headers --- src/Simplex/Chat/Markdown.hs | 12 +++++++++++- tests/MarkdownTests.hs | 25 +++++++++++++++++++++++++ 2 files changed, 36 insertions(+), 1 deletion(-) diff --git a/src/Simplex/Chat/Markdown.hs b/src/Simplex/Chat/Markdown.hs index c877a22c2b..58ff11a130 100644 --- a/src/Simplex/Chat/Markdown.hs +++ b/src/Simplex/Chat/Markdown.hs @@ -55,6 +55,7 @@ data Format | Snippet | Secret | Small + | Header {level :: Int} | Colored {color :: FormatColor} | Uri -- showText is Nothing for the usual Uri without text @@ -203,8 +204,16 @@ hasObfuscatedSimplexLink t = <|> pure False markdownP :: Parser Markdown -markdownP = mconcat <$> A.many' fragmentP +markdownP = headerP <|> (mconcat <$> A.many' fragmentP) where + headerP :: Parser Markdown + headerP = do + hs <- A.takeWhile1 (== '#') + s <- A.takeText + let n = T.length hs + if n > 6 || T.null s || T.head s /= ' ' + then fail "not header" + else pure $ markdown (Header n) s fragmentP :: Parser Markdown fragmentP = A.peekChar >>= \case @@ -479,6 +488,7 @@ markdownText (FormattedText f_ t) = case f_ of Snippet -> around '`' Secret -> around '#' Small -> "!- " <> t <> "!" + Header n -> T.replicate n "#" <> t Colored (FormatColor c) -> color c Uri -> t HyperLink {} -> t diff --git a/tests/MarkdownTests.hs b/tests/MarkdownTests.hs index 1f9936044c..db0e48b0ad 100644 --- a/tests/MarkdownTests.hs +++ b/tests/MarkdownTests.hs @@ -20,6 +20,7 @@ import qualified URI.ByteString as U markdownTests :: Spec markdownTests = do textFormat + textHeader secretText textSmall textColor @@ -57,6 +58,9 @@ s <<==>> ft = (s ==>> ft) >> (s <<== ft) bold :: Text -> Markdown bold = markdown Bold +header :: Int -> Text -> Markdown +header n = markdown (Header n) + textFormat :: Spec textFormat = describe "text format (bold)" do it "correct markdown" do @@ -116,6 +120,27 @@ textFormat = describe "text format (bold)" do "snippet: `this is *bold text*`" <==> "snippet: " <> markdown Snippet "this is *bold text*" +textHeader :: Spec +textHeader = describe "text header" do + it "correct markdown" do + "# Header" + <==> header 1 " Header" + "## Header" + <==> header 2 " Header" + "###### Header" + <==> header 6 " Header" + "# Header" + <==> header 1 " Header" + "# Header with *bold* not nested" + <==> header 1 " Header with *bold* not nested" + it "ignored as markdown" do + "####### Header" + <==> "####### Header" + " # Header" + <==> " # Header" + "#" + <==> "#" + secretText :: Spec secretText = describe "secret text" do it "correct markdown" do