git.iko.soy/typeable/pandoc
on b3473df help sign in
typeable/pandoc/test/Tests/Readers/HTML.hs
97 lines 4.7 kB history raw
1{-# LANGUAGE NoImplicitPrelude #-}
2{-# LANGUAGE OverloadedStrings #-}
3{- |
4 Module : Tests.Readers.HTML
5 Copyright : © 2006-2019 John MacFarlane
6 License : GNU GPL, version 2 or above
8 Maintainer : John MacFarlane <jgm@berkeley.edu>
9 Stability : alpha
10 Portability : portable
12Tests for the HTML reader.
13-}
14module Tests.Readers.HTML (tests) where
16import Prelude
17import Data.Text (Text)
18import qualified Data.Text as T
19import Test.Tasty
20import Test.Tasty.QuickCheck
21import Test.Tasty.Options (IsOption(defaultValue))
22import Tests.Helpers
23import Text.Pandoc
24import Text.Pandoc.Arbitrary ()
25import Text.Pandoc.Builder
26import Text.Pandoc.Walk (walk)
28html :: Text -> Pandoc
29html = purely $ readHtml def
31htmlNativeDivs :: Text -> Pandoc
32htmlNativeDivs = purely $ readHtml def { readerExtensions = enableExtension Ext_native_divs $ readerExtensions def }
34makeRoundTrip :: Block -> Block
35makeRoundTrip CodeBlock{} = Para [Str "code block was here"]
36makeRoundTrip LineBlock{} = Para [Str "line block was here"]
37makeRoundTrip RawBlock{} = Para [Str "raw block was here"]
38makeRoundTrip x = x
40removeRawInlines :: Inline -> Inline
41removeRawInlines RawInline{} = Str "raw inline was here"
42removeRawInlines x = x
44roundTrip :: Blocks -> Bool
45roundTrip b = d'' == d'''
46 where d = walk removeRawInlines $
47 walk makeRoundTrip $ Pandoc nullMeta $ toList b
48 d' = rewrite d
49 d'' = rewrite d'
50 d''' = rewrite d''
51 rewrite = html . T.pack . (++ "\n") . T.unpack .
52 purely (writeHtml5String def
53 { writerWrapText = WrapPreserve })
55tests :: [TestTree]
56tests = [ testGroup "base tag"
57 [ test html "simple" $
58 "<head><base href=\"http://www.w3schools.com/images/foo\" ></head><body><img src=\"stickman.gif\" alt=\"Stickman\"></head>" =?>
59 plain (image "http://www.w3schools.com/images/stickman.gif" "" (text "Stickman"))
60 , test html "slash at end of base" $
61 "<head><base href=\"http://www.w3schools.com/images/\" ></head><body><img src=\"stickman.gif\" alt=\"Stickman\"></head>" =?>
62 plain (image "http://www.w3schools.com/images/stickman.gif" "" (text "Stickman"))
63 , test html "slash at beginning of href" $
64 "<head><base href=\"http://www.w3schools.com/images/\" ></head><body><img src=\"/stickman.gif\" alt=\"Stickman\"></head>" =?>
65 plain (image "http://www.w3schools.com/stickman.gif" "" (text "Stickman"))
66 , test html "absolute URL" $
67 "<head><base href=\"http://www.w3schools.com/images/\" ></head><body><img src=\"http://example.com/stickman.gif\" alt=\"Stickman\"></head>" =?>
68 plain (image "http://example.com/stickman.gif" "" (text "Stickman"))
69 ]
70 , testGroup "anchors"
71 [ test html "anchor without href" $ "<a name=\"anchor\"/>" =?>
72 plain (spanWith ("anchor",[],[]) mempty)
73 ]
74 , testGroup "lang"
75 [ test html "lang on <html>" $ "<html lang=\"es\">hola" =?>
76 setMeta "lang" (text "es") (doc (plain (text "hola")))
77 , test html "xml:lang on <html>" $ "<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"es\"><head></head><body>hola</body></html>" =?>
78 setMeta "lang" (text "es") (doc (plain (text "hola")))
79 ]
80 , testGroup "main"
81 [ test htmlNativeDivs "<main> becomes <div role=main>" $ "<main>hello</main>" =?>
82 doc (divWith ("", [], [("role", "main")]) (plain (text "hello")))
83 , test htmlNativeDivs "<main role=X> becomes <div role=X>" $ "<main role=foobar>hello</main>" =?>
84 doc (divWith ("", [], [("role", "foobar")]) (plain (text "hello")))
85 , test htmlNativeDivs "<main> has attributes preserved" $ "<main id=foo class=bar data-baz=qux>hello</main>" =?>
86 doc (divWith ("foo", ["bar"], [("role", "main"), ("data-baz", "qux")]) (plain (text "hello")))
87 , test htmlNativeDivs "<main> closes <p>" $ "<p>hello<main>main content</main>" =?>
88 doc (para (text "hello") <> divWith ("", [], [("role", "main")]) (plain (text "main content")))
89 , test htmlNativeDivs "<main> followed by text" $ "<main>main content</main>non-main content" =?>
90 doc (divWith ("", [], [("role", "main")]) (plain (text "main content")) <> plain (text "non-main content"))
91 ]
92 , askOption $ \(QuickCheckTests numtests) ->
93 testProperty "Round trip" $
94 withMaxSuccess (if QuickCheckTests numtests == defaultValue
95 then 25
96 else numtests) roundTrip
97 ]