diff options
Diffstat (limited to 'test/Tests/Writers')
| -rw-r--r-- | test/Tests/Writers/AsciiDoc.hs | 56 | ||||
| -rw-r--r-- | test/Tests/Writers/ConTeXt.hs | 149 | ||||
| -rw-r--r-- | test/Tests/Writers/Docbook.hs | 303 | ||||
| -rw-r--r-- | test/Tests/Writers/Docx.hs | 157 | ||||
| -rw-r--r-- | test/Tests/Writers/FB2.hs | 34 | ||||
| -rw-r--r-- | test/Tests/Writers/HTML.hs | 44 | ||||
| -rw-r--r-- | test/Tests/Writers/JATS.hs | 122 | ||||
| -rw-r--r-- | test/Tests/Writers/LaTeX.hs | 176 | ||||
| -rw-r--r-- | test/Tests/Writers/Markdown.hs | 267 | ||||
| -rw-r--r-- | test/Tests/Writers/Muse.hs | 385 | ||||
| -rw-r--r-- | test/Tests/Writers/Native.hs | 22 | ||||
| -rw-r--r-- | test/Tests/Writers/OOXML.hs | 184 | ||||
| -rw-r--r-- | test/Tests/Writers/Org.hs | 25 | ||||
| -rw-r--r-- | test/Tests/Writers/Plain.hs | 21 | ||||
| -rw-r--r-- | test/Tests/Writers/Powerpoint.hs | 93 | ||||
| -rw-r--r-- | test/Tests/Writers/RST.hs | 117 | ||||
| -rw-r--r-- | test/Tests/Writers/TEI.hs | 43 |
17 files changed, 2198 insertions, 0 deletions
diff --git a/test/Tests/Writers/AsciiDoc.hs b/test/Tests/Writers/AsciiDoc.hs new file mode 100644 index 000000000..6b97c0761 --- /dev/null +++ b/test/Tests/Writers/AsciiDoc.hs @@ -0,0 +1,56 @@ +module Tests.Writers.AsciiDoc (tests) where + +import Data.Text (unpack) +import Test.Tasty +import Tests.Helpers +import Text.Pandoc +import Text.Pandoc.Arbitrary () +import Text.Pandoc.Builder + +asciidoc :: (ToPandoc a) => a -> String +asciidoc = unpack . purely (writeAsciiDoc def{ writerWrapText = WrapNone }) . toPandoc + +tests :: [TestTree] +tests = [ testGroup "emphasis" + [ test asciidoc "emph word before" $ + para (text "foo" <> emph (text "bar")) =?> + "foo__bar__" + , test asciidoc "emph word after" $ + para (emph (text "foo") <> text "bar") =?> + "__foo__bar" + , test asciidoc "emph quoted" $ + para (doubleQuoted (emph (text "foo"))) =?> + "``__foo__''" + , test asciidoc "strong word before" $ + para (text "foo" <> strong (text "bar")) =?> + "foo**bar**" + , test asciidoc "strong word after" $ + para (strong (text "foo") <> text "bar") =?> + "**foo**bar" + , test asciidoc "strong quoted" $ + para (singleQuoted (strong (text "foo"))) =?> + "`**foo**'" + ] + , testGroup "tables" + [ test asciidoc "empty cells" $ + simpleTable [] [[mempty],[mempty]] =?> unlines + [ "[cols=\"\",]" + , "|====" + , "|" + , "|" + , "|====" + ] + , test asciidoc "multiblock cells" $ + simpleTable [] [[para (text "Para 1") <> para (text "Para 2")]] + =?> unlines + [ "[cols=\"\",]" + , "|=====" + , "a|" + , "Para 1" + , "" + , "Para 2" + , "" + , "|=====" + ] + ] + ] diff --git a/test/Tests/Writers/ConTeXt.hs b/test/Tests/Writers/ConTeXt.hs new file mode 100644 index 000000000..812aab4a6 --- /dev/null +++ b/test/Tests/Writers/ConTeXt.hs @@ -0,0 +1,149 @@ +{-# LANGUAGE OverloadedStrings #-} +module Tests.Writers.ConTeXt (tests) where + +import Data.Text (unpack) +import Test.Tasty +import Test.Tasty.QuickCheck +import Tests.Helpers +import Text.Pandoc +import Text.Pandoc.Arbitrary () +import Text.Pandoc.Builder + +context :: (ToPandoc a) => a -> String +context = unpack . purely (writeConTeXt def) . toPandoc + +context' :: (ToPandoc a) => a -> String +context' = unpack . purely (writeConTeXt def{ writerWrapText = WrapNone }) . toPandoc + +contextNtb :: (ToPandoc a) => a -> String +contextNtb = unpack . purely (writeConTeXt def{ writerExtensions = enableExtension Ext_ntb pandocExtensions }) . toPandoc + +contextDiv :: (ToPandoc a) => a -> String +contextDiv = unpack . purely (writeConTeXt def{ writerSectionDivs = True }) . toPandoc + +{- + "my test" =: X =?> Y + +is shorthand for + + test context "my test" $ X =?> Y + +which is in turn shorthand for + + test context "my test" (X,Y) +-} + +infix 4 =: +(=:) :: (ToString a, ToPandoc a) + => String -> (a, String) -> TestTree +(=:) = test context + +tests :: [TestTree] +tests = [ testGroup "inline code" + [ "with '}'" =: code "}" =?> "\\mono{\\}}" + , "without '}'" =: code "]" =?> "\\type{]}" + , testProperty "code property" $ \s -> null s || + if '{' `elem` s || '}' `elem` s + then context' (code s) == "\\mono{" ++ + context' (str s) ++ "}" + else context' (code s) == "\\type{" ++ s ++ "}" + ] + , testGroup "headers" + [ "level 1" =: + headerWith ("my-header",[],[]) 1 "My header" =?> "\\section[title={My header},reference={my-header}]" + , test contextDiv "section-divs" $ + ( headerWith ("header1", [], []) 1 (text "Header1") + <> headerWith ("header2", [], []) 2 (text "Header2") + <> headerWith ("header3", [], []) 3 (text "Header3") + <> headerWith ("header4", [], []) 4 (text "Header4") + <> headerWith ("header5", [], []) 5 (text "Header5") + <> headerWith ("header6", [], []) 6 (text "Header6")) + =?> + unlines [ "\\startsection[title={Header1},reference={header1}]\n" + , "\\startsubsection[title={Header2},reference={header2}]\n" + , "\\startsubsubsection[title={Header3},reference={header3}]\n" + , "\\startsubsubsubsection[title={Header4},reference={header4}]\n" + , "\\startsubsubsubsubsection[title={Header5},reference={header5}]\n" + , "\\startsubsubsubsubsubsection[title={Header6},reference={header6}]\n" + , "\\stopsubsubsubsubsubsection\n" + , "\\stopsubsubsubsubsection\n" + , "\\stopsubsubsubsection\n" + , "\\stopsubsubsection\n" + , "\\stopsubsection\n" + , "\\stopsection" ] + ] + , testGroup "bullet lists" + [ "nested" =: + bulletList [ + plain (text "top") + <> bulletList [ + plain (text "next") + <> bulletList [plain (text "bot")] + ] + ] =?> unlines + [ "\\startitemize[packed]" + , "\\item" + , " top" + , " \\startitemize[packed]" + , " \\item" + , " next" + , " \\startitemize[packed]" + , " \\item" + , " bot" + , " \\stopitemize" + , " \\stopitemize" + , "\\stopitemize" ] + ] + , testGroup "natural tables" + [ test contextNtb "table with header and caption" $ + let caption = text "Table 1" + aligns = [(AlignRight, 0.0), (AlignLeft, 0.0), (AlignCenter, 0.0), (AlignDefault, 0.0)] + headers = [plain $ text "Right", + plain $ text "Left", + plain $ text "Center", + plain $ text "Default"] + rows = [[plain $ text "1.1", + plain $ text "1.2", + plain $ text "1.3", + plain $ text "1.4"] + ,[plain $ text "2.1", + plain $ text "2.2", + plain $ text "2.3", + plain $ text "2.4"] + ,[plain $ text "3.1", + plain $ text "3.2", + plain $ text "3.3", + plain $ text "3.4"]] + in table caption aligns headers rows + =?> unlines [ "\\startplacetable[title={Table 1}]" + , "\\startTABLE" + , "\\startTABLEhead" + , "\\NC[align=left] Right" + , "\\NC[align=right] Left" + , "\\NC[align=middle] Center" + , "\\NC Default" + , "\\NC\\NR" + , "\\stopTABLEhead" + , "\\startTABLEbody" + , "\\NC[align=left] 1.1" + , "\\NC[align=right] 1.2" + , "\\NC[align=middle] 1.3" + , "\\NC 1.4" + , "\\NC\\NR" + , "\\NC[align=left] 2.1" + , "\\NC[align=right] 2.2" + , "\\NC[align=middle] 2.3" + , "\\NC 2.4" + , "\\NC\\NR" + , "\\stopTABLEbody" + , "\\startTABLEfoot" + , "\\NC[align=left] 3.1" + , "\\NC[align=right] 3.2" + , "\\NC[align=middle] 3.3" + , "\\NC 3.4" + , "\\NC\\NR" + , "\\stopTABLEfoot" + , "\\stopTABLE" + , "\\stopplacetable" ] + ] + ] diff --git a/test/Tests/Writers/Docbook.hs b/test/Tests/Writers/Docbook.hs new file mode 100644 index 000000000..89ea76586 --- /dev/null +++ b/test/Tests/Writers/Docbook.hs @@ -0,0 +1,303 @@ +{-# LANGUAGE OverloadedStrings #-} +module Tests.Writers.Docbook (tests) where + +import Data.Text (unpack) +import Test.Tasty +import Tests.Helpers +import Text.Pandoc +import Text.Pandoc.Arbitrary () +import Text.Pandoc.Builder + +docbook :: (ToPandoc a) => a -> String +docbook = docbookWithOpts def{ writerWrapText = WrapNone } + +docbookWithOpts :: ToPandoc a => WriterOptions -> a -> String +docbookWithOpts opts = unpack . purely (writeDocbook4 opts) . toPandoc + +{- + "my test" =: X =?> Y + +is shorthand for + + test docbook "my test" $ X =?> Y + +which is in turn shorthand for + + test docbook "my test" (X,Y) +-} + +infix 4 =: +(=:) :: (ToString a, ToPandoc a) + => String -> (a, String) -> TestTree +(=:) = test docbook + +lineblock :: Blocks +lineblock = para ("some text" <> linebreak <> + "and more lines" <> linebreak <> + "and again") +lineblock_out :: [String] +lineblock_out = [ "<literallayout>some text" + , "and more lines" + , "and again</literallayout>" + ] + +tests :: [TestTree] +tests = [ testGroup "line blocks" + [ "none" =: para "This is a test" + =?> unlines + [ "<para>" + , " This is a test" + , "</para>" + ] + , "basic" =: lineblock + =?> unlines lineblock_out + , "blockquote" =: blockQuote lineblock + =?> unlines + ( [ "<blockquote>" ] ++ + lineblock_out ++ + [ "</blockquote>" ] + ) + , "footnote" =: para ("This is a test" <> + note lineblock <> + " of footnotes") + =?> unlines + ( [ "<para>" + , " This is a test<footnote>" ] ++ + lineblock_out ++ + [ " </footnote> of footnotes" + , "</para>" ] + ) + ] + , testGroup "compact lists" + [ testGroup "bullet" + [ "compact" =: bulletList [plain "a", plain "b", plain "c"] + =?> unlines + [ "<itemizedlist spacing=\"compact\">" + , " <listitem>" + , " <para>" + , " a" + , " </para>" + , " </listitem>" + , " <listitem>" + , " <para>" + , " b" + , " </para>" + , " </listitem>" + , " <listitem>" + , " <para>" + , " c" + , " </para>" + , " </listitem>" + , "</itemizedlist>" + ] + , "loose" =: bulletList [para "a", para "b", para "c"] + =?> unlines + [ "<itemizedlist>" + , " <listitem>" + , " <para>" + , " a" + , " </para>" + , " </listitem>" + , " <listitem>" + , " <para>" + , " b" + , " </para>" + , " </listitem>" + , " <listitem>" + , " <para>" + , " c" + , " </para>" + , " </listitem>" + , "</itemizedlist>" + ] + ] + , testGroup "ordered" + [ "compact" =: orderedList [plain "a", plain "b", plain "c"] + =?> unlines + [ "<orderedlist spacing=\"compact\">" + , " <listitem>" + , " <para>" + , " a" + , " </para>" + , " </listitem>" + , " <listitem>" + , " <para>" + , " b" + , " </para>" + , " </listitem>" + , " <listitem>" + , " <para>" + , " c" + , " </para>" + , " </listitem>" + , "</orderedlist>" + ] + , "loose" =: orderedList [para "a", para "b", para "c"] + =?> unlines + [ "<orderedlist>" + , " <listitem>" + , " <para>" + , " a" + , " </para>" + , " </listitem>" + , " <listitem>" + , " <para>" + , " b" + , " </para>" + , " </listitem>" + , " <listitem>" + , " <para>" + , " c" + , " </para>" + , " </listitem>" + , "</orderedlist>" + ] + ] + , testGroup "definition" + [ "compact" =: definitionList [ ("an", [plain "apple" ]) + , ("a", [plain "banana"]) + , ("an", [plain "orange"])] + =?> unlines + [ "<variablelist spacing=\"compact\">" + , " <varlistentry>" + , " <term>" + , " an" + , " </term>" + , " <listitem>" + , " <para>" + , " apple" + , " </para>" + , " </listitem>" + , " </varlistentry>" + , " <varlistentry>" + , " <term>" + , " a" + , " </term>" + , " <listitem>" + , " <para>" + , " banana" + , " </para>" + , " </listitem>" + , " </varlistentry>" + , " <varlistentry>" + , " <term>" + , " an" + , " </term>" + , " <listitem>" + , " <para>" + , " orange" + , " </para>" + , " </listitem>" + , " </varlistentry>" + , "</variablelist>" + ] + , "loose" =: definitionList [ ("an", [para "apple" ]) + , ("a", [para "banana"]) + , ("an", [para "orange"])] + =?> unlines + [ "<variablelist>" + , " <varlistentry>" + , " <term>" + , " an" + , " </term>" + , " <listitem>" + , " <para>" + , " apple" + , " </para>" + , " </listitem>" + , " </varlistentry>" + , " <varlistentry>" + , " <term>" + , " a" + , " </term>" + , " <listitem>" + , " <para>" + , " banana" + , " </para>" + , " </listitem>" + , " </varlistentry>" + , " <varlistentry>" + , " <term>" + , " an" + , " </term>" + , " <listitem>" + , " <para>" + , " orange" + , " </para>" + , " </listitem>" + , " </varlistentry>" + , "</variablelist>" + ] + ] + ] + , testGroup "writer options" + [ testGroup "top-level division" $ + let + headers = header 1 (text "header1") + <> header 2 (text "header2") + <> header 3 (text "header3") + + docbookTopLevelDiv :: (ToPandoc a) + => TopLevelDivision -> a -> String + docbookTopLevelDiv division = + docbookWithOpts def{ writerTopLevelDivision = division } + in + [ test (docbookTopLevelDiv TopLevelSection) "sections as top-level" $ + headers =?> + unlines [ "<sect1>" + , " <title>header1</title>" + , " <sect2>" + , " <title>header2</title>" + , " <sect3>" + , " <title>header3</title>" + , " <para>" + , " </para>" + , " </sect3>" + , " </sect2>" + , "</sect1>" + ] + , test (docbookTopLevelDiv TopLevelChapter) "chapters as top-level" $ + headers =?> + unlines [ "<chapter>" + , " <title>header1</title>" + , " <sect1>" + , " <title>header2</title>" + , " <sect2>" + , " <title>header3</title>" + , " <para>" + , " </para>" + , " </sect2>" + , " </sect1>" + , "</chapter>" + ] + , test (docbookTopLevelDiv TopLevelPart) "parts as top-level" $ + headers =?> + unlines [ "<part>" + , " <title>header1</title>" + , " <chapter>" + , " <title>header2</title>" + , " <sect1>" + , " <title>header3</title>" + , " <para>" + , " </para>" + , " </sect1>" + , " </chapter>" + , "</part>" + ] + , test (docbookTopLevelDiv TopLevelDefault) "default top-level" $ + headers =?> + unlines [ "<sect1>" + , " <title>header1</title>" + , " <sect2>" + , " <title>header2</title>" + , " <sect3>" + , " <title>header3</title>" + , " <para>" + , " </para>" + , " </sect3>" + , " </sect2>" + , "</sect1>" + ] + ] + ] + ] diff --git a/test/Tests/Writers/Docx.hs b/test/Tests/Writers/Docx.hs new file mode 100644 index 000000000..3ded0aa38 --- /dev/null +++ b/test/Tests/Writers/Docx.hs @@ -0,0 +1,157 @@ +module Tests.Writers.Docx (tests) where + +import Text.Pandoc +import Test.Tasty +import Tests.Writers.OOXML +import Test.Tasty.HUnit +import Data.List (isPrefixOf) + +-- we add an extra check to make sure that we're not writing in the +-- toplevel docx directory. We don't want to accidentally overwrite an +-- Word-generated docx file used to test the reader. +docxTest :: String -> WriterOptions -> FilePath -> FilePath -> TestTree +docxTest testName opts nativeFP goldenFP = + if "docx/golden/" `isPrefixOf` goldenFP + then ooxmlTest writeDocx testName opts nativeFP goldenFP + else testCase testName $ + assertFailure $ + goldenFP ++ " is not in `test/docx/golden`" + +tests :: [TestTree] +tests = [ testGroup "inlines" + [ docxTest + "font formatting" + def + "docx/inline_formatting.native" + "docx/golden/inline_formatting.docx" + , docxTest + "hyperlinks" + def + "docx/links.native" + "docx/golden/links.docx" + , docxTest + "inline image" + def + "docx/image_writer_test.native" + "docx/golden/image.docx" + , docxTest + "inline images" + def + "docx/inline_images_writer_test.native" + "docx/golden/inline_images.docx" + , docxTest + "handling unicode input" + def + "docx/unicode.native" + "docx/golden/unicode.docx" + , docxTest + "inline code" + def + "docx/inline_code.native" + "docx/golden/inline_code.docx" + , docxTest + "inline code in subscript and superscript" + def + "docx/verbatim_subsuper.native" + "docx/golden/verbatim_subsuper.docx" + ] + , testGroup "blocks" + [ docxTest + "headers" + def + "docx/headers.native" + "docx/golden/headers.docx" + , docxTest + "nested anchor spans in header" + def + "docx/nested_anchors_in_header.native" + "docx/golden/nested_anchors_in_header.docx" + , docxTest + "lists" + def + "docx/lists.native" + "docx/golden/lists.docx" + , docxTest + "lists continuing after interruption" + def + "docx/lists_continuing.native" + "docx/golden/lists_continuing.docx" + , docxTest + "lists restarting after interruption" + def + "docx/lists_restarting.native" + "docx/golden/lists_restarting.docx" + , docxTest + "definition lists" + def + "docx/definition_list.native" + "docx/golden/definition_list.docx" + , docxTest + "footnotes and endnotes" + def + "docx/notes.native" + "docx/golden/notes.docx" + , docxTest + "links in footnotes and endnotes" + def + "docx/link_in_notes.native" + "docx/golden/link_in_notes.docx" + , docxTest + "blockquotes" + def + "docx/block_quotes_parse_indent.native" + "docx/golden/block_quotes.docx" + , docxTest + "tables" + def + "docx/tables.native" + "docx/golden/tables.docx" + , docxTest + "tables with lists in cells" + def + "docx/table_with_list_cell.native" + "docx/golden/table_with_list_cell.docx" + , docxTest + "tables with one row" + def + "docx/table_one_row.native" + "docx/golden/table_one_row.docx" + , docxTest + "code block" + def + "docx/codeblock.native" + "docx/golden/codeblock.docx" + ] + , testGroup "track changes" + [ docxTest + "insertion" + def + "docx/track_changes_insertion_all.native" + "docx/golden/track_changes_insertion.docx" + , docxTest + "deletion" + def + "docx/track_changes_deletion_all.native" + "docx/golden/track_changes_deletion.docx" + , docxTest + "move text" + def + "docx/track_changes_move_all.native" + "docx/golden/track_changes_move.docx" + , docxTest + "comments" + def + "docx/comments.native" + "docx/golden/comments.docx" + ] + , testGroup "custom styles" + [ docxTest "custom styles without reference.docx" + def + "docx/custom_style.native" + "docx/golden/custom_style_no_reference.docx" + , docxTest "custom styles with reference.docx" + def{writerReferenceDoc = Just "docx/custom-style-reference.docx"} + "docx/custom_style.native" + "docx/golden/custom_style_reference.docx" + ] + ] diff --git a/test/Tests/Writers/FB2.hs b/test/Tests/Writers/FB2.hs new file mode 100644 index 000000000..6663c42f8 --- /dev/null +++ b/test/Tests/Writers/FB2.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE OverloadedStrings #-} +module Tests.Writers.FB2 (tests) where + +import Test.Tasty +import Tests.Helpers +import Text.Pandoc +import Text.Pandoc.Arbitrary () +import Text.Pandoc.Builder + +fb2 :: String -> String +fb2 x = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" ++ + "<FictionBook xmlns=\"http://www.gribuser.ru/xml/fictionbook/2.0\" xmlns:l=\"http://www.w3.org/1999/xlink\"><description><title-info><genre>unrecognised</genre></title-info><document-info><program-used>pandoc</program-used></document-info></description><body><title><p /></title><section>" ++ x ++ "</section></body></FictionBook>" + +infix 4 =: +(=:) :: (ToString a, ToPandoc a) + => String -> (a, String) -> TestTree +(=:) = test (purely (writeFB2 def) . toPandoc) + +tests :: [TestTree] +tests = [ testGroup "block elements" + ["para" =: para "Lorem ipsum cetera." + =?> fb2 "<p>Lorem ipsum cetera.</p>" + ] + , testGroup "inlines" + [ + "Emphasis" =: emph "emphasized" + =?> fb2 "<emphasis>emphasized</emphasis>" + ] + , "bullet list" =: bulletList [ plain $ text "first" + , plain $ text "second" + , plain $ text "third" + ] + =?> fb2 "<p>\x2022 first</p><p>\x2022 second</p><p>\x2022 third</p>" + ] diff --git a/test/Tests/Writers/HTML.hs b/test/Tests/Writers/HTML.hs new file mode 100644 index 000000000..23ff718d3 --- /dev/null +++ b/test/Tests/Writers/HTML.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE OverloadedStrings #-} +module Tests.Writers.HTML (tests) where + +import Data.Text (unpack) +import Test.Tasty +import Tests.Helpers +import Text.Pandoc +import Text.Pandoc.Arbitrary () +import Text.Pandoc.Builder + +html :: (ToPandoc a) => a -> String +html = unpack . purely (writeHtml4String def{ writerWrapText = WrapNone }) . toPandoc + +{- + "my test" =: X =?> Y + +is shorthand for + + test html "my test" $ X =?> Y + +which is in turn shorthand for + + test html "my test" (X,Y) +-} + +infix 4 =: +(=:) :: (ToString a, ToPandoc a) + => String -> (a, String) -> TestTree +(=:) = test html + +tests :: [TestTree] +tests = [ testGroup "inline code" + [ "basic" =: code "@&" =?> "<code>@&</code>" + , "haskell" =: codeWith ("",["haskell"],[]) ">>=" + =?> "<code class=\"sourceCode haskell\"><span class=\"fu\">>>=</span></code>" + , "nolanguage" =: codeWith ("",["nolanguage"],[]) ">>=" + =?> "<code class=\"nolanguage\">>>=</code>" + ] + , testGroup "images" + [ "alt with formatting" =: + image "/url" "title" ("my " <> emph "image") + =?> "<img src=\"/url\" title=\"title\" alt=\"my image\" />" + ] + ] diff --git a/test/Tests/Writers/JATS.hs b/test/Tests/Writers/JATS.hs new file mode 100644 index 000000000..572b16451 --- /dev/null +++ b/test/Tests/Writers/JATS.hs @@ -0,0 +1,122 @@ +{-# LANGUAGE OverloadedStrings #-} +module Tests.Writers.JATS (tests) where + +import Data.Text (unpack) +import Test.Tasty +import Tests.Helpers +import Text.Pandoc +import Text.Pandoc.Arbitrary () +import Text.Pandoc.Builder + +jats :: (ToPandoc a) => a -> String +jats = unpack . purely (writeJATS def{ writerWrapText = WrapNone }) . toPandoc + +{- + "my test" =: X =?> Y + +is shorthand for + + test jats "my test" $ X =?> Y + +which is in turn shorthand for + + test jats "my test" (X,Y) +-} + +infix 4 =: +(=:) :: (ToString a, ToPandoc a) + => String -> (a, String) -> TestTree +(=:) = test jats + +tests :: [TestTree] +tests = [ testGroup "inline code" + [ "basic" =: code "@&" =?> "<p>\n <monospace>@&</monospace>\n</p>" + , "lang" =: codeWith ("", ["c"], []) "@&" =?> "<p>\n <code language=\"c\">@&</code>\n</p>" + ] + , testGroup "block code" + [ "basic" =: codeBlock "@&" =?> "<preformat>@&</preformat>" + , "lang" =: codeBlockWith ("", ["c"], []) "@&" =?> "<code language=\"c\">@&</code>" + ] + , testGroup "images" + [ "basic" =: + image "/url" "title" mempty + =?> "<graphic mimetype=\"image\" mime-subtype=\"\" xlink:href=\"/url\" xlink:title=\"title\" />" + ] + , testGroup "inlines" + [ "Emphasis" =: emph "emphasized" + =?> "<p>\n <italic>emphasized</italic>\n</p>" + ] + , "bullet list" =: bulletList [ plain $ text "first" + , plain $ text "second" + , plain $ text "third" + ] + =?> "<list list-type=\"bullet\">\n\ + \ <list-item>\n\ + \ <p>\n\ + \ first\n\ + \ </p>\n\ + \ </list-item>\n\ + \ <list-item>\n\ + \ <p>\n\ + \ second\n\ + \ </p>\n\ + \ </list-item>\n\ + \ <list-item>\n\ + \ <p>\n\ + \ third\n\ + \ </p>\n\ + \ </list-item>\n\ + \</list>" + , testGroup "definition lists" + [ "with internal link" =: definitionList [(link "#go" "" (str "testing"), + [plain (text "hi there")])] =?> + "<def-list>\n\ + \ <def-item>\n\ + \ <term>\n\ + \ <xref alt=\"testing\" rid=\"go\">testing</xref>\n\ + \ </term>\n\ + \ <def>\n\ + \ <p>\n\ + \ hi there\n\ + \ </p>\n\ + \ </def>\n\ + \ </def-item>\n\ + \</def-list>" + ] + , testGroup "math" + [ "escape |" =: para (math "\\sigma|_{\\{x\\}}") =?> + "<p>\n\ + \ <inline-formula><alternatives>\n\ + \ <tex-math><![CDATA[\\sigma|_{\\{x\\}}]]></tex-math>\n\ + \ <mml:math display=\"inline\" xmlns:mml=\"http://www.w3.org/1998/Math/MathML\"><mml:mrow><mml:mi>σ</mml:mi><mml:msub><mml:mo stretchy=\"false\" form=\"prefix\">|</mml:mo><mml:mrow><mml:mo stretchy=\"false\" form=\"prefix\">{</mml:mo><mml:mi>x</mml:mi><mml:mo stretchy=\"false\" form=\"postfix\">}</mml:mo></mml:mrow></mml:msub></mml:mrow></mml:math></alternatives></inline-formula>\n\ + \</p>" + ] + , testGroup "headers" + [ "unnumbered header" =: + headerWith ("foo",["unnumbered"],[]) 1 + (text "Header 1" <> note (plain $ text "note")) =?> + "<sec id=\"foo\">\n\ + \ <title>Header 1<fn>\n\ + \ <p>\n\ + \ note\n\ + \ </p>\n\ + \ </fn></title>\n\ + \</sec>" + , "unnumbered sub header" =: + headerWith ("foo",["unnumbered"],[]) 1 + (text "Header") + <> headerWith ("foo",["unnumbered"],[]) 2 + (text "Sub-Header") =?> + "<sec id=\"foo\">\n\ + \ <title>Header</title>\n\ + \ <sec id=\"foo\">\n\ + \ <title>Sub-Header</title>\n\ + \ </sec>\n\ + \</sec>" + , "containing image" =: + header 1 (image "imgs/foo.jpg" "" (text "Alt text")) =?> + "<sec>\n\ + \ <title><inline-graphic mimetype=\"image\" mime-subtype=\"jpeg\" xlink:href=\"imgs/foo.jpg\" /></title>\n\ + \</sec>" + ] + ] diff --git a/test/Tests/Writers/LaTeX.hs b/test/Tests/Writers/LaTeX.hs new file mode 100644 index 000000000..471d9d9e7 --- /dev/null +++ b/test/Tests/Writers/LaTeX.hs @@ -0,0 +1,176 @@ +{-# LANGUAGE OverloadedStrings #-} +module Tests.Writers.LaTeX (tests) where + +import Data.Text (unpack) +import Test.Tasty +import Tests.Helpers +import Text.Pandoc +import Text.Pandoc.Arbitrary () +import Text.Pandoc.Builder + +latex :: (ToPandoc a) => a -> String +latex = latexWithOpts def + +latexListing :: (ToPandoc a) => a -> String +latexListing = latexWithOpts def{ writerListings = True } + +latexWithOpts :: (ToPandoc a) => WriterOptions -> a -> String +latexWithOpts opts = unpack . purely (writeLaTeX opts) . toPandoc + +beamerWithOpts :: (ToPandoc a) => WriterOptions -> a -> String +beamerWithOpts opts = unpack . purely (writeBeamer opts) . toPandoc + +{- + "my test" =: X =?> Y + +is shorthand for + + test latex "my test" $ X =?> Y + +which is in turn shorthand for + + test latex "my test" (X,Y) +-} + +infix 4 =: +(=:) :: (ToString a, ToPandoc a) + => String -> (a, String) -> TestTree +(=:) = test latex + +tests :: [TestTree] +tests = [ testGroup "code blocks" + [ "in footnotes" =: note (para "hi" <> codeBlock "hi") =?> + "\\footnote{hi\n\n\\begin{Verbatim}\nhi\n\\end{Verbatim}\n}" + , test latexListing "identifier" $ codeBlockWith ("id",[],[]) "hi" =?> + ("\\begin{lstlisting}[label=id]\nhi\n\\end{lstlisting}" :: String) + , test latexListing "no identifier" $ codeBlock "hi" =?> + ("\\begin{lstlisting}\nhi\n\\end{lstlisting}" :: String) + ] + , testGroup "definition lists" + [ "with internal link" =: definitionList [(link "#go" "" (str "testing"), + [plain (text "hi there")])] =?> + "\\begin{description}\n\\tightlist\n\\item[{\\protect\\hyperlink{go}{testing}}]\nhi there\n\\end{description}" + ] + , testGroup "math" + [ "escape |" =: para (math "\\sigma|_{\\{x\\}}") =?> + "\\(\\sigma|_{\\{x\\}}\\)" + ] + , testGroup "headers" + [ "unnumbered header" =: + headerWith ("foo",["unnumbered"],[]) 1 + (text "Header 1" <> note (plain $ text "note")) =?> + "\\hypertarget{foo}{%\n\\section*{\\texorpdfstring{Header 1\\footnote{note}}{Header 1}}\\label{foo}}\n\\addcontentsline{toc}{section}{Header 1}\n" + , "in list item" =: + bulletList [header 2 (text "foo")] =?> + "\\begin{itemize}\n\\item ~\n \\subsection{foo}\n\\end{itemize}" + , "in definition list item" =: + definitionList [(text "foo", [header 2 (text "bar"), + para $ text "baz"])] =?> + "\\begin{description}\n\\item[foo] ~ \n\\subsection{bar}\n\nbaz\n\\end{description}" + , "containing image" =: + header 1 (image "imgs/foo.jpg" "" (text "Alt text")) =?> + "\\section{\\texorpdfstring{\\protect\\includegraphics{imgs/foo.jpg}}{Alt text}}" + ] + , testGroup "inline code" + [ "struck out and highlighted" =: + strikeout (codeWith ("",["haskell"],[]) "foo" <> space + <> str "bar") =?> + "\\sout{\\mbox{\\VERB|\\NormalTok{foo}|} bar}" + , "struck out and not highlighted" =: + strikeout (code "foo" <> space + <> str "bar") =?> + "\\sout{\\texttt{foo} bar}" + , "single quotes" =: + code "dog's" =?> "\\texttt{dog\\textquotesingle{}s}" + , "backtick" =: + code "`nu?`" =?> "\\texttt{\\textasciigrave{}nu?\\textasciigrave{}}" + ] + , testGroup "writer options" + [ testGroup "top-level division" $ + let + headers = header 1 (text "header1") + <> header 2 (text "header2") + <> header 3 (text "header3") + + latexTopLevelDiv :: (ToPandoc a) => TopLevelDivision -> a -> String + latexTopLevelDiv division = + latexWithOpts def{ writerTopLevelDivision = division } + + beamerTopLevelDiv :: (ToPandoc a) + => TopLevelDivision -> a -> String + beamerTopLevelDiv division = + beamerWithOpts def { writerTopLevelDivision = division } + in + [ test (latexTopLevelDiv TopLevelSection) + "sections as top-level" $ headers =?> + unlines [ "\\section{header1}\n" + , "\\subsection{header2}\n" + , "\\subsubsection{header3}" + ] + , test (latexTopLevelDiv TopLevelChapter) + "chapters as top-level" $ headers =?> + unlines [ "\\chapter{header1}\n" + , "\\section{header2}\n" + , "\\subsection{header3}" + ] + , test (latexTopLevelDiv TopLevelPart) + "parts as top-level" $ headers =?> + unlines [ "\\part{header1}\n" + , "\\chapter{header2}\n" + , "\\section{header3}" + ] + , test (latexTopLevelDiv TopLevelDefault) + "default top-level" $ headers =?> + unlines [ "\\section{header1}\n" + , "\\subsection{header2}\n" + , "\\subsubsection{header3}" + ] + , test (beamerTopLevelDiv TopLevelSection) + "sections as top-level in beamer" $ headers =?> + unlines [ "\\section{header1}\n" + , "\\subsection{header2}\n" + , "\\subsubsection{header3}" + ] + , test (beamerTopLevelDiv TopLevelChapter) + "chapters are as part in beamer" $ headers =?> + unlines [ "\\part{header1}\n" + , "\\section{header2}\n" + , "\\subsection{header3}" + ] + , test (beamerTopLevelDiv TopLevelPart) + "parts as top-level in beamer" $ headers =?> + unlines [ "\\part{header1}\n" + , "\\section{header2}\n" + , "\\subsection{header3}" + ] + , test (beamerTopLevelDiv TopLevelDefault) + "default top-level in beamer" $ headers =?> + unlines [ "\\section{header1}\n" + , "\\subsection{header2}\n" + , "\\subsubsection{header3}" + ] + , test (latexTopLevelDiv TopLevelPart) + "part top-level, section not in toc" $ + ( headerWith ("", ["unnumbered"], []) 1 (text "header1") + <> headerWith ("", ["unnumbered"], []) 2 (text "header2") + <> headerWith ("", ["unnumbered"], []) 3 (text "header3") + <> headerWith ("", ["unnumbered"], []) 4 (text "header4") + <> headerWith ("", ["unnumbered"], []) 5 (text "header5") + <> headerWith ("", ["unnumbered"], []) 6 (text "header6")) + =?> + unlines [ "\\part*{header1}" + , "\\addcontentsline{toc}{part}{header1}\n" + , "\\chapter*{header2}" + , "\\addcontentsline{toc}{chapter}{header2}\n" + , "\\section*{header3}" + , "\\addcontentsline{toc}{section}{header3}\n" + , "\\subsection*{header4}" + , "\\addcontentsline{toc}{subsection}{header4}\n" + , "\\subsubsection*{header5}" + , "\\addcontentsline{toc}{subsubsection}{header5}\n" + , "\\paragraph{header6}" + , "\\addcontentsline{toc}{paragraph}{header6}" + ] + ] + ] + ] diff --git a/test/Tests/Writers/Markdown.hs b/test/Tests/Writers/Markdown.hs new file mode 100644 index 000000000..7f9ac3627 --- /dev/null +++ b/test/Tests/Writers/Markdown.hs @@ -0,0 +1,267 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-name-shadowing #-} +module Tests.Writers.Markdown (tests) where + +import Data.Text (unpack) +import Test.Tasty +import Tests.Helpers +import Text.Pandoc +import Text.Pandoc.Arbitrary () +import Text.Pandoc.Builder + +defopts :: WriterOptions +defopts = def{ writerExtensions = pandocExtensions } + +markdown :: (ToPandoc a) => a -> String +markdown = unpack . purely (writeMarkdown defopts) . toPandoc + +markdownWithOpts :: (ToPandoc a) => WriterOptions -> a -> String +markdownWithOpts opts x = unpack . purely (writeMarkdown opts) $ toPandoc x + +{- + "my test" =: X =?> Y + +is shorthand for + + test markdown "my test" $ X =?> Y + +which is in turn shorthand for + + test markdown "my test" (X,Y) +-} + +infix 4 =: +(=:) :: (ToString a, ToPandoc a) + => String -> (a, String) -> TestTree +(=:) = test markdown + +tests :: [TestTree] +tests = [ "indented code after list" + =: (orderedList [ para "one" <> para "two" ] <> codeBlock "test") + =?> "1. one\n\n two\n\n<!-- -->\n\n test" + , "list with tight sublist" + =: bulletList [ plain "foo" <> bulletList [ plain "bar" ], + plain "baz" ] + =?> "- foo\n - bar\n- baz\n" + ] ++ [noteTests] ++ [shortcutLinkRefsTests] + +{- + +Testing with the following text: + +First Header +============ + +This is a footnote.[^1] And this is a [link](https://www.google.com). + +> A note inside a block quote.[^2] +> +> A second paragraph. + +Second Header +============= + +Some more text. + + +[^1]: Down here. + +[^2]: The second note. + +-} + +noteTestDoc :: Blocks +noteTestDoc = + header 1 "First Header" <> + para ("This is a footnote." <> + note (para "Down here.") <> + " And this is a " <> + link "https://www.google.com" "" "link" <> + ".") <> + blockQuote (para ("A note inside a block quote." <> + note (para "The second note.")) <> + para "A second paragraph.") <> + header 1 "Second Header" <> + para "Some more text." + + + +noteTests :: TestTree +noteTests = testGroup "note and reference location" + [ test (markdownWithOpts defopts) + "footnotes at the end of a document" $ + noteTestDoc =?> + (unlines [ "First Header" + , "============" + , "" + , "This is a footnote.[^1] And this is a [link](https://www.google.com)." + , "" + , "> A note inside a block quote.[^2]" + , ">" + , "> A second paragraph." + , "" + , "Second Header" + , "=============" + , "" + , "Some more text." + , "" + , "[^1]: Down here." + , "" + , "[^2]: The second note." + ]) + , test (markdownWithOpts defopts{writerReferenceLocation=EndOfBlock}) + "footnotes at the end of blocks" $ + noteTestDoc =?> + (unlines [ "First Header" + , "============" + , "" + , "This is a footnote.[^1] And this is a [link](https://www.google.com)." + , "" + , "[^1]: Down here." + , "" + , "> A note inside a block quote.[^2]" + , ">" + , "> A second paragraph." + , "" + , "[^2]: The second note." + , "" + , "Second Header" + , "=============" + , "" + , "Some more text." + ]) + , test (markdownWithOpts defopts{writerReferenceLocation=EndOfBlock, writerReferenceLinks=True}) + "footnotes and reference links at the end of blocks" $ + noteTestDoc =?> + (unlines [ "First Header" + , "============" + , "" + , "This is a footnote.[^1] And this is a [link]." + , "" + , "[^1]: Down here." + , "" + , " [link]: https://www.google.com" + , "" + , "> A note inside a block quote.[^2]" + , ">" + , "> A second paragraph." + , "" + , "[^2]: The second note." + , "" + , "Second Header" + , "=============" + , "" + , "Some more text." + ]) + , test (markdownWithOpts defopts{writerReferenceLocation=EndOfSection}) + "footnotes at the end of section" $ + noteTestDoc =?> + (unlines [ "First Header" + , "============" + , "" + , "This is a footnote.[^1] And this is a [link](https://www.google.com)." + , "" + , "> A note inside a block quote.[^2]" + , ">" + , "> A second paragraph." + , "" + , "[^1]: Down here." + , "" + , "[^2]: The second note." + , "" + , "Second Header" + , "=============" + , "" + , "Some more text." + ]) + + ] + +shortcutLinkRefsTests :: TestTree +shortcutLinkRefsTests = + let infix 4 =: + (=:) :: (ToString a, ToPandoc a) + + => String -> (a, String) -> TestTree + (=:) = test (purely (writeMarkdown defopts{writerReferenceLinks = True}) . toPandoc) + in testGroup "Shortcut reference links" + [ "Simple link (shortcutable)" + =: para (link "/url" "title" "foo") + =?> "[foo]\n\n [foo]: /url \"title\"" + , "Followed by another link (unshortcutable)" + =: para ((link "/url1" "title1" "first") + <> (link "/url2" "title2" "second")) + =?> unlines [ "[first][][second]" + , "" + , " [first]: /url1 \"title1\"" + , " [second]: /url2 \"title2\"" + ] + , "Followed by space and another link (unshortcutable)" + =: para ((link "/url1" "title1" "first") <> " " + <> (link "/url2" "title2" "second")) + =?> unlines [ "[first][] [second]" + , "" + , " [first]: /url1 \"title1\"" + , " [second]: /url2 \"title2\"" + ] + , "Reference link is used multiple times (unshortcutable)" + =: para ((link "/url1" "" "foo") <> (link "/url2" "" "foo") + <> (link "/url3" "" "foo")) + =?> unlines [ "[foo][][foo][1][foo][2]" + , "" + , " [foo]: /url1" + , " [1]: /url2" + , " [2]: /url3" + ] + , "Reference link is used multiple times (unshortcutable)" + =: para ((link "/url1" "" "foo") <> " " <> (link "/url2" "" "foo") + <> " " <> (link "/url3" "" "foo")) + =?> unlines [ "[foo][] [foo][1] [foo][2]" + , "" + , " [foo]: /url1" + , " [1]: /url2" + , " [2]: /url3" + ] + , "Reference link is followed by text in brackets" + =: para ((link "/url" "" "link") <> "[text in brackets]") + =?> unlines [ "[link][]\\[text in brackets\\]" + , "" + , " [link]: /url" + ] + , "Reference link is followed by space and text in brackets" + =: para ((link "/url" "" "link") <> " [text in brackets]") + =?> unlines [ "[link][] \\[text in brackets\\]" + , "" + , " [link]: /url" + ] + , "Reference link is followed by RawInline" + =: para ((link "/url" "" "link") <> rawInline "markdown" "[rawText]") + =?> unlines [ "[link][][rawText]" + , "" + , " [link]: /url" + ] + , "Reference link is followed by space and RawInline" + =: para ((link "/url" "" "link") <> space <> rawInline "markdown" "[rawText]") + =?> unlines [ "[link][] [rawText]" + , "" + , " [link]: /url" + ] + , "Reference link is followed by RawInline with space" + =: para ((link "/url" "" "link") <> rawInline "markdown" " [rawText]") + =?> unlines [ "[link][] [rawText]" + , "" + , " [link]: /url" + ] + , "Reference link is followed by citation" + =: para ((link "/url" "" "link") <> cite [Citation "author" [] [] NormalCitation 0 0] (str "[@author]")) + =?> unlines [ "[link][][@author]" + , "" + , " [link]: /url" + ] + , "Reference link is followed by space and citation" + =: para ((link "/url" "" "link") <> space <> cite [Citation "author" [] [] NormalCitation 0 0] (str "[@author]")) + =?> unlines [ "[link][] [@author]" + , "" + , " [link]: /url" + ] + ] diff --git a/test/Tests/Writers/Muse.hs b/test/Tests/Writers/Muse.hs new file mode 100644 index 000000000..0b8a08258 --- /dev/null +++ b/test/Tests/Writers/Muse.hs @@ -0,0 +1,385 @@ +module Tests.Writers.Muse (tests) where + +import Data.Text (unpack) +import Test.Tasty +import Tests.Helpers +import Text.Pandoc +import Text.Pandoc.Arbitrary () +import Text.Pandoc.Builder + +muse :: (ToPandoc a) => a -> String +muse = museWithOpts def{ writerWrapText = WrapNone, + writerExtensions = extensionsFromList [Ext_amuse, + Ext_auto_identifiers] } + +museWithOpts :: (ToPandoc a) => WriterOptions -> a -> String +museWithOpts opts = unpack . purely (writeMuse opts) . toPandoc + +infix 4 =: +(=:) :: (ToString a, ToPandoc a) + => String -> (a, String) -> TestTree +(=:) = test muse + +tests :: [TestTree] +tests = [ testGroup "block elements" + [ "plain" =: plain (text "Foo bar.") =?> "Foo bar." + , testGroup "paragraphs" + [ "single paragraph" =: para (text "Sample paragraph.") + =?> "Sample paragraph." + , "two paragraphs" =: para (text "First paragraph.") <> + para (text "Second paragraph.") + =?> unlines [ "First paragraph." + , "" + , "Second paragraph." + ] + ] + , "line block" =: lineBlock [text "Foo", text "bar", text "baz"] + =?> unlines [ "> Foo" + , "> bar" + , "> baz" + ] + , "code block" =: codeBlock "int main(void) {\n\treturn 0;\n}" + =?> unlines [ "<example>" + , "int main(void) {" + , "\treturn 0;" + , "}" + , "</example>" + ] + , "html raw block" =: rawBlock "html" "<hr>" + =?> unlines [ "<literal style=\"html\">" + , "<hr>" + , "</literal>" + ] + , "block quote" =: blockQuote (para (text "Foo")) + =?> unlines [ "<quote>" + , "Foo" + , "</quote>" + ] + , testGroup "lists" + [ testGroup "simple lists" + [ + "ordered list" =: orderedList [ plain $ text "first" + , plain $ text "second" + , plain $ text "third" + ] + =?> unlines [ " 1. first" + , " 2. second" + , " 3. third" + ] + , "ordered list with Roman numerals" + =: orderedListWith (1, UpperRoman, DefaultDelim) + [ plain $ text "first" + , plain $ text "second" + , plain $ text "third" + ] + =?> unlines [ " I. first" + , " II. second" + , " III. third" + ] + , "bullet list" =: bulletList [ plain $ text "first" + , plain $ text "second" + , plain $ text "third" + ] + =?> unlines [ " - first" + , " - second" + , " - third" + ] + , "definition list" =: definitionList [ (text "first definition", [plain $ text "first description"]) + , (text "second definition", [plain $ text "second description"]) + , (text "third definition", [plain $ text "third description"]) + ] + =?> unlines [ " first definition :: first description" + , " second definition :: second description" + , " third definition :: third description" + ] + , "definition list with multiple descriptions" =: + definitionList [ (text "first definition", [plain $ text "first description" + ,plain $ text "second description"]) + , (text "second definition", [plain $ text "third description"]) + ] + =?> unlines [ " first definition :: first description" + , " :: second description" + , " second definition :: third description" + ] + ] + -- Test that lists of the same type and style are separated with two blanklines + , testGroup "sequential lists" + [ "bullet lists" =: + bulletList [ para $ text "First" + , para $ text "Second" + , para $ text "Third" + ] <> + bulletList [ para $ text "Fourth" + , para $ text "Fifth" + ] =?> + unlines [ " - First" + , " - Second" + , " - Third" + , "" + , "" + , " - Fourth" + , " - Fifth" + ] + , "ordered lists of the same style" =: + orderedListWith (1, UpperRoman, DefaultDelim) [ para $ text "First" + , para $ text "Second" + ] <> + orderedListWith (1, UpperRoman, DefaultDelim) [ para $ text "Third" + , para $ text "Fourth" + ] =?> + unlines [ " I. First" + , " II. Second" + , "" + , "" + , " I. Third" + , " II. Fourth" + ] + , "ordered lists with equal styles" =: + orderedList [ para $ text "First" + , para $ text "Second" + ] <> + orderedListWith (1, Decimal, DefaultDelim) [ para $ text "Third" + , para $ text "Fourth" + ] =?> + unlines [ " 1. First" + , " 2. Second" + , "" + , "" + , " 1. Third" + , " 2. Fourth" + ] + , "bullet and ordered lists" =: + bulletList [ para $ text "First" + , para $ text "Second" + ] <> + orderedListWith (1, UpperRoman, DefaultDelim) [ para $ text "Third" + , para $ text "Fourth" + ] =?> + unlines [ " - First" + , " - Second" + , "" + , " I. Third" + , " II. Fourth" + ] + , "different style ordered lists" =: + orderedListWith (1, UpperRoman, DefaultDelim) [ para $ text "First" + , para $ text "Second" + ] <> + orderedListWith (1, Decimal, DefaultDelim) [ para $ text "Third" + , para $ text "Fourth" + ] =?> + unlines [ " I. First" + , " II. Second" + , "" + , " 1. Third" + , " 2. Fourth" + ] + ] + , testGroup "nested lists" + [ "nested ordered list" =: orderedList [ plain $ text "First outer" + , plain (text "Second outer:") <> + orderedList [ plain $ text "first" + , plain $ text "second" + ] + , plain $ text "Third outer" + ] + =?> unlines [ " 1. First outer" + , " 2. Second outer:" + , " 1. first" + , " 2. second" + , " 3. Third outer" + ] + , "nested bullet lists" =: bulletList [ plain $ text "First outer" + , plain (text "Second outer:") <> + bulletList [ plain $ text "first" + , plain $ text "second" + ] + , plain $ text "Third outer" + ] + =?> unlines [ " - First outer" + , " - Second outer:" + , " - first" + , " - second" + , " - Third outer" + ] + , "nested definition lists" =: definitionList [ (text "first definition", [plain $ text "first description"]) + , (text "second definition", + [ plain (text "second description") <> + definitionList [ ( text "first inner definition" + , [plain $ text "first inner description"]) + , ( text "second inner definition" + , [plain $ text "second inner description"]) + ] + ] + ) + ] + =?> unlines [ " first definition :: first description" + , " second definition :: second description" + , " first inner definition :: first inner description" + , " second inner definition :: second inner description" + ] + ] + -- Check that list is intended with one space even inside a quote + , "List inside block quote" =: blockQuote (orderedList [ plain $ text "first" + , plain $ text "second" + , plain $ text "third" + ]) + =?> unlines [ "<quote>" + , " 1. first" + , " 2. second" + , " 3. third" + , "</quote>" + ] + ] + , testGroup "headings" + [ "normal heading" =: + header 1 (text "foo") =?> "* foo" + , "heading levels" =: + header 1 (text "First level") <> + header 3 (text "Third level") =?> + unlines [ "* First level" + , "" + , "*** Third level" + ] + , "heading with ID" =: + headerWith ("bar", [], []) 2 (text "Foo") =?> + unlines [ "** Foo" + , "#bar" + ] + ] + , "horizontal rule" =: horizontalRule =?> "----" + , "escape horizontal rule" =: para (text "----") =?> "<verbatim>----</verbatim>" + , "escape nonbreaking space" =: para (text "~~") =?> "<verbatim>~~</verbatim>" + , testGroup "tables" + [ "table without header" =: + let rows = [[para $ text "Para 1.1", para $ text "Para 1.2"] + ,[para $ text "Para 2.1", para $ text "Para 2.2"]] + in simpleTable [] rows + =?> + unlines [ " Para 1.1 | Para 1.2" + , " Para 2.1 | Para 2.2" + ] + , "table with header" =: + let headers = [plain $ text "header 1", plain $ text "header 2"] + rows = [[para $ text "Para 1.1", para $ text "Para 1.2"] + ,[para $ text "Para 2.1", para $ text "Para 2.2"]] + in simpleTable headers rows + =?> + unlines [ " header 1 || header 2" + , " Para 1.1 | Para 1.2" + , " Para 2.1 | Para 2.2" + ] + , "table with header and caption" =: + let caption = text "Table 1" + headers = [plain $ text "header 1", plain $ text "header 2"] + rows = [[para $ text "Para 1.1", para $ text "Para 1.2"] + ,[para $ text "Para 2.1", para $ text "Para 2.2"]] + in table caption mempty headers rows + =?> unlines [ " header 1 || header 2" + , " Para 1.1 | Para 1.2" + , " Para 2.1 | Para 2.2" + , " |+ Table 1 +|" + ] + ] + , "div with bullet list" =: + divWith nullAttr (bulletList [para $ text "foo"]) =?> + unlines [ " - foo" ] -- Making sure bullets are indented + -- Null is trivial + ] + , testGroup "inline elements" + [ testGroup "string" + [ "string" =: str "foo" =?> "foo" + , "escape footnote" =: str "[1]" =?> "<verbatim>[1]</verbatim>" + , "escape verbatim close tag" =: str "foo</verbatim>bar" + =?> "<verbatim>foo<</verbatim><verbatim>/verbatim>bar</verbatim>" + , "escape pipe to avoid accidental tables" =: str "foo | bar" + =?> "<verbatim>foo | bar</verbatim>" + , "escape hash to avoid accidental anchors" =: text "#foo bar" + =?> "<verbatim>#foo</verbatim> bar" + , "escape definition list markers" =: str "::" =?> "<verbatim>::</verbatim>" + , "normalize strings before escaping" =: fromList [Str ":", Str ":"] =?> "<verbatim>::</verbatim>" + -- We don't want colons to be escaped if they can't be confused + -- with definition list item markers. + , "do not escape colon" =: str ":" =?> ":" + ] + , testGroup "emphasis" + [ "emph" =: emph (text "foo") =?> "<em>foo</em>" + , "strong" =: strong (text "foo") =?> "<strong>foo</strong>" + , "strikeout" =: strikeout (text "foo") =?> "<del>foo</del>" + ] + , "superscript" =: superscript (text "foo") =?> "<sup>foo</sup>" + , "subscript" =: subscript (text "foo") =?> "<sub>foo</sub>" + , "smallcaps" =: smallcaps (text "foo") =?> "foo" + , "single quoted" =: singleQuoted (text "foo") =?> "‘foo’" + , "double quoted" =: doubleQuoted (text "foo") =?> "“foo”" + -- Cite is trivial + , testGroup "code" + [ "simple" =: code "foo" =?> "<code>foo</code>" + , "escape tag" =: code "<code>foo = bar</code> baz" =?> "<code><code>foo = bar<</code><code>/code> baz</code>" + , "normalization with attributes" =: codeWith ("",["haskell"],[]) "foo" <> code "bar" =?> "<code>foobar</code>" + , "normalization" =: code "</co" <> code "de>" =?> "<code><</code><code>/code></code>" + , "normalization with empty string" =: code "</co" <> str "" <> code "de>" =?> "<code><</code><code>/code></code>" + ] + , testGroup "spaces" + [ "space" =: text "a" <> space <> text "b" =?> "a b" + , "soft break" =: text "a" <> softbreak <> text "b" =?> "a b" + , test (museWithOpts def{ writerWrapText = WrapPreserve }) + "preserve soft break" $ text "a" <> softbreak <> text "b" + =?> "a\nb" + , "line break" =: text "a" <> linebreak <> text "b" =?> "a<br>\nb" + ] + , testGroup "math" + [ "inline math" =: math "2^3" =?> "2<sup>3</sup>" + , "display math" =: displayMath "2^3" =?> "2<sup>3</sup>" + , "multiple letters in inline math" =: math "abc" =?> "<em>abc</em>" + ] + , "raw inline" + =: rawInline "html" "<mark>marked text</mark>" + =?> "<literal style=\"html\"><mark>marked text</mark></literal>" + , testGroup "links" + [ "link with description" =: link "https://example.com" "" (str "Link 1") + =?> "[[https://example.com][Link 1]]" + , "link without description" =: link "https://example.com" "" (str "https://example.com") + =?> "[[https://example.com]]" + -- Internal links in Muse include '#' + , "link to anchor" =: link "#intro" "" (str "Introduction") + =?> "[[#intro][Introduction]]" + -- According to Emacs Muse manual, links to images should be prefixed with "URL:" + , "link to image with description" =: link "1.png" "" (str "Link to image") + =?> "[[URL:1.png][Link to image]]" + , "link to image without description" =: link "1.png" "" (str "1.png") + =?> "[[URL:1.png]]" + ] + , "image" =: image "image.png" "Image 1" (str "") =?> "[[image.png][Image 1]]" + , "image with width" =: + imageWith ("", [], [("width", "60%")]) "image.png" "Image" (str "") =?> + "[[image.png 60][Image]]" + , "note" =: note (plain (text "Foo")) + =?> unlines [ "[1]" + , "" + , "[1] Foo" + ] + , "span" =: spanWith ("",["foobar"],[]) (str "Some text") + =?> "<class name=\"foobar\">Some text</class>" + , testGroup "combined" + [ "emph word before" =: + para (text "foo" <> emph (text "bar")) =?> + "foo<em>bar</em>" + , "emph word after" =: + para (emph (text "foo") <> text "bar") =?> + "<em>foo</em>bar" + , "emph quoted" =: + para (doubleQuoted (emph (text "foo"))) =?> + "“<em>foo</em>”" + , "strong word before" =: + para (text "foo" <> strong (text "bar")) =?> + "foo<strong>bar</strong>" + , "strong word after" =: + para (strong (text "foo") <> text "bar") =?> + "<strong>foo</strong>bar" + , "strong quoted" =: + para (singleQuoted (strong (text "foo"))) =?> + "‘<strong>foo</strong>’" + ] + ] + ] diff --git a/test/Tests/Writers/Native.hs b/test/Tests/Writers/Native.hs new file mode 100644 index 000000000..0c4bf7623 --- /dev/null +++ b/test/Tests/Writers/Native.hs @@ -0,0 +1,22 @@ +module Tests.Writers.Native (tests) where + +import Data.Text (unpack) +import Test.Tasty +import Test.Tasty.QuickCheck +import Tests.Helpers +import Text.Pandoc +import Text.Pandoc.Arbitrary () + +p_write_rt :: Pandoc -> Bool +p_write_rt d = + read (unpack $ purely (writeNative def{ writerTemplate = Just "" }) d) == d + +p_write_blocks_rt :: [Block] -> Bool +p_write_blocks_rt bs = + read (unpack $ purely (writeNative def) (Pandoc nullMeta bs)) == bs + +tests :: [TestTree] +tests = [ testProperty "p_write_rt" p_write_rt + , testProperty "p_write_blocks_rt" $ mapSize + (\x -> if x > 3 then 3 else x) p_write_blocks_rt + ] diff --git a/test/Tests/Writers/OOXML.hs b/test/Tests/Writers/OOXML.hs new file mode 100644 index 000000000..bdfdea145 --- /dev/null +++ b/test/Tests/Writers/OOXML.hs @@ -0,0 +1,184 @@ +{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE OverloadedStrings #-} + +module Tests.Writers.OOXML (ooxmlTest) where + +import Text.Pandoc +import Test.Tasty +import Test.Tasty.Golden.Advanced +import Codec.Archive.Zip +import Text.XML.Light +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BL +import qualified Data.Text.IO as T +import Data.List (isSuffixOf, sort, (\\), intercalate, union) +import Data.Maybe (catMaybes, mapMaybe) +import Tests.Helpers +import Data.Algorithm.Diff +import System.FilePath.Glob (compile, match) + +compareXMLBool :: Content -> Content -> Bool +-- We make a special exception for times at the moment, and just pass +-- them because we can't control the utctime when running IO. Besides, +-- so long as we have two times, we're okay. +compareXMLBool (Elem myElem) (Elem goodElem) + | (QName "created" _ (Just "dcterms")) <- elName myElem + , (QName "created" _ (Just "dcterms")) <- elName goodElem = + True +compareXMLBool (Elem myElem) (Elem goodElem) + | (QName "modified" _ (Just "dcterms")) <- elName myElem + , (QName "modified" _ (Just "dcterms")) <- elName goodElem = + True +compareXMLBool (Elem myElem) (Elem goodElem) = + elName myElem == elName goodElem && + elAttribs myElem == elAttribs goodElem && + and (zipWith compareXMLBool (elContent myElem) (elContent goodElem)) +compareXMLBool (Text myCData) (Text goodCData) = + cdVerbatim myCData == cdVerbatim goodCData && + cdData myCData == cdData goodCData && + cdLine myCData == cdLine goodCData +compareXMLBool (CRef myStr) (CRef goodStr) = + myStr == goodStr +compareXMLBool _ _ = False + +displayDiff :: Content -> Content -> String +displayDiff elemA elemB = + showDiff (1,1) $ getDiff (lines $ ppContent elemA) (lines $ ppContent elemB) + +goldenArchive :: FilePath -> IO Archive +goldenArchive fp = (toArchive . BL.fromStrict) <$> BS.readFile fp + +testArchive :: (WriterOptions -> Pandoc -> PandocIO BL.ByteString) + -> WriterOptions + -> FilePath + -> IO Archive +testArchive writerFn opts fp = do + txt <- T.readFile fp + bs <- runIOorExplode $ readNative def txt >>= writerFn opts + return $ toArchive bs + +compareFileList :: FilePath -> Archive -> Archive -> Maybe String +compareFileList goldenFP goldenArch testArch = + let testFiles = filesInArchive testArch + goldenFiles = filesInArchive goldenArch + diffTestGolden = testFiles \\ goldenFiles + diffGoldenTest = goldenFiles \\ testFiles + + results = + [ if null diffGoldenTest + then Nothing + else Just $ + "Files in " ++ goldenFP ++ " but not in generated archive:\n" ++ + intercalate ", " diffGoldenTest + , if null diffTestGolden + then Nothing + else Just $ + "Files in generated archive but not in " ++ goldenFP ++ ":\n" ++ + intercalate ", " diffTestGolden + ] + in + if null $ catMaybes results + then Nothing + else Just $ intercalate "\n" $ catMaybes results + +compareXMLFile' :: FilePath -> Archive -> Archive -> Either String () +compareXMLFile' fp goldenArch testArch = do + testEntry <- case findEntryByPath fp testArch of + Just entry -> Right entry + Nothing -> Left $ + "Can't extract " ++ fp ++ " from generated archive" + testXMLDoc <- case parseXMLDoc $ fromEntry testEntry of + Just doc -> Right doc + Nothing -> Left $ + "Can't parse xml in " ++ fp ++ " from generated archive" + + goldenEntry <- case findEntryByPath fp goldenArch of + Just entry -> Right entry + Nothing -> Left $ + "Can't extract " ++ fp ++ " from archive in stored file" + goldenXMLDoc <- case parseXMLDoc $ fromEntry goldenEntry of + Just doc -> Right doc + Nothing -> Left $ + "Can't parse xml in " ++ fp ++ " from archive in stored file" + + let testContent = Elem testXMLDoc + goldenContent = Elem goldenXMLDoc + + if compareXMLBool goldenContent testContent + then Right () + else Left $ + "Non-matching xml in " ++ fp ++ ":\n" ++ displayDiff testContent goldenContent + +compareXMLFile :: FilePath -> Archive -> Archive -> Maybe String +compareXMLFile fp goldenArch testArch = + case compareXMLFile' fp goldenArch testArch of + Right _ -> Nothing + Left s -> Just s + +compareAllXMLFiles :: Archive -> Archive -> Maybe String +compareAllXMLFiles goldenArch testArch = + let allFiles = filesInArchive goldenArch `union` filesInArchive testArch + allXMLFiles = sort $ + filter + (\fp -> ".xml" `isSuffixOf` fp || ".rels" `isSuffixOf` fp) + allFiles + results = + mapMaybe (\fp -> compareXMLFile fp goldenArch testArch) allXMLFiles + in + if null results + then Nothing + else Just $ unlines results + +compareMediaFile' :: FilePath -> Archive -> Archive -> Either String () +compareMediaFile' fp goldenArch testArch = do + testEntry <- case findEntryByPath fp testArch of + Just entry -> Right entry + Nothing -> Left $ + "Can't extract " ++ fp ++ " from generated archive" + goldenEntry <- case findEntryByPath fp goldenArch of + Just entry -> Right entry + Nothing -> Left $ + "Can't extract " ++ fp ++ " from archive in stored file" + + if fromEntry testEntry == fromEntry goldenEntry + then Right () + else Left $ + "Non-matching binary file: " ++ fp + +compareMediaFile :: FilePath -> Archive -> Archive -> Maybe String +compareMediaFile fp goldenArch testArch = + case compareMediaFile' fp goldenArch testArch of + Right _ -> Nothing + Left s -> Just s + +compareAllMediaFiles :: Archive -> Archive -> Maybe String +compareAllMediaFiles goldenArch testArch = + let allFiles = filesInArchive goldenArch `union` filesInArchive testArch + mediaPattern = compile "*/media/*" + allMediaFiles = sort $ + filter (match mediaPattern) allFiles + results = + mapMaybe (\fp -> compareMediaFile fp goldenArch testArch) allMediaFiles + in + if null results + then Nothing + else Just $ unlines results + +ooxmlTest :: (WriterOptions -> Pandoc -> PandocIO BL.ByteString) + -> String + -> WriterOptions + -> FilePath + -> FilePath + -> TestTree +ooxmlTest writerFn testName opts nativeFP goldenFP = + goldenTest + testName + (goldenArchive goldenFP) + (testArchive writerFn opts nativeFP) + (\goldenArch testArch -> + let res = catMaybes [ compareFileList goldenFP goldenArch testArch + , compareAllXMLFiles goldenArch testArch + , compareAllMediaFiles goldenArch testArch + ] + in return $ if null res then Nothing else Just $ unlines res) + (\a -> BL.writeFile goldenFP $ fromArchive a) diff --git a/test/Tests/Writers/Org.hs b/test/Tests/Writers/Org.hs new file mode 100644 index 000000000..9cbe360da --- /dev/null +++ b/test/Tests/Writers/Org.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE OverloadedStrings #-} +module Tests.Writers.Org (tests) where + +import Test.Tasty +import Tests.Helpers +import Text.Pandoc +import Text.Pandoc.Arbitrary () +import Text.Pandoc.Builder + +infix 4 =: +(=:) :: (ToString a, ToPandoc a) + => String -> (a, String) -> TestTree +(=:) = test (purely (writeOrg def . toPandoc)) + +tests :: [TestTree] +tests = [ testGroup "links" + -- See http://orgmode.org/manual/Internal-links.html#Internal-links + [ "simple link" + =: link "/url" "" "foo" + =?> "[[/url][foo]]" + , "internal link to anchor" + =: link "#my-custom-id" "" "#my-custom-id" + =?> "[[#my-custom-id]]" + ] + ] diff --git a/test/Tests/Writers/Plain.hs b/test/Tests/Writers/Plain.hs new file mode 100644 index 000000000..ab09bca26 --- /dev/null +++ b/test/Tests/Writers/Plain.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE OverloadedStrings #-} +module Tests.Writers.Plain (tests) where + +import Test.Tasty +import Tests.Helpers +import Text.Pandoc +import Text.Pandoc.Arbitrary () +import Text.Pandoc.Builder + + +infix 4 =: +(=:) :: (ToString a, ToPandoc a) + => String -> (a, String) -> TestTree +(=:) = test (purely (writePlain def) . toPandoc) + + +tests :: [TestTree] +tests = [ "strongly emphasized text to uppercase" + =: strong "Straße" + =?> "STRASSE" + ] diff --git a/test/Tests/Writers/Powerpoint.hs b/test/Tests/Writers/Powerpoint.hs new file mode 100644 index 000000000..9af8fc471 --- /dev/null +++ b/test/Tests/Writers/Powerpoint.hs @@ -0,0 +1,93 @@ +module Tests.Writers.Powerpoint (tests) where + +import Tests.Writers.OOXML (ooxmlTest) +import Text.Pandoc +import Test.Tasty +import System.FilePath + +-- templating is important enough, and can break enough things, that +-- we want to run all our tests with both default formatting and a +-- template. + +modifyPptxName :: FilePath -> FilePath +modifyPptxName fp = + addExtension (dropExtension fp ++ "_templated") "pptx" + +pptxTests :: String -> WriterOptions -> FilePath -> FilePath -> (TestTree, TestTree) +pptxTests name opts native pptx = + let referenceDoc = "pptx/reference_depth.pptx" + in + ( ooxmlTest + writePowerpoint + name + opts{writerReferenceDoc=Nothing} + native + pptx + , ooxmlTest + writePowerpoint + name + opts{writerReferenceDoc=Just referenceDoc} + native + (modifyPptxName pptx) + ) + +groupPptxTests :: [(TestTree, TestTree)] -> [TestTree] +groupPptxTests pairs = + let (noRefs, refs) = unzip pairs + in + [ testGroup "Default slide formatting" noRefs + , testGroup "With `--reference-doc` pptx file" refs + ] + + +tests :: [TestTree] +tests = groupPptxTests [ pptxTests "Inline formatting" + def + "pptx/inline_formatting.native" + "pptx/inline_formatting.pptx" + , pptxTests "Slide breaks (default slide-level)" + def + "pptx/slide_breaks.native" + "pptx/slide_breaks.pptx" + , pptxTests "slide breaks (slide-level set to 1)" + def{ writerSlideLevel = Just 1 } + "pptx/slide_breaks.native" + "pptx/slide_breaks_slide_level_1.pptx" + , pptxTests "lists" + def + "pptx/lists.native" + "pptx/lists.pptx" + , pptxTests "tables" + def + "pptx/tables.native" + "pptx/tables.pptx" + , pptxTests "table of contents" + def{ writerTableOfContents = True } + "pptx/slide_breaks.native" + "pptx/slide_breaks_toc.pptx" + , pptxTests "end notes" + def + "pptx/endnotes.native" + "pptx/endnotes.pptx" + , pptxTests "end notes, with table of contents" + def { writerTableOfContents = True } + "pptx/endnotes.native" + "pptx/endnotes_toc.pptx" + , pptxTests "images" + def + "pptx/images.native" + "pptx/images.pptx" + , pptxTests "two-column layout" + def + "pptx/two_column.native" + "pptx/two_column.pptx" + , pptxTests "speaker notes" + def + "pptx/speaker_notes.native" + "pptx/speaker_notes.pptx" + , pptxTests "remove empty slides" + def + "pptx/remove_empty_slides.native" + "pptx/remove_empty_slides.pptx" + + ] diff --git a/test/Tests/Writers/RST.hs b/test/Tests/Writers/RST.hs new file mode 100644 index 000000000..4c0a926bb --- /dev/null +++ b/test/Tests/Writers/RST.hs @@ -0,0 +1,117 @@ +{-# LANGUAGE OverloadedStrings #-} +module Tests.Writers.RST (tests) where + +import Test.Tasty +import Tests.Helpers +import Text.Pandoc +import Text.Pandoc.Arbitrary () +import Text.Pandoc.Builder + +infix 4 =: +(=:) :: (ToString a, ToPandoc a) + => String -> (a, String) -> TestTree +(=:) = test (purely (writeRST def . toPandoc)) + +tests :: [TestTree] +tests = [ testGroup "rubrics" + [ "in list item" =: + bulletList [header 2 (text "foo")] =?> + "- .. rubric:: foo" + , "in definition list item" =: + definitionList [(text "foo", [header 2 (text "bar"), + para $ text "baz"])] =?> + unlines + [ "foo" + , " .. rubric:: bar" + , "" + , " baz"] + , "in block quote" =: + blockQuote (header 1 (text "bar")) =?> + " .. rubric:: bar" + , "with id" =: + blockQuote (headerWith ("foo",[],[]) 1 (text "bar")) =?> + unlines + [ " .. rubric:: bar" + , " :name: foo"] + , "with id class" =: + blockQuote (headerWith ("foo",["baz"],[]) 1 (text "bar")) =?> + unlines + [ " .. rubric:: bar" + , " :name: foo" + , " :class: baz"] + ] + , testGroup "ligatures" -- handling specific sequences of blocks + [ "a list is closed by a comment before a quote" =: -- issue 4248 + bulletList [plain "bulleted"] <> blockQuote (plain "quoted") =?> + unlines + [ "- bulleted" + , "" + , ".." + , "" + , " quoted"] + ] + , testGroup "headings" + [ "normal heading" =: + header 1 (text "foo") =?> + unlines + [ "foo" + , "==="] + -- note: heading normalization is only done in standalone mode + , test (purely (writeRST def{ writerTemplate = Just "$body$\n" }) . toPandoc) + "heading levels" $ + header 1 (text "Header 1") <> + header 3 (text "Header 2") <> + header 2 (text "Header 2") <> + header 1 (text "Header 1") <> + header 4 (text "Header 2") <> + header 5 (text "Header 3") <> + header 3 (text "Header 2") =?> + unlines + [ "Header 1" + , "========" + , "" + , "Header 2" + , "--------" + , "" + , "Header 2" + , "--------" + , "" + , "Header 1" + , "========" + , "" + , "Header 2" + , "--------" + , "" + , "Header 3" + , "~~~~~~~~" + , "" + , "Header 2" + , "--------"] + , test (purely (writeRST def{ writerTemplate = Just "$body$\n" }) . toPandoc) + "minimal heading levels" $ + header 2 (text "Header 1") <> + header 3 (text "Header 2") <> + header 2 (text "Header 1") <> + header 4 (text "Header 2") <> + header 5 (text "Header 3") <> + header 3 (text "Header 2") =?> + unlines + [ "Header 1" + , "========" + , "" + , "Header 2" + , "--------" + , "" + , "Header 1" + , "========" + , "" + , "Header 2" + , "--------" + , "" + , "Header 3" + , "~~~~~~~~" + , "" + , "Header 2" + , "--------"] + ] + ] diff --git a/test/Tests/Writers/TEI.hs b/test/Tests/Writers/TEI.hs new file mode 100644 index 000000000..fa372909f --- /dev/null +++ b/test/Tests/Writers/TEI.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE OverloadedStrings #-} +module Tests.Writers.TEI (tests) where + +import Test.Tasty +import Tests.Helpers +import Text.Pandoc +import Text.Pandoc.Arbitrary () +import Text.Pandoc.Builder + +{- + "my test" =: X =?> Y + +is shorthand for + + test html "my test" $ X =?> Y + +which is in turn shorthand for + + test html "my test" (X,Y) +-} + +infix 4 =: +(=:) :: (ToString a, ToPandoc a) + => String -> (a, String) -> TestTree +(=:) = test (purely (writeTEI def) . toPandoc) + +tests :: [TestTree] +tests = [ testGroup "block elements" + ["para" =: para "Lorem ipsum cetera." + =?> "<p>Lorem ipsum cetera.</p>" + ] + , testGroup "inlines" + [ + "Emphasis" =: emph "emphasized" + =?> "<p><hi rendition=\"simple:italic\">emphasized</hi></p>" + ,"SingleQuoted" =: singleQuoted (text "quoted material") + =?> "<p><quote>quoted material</quote></p>" + ,"DoubleQuoted" =: doubleQuoted (text "quoted material") + =?> "<p><quote>quoted material</quote></p>" + ,"NestedQuoted" =: doubleQuoted (singleQuoted (text "quoted material")) + =?> "<p><quote><quote>quoted material</quote></quote></p>" + ] + ] |