markdown tests (#86)

apps/dog-food/Styled.hs

@@ -32,7 +32,6 @@ styleMarkdown (Markdown f s) = Styled sgr $ T.unpack s
       Italic -> [SetUnderlining SingleUnderline, SetItalicized True]
       Underline -> [SetUnderlining SingleUnderline]
       StrikeThrough -> [SetSwapForegroundBackground True]
-      Colored Black -> [SetColor Foreground Dull Black]
       Colored c -> [SetColor Foreground Vivid c]
       Snippet -> []
       NoFormat -> []

src/Simplex/Markdown.hs

@@ -16,7 +16,7 @@ import qualified Data.Text as T
 import System.Console.ANSI.Types
 
 data Markdown = Markdown Format Text | Markdown :|: Markdown
-  deriving (Show)
+  deriving (Eq, Show)
 
 data Format
   = Bold
@@ -26,7 +26,7 @@ data Format
   | Snippet
   | Colored Color
   | NoFormat
-  deriving (Show)
+  deriving (Eq, Show)
 
 instance Semigroup Markdown where (<>) = (:|:)
 
@@ -82,8 +82,7 @@ markdownP = merge <$> A.many' fragmentP
   where
     merge :: [Markdown] -> Markdown
     merge [] = ""
-    merge [f] = f
-    merge (f : fs) = foldl (:|:) f fs
+    merge fs = foldr1 (:|:) fs
     fragmentP :: Parser Markdown
     fragmentP =
       A.anyChar >>= \case

tests/MarkdownTests.hs

@@ -0,0 +1,89 @@
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module MarkdownTests where
+
+import Data.Text (Text)
+import Simplex.Markdown
+import System.Console.ANSI.Types
+import Test.Hspec
+
+markdownTests :: Spec
+markdownTests = do
+  textFormat
+  textColor
+
+textFormat :: Spec
+textFormat = describe "text format (bold)" do
+  it "correct markdown" do
+    parseMarkdown "this is *bold formatted* text"
+      `shouldBe` "this is " <> Markdown Bold "bold formatted" <> " " <> "text"
+    parseMarkdown "*bold formatted* text"
+      `shouldBe` Markdown Bold "bold formatted" <> " " <> "text"
+    parseMarkdown "this is *bold*"
+      `shouldBe` "this is " <> Markdown Bold "bold"
+    parseMarkdown " *bold* text"
+      `shouldBe` " " <> Markdown Bold "bold" <> " " <> "text"
+    parseMarkdown "   *bold* text"
+      `shouldBe` "   " <> Markdown Bold "bold" <> " " <> "text"
+    parseMarkdown "this is *bold* "
+      `shouldBe` "this is " <> Markdown Bold "bold" <> " "
+    parseMarkdown "this is *bold*   "
+      `shouldBe` "this is " <> Markdown Bold "bold" <> "   "
+  it "ignored as markdown" do
+    parseMarkdown "this is * unformatted * text"
+      `shouldBe` "this is " <> "* unformatted *" <> " " <> "text"
+    parseMarkdown "this is *unformatted * text"
+      `shouldBe` "this is " <> "*unformatted *" <> " " <> "text"
+    parseMarkdown "this is * unformatted* text"
+      `shouldBe` "this is " <> "* unformatted*" <> " " <> "text"
+    parseMarkdown "this is **unformatted** text"
+      `shouldBe` "this is " <> "**" <> "unformatted** text"
+    parseMarkdown "this is*unformatted* text"
+      `shouldBe` "this is*unformatted* text"
+    parseMarkdown "this is *unformatted text"
+      `shouldBe` "this is " <> "*unformatted text"
+  it "ignored internal markdown" do
+    parseMarkdown "this is *long _bold_ (not italic)* text"
+      `shouldBe` "this is " <> Markdown Bold "long _bold_ (not italic)" <> " " <> "text"
+    parseMarkdown "snippet: `this is *bold text*`"
+      `shouldBe` "snippet: " <> Markdown Snippet "this is *bold text*"
+
+red :: Text -> Markdown
+red = Markdown (Colored Red)
+
+textColor :: Spec
+textColor = describe "text color (red)" do
+  it "correct markdown" do
+    parseMarkdown "this is !1 red color! text"
+      `shouldBe` "this is " <> red "red color" <> " " <> "text"
+    parseMarkdown "!1 red! text"
+      `shouldBe` red "red" <> " " <> "text"
+    parseMarkdown "this is !1 red!"
+      `shouldBe` "this is " <> red "red"
+    parseMarkdown " !1 red! text"
+      `shouldBe` " " <> red "red" <> " " <> "text"
+    parseMarkdown "   !1 red! text"
+      `shouldBe` "   " <> red "red" <> " " <> "text"
+    parseMarkdown "this is !1 red! "
+      `shouldBe` "this is " <> red "red" <> " "
+    parseMarkdown "this is !1 red!   "
+      `shouldBe` "this is " <> red "red" <> "   "
+  it "ignored as markdown" do
+    parseMarkdown "this is !1 unformatted ! text"
+      `shouldBe` "this is " <> "!1 unformatted !" <> " " <> "text"
+    parseMarkdown "this is !1 unformatted ! text"
+      `shouldBe` "this is " <> "!1 unformatted !" <> " " <> "text"
+    parseMarkdown "this is !1  unformatted! text"
+      `shouldBe` "this is " <> "!1  unformatted!" <> " " <> "text"
+    -- parseMarkdown "this is !!1 unformatted!! text"
+    --   `shouldBe` "this is " <> "!!1" <> "unformatted!! text"
+    parseMarkdown "this is!1 unformatted! text"
+      `shouldBe` "this is!1 unformatted! text"
+    parseMarkdown "this is !1 unformatted text"
+      `shouldBe` "this is " <> "!1 unformatted text"
+  it "ignored internal markdown" do
+    parseMarkdown "this is !1 long *red* (not bold)! text"
+      `shouldBe` "this is " <> red "long *red* (not bold)" <> " " <> "text"
+    parseMarkdown "snippet: `this is !1 red text!`"
+      `shouldBe` "snippet: " <> Markdown Snippet "this is !1 red text!"

tests/Test.hs

@@ -1,10 +1,10 @@
-{-# LANGUAGE BlockArguments #-}
-
 import AgentTests
+import MarkdownTests
 import ServerTests
 import Test.Hspec
 
 main :: IO ()
-main = hspec do
+main = hspec $ do
+  describe "SimpleX markdown" markdownTests
   describe "SMP server" serverTests
   describe "SMP client agent" agentTests