aboutsummaryrefslogtreecommitdiff
path: root/test
diff options
context:
space:
mode:
authorAlexander Krotov <ilabdsf@gmail.com>2018-09-10 12:15:27 +0300
committerAlexander Krotov <ilabdsf@gmail.com>2018-09-10 12:15:27 +0300
commit4467fe6d387e549db136d97510eb272880471908 (patch)
tree52375e705fd6a947efb1323e8764c59c4f55c297 /test
parentfa4ebd71a33a3ca1b435bda34fce91f4a13055f5 (diff)
downloadpandoc-4467fe6d387e549db136d97510eb272880471908.tar.gz
HTML reader: test round trip property
Diffstat (limited to 'test')
-rw-r--r--test/Tests/Readers/HTML.hs23
1 files changed, 23 insertions, 0 deletions
diff --git a/test/Tests/Readers/HTML.hs b/test/Tests/Readers/HTML.hs
index f61f1f497..0a6302c1e 100644
--- a/test/Tests/Readers/HTML.hs
+++ b/test/Tests/Readers/HTML.hs
@@ -4,11 +4,14 @@ module Tests.Readers.HTML (tests) where
import Prelude
import Data.Text (Text)
+import qualified Data.Text as T
import Test.Tasty
+import Test.Tasty.QuickCheck
import Tests.Helpers
import Text.Pandoc
import Text.Pandoc.Arbitrary ()
import Text.Pandoc.Builder
+import Text.Pandoc.Walk (walk)
html :: Text -> Pandoc
html = purely $ readHtml def
@@ -16,6 +19,25 @@ html = purely $ readHtml def
htmlNativeDivs :: Text -> Pandoc
htmlNativeDivs = purely $ readHtml def { readerExtensions = enableExtension Ext_native_divs $ readerExtensions def }
+makeRoundTrip :: Block -> Block
+makeRoundTrip Table{} = Para [Str "table was here"]
+makeRoundTrip CodeBlock{} = Para [Str "code block was here"]
+makeRoundTrip LineBlock{} = Para [Str "line block was here"]
+makeRoundTrip x = x
+
+removeRawInlines :: Inline -> Inline
+removeRawInlines RawInline{} = Str "raw inline was here"
+removeRawInlines x = x
+
+roundTrip :: Block -> Bool
+roundTrip b = d'' == d'''
+ where d = walk removeRawInlines $ walk makeRoundTrip $ Pandoc nullMeta [b]
+ d' = rewrite d
+ d'' = rewrite d'
+ d''' = rewrite d''
+ rewrite = html . T.pack . (++ "\n") . T.unpack .
+ purely (writeHtml5String def { writerWrapText = WrapPreserve })
+
tests :: [TestTree]
tests = [ testGroup "base tag"
[ test html "simple" $
@@ -53,4 +75,5 @@ tests = [ testGroup "base tag"
, test htmlNativeDivs "<main> followed by text" $ "<main>main content</main>non-main content" =?>
doc (divWith ("", [], [("role", "main")]) (plain (text "main content")) <> plain (text "non-main content"))
]
+ , testProperty "Round trip" roundTrip
]