Implement some tests for the ‘Text.MMark.Extension’ module

Text/MMark/Parser.hs

@@ -106,7 +106,7 @@ parseMMark file input =
 pBlocks :: Parser [Block Isp]
 pBlocks = do
   setTabWidth (mkPos 4)
-  between sc eof (many pBlock)
+  between sc eof (manyTill pBlock eof)
 
 pBlock :: Parser (Block Isp)
 pBlock = choice
@@ -127,25 +127,26 @@ pThematicBreak = try $ do
 pAtxHeading :: Parser (Block Isp)
 pAtxHeading = try $ do
   void casualLevel
-  startPos <- getPosition
   hlevel   <- atxOpening
+  finished <- grabNewline
+  (startPos, heading) <-
+    if finished
+      then (,) <$> getPosition <*> pure ""
+      else do
+        sc1'
+        startPos <- getPosition
+        let justClosing = "" <$ some (char '#') <* sc' <* (eof <|> eol)
+            normHeading = T.pack <$> manyTill anyChar
+              (optional (try $ char ' ' *> some (char '#') *> sc') *> (eof <|> eol))
+        r <- try justClosing <|> normHeading
+        return (startPos, r)
   let toBlock = case hlevel of
         1 -> Heading1
         2 -> Heading2
         3 -> Heading3
         4 -> Heading4
         5 -> Heading5
         _ -> Heading6
-  finished <- grabNewline
-  heading <-
-    if finished
-      then return ""
-      else do
-        void (char ' ')
-        let justClosing = "" <$ some (char '#') <* sc' <* eol
-            normHeading = T.pack <$> manyTill anyChar
-              (try $ optional (try $ char ' ' *> some (char '#') *> sc') *> eol)
-        try justClosing <|> normHeading
   toBlock (Isp startPos (T.strip heading)) <$ sc
 
 pParagraph :: Parser (Block Isp)
@@ -381,7 +382,10 @@ sc1 :: MonadParsec Void Text m => m ()
 sc1 = void $ takeWhile1P (Just "white space") isSpaceN
 
 sc' :: Parser ()
-sc' = void $ takeWhileP Nothing spaceNoNewline
+sc' = void $ takeWhileP (Just "white space") spaceNoNewline
+
+sc1' :: Parser ()
+sc1' = void $ takeWhileP (Just "white space") spaceNoNewline
 
 spaceNoNewline :: Char -> Bool
 spaceNoNewline x = x == '\t' || x == ' '
@@ -427,6 +431,7 @@ grabNewline :: Parser Bool
 grabNewline = choice
   [ True <$ char '\n'
   , True <$ char '\r'
+  , True <$ eof
   , pure False ]
 
 assembleParagraph :: [Text] -> Text

mmark.cabal

@@ -53,9 +53,12 @@ test-suite tests
   main-is:            Spec.hs
   hs-source-dirs:     tests
   type:               exitcode-stdio-1.0
-  build-depends:      base             >= 4.7 && < 5.0
-                    , hspec            >= 2.0 && < 3.0
+  build-depends:      base             >= 4.8  && < 5.0
+                    , hspec            >= 2.0  && < 3.0
+                    , lucid            >= 2.6  && < 3.0
+                    , megaparsec       >= 6.0  && < 7.0
                     , mmark
+                    , text             >= 0.2  && < 1.3
   other-modules:      Text.MMarkSpec
                     , Text.MMark.ExtensionSpec
   if flag(dev)
@@ -86,7 +89,7 @@ benchmark bench-speed
   main-is:            Main.hs
   hs-source-dirs:     bench/speed
   type:               exitcode-stdio-1.0
-  build-depends:      base             >= 4.7 && < 5.0
+  build-depends:      base             >= 4.8 && < 5.0
                     , criterion        >= 0.6.2.1 && < 1.3
                     , mmark
   if flag(dev)
@@ -99,7 +102,7 @@ benchmark bench-memory
   main-is:            Main.hs
   hs-source-dirs:     bench/memory
   type:               exitcode-stdio-1.0
-  build-depends:      base             >= 4.7 && < 5.0
+  build-depends:      base             >= 4.8 && < 5.0
                     , mmark
                     , weigh            >= 0.0.4
   if flag(dev)

tests/Text/MMark/ExtensionSpec.hs

@@ -1,15 +1,87 @@
+{-# LANGUAGE LambdaCase        #-}
+{-# LANGUAGE OverloadedStrings #-}
+
 module Text.MMark.ExtensionSpec (spec) where
 
+import Data.Text (Text)
 import Test.Hspec
--- import Text.MMark.Extension
+import Text.MMark
+import Text.MMark.Extension
+import Text.Megaparsec
+import qualified Data.Text.Lazy as TL
+import qualified Lucid          as L
 
 spec :: Spec
 spec = do
   describe "blockTrans" $
-    it "" pending -- TODO
+    it "works" $ do
+      doc <- mkDoc "# My heading"
+      renderToText (useExtension h1_to_h2 doc)
+        `shouldBe` "<h2>My heading</h2>\n"
   describe "blockRender" $
-    it "" pending -- TODO
+    it "works" $ do
+      doc <- mkDoc "# My heading"
+      renderToText (useExtension (add_h1_id "foo") doc)
+        `shouldBe` "<h1 id=\"foo\">My heading</h1>\n"
   describe "inlineTrans" $
-    it "" pending -- TODO
+    it "works" $ do
+      doc <- mkDoc "# My *heading*"
+      renderToText (useExtension em_to_strong doc)
+        `shouldBe` "<h1>My <strong>heading</strong></h1>\n"
   describe "inlineRender" $
-    it "" pending -- TODO
+    it "works" $ do
+      doc <- mkDoc "# My *heading*"
+      renderToText (useExtension (add_em_class "foo") doc)
+        `shouldBe` "<h1>My <em class=\"foo\">heading</em></h1>\n"
+
+----------------------------------------------------------------------------
+-- Testing extensions
+
+-- | Convert H1 headings into H2 headings.
+
+h1_to_h2 :: Extension
+h1_to_h2 = blockTrans $ \case
+  Heading1 inner -> Heading2 inner
+  other          -> other
+
+-- | Add given id to all headings with on level 1.
+
+add_h1_id :: Text -> Extension
+add_h1_id given = blockRender $ \old block ->
+  case block of
+    Heading1 inner -> L.with (old (Heading1 inner)) [L.id_ given]
+    other          -> old other
+
+-- | Covert all 'Emphasis' to 'Strong'.
+
+em_to_strong :: Extension
+em_to_strong = inlineTrans $ \case
+  Emphasis inner -> Strong inner
+  other          -> other
+
+-- | Add given class to all 'Emphasis' things.
+
+add_em_class :: Text -> Extension
+add_em_class given = inlineRender $ \old inline ->
+  case inline of
+    Emphasis inner -> L.with (old (Emphasis inner)) [L.class_ given]
+    other          -> old other
+
+----------------------------------------------------------------------------
+-- Helpers
+
+-- | Create an 'MMark' document from given input reporting an expectation
+-- failure if it cannot be parsed.
+
+mkDoc :: Text -> IO MMark
+mkDoc input =
+  case parseMMark "" input of
+    Left errs -> do
+      expectationFailure (concatMap (parseErrorPretty' input) errs)
+      undefined
+    Right x -> return x
+
+-- | Render an 'MMark' document to 'Text'.
+
+renderToText :: MMark -> Text
+renderToText = TL.toStrict . L.renderText . renderMMark