core: markdown headers

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

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