@@ -4,11 +4,14 @@ module Tests.Readers.HTML (tests) where
44
55import Prelude
66import Data.Text (Text)
7+import qualified Data.Text as T
78import Test.Tasty
9+import Test.Tasty.QuickCheck
810import Tests.Helpers
911import Text.Pandoc
1012import Text.Pandoc.Arbitrary ()
1113import Text.Pandoc.Builder
14+import Text.Pandoc.Walk (walk)
1215
1316html :: Text -> Pandoc
1417html = purely $ readHtml def
@@ -16,6 +19,25 @@ html = purely $ readHtml def
1619htmlNativeDivs :: Text -> Pandoc
1720htmlNativeDivs = purely $ readHtml def { readerExtensions = enableExtension Ext_native_divs $ readerExtensions def }
1821
22+makeRoundTrip :: Block -> Block
23+makeRoundTrip Table{} = Para [Str "table was here"]
24+makeRoundTrip CodeBlock{} = Para [Str "code block was here"]
25+makeRoundTrip LineBlock{} = Para [Str "line block was here"]
26+makeRoundTrip x = x
27+
28+removeRawInlines :: Inline -> Inline
29+removeRawInlines RawInline{} = Str "raw inline was here"
30+removeRawInlines x = x
31+
32+roundTrip :: Block -> Bool
33+roundTrip b = d'' == d'''
34+ where d = walk removeRawInlines $ walk makeRoundTrip $ Pandoc nullMeta [b]
35+ d' = rewrite d
36+ d'' = rewrite d'
37+ d''' = rewrite d''
38+ rewrite = html . T.pack . (++ "\n") . T.unpack .
39+ purely (writeHtml5String def { writerWrapText = WrapPreserve })
40+
1941tests :: [TestTree]
2042tests = [ testGroup "base tag"
2143 [ test html "simple" $
@@ -53,4 +75,5 @@ tests = [ testGroup "base tag"
5375 , test htmlNativeDivs "<main> followed by text" $ "<main>main content</main>non-main content" =?>
5476 doc (divWith ("", [], [("role", "main")]) (plain (text "main content")) <> plain (text "non-main content"))
5577 ]
78+ , testProperty "Round trip" roundTrip
5679 ]