diff options
author | John MacFarlane <jgm@berkeley.edu> | 2017-02-04 12:56:30 +0100 |
---|---|---|
committer | John MacFarlane <jgm@berkeley.edu> | 2017-02-04 12:56:30 +0100 |
commit | 18ab8642692caca2716fd9b5a0e6dbfd3d9cf9cc (patch) | |
tree | 05f4e9024093e233c131b3494e71265062ffd94a /test/Tests/Readers | |
parent | 8418c1a7d7e5312dfddbc011adb257552b2a864b (diff) | |
download | pandoc-18ab8642692caca2716fd9b5a0e6dbfd3d9cf9cc.tar.gz |
Moved tests/ -> test/.
Diffstat (limited to 'test/Tests/Readers')
-rw-r--r-- | test/Tests/Readers/Docx.hs | 344 | ||||
-rw-r--r-- | test/Tests/Readers/EPUB.hs | 39 | ||||
-rw-r--r-- | test/Tests/Readers/HTML.hs | 33 | ||||
-rw-r--r-- | test/Tests/Readers/LaTeX.hs | 226 | ||||
-rw-r--r-- | test/Tests/Readers/Markdown.hs | 461 | ||||
-rw-r--r-- | test/Tests/Readers/Odt.hs | 165 | ||||
-rw-r--r-- | test/Tests/Readers/Org.hs | 1724 | ||||
-rw-r--r-- | test/Tests/Readers/RST.hs | 174 | ||||
-rw-r--r-- | test/Tests/Readers/Txt2Tags.hs | 436 |
9 files changed, 3602 insertions, 0 deletions
diff --git a/test/Tests/Readers/Docx.hs b/test/Tests/Readers/Docx.hs new file mode 100644 index 000000000..548553579 --- /dev/null +++ b/test/Tests/Readers/Docx.hs @@ -0,0 +1,344 @@ +module Tests.Readers.Docx (tests) where + +import Text.Pandoc +import Tests.Helpers +import Test.Framework +import Test.HUnit (assertBool) +import Test.Framework.Providers.HUnit +import qualified Data.ByteString.Lazy as B +import qualified Data.Map as M +import Text.Pandoc.MediaBag (MediaBag, lookupMedia, mediaDirectory) +import Codec.Archive.Zip +import qualified Text.Pandoc.Class as P + +-- We define a wrapper around pandoc that doesn't normalize in the +-- tests. Since we do our own normalization, we want to make sure +-- we're doing it right. + +data NoNormPandoc = NoNormPandoc {unNoNorm :: Pandoc} + deriving Show + +noNorm :: Pandoc -> NoNormPandoc +noNorm = NoNormPandoc + +defopts :: ReaderOptions +defopts = def{ readerExtensions = getDefaultExtensions "docx" } + +instance ToString NoNormPandoc where + toString d = purely (writeNative def{ writerTemplate = s }) $ toPandoc d + where s = case d of + NoNormPandoc (Pandoc (Meta m) _) + | M.null m -> Nothing + | otherwise -> Just "" -- need this to get meta output + +instance ToPandoc NoNormPandoc where + toPandoc = unNoNorm + +compareOutput :: ReaderOptions + -> FilePath + -> FilePath + -> IO (NoNormPandoc, NoNormPandoc) +compareOutput opts docxFile nativeFile = do + df <- B.readFile docxFile + nf <- Prelude.readFile nativeFile + p <- runIOorExplode $ readDocx opts df + df' <- runIOorExplode $ readNative def nf + return $ (noNorm p, noNorm df') + +testCompareWithOptsIO :: ReaderOptions -> String -> FilePath -> FilePath -> IO Test +testCompareWithOptsIO opts name docxFile nativeFile = do + (dp, np) <- compareOutput opts docxFile nativeFile + return $ test id name (dp, np) + +testCompareWithOpts :: ReaderOptions -> String -> FilePath -> FilePath -> Test +testCompareWithOpts opts name docxFile nativeFile = + buildTest $ testCompareWithOptsIO opts name docxFile nativeFile + +testCompare :: String -> FilePath -> FilePath -> Test +testCompare = testCompareWithOpts defopts + +testForWarningsWithOptsIO :: ReaderOptions -> String -> FilePath -> [String] -> IO Test +testForWarningsWithOptsIO opts name docxFile expected = do + df <- B.readFile docxFile + logs <- runIOorExplode (readDocx opts df >> P.getLog) + let warns = [s | (WARNING, s) <- logs] + return $ test id name (unlines warns, unlines expected) + +testForWarningsWithOpts :: ReaderOptions -> String -> FilePath -> [String] -> Test +testForWarningsWithOpts opts name docxFile expected = + buildTest $ testForWarningsWithOptsIO opts name docxFile expected + +-- testForWarnings :: String -> FilePath -> [String] -> Test +-- testForWarnings = testForWarningsWithOpts defopts + +getMedia :: FilePath -> FilePath -> IO (Maybe B.ByteString) +getMedia archivePath mediaPath = do + zf <- B.readFile archivePath >>= return . toArchive + return $ findEntryByPath ("word/" ++ mediaPath) zf >>= (Just . fromEntry) + +compareMediaPathIO :: FilePath -> MediaBag -> FilePath -> IO Bool +compareMediaPathIO mediaPath mediaBag docxPath = do + docxMedia <- getMedia docxPath mediaPath + let mbBS = case lookupMedia mediaPath mediaBag of + Just (_, bs) -> bs + Nothing -> error ("couldn't find " ++ + mediaPath ++ + " in media bag") + docxBS = case docxMedia of + Just bs -> bs + Nothing -> error ("couldn't find " ++ + mediaPath ++ + " in media bag") + return $ mbBS == docxBS + +compareMediaBagIO :: FilePath -> IO Bool +compareMediaBagIO docxFile = do + df <- B.readFile docxFile + mb <- runIOorExplode (readDocx defopts df >> P.getMediaBag) + bools <- mapM + (\(fp, _, _) -> compareMediaPathIO fp mb docxFile) + (mediaDirectory mb) + return $ and bools + +testMediaBagIO :: String -> FilePath -> IO Test +testMediaBagIO name docxFile = do + outcome <- compareMediaBagIO docxFile + return $ testCase name (assertBool + ("Media didn't match media bag in file " ++ docxFile) + outcome) + +testMediaBag :: String -> FilePath -> Test +testMediaBag name docxFile = buildTest $ testMediaBagIO name docxFile + +tests :: [Test] +tests = [ testGroup "inlines" + [ testCompare + "font formatting" + "docx/inline_formatting.docx" + "docx/inline_formatting.native" + , testCompare + "font formatting with character styles" + "docx/char_styles.docx" + "docx/char_styles.native" + , testCompare + "hyperlinks" + "docx/links.docx" + "docx/links.native" + , testCompare + "normalizing adjacent hyperlinks" + "docx/adjacent_links.docx" + "docx/adjacent_links.native" + , testCompare + "inline image" + "docx/image.docx" + "docx/image_no_embed.native" + , testCompare + "VML image" + "docx/image_vml.docx" + "docx/image_vml.native" + , testCompare + "inline image in links" + "docx/inline_images.docx" + "docx/inline_images.native" + , testCompare + "handling unicode input" + "docx/unicode.docx" + "docx/unicode.native" + , testCompare + "literal tabs" + "docx/tabs.docx" + "docx/tabs.native" + , testCompare + "special punctuation" + "docx/special_punctuation.docx" + "docx/special_punctuation.native" + , testCompare + "normalizing inlines" + "docx/normalize.docx" + "docx/normalize.native" + , testCompare + "normalizing inlines deep inside blocks" + "docx/deep_normalize.docx" + "docx/deep_normalize.native" + , testCompare + "move trailing spaces outside of formatting" + "docx/trailing_spaces_in_formatting.docx" + "docx/trailing_spaces_in_formatting.native" + , testCompare + "inline code (with VerbatimChar style)" + "docx/inline_code.docx" + "docx/inline_code.native" + , testCompare + "inline code in subscript and superscript" + "docx/verbatim_subsuper.docx" + "docx/verbatim_subsuper.native" + ] + , testGroup "blocks" + [ testCompare + "headers" + "docx/headers.docx" + "docx/headers.native" + , testCompare + "headers already having auto identifiers" + "docx/already_auto_ident.docx" + "docx/already_auto_ident.native" + , testCompare + "nested anchor spans in header" + "docx/nested_anchors_in_header.docx" + "docx/nested_anchors_in_header.native" + , testCompare + "single numbered item not made into list" + "docx/numbered_header.docx" + "docx/numbered_header.native" + , testCompare + "enumerated headers not made into numbered list" + "docx/enumerated_headings.docx" + "docx/enumerated_headings.native" + , testCompare + "i18n blocks (headers and blockquotes)" + "docx/i18n_blocks.docx" + "docx/i18n_blocks.native" + , testCompare + "lists" + "docx/lists.docx" + "docx/lists.native" + , testCompare + "definition lists" + "docx/definition_list.docx" + "docx/definition_list.native" + , testCompare + "custom defined lists in styles" + "docx/german_styled_lists.docx" + "docx/german_styled_lists.native" + , testCompare + "user deletes bullet after list item (=> part of item par)" + "docx/dummy_item_after_list_item.docx" + "docx/dummy_item_after_list_item.native" + , testCompare + "user deletes bullet after par (=> new par)" + "docx/dummy_item_after_paragraph.docx" + "docx/dummy_item_after_paragraph.native" + , testCompare + "footnotes and endnotes" + "docx/notes.docx" + "docx/notes.native" + , testCompare + "links in footnotes and endnotes" + "docx/link_in_notes.docx" + "docx/link_in_notes.native" + , testCompare + "blockquotes (parsing indent as blockquote)" + "docx/block_quotes.docx" + "docx/block_quotes_parse_indent.native" + , testCompare + "hanging indents" + "docx/hanging_indent.docx" + "docx/hanging_indent.native" + , testCompare + "tables" + "docx/tables.docx" + "docx/tables.native" + , testCompare + "tables with lists in cells" + "docx/table_with_list_cell.docx" + "docx/table_with_list_cell.native" + , testCompare + "tables with one row" + "docx/table_one_row.docx" + "docx/table_one_row.native" + , testCompare + "code block" + "docx/codeblock.docx" + "docx/codeblock.native" + , testCompare + "dropcap paragraphs" + "docx/drop_cap.docx" + "docx/drop_cap.native" + ] + , testGroup "track changes" + [ testCompare + "insertion (default)" + "docx/track_changes_insertion.docx" + "docx/track_changes_insertion_accept.native" + , testCompareWithOpts def{readerTrackChanges=AcceptChanges} + "insert insertion (accept)" + "docx/track_changes_insertion.docx" + "docx/track_changes_insertion_accept.native" + , testCompareWithOpts def{readerTrackChanges=RejectChanges} + "remove insertion (reject)" + "docx/track_changes_insertion.docx" + "docx/track_changes_insertion_reject.native" + , testCompare + "deletion (default)" + "docx/track_changes_deletion.docx" + "docx/track_changes_deletion_accept.native" + , testCompareWithOpts def{readerTrackChanges=AcceptChanges} + "remove deletion (accept)" + "docx/track_changes_deletion.docx" + "docx/track_changes_deletion_accept.native" + , testCompareWithOpts def{readerTrackChanges=RejectChanges} + "insert deletion (reject)" + "docx/track_changes_deletion.docx" + "docx/track_changes_deletion_reject.native" + , testCompareWithOpts def{readerTrackChanges=AllChanges} + "keep insertion (all)" + "docx/track_changes_deletion.docx" + "docx/track_changes_deletion_all.native" + , testCompareWithOpts def{readerTrackChanges=AllChanges} + "keep deletion (all)" + "docx/track_changes_deletion.docx" + "docx/track_changes_deletion_all.native" + , testCompareWithOpts def{readerTrackChanges=AcceptChanges} + "move text (accept)" + "docx/track_changes_move.docx" + "docx/track_changes_move_accept.native" + , testCompareWithOpts def{readerTrackChanges=RejectChanges} + "move text (reject)" + "docx/track_changes_move.docx" + "docx/track_changes_move_reject.native" + , testCompareWithOpts def{readerTrackChanges=AllChanges} + "move text (all)" + "docx/track_changes_move.docx" + "docx/track_changes_move_all.native" + , testCompareWithOpts def{readerTrackChanges=AcceptChanges} + "comments (accept -- no comments)" + "docx/comments.docx" + "docx/comments_no_comments.native" + , testCompareWithOpts def{readerTrackChanges=RejectChanges} + "comments (reject -- comments)" + "docx/comments.docx" + "docx/comments_no_comments.native" + , testCompareWithOpts def{readerTrackChanges=AllChanges} + "comments (all comments)" + "docx/comments.docx" + "docx/comments.native" + , testForWarningsWithOpts def{readerTrackChanges=AcceptChanges} + "comment warnings (accept -- no warnings)" + "docx/comments_warning.docx" + [] + , testForWarningsWithOpts def{readerTrackChanges=RejectChanges} + "comment warnings (reject -- no warnings)" + "docx/comments_warning.docx" + [] + , testForWarningsWithOpts def{readerTrackChanges=AllChanges} + "comment warnings (all)" + "docx/comments_warning.docx" + ["Docx comment 1 will not retain formatting"] + ] + , testGroup "media" + [ testMediaBag + "image extraction" + "docx/image.docx" + ] + , testGroup "metadata" + [ testCompareWithOpts def{readerStandalone=True} + "metadata fields" + "docx/metadata.docx" + "docx/metadata.native" + , testCompareWithOpts def{readerStandalone=True} + "stop recording metadata with normal text" + "docx/metadata_after_normal.docx" + "docx/metadata_after_normal.native" + ] + + ] diff --git a/test/Tests/Readers/EPUB.hs b/test/Tests/Readers/EPUB.hs new file mode 100644 index 000000000..9190671c3 --- /dev/null +++ b/test/Tests/Readers/EPUB.hs @@ -0,0 +1,39 @@ +module Tests.Readers.EPUB (tests) where + +import Text.Pandoc.Options +import Test.Framework +import Test.HUnit (assertBool) +import Test.Framework.Providers.HUnit +import qualified Data.ByteString.Lazy as BL +import Text.Pandoc.Readers.EPUB +import Text.Pandoc.MediaBag (MediaBag, mediaDirectory) +import qualified Text.Pandoc.Class as P + +getMediaBag :: FilePath -> IO MediaBag +getMediaBag fp = do + bs <- BL.readFile fp + snd <$> (P.runIOorExplode $ P.withMediaBag $ readEPUB def bs) + +testMediaBag :: FilePath -> [(String, String, Int)] -> IO () +testMediaBag fp bag = do + actBag <- (mediaDirectory <$> getMediaBag fp) + assertBool (show "MediaBag did not match:\nExpected: " + ++ show bag + ++ "\nActual: " + ++ show actBag) + (actBag == bag) + +featuresBag :: [(String, String, Int)] +featuresBag = [("img/check.gif","image/gif",1340) + ,("img/check.jpg","image/jpeg",2661) + ,("img/check.png","image/png",2815) + ,("img/multiscripts_and_greek_alphabet.png","image/png",10060) + ] + +tests :: [Test] +tests = + [ testGroup "EPUB Mediabag" + [ testCase "features bag" + (testMediaBag "epub/img.epub" featuresBag) + ] + ] diff --git a/test/Tests/Readers/HTML.hs b/test/Tests/Readers/HTML.hs new file mode 100644 index 000000000..a1533e42a --- /dev/null +++ b/test/Tests/Readers/HTML.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE OverloadedStrings #-} +module Tests.Readers.HTML (tests) where + +import Text.Pandoc.Definition +import Test.Framework +import Tests.Helpers +import Text.Pandoc.Arbitrary() +import Text.Pandoc.Builder +import Text.Pandoc + +html :: String -> Pandoc +html = purely $ readHtml def + +tests :: [Test] +tests = [ testGroup "base tag" + [ test html "simple" $ + "<head><base href=\"http://www.w3schools.com/images/foo\" ></head><body><img src=\"stickman.gif\" alt=\"Stickman\"></head>" =?> + plain (image "http://www.w3schools.com/images/stickman.gif" "" (text "Stickman")) + , test html "slash at end of base" $ + "<head><base href=\"http://www.w3schools.com/images/\" ></head><body><img src=\"stickman.gif\" alt=\"Stickman\"></head>" =?> + plain (image "http://www.w3schools.com/images/stickman.gif" "" (text "Stickman")) + , test html "slash at beginning of href" $ + "<head><base href=\"http://www.w3schools.com/images/\" ></head><body><img src=\"/stickman.gif\" alt=\"Stickman\"></head>" =?> + plain (image "http://www.w3schools.com/stickman.gif" "" (text "Stickman")) + , test html "absolute URL" $ + "<head><base href=\"http://www.w3schools.com/images/\" ></head><body><img src=\"http://example.com/stickman.gif\" alt=\"Stickman\"></head>" =?> + plain (image "http://example.com/stickman.gif" "" (text "Stickman")) + ] + , testGroup "anchors" + [ test html "anchor without href" $ "<a name=\"anchor\"/>" =?> + plain (spanWith ("anchor",[],[]) mempty) + ] + ] diff --git a/test/Tests/Readers/LaTeX.hs b/test/Tests/Readers/LaTeX.hs new file mode 100644 index 000000000..d8572b15b --- /dev/null +++ b/test/Tests/Readers/LaTeX.hs @@ -0,0 +1,226 @@ +{-# LANGUAGE OverloadedStrings #-} +module Tests.Readers.LaTeX (tests) where + +import Text.Pandoc.Definition +import Test.Framework +import Tests.Helpers +import Text.Pandoc.Arbitrary() +import Text.Pandoc.Builder +import Text.Pandoc + +latex :: String -> Pandoc +latex = purely $ readLaTeX def{ + readerExtensions = getDefaultExtensions "latex" } + +infix 4 =: +(=:) :: ToString c + => String -> (String, c) -> Test +(=:) = test latex + +simpleTable' :: [Alignment] -> [[Blocks]] -> Blocks +simpleTable' aligns = table "" (zip aligns (repeat 0.0)) + (map (const mempty) aligns) + +tests :: [Test] +tests = [ testGroup "basic" + [ "simple" =: + "word" =?> para "word" + , "space" =: + "some text" =?> para "some text" + , "emphasized" =: + "\\emph{emphasized}" =?> para (emph "emphasized") + ] + + , testGroup "headers" + [ "level 1" =: + "\\section{header}" =?> headerWith ("header",[],[]) 1 "header" + , "level 2" =: + "\\subsection{header}" =?> headerWith ("header",[],[]) 2 "header" + , "level 3" =: + "\\subsubsection{header}" =?> headerWith ("header",[],[]) 3 "header" + , "emph" =: + "\\section{text \\emph{emph}}" =?> + headerWith ("text-emph",[],[]) 1 ("text" <> space <> emph "emph") + , "link" =: + "\\section{text \\href{/url}{link}}" =?> + headerWith ("text-link",[],[]) 1 ("text" <> space <> link "/url" "" "link") + ] + + , testGroup "math" + [ "escaped $" =: + "$x=\\$4$" =?> para (math "x=\\$4") + ] + + , testGroup "space and comments" + [ "blank lines + space at beginning" =: + "\n \n hi" =?> para "hi" + , "blank lines + space + comments" =: + "% my comment\n\n \n % another\n\nhi" =?> para "hi" + , "comment in paragraph" =: + "hi % this is a comment\nthere\n" =?> para "hi there" + ] + + , testGroup "code blocks" + [ "identifier" =: + "\\begin{lstlisting}[label=test]\\end{lstlisting}" =?> codeBlockWith ("test", [], [("label","test")]) "" + , "no identifier" =: + "\\begin{lstlisting}\\end{lstlisting}" =?> codeBlock "" + ] + + , testGroup "tables" + [ "Single cell table" =: + "\\begin{tabular}{|l|}Test\\\\\\end{tabular}" =?> + simpleTable' [AlignLeft] [[plain "Test"]] + , "Multi cell table" =: + "\\begin{tabular}{|rl|}One & Two\\\\ \\end{tabular}" =?> + simpleTable' [AlignRight,AlignLeft] [[plain "One", plain "Two"]] + , "Multi line table" =: + unlines [ "\\begin{tabular}{|c|}" + , "One\\\\" + , "Two\\\\" + , "Three\\\\" + , "\\end{tabular}" ] =?> + simpleTable' [AlignCenter] + [[plain "One"], [plain "Two"], [plain "Three"]] + , "Empty table" =: + "\\begin{tabular}{}\\end{tabular}" =?> + simpleTable' [] [] + , "Table with fixed column width" =: + "\\begin{tabular}{|p{5cm}r|}One & Two\\\\ \\end{tabular}" =?> + simpleTable' [AlignLeft,AlignRight] [[plain "One", plain "Two"]] + , "Table with empty column separators" =: + "\\begin{tabular}{@{}r@{}l}One & Two\\\\ \\end{tabular}" =?> + simpleTable' [AlignRight,AlignLeft] [[plain "One", plain "Two"]] + , "Table with custom column separators" =: + unlines [ "\\begin{tabular}{@{($\\to$)}r@{\\hspace{2cm}}l}" + , "One&Two\\\\" + , "\\end{tabular}" ] =?> + simpleTable' [AlignRight,AlignLeft] [[plain "One", plain "Two"]] + , "Table with vertical alignment argument" =: + "\\begin{tabular}[t]{r|r}One & Two\\\\ \\end{tabular}" =?> + simpleTable' [AlignRight,AlignRight] [[plain "One", plain "Two"]] + ] + + , testGroup "citations" + [ natbibCitations + , biblatexCitations + ] + + , let hex = ['0'..'9']++['a'..'f'] in + testGroup "Character Escapes" + [ "Two-character escapes" =: + concat ["^^"++[i,j] | i <- hex, j <- hex] =?> + para (str ['\0'..'\255']) + , "One-character escapes" =: + concat ["^^"++[i] | i <- hex] =?> + para (str $ ['p'..'y']++['!'..'&']) + ] + ] + +baseCitation :: Citation +baseCitation = Citation{ citationId = "item1" + , citationPrefix = [] + , citationSuffix = [] + , citationMode = AuthorInText + , citationNoteNum = 0 + , citationHash = 0 + } + +rt :: String -> Inlines +rt = rawInline "latex" + +natbibCitations :: Test +natbibCitations = testGroup "natbib" + [ "citet" =: "\\citet{item1}" + =?> para (cite [baseCitation] (rt "\\citet{item1}")) + , "suffix" =: "\\citet[p.~30]{item1}" + =?> para + (cite [baseCitation{ citationSuffix = toList $ text "p.\160\&30" }] (rt "\\citet[p.~30]{item1}")) + , "suffix long" =: "\\citet[p.~30, with suffix]{item1}" + =?> para (cite [baseCitation{ citationSuffix = + toList $ text "p.\160\&30, with suffix" }] (rt "\\citet[p.~30, with suffix]{item1}")) + , "multiple" =: "\\citeauthor{item1} \\citetext{\\citeyear{item1}; \\citeyear[p.~30]{item2}; \\citealp[see also][]{item3}}" + =?> para (cite [baseCitation{ citationMode = AuthorInText } + ,baseCitation{ citationMode = SuppressAuthor + , citationSuffix = [Str "p.\160\&30"] + , citationId = "item2" } + ,baseCitation{ citationId = "item3" + , citationPrefix = [Str "see",Space,Str "also"] + , citationMode = NormalCitation } + ] (rt "\\citetext{\\citeyear{item1}; \\citeyear[p.~30]{item2}; \\citealp[see also][]{item3}}")) + , "group" =: "\\citetext{\\citealp[see][p.~34--35]{item1}; \\citealp[also][chap. 3]{item3}}" + =?> para (cite [baseCitation{ citationMode = NormalCitation + , citationPrefix = [Str "see"] + , citationSuffix = [Str "p.\160\&34\8211\&35"] } + ,baseCitation{ citationMode = NormalCitation + , citationId = "item3" + , citationPrefix = [Str "also"] + , citationSuffix = [Str "chap.",Space,Str "3"] } + ] (rt "\\citetext{\\citealp[see][p.~34--35]{item1}; \\citealp[also][chap. 3]{item3}}")) + , "suffix and locator" =: "\\citep[pp.~33, 35--37, and nowhere else]{item1}" + =?> para (cite [baseCitation{ citationMode = NormalCitation + , citationSuffix = [Str "pp.\160\&33,",Space,Str "35\8211\&37,",Space,Str "and",Space,Str "nowhere",Space, Str "else"] }] (rt "\\citep[pp.~33, 35--37, and nowhere else]{item1}")) + , "suffix only" =: "\\citep[and nowhere else]{item1}" + =?> para (cite [baseCitation{ citationMode = NormalCitation + , citationSuffix = toList $ text "and nowhere else" }] (rt "\\citep[and nowhere else]{item1}")) + , "no author" =: "\\citeyearpar{item1}, and now Doe with a locator \\citeyearpar[p.~44]{item2}" + =?> para (cite [baseCitation{ citationMode = SuppressAuthor }] (rt "\\citeyearpar{item1}") <> + text ", and now Doe with a locator " <> + cite [baseCitation{ citationMode = SuppressAuthor + , citationSuffix = [Str "p.\160\&44"] + , citationId = "item2" }] (rt "\\citeyearpar[p.~44]{item2}")) + , "markup" =: "\\citep[\\emph{see}][p. \\textbf{32}]{item1}" + =?> para (cite [baseCitation{ citationMode = NormalCitation + , citationPrefix = [Emph [Str "see"]] + , citationSuffix = [Str "p.",Space, + Strong [Str "32"]] }] (rt "\\citep[\\emph{see}][p. \\textbf{32}]{item1}")) + ] + +biblatexCitations :: Test +biblatexCitations = testGroup "biblatex" + [ "textcite" =: "\\textcite{item1}" + =?> para (cite [baseCitation] (rt "\\textcite{item1}")) + , "suffix" =: "\\textcite[p.~30]{item1}" + =?> para + (cite [baseCitation{ citationSuffix = toList $ text "p.\160\&30" }] (rt "\\textcite[p.~30]{item1}")) + , "suffix long" =: "\\textcite[p.~30, with suffix]{item1}" + =?> para (cite [baseCitation{ citationSuffix = + toList $ text "p.\160\&30, with suffix" }] (rt "\\textcite[p.~30, with suffix]{item1}")) + , "multiple" =: "\\textcites{item1}[p.~30]{item2}[see also][]{item3}" + =?> para (cite [baseCitation{ citationMode = AuthorInText } + ,baseCitation{ citationMode = NormalCitation + , citationSuffix = [Str "p.\160\&30"] + , citationId = "item2" } + ,baseCitation{ citationId = "item3" + , citationPrefix = [Str "see",Space,Str "also"] + , citationMode = NormalCitation } + ] (rt "\\textcites{item1}[p.~30]{item2}[see also][]{item3}")) + , "group" =: "\\autocites[see][p.~34--35]{item1}[also][chap. 3]{item3}" + =?> para (cite [baseCitation{ citationMode = NormalCitation + , citationPrefix = [Str "see"] + , citationSuffix = [Str "p.\160\&34\8211\&35"] } + ,baseCitation{ citationMode = NormalCitation + , citationId = "item3" + , citationPrefix = [Str "also"] + , citationSuffix = [Str "chap.",Space,Str "3"] } + ] (rt "\\autocites[see][p.~34--35]{item1}[also][chap. 3]{item3}")) + , "suffix and locator" =: "\\autocite[pp.~33, 35--37, and nowhere else]{item1}" + =?> para (cite [baseCitation{ citationMode = NormalCitation + , citationSuffix = [Str "pp.\160\&33,",Space,Str "35\8211\&37,",Space,Str "and",Space,Str "nowhere",Space, Str "else"] }] (rt "\\autocite[pp.~33, 35--37, and nowhere else]{item1}")) + , "suffix only" =: "\\autocite[and nowhere else]{item1}" + =?> para (cite [baseCitation{ citationMode = NormalCitation + , citationSuffix = toList $ text "and nowhere else" }] (rt "\\autocite[and nowhere else]{item1}")) + , "no author" =: "\\autocite*{item1}, and now Doe with a locator \\autocite*[p.~44]{item2}" + =?> para (cite [baseCitation{ citationMode = SuppressAuthor }] (rt "\\autocite*{item1}") <> + text ", and now Doe with a locator " <> + cite [baseCitation{ citationMode = SuppressAuthor + , citationSuffix = [Str "p.\160\&44"] + , citationId = "item2" }] (rt "\\autocite*[p.~44]{item2}")) + , "markup" =: "\\autocite[\\emph{see}][p. \\textbf{32}]{item1}" + =?> para (cite [baseCitation{ citationMode = NormalCitation + , citationPrefix = [Emph [Str "see"]] + , citationSuffix = [Str "p.",Space, + Strong [Str "32"]] }] (rt "\\autocite[\\emph{see}][p. \\textbf{32}]{item1}")) + , "parencite" =: "\\parencite{item1}" + =?> para (cite [baseCitation{ citationMode = NormalCitation }] (rt "\\parencite{item1}")) + ] diff --git a/test/Tests/Readers/Markdown.hs b/test/Tests/Readers/Markdown.hs new file mode 100644 index 000000000..65edf7c38 --- /dev/null +++ b/test/Tests/Readers/Markdown.hs @@ -0,0 +1,461 @@ +{-# LANGUAGE OverloadedStrings #-} +module Tests.Readers.Markdown (tests) where + +import Text.Pandoc.Definition +import Test.Framework +import Tests.Helpers +import Text.Pandoc.Arbitrary() +import Text.Pandoc.Builder +import Text.Pandoc + +markdown :: String -> Pandoc +markdown = purely $ readMarkdown def { readerExtensions = + disableExtension Ext_smart pandocExtensions } + +markdownSmart :: String -> Pandoc +markdownSmart = purely $ readMarkdown def { readerExtensions = + enableExtension Ext_smart pandocExtensions } + +markdownCDL :: String -> Pandoc +markdownCDL = purely $ readMarkdown def { readerExtensions = enableExtension + Ext_compact_definition_lists pandocExtensions } + +markdownGH :: String -> Pandoc +markdownGH = purely $ readMarkdown def { + readerExtensions = githubMarkdownExtensions } + +infix 4 =: +(=:) :: ToString c + => String -> (String, c) -> Test +(=:) = test markdown + +testBareLink :: (String, Inlines) -> Test +testBareLink (inp, ils) = + test (purely $ readMarkdown def{ readerExtensions = + extensionsFromList [Ext_autolink_bare_uris, Ext_raw_html] }) + inp (inp, doc $ para ils) + +autolink :: String -> Inlines +autolink = autolinkWith nullAttr + +autolinkWith :: Attr -> String -> Inlines +autolinkWith attr s = linkWith attr s "" (str s) + +bareLinkTests :: [(String, Inlines)] +bareLinkTests = + [ ("http://google.com is a search engine.", + autolink "http://google.com" <> " is a search engine.") + , ("<a href=\"http://foo.bar.baz\">http://foo.bar.baz</a>", + rawInline "html" "<a href=\"http://foo.bar.baz\">" <> + "http://foo.bar.baz" <> rawInline "html" "</a>") + , ("Try this query: http://google.com?search=fish&time=hour.", + "Try this query: " <> autolink "http://google.com?search=fish&time=hour" <> ".") + , ("HTTPS://GOOGLE.COM,", + autolink "HTTPS://GOOGLE.COM" <> ",") + , ("http://el.wikipedia.org/wiki/Τεχνολογία,", + autolink "http://el.wikipedia.org/wiki/Τεχνολογία" <> ",") + , ("doi:10.1000/182,", + autolink "doi:10.1000/182" <> ",") + , ("git://github.com/foo/bar.git,", + autolink "git://github.com/foo/bar.git" <> ",") + , ("file:///Users/joe/joe.txt, and", + autolink "file:///Users/joe/joe.txt" <> ", and") + , ("mailto:someone@somedomain.com.", + autolink "mailto:someone@somedomain.com" <> ".") + , ("Use http: this is not a link!", + "Use http: this is not a link!") + , ("(http://google.com).", + "(" <> autolink "http://google.com" <> ").") + , ("http://en.wikipedia.org/wiki/Sprite_(computer_graphics)", + autolink "http://en.wikipedia.org/wiki/Sprite_(computer_graphics)") + , ("http://en.wikipedia.org/wiki/Sprite_[computer_graphics]", + link "http://en.wikipedia.org/wiki/Sprite_%5Bcomputer_graphics%5D" "" + (str "http://en.wikipedia.org/wiki/Sprite_[computer_graphics]")) + , ("http://en.wikipedia.org/wiki/Sprite_{computer_graphics}", + link "http://en.wikipedia.org/wiki/Sprite_%7Bcomputer_graphics%7D" "" + (str "http://en.wikipedia.org/wiki/Sprite_{computer_graphics}")) + , ("http://example.com/Notification_Center-GitHub-20101108-140050.jpg", + autolink "http://example.com/Notification_Center-GitHub-20101108-140050.jpg") + , ("https://github.com/github/hubot/blob/master/scripts/cream.js#L20-20", + autolink "https://github.com/github/hubot/blob/master/scripts/cream.js#L20-20") + , ("http://www.rubyonrails.com", + autolink "http://www.rubyonrails.com") + , ("http://www.rubyonrails.com:80", + autolink "http://www.rubyonrails.com:80") + , ("http://www.rubyonrails.com/~minam", + autolink "http://www.rubyonrails.com/~minam") + , ("https://www.rubyonrails.com/~minam", + autolink "https://www.rubyonrails.com/~minam") + , ("http://www.rubyonrails.com/~minam/url%20with%20spaces", + autolink "http://www.rubyonrails.com/~minam/url%20with%20spaces") + , ("http://www.rubyonrails.com/foo.cgi?something=here", + autolink "http://www.rubyonrails.com/foo.cgi?something=here") + , ("http://www.rubyonrails.com/foo.cgi?something=here&and=here", + autolink "http://www.rubyonrails.com/foo.cgi?something=here&and=here") + , ("http://www.rubyonrails.com/contact;new", + autolink "http://www.rubyonrails.com/contact;new") + , ("http://www.rubyonrails.com/contact;new%20with%20spaces", + autolink "http://www.rubyonrails.com/contact;new%20with%20spaces") + , ("http://www.rubyonrails.com/contact;new?with=query&string=params", + autolink "http://www.rubyonrails.com/contact;new?with=query&string=params") + , ("http://www.rubyonrails.com/~minam/contact;new?with=query&string=params", + autolink "http://www.rubyonrails.com/~minam/contact;new?with=query&string=params") + , ("http://en.wikipedia.org/wiki/Wikipedia:Today%27s_featured_picture_%28animation%29/January_20%2C_2007", + autolink "http://en.wikipedia.org/wiki/Wikipedia:Today%27s_featured_picture_%28animation%29/January_20%2C_2007") + , ("http://www.mail-archive.com/rails@lists.rubyonrails.org/", + autolink "http://www.mail-archive.com/rails@lists.rubyonrails.org/") + , ("http://www.amazon.com/Testing-Equal-Sign-In-Path/ref=pd_bbs_sr_1?ie=UTF8&s=books&qid=1198861734&sr=8-1", + autolink "http://www.amazon.com/Testing-Equal-Sign-In-Path/ref=pd_bbs_sr_1?ie=UTF8&s=books&qid=1198861734&sr=8-1") + , ("http://en.wikipedia.org/wiki/Texas_hold%27em", + autolink "http://en.wikipedia.org/wiki/Texas_hold%27em") + , ("https://www.google.com/doku.php?id=gps:resource:scs:start", + autolink "https://www.google.com/doku.php?id=gps:resource:scs:start") + , ("http://www.rubyonrails.com", + autolink "http://www.rubyonrails.com") + , ("http://manuals.ruby-on-rails.com/read/chapter.need_a-period/103#page281", + autolink "http://manuals.ruby-on-rails.com/read/chapter.need_a-period/103#page281") + , ("http://foo.example.com/controller/action?parm=value&p2=v2#anchor123", + autolink "http://foo.example.com/controller/action?parm=value&p2=v2#anchor123") + , ("http://foo.example.com:3000/controller/action", + autolink "http://foo.example.com:3000/controller/action") + , ("http://foo.example.com:3000/controller/action+pack", + autolink "http://foo.example.com:3000/controller/action+pack") + , ("http://business.timesonline.co.uk/article/0,,9065-2473189,00.html", + autolink "http://business.timesonline.co.uk/article/0,,9065-2473189,00.html") + , ("http://www.mail-archive.com/ruby-talk@ruby-lang.org/", + autolink "http://www.mail-archive.com/ruby-talk@ruby-lang.org/") + , ("https://example.org/?anchor=lala-", + autolink "https://example.org/?anchor=lala-") + , ("https://example.org/?anchor=-lala", + autolink "https://example.org/?anchor=-lala") + ] + +{- +p_markdown_round_trip :: Block -> Bool +p_markdown_round_trip b = matches d' d'' + where d' = normalize $ Pandoc (Meta [] [] []) [b] + d'' = normalize + $ readMarkdown def { readerSmart = True } + $ writeMarkdown def d' + matches (Pandoc _ [Plain []]) (Pandoc _ []) = True + matches (Pandoc _ [Para []]) (Pandoc _ []) = True + matches (Pandoc _ [Plain xs]) (Pandoc _ [Para xs']) = xs == xs' + matches x y = x == y +-} + +tests :: [Test] +tests = [ testGroup "inline code" + [ "with attribute" =: + "`document.write(\"Hello\");`{.javascript}" + =?> para + (codeWith ("",["javascript"],[]) "document.write(\"Hello\");") + , "with attribute space" =: + "`*` {.haskell .special x=\"7\"}" + =?> para (code "*" <> space <> str "{.haskell" <> space <> + str ".special" <> space <> str "x=\"7\"}") + ] + , testGroup "emph and strong" + [ "two strongs in emph" =: + "***a**b **c**d*" =?> para (emph (strong (str "a") <> str "b" <> space + <> strong (str "c") <> str "d")) + , "emph and strong emph alternating" =: + "*xxx* ***xxx*** xxx\n*xxx* ***xxx*** xxx" + =?> para (emph "xxx" <> space <> strong (emph "xxx") <> + space <> "xxx" <> softbreak <> + emph "xxx" <> space <> strong (emph "xxx") <> + space <> "xxx") + , "emph with spaced strong" =: + "*x **xx** x*" + =?> para (emph ("x" <> space <> strong "xx" <> space <> "x")) + , "intraword underscore with opening underscore (#1121)" =: + "_foot_ball_" =?> para (emph (text "foot_ball")) + ] + , testGroup "raw LaTeX" + [ "in URL" =: + "\\begin\n" =?> para (text "\\begin") + ] + , testGroup "raw HTML" + [ "nesting (issue #1330)" =: + "<del>test</del>" =?> + rawBlock "html" "<del>" <> plain (str "test") <> + rawBlock "html" "</del>" + , "invalid tag (issue #1820" =: + "</ div></.div>" =?> + para (text "</ div></.div>") + , "technically invalid comment" =: + "<!-- pandoc --help -->" =?> + rawBlock "html" "<!-- pandoc --help -->" + , test markdownGH "issue 2469" $ + "<\n\na>" =?> + para (text "<") <> para (text "a>") + ] + , testGroup "raw email addresses" + [ test markdownGH "issue 2940" $ + "**@user**" =?> + para (strong (text "@user")) + ] + , testGroup "emoji" + [ test markdownGH "emoji symbols" $ + ":smile: and :+1:" =?> para (text "😄 and 👍") + ] + , "unbalanced brackets" =: + "[[[[[[[[[[[[[[[hi" =?> para (text "[[[[[[[[[[[[[[[hi") + , testGroup "backslash escapes" + [ "in URL" =: + "[hi](/there\\))" + =?> para (link "/there)" "" "hi") + , "in title" =: + "[hi](/there \"a\\\"a\")" + =?> para (link "/there" "a\"a" "hi") + , "in reference link title" =: + "[hi]\n\n[hi]: /there (a\\)a)" + =?> para (link "/there" "a)a" "hi") + , "in reference link URL" =: + "[hi]\n\n[hi]: /there\\.0" + =?> para (link "/there.0" "" "hi") + ] + , testGroup "bare URIs" + (map testBareLink bareLinkTests) + , testGroup "autolinks" + [ "with unicode dash following" =: + "<http://foo.bar>\8212" =?> para (autolink "http://foo.bar" <> + str "\8212") + , "a partial URL (#2277)" =: + "<www.boe.es/buscar/act.php?id=BOE-A-1996-8930#a66>" =?> + para (text "<www.boe.es/buscar/act.php?id=BOE-A-1996-8930#a66>") + , "with some attributes" =: + "<http://foo.bar>{#i .j .z k=v}" =?> + para (autolinkWith ("i", ["j", "z"], [("k", "v")]) "http://foo.bar") + , "with some attributes and spaces" =: + "<http://foo.bar> {#i .j .z k=v}" =?> + para (autolink "http://foo.bar" <> space <> text "{#i .j .z k=v}") + ] + , testGroup "links" + [ "no autolink inside link" =: + "[<https://example.org>](url)" =?> + para (link "url" "" (text "<https://example.org>")) + , "no inline link inside link" =: + "[[a](url2)](url)" =?> + para (link "url" "" (text "[a](url2)")) + , "no bare URI inside link" =: + "[https://example.org(](url)" =?> + para (link "url" "" (text "https://example.org(")) + ] + , testGroup "Headers" + [ "blank line before header" =: + "\n# Header\n" + =?> headerWith ("header",[],[]) 1 "Header" + , "bracketed text (#2062)" =: + "# [hi]\n" + =?> headerWith ("hi",[],[]) 1 "[hi]" + , "ATX header without trailing #s" =: + "# Foo bar\n\n" =?> + headerWith ("foo-bar",[],[]) 1 "Foo bar" + , "ATX header without trailing #s" =: + "# Foo bar with # #" =?> + headerWith ("foo-bar-with",[],[]) 1 "Foo bar with #" + , "setext header" =: + "Foo bar\n=\n\n Foo bar 2 \n=" =?> + headerWith ("foo-bar",[],[]) 1 "Foo bar" + <> headerWith ("foo-bar-2",[],[]) 1 "Foo bar 2" + ] + , testGroup "Implicit header references" + [ "ATX header without trailing #s" =: + "# Header\n[header]\n\n[header ]\n\n[ header]" =?> + headerWith ("header",[],[]) 1 "Header" + <> para (link "#header" "" (text "header")) + <> para (link "#header" "" (text "header")) + <> para (link "#header" "" (text "header")) + , "ATX header with trailing #s" =: + "# Foo bar #\n[foo bar]\n\n[foo bar ]\n\n[ foo bar]" =?> + headerWith ("foo-bar",[],[]) 1 "Foo bar" + <> para (link "#foo-bar" "" (text "foo bar")) + <> para (link "#foo-bar" "" (text "foo bar")) + <> para (link "#foo-bar" "" (text "foo bar")) + , "setext header" =: + " Header \n=\n\n[header]\n\n[header ]\n\n[ header]" =?> + headerWith ("header",[],[]) 1 "Header" + <> para (link "#header" "" (text "header")) + <> para (link "#header" "" (text "header")) + <> para (link "#header" "" (text "header")) + ] + , testGroup "smart punctuation" + [ test markdownSmart "quote before ellipses" + ("'...hi'" + =?> para (singleQuoted "…hi")) + , test markdownSmart "apostrophe before emph" + ("D'oh! A l'*aide*!" + =?> para ("D’oh! A l’" <> emph "aide" <> "!")) + , test markdownSmart "apostrophe in French" + ("À l'arrivée de la guerre, le thème de l'«impossibilité du socialisme»" + =?> para "À l’arrivée de la guerre, le thème de l’«impossibilité du socialisme»") + , test markdownSmart "apostrophe after math" $ -- issue #1909 + "The value of the $x$'s and the systems' condition." =?> + para (text "The value of the " <> math "x" <> text "\8217s and the systems\8217 condition.") + ] + , testGroup "footnotes" + [ "indent followed by newline and flush-left text" =: + "[^1]\n\n[^1]: my note\n\n \nnot in note\n" + =?> para (note (para "my note")) <> para "not in note" + , "indent followed by newline and indented text" =: + "[^1]\n\n[^1]: my note\n \n in note\n" + =?> para (note (para "my note" <> para "in note")) + , "recursive note" =: + "[^1]\n\n[^1]: See [^1]\n" + =?> para (note (para "See [^1]")) + ] + , testGroup "lhs" + [ test (purely $ readMarkdown def{ readerExtensions = enableExtension + Ext_literate_haskell pandocExtensions }) + "inverse bird tracks and html" $ + "> a\n\n< b\n\n<div>\n" + =?> codeBlockWith ("",["sourceCode","literate","haskell"],[]) "a" + <> + codeBlockWith ("",["sourceCode","haskell"],[]) "b" + <> + rawBlock "html" "<div>\n\n" + ] +-- the round-trip properties frequently fail +-- , testGroup "round trip" +-- [ property "p_markdown_round_trip" p_markdown_round_trip +-- ] + , testGroup "definition lists" + [ "no blank space" =: + "foo1\n : bar\n\nfoo2\n : bar2\n : bar3\n" =?> + definitionList [ (text "foo1", [plain (text "bar")]) + , (text "foo2", [plain (text "bar2"), + plain (text "bar3")]) + ] + , "blank space before first def" =: + "foo1\n\n : bar\n\nfoo2\n\n : bar2\n : bar3\n" =?> + definitionList [ (text "foo1", [para (text "bar")]) + , (text "foo2", [para (text "bar2"), + plain (text "bar3")]) + ] + , "blank space before second def" =: + "foo1\n : bar\n\nfoo2\n : bar2\n\n : bar3\n" =?> + definitionList [ (text "foo1", [plain (text "bar")]) + , (text "foo2", [plain (text "bar2"), + para (text "bar3")]) + ] + , "laziness" =: + "foo1\n : bar\nbaz\n : bar2\n" =?> + definitionList [ (text "foo1", [plain (text "bar" <> + softbreak <> text "baz"), + plain (text "bar2")]) + ] + , "no blank space before first of two paragraphs" =: + "foo1\n : bar\n\n baz\n" =?> + definitionList [ (text "foo1", [para (text "bar") <> + para (text "baz")]) + ] + , "first line not indented" =: + "foo\n: bar\n" =?> + definitionList [ (text "foo", [plain (text "bar")]) ] + , "list in definition" =: + "foo\n: - bar\n" =?> + definitionList [ (text "foo", [bulletList [plain (text "bar")]]) ] + , "in div" =: + "<div>foo\n: - bar\n</div>" =?> + divWith nullAttr (definitionList + [ (text "foo", [bulletList [plain (text "bar")]]) ]) + ] + , testGroup "+compact_definition_lists" + [ test markdownCDL "basic compact list" $ + "foo1\n: bar\n baz\nfoo2\n: bar2\n" =?> + definitionList [ (text "foo1", [plain (text "bar" <> softbreak <> + text "baz")]) + , (text "foo2", [plain (text "bar2")]) + ] + ] + , testGroup "lists" + [ "issue #1154" =: + " - <div>\n first div breaks\n </div>\n\n <button>if this button exists</button>\n\n <div>\n with this div too.\n </div>\n" + =?> bulletList [divWith nullAttr (para $ text "first div breaks") <> + rawBlock "html" "<button>" <> + plain (text "if this button exists") <> + rawBlock "html" "</button>" <> + divWith nullAttr (para $ text "with this div too.")] + , test markdownGH "issue #1636" $ + unlines [ "* a" + , "* b" + , "* c" + , " * d" ] + =?> + bulletList [ plain "a" + , plain "b" + , plain "c" <> bulletList [plain "d"] ] + ] + , testGroup "entities" + [ "character references" =: + "⟨ ö" =?> para (text "\10216 ö") + , "numeric" =: + ",DD" =?> para (text ",DD") + , "in link title" =: + "[link](/url \"title ⟨ ö ,\")" =?> + para (link "/url" "title \10216 ö ," (text "link")) + ] + , testGroup "citations" + [ "simple" =: + "@item1" =?> para (cite [ + Citation{ citationId = "item1" + , citationPrefix = [] + , citationSuffix = [] + , citationMode = AuthorInText + , citationNoteNum = 0 + , citationHash = 0 + } + ] "@item1") + , "key starts with digit" =: + "@1657:huyghens" =?> para (cite [ + Citation{ citationId = "1657:huyghens" + , citationPrefix = [] + , citationSuffix = [] + , citationMode = AuthorInText + , citationNoteNum = 0 + , citationHash = 0 + } + ] "@1657:huyghens") + ] + , let citation = cite [Citation "cita" [] [] AuthorInText 0 0] (str "@cita") + in testGroup "footnote/link following citation" -- issue #2083 + [ "footnote" =: + unlines [ "@cita[^note]" + , "" + , "[^note]: note" ] =?> + para ( + citation <> note (para $ str "note") + ) + , "normal link" =: + "@cita [link](http://www.com)" =?> + para ( + citation <> space <> link "http://www.com" "" (str "link") + ) + , "reference link" =: + unlines [ "@cita [link][link]" + , "" + , "[link]: http://www.com" ] =?> + para ( + citation <> space <> link "http://www.com" "" (str "link") + ) + , "short reference link" =: + unlines [ "@cita [link]" + , "" + , "[link]: http://www.com" ] =?> + para ( + citation <> space <> link "http://www.com" "" (str "link") + ) + , "implicit header link" =: + unlines [ "# Header" + , "@cita [Header]" ] =?> + headerWith ("header",[],[]) 1 (str "Header") <> para ( + citation <> space <> link "#header" "" (str "Header") + ) + , "regular citation" =: + "@cita [foo]" =?> + para ( + cite [Citation "cita" [] [Str "foo"] AuthorInText 0 0] + (str "@cita" <> space <> str "[foo]") + ) + ] + ] diff --git a/test/Tests/Readers/Odt.hs b/test/Tests/Readers/Odt.hs new file mode 100644 index 000000000..653252c5c --- /dev/null +++ b/test/Tests/Readers/Odt.hs @@ -0,0 +1,165 @@ +module Tests.Readers.Odt (tests) where + +import Control.Monad ( liftM ) +import Text.Pandoc +import Tests.Helpers +import Test.Framework +import qualified Data.ByteString.Lazy as B +import qualified Data.Map as M + +defopts :: ReaderOptions +defopts = def{ readerExtensions = getDefaultExtensions "odt" } + +tests :: [Test] +tests = testsComparingToMarkdown ++ testsComparingToNative + +testsComparingToMarkdown :: [Test] +testsComparingToMarkdown = map nameToTest namesOfTestsComparingToMarkdown + where nameToTest name = createTest + compareOdtToMarkdown + name + (toOdtPath name) + (toMarkdownPath name) + toOdtPath name = "odt/odt/" ++ name ++ ".odt" + toMarkdownPath name = "odt/markdown/" ++ name ++ ".md" + +testsComparingToNative :: [Test] +testsComparingToNative = map nameToTest namesOfTestsComparingToNative + where nameToTest name = createTest + compareOdtToNative + name + (toOdtPath name) + (toNativePath name) + toOdtPath name = "odt/odt/" ++ name ++ ".odt" + toNativePath name = "odt/native/" ++ name ++ ".native" + + +newtype NoNormPandoc = NoNormPandoc {unNoNorm :: Pandoc} + deriving ( Show ) + +instance ToString NoNormPandoc where + toString d = purely (writeNative def{ writerTemplate = s }) $ toPandoc d + where s = case d of + NoNormPandoc (Pandoc (Meta m) _) + | M.null m -> Nothing + | otherwise -> Just "" -- need this for Meta output + +instance ToPandoc NoNormPandoc where + toPandoc = unNoNorm + +getNoNormVia :: (a -> Pandoc) -> String -> Either PandocError a -> NoNormPandoc +getNoNormVia _ readerName (Left _) = error (readerName ++ " reader failed") +getNoNormVia f _ (Right a) = NoNormPandoc (f a) + +type TestCreator = ReaderOptions + -> FilePath -> FilePath + -> IO (NoNormPandoc, NoNormPandoc) + +compareOdtToNative :: TestCreator +compareOdtToNative opts odtPath nativePath = do + nativeFile <- Prelude.readFile nativePath + odtFile <- B.readFile odtPath + native <- getNoNormVia id "native" <$> runIO (readNative def nativeFile) + odt <- getNoNormVia id "odt" <$> runIO (readOdt opts odtFile) + return (odt,native) + +compareOdtToMarkdown :: TestCreator +compareOdtToMarkdown opts odtPath markdownPath = do + markdownFile <- Prelude.readFile markdownPath + odtFile <- B.readFile odtPath + markdown <- getNoNormVia id "markdown" <$> + runIO (readMarkdown def{ readerExtensions = pandocExtensions } + markdownFile) + odt <- getNoNormVia id "odt" <$> runIO (readOdt opts odtFile) + return (odt,markdown) + + +createTest :: TestCreator + -> TestName + -> FilePath -> FilePath + -> Test +createTest creator name path1 path2 = + buildTest $ liftM (test id name) (creator defopts path1 path2) + +{- +-- + +getMedia :: FilePath -> FilePath -> IO (Maybe B.ByteString) +getMedia archivePath mediaPath = do + zf <- B.readFile archivePath >>= return . toArchive + return $ findEntryByPath ("Pictures/" ++ mediaPath) zf >>= (Just . fromEntry) + +compareMediaPathIO :: FilePath -> MediaBag -> FilePath -> IO Bool +compareMediaPathIO mediaPath mediaBag odtPath = do + odtMedia <- getMedia odtPath mediaPath + let mbBS = case lookupMedia mediaPath mediaBag of + Just (_, bs) -> bs + Nothing -> error ("couldn't find " ++ + mediaPath ++ + " in media bag") + odtBS = case odtMedia of + Just bs -> bs + Nothing -> error ("couldn't find " ++ + mediaPath ++ + " in media bag") + return $ mbBS == odtBS + +compareMediaBagIO :: FilePath -> IO Bool +compareMediaBagIO odtFile = do + df <- B.readFile odtFile + let (_, mb) = readOdt def df + bools <- mapM + (\(fp, _, _) -> compareMediaPathIO fp mb odtFile) + (mediaDirectory mb) + return $ and bools + +testMediaBagIO :: String -> FilePath -> IO Test +testMediaBagIO name odtFile = do + outcome <- compareMediaBagIO odtFile + return $ testCase name (assertBool + ("Media didn't match media bag in file " ++ odtFile) + outcome) + +testMediaBag :: String -> FilePath -> Test +testMediaBag name odtFile = buildTest $ testMediaBagIO name odtFile +-} +-- + + + +namesOfTestsComparingToMarkdown :: [ String ] +namesOfTestsComparingToMarkdown = [ "bold" +-- , "citation" + , "endnote" + , "externalLink" + , "footnote" + , "headers" +-- , "horizontalRule" + , "italic" +-- , "listBlocks" + , "paragraph" + , "strikeout" +-- , "trackedChanges" + , "underlined" + ] + +namesOfTestsComparingToNative :: [ String ] +namesOfTestsComparingToNative = [ "blockquote" + , "image" + , "imageIndex" + , "imageWithCaption" + , "inlinedCode" + , "orderedListMixed" + , "orderedListRoman" + , "orderedListSimple" + , "referenceToChapter" + , "referenceToListItem" + , "referenceToText" + , "simpleTable" + , "simpleTableWithCaption" +-- , "table" + , "textMixedStyles" + , "tableWithContents" + , "unicode" + , "unorderedList" + ] diff --git a/test/Tests/Readers/Org.hs b/test/Tests/Readers/Org.hs new file mode 100644 index 000000000..ef0530b37 --- /dev/null +++ b/test/Tests/Readers/Org.hs @@ -0,0 +1,1724 @@ +{-# LANGUAGE OverloadedStrings #-} +module Tests.Readers.Org (tests) where + +import Text.Pandoc.Definition +import Test.Framework +import Tests.Helpers +import Text.Pandoc.Builder +import Text.Pandoc +import Data.List (intersperse) + +org :: String -> Pandoc +org = purely $ readOrg def{ readerExtensions = getDefaultExtensions "org" } + +orgSmart :: String -> Pandoc +orgSmart = purely $ readOrg def { readerExtensions = + enableExtension Ext_smart $ getDefaultExtensions "org" } + +infix 4 =: +(=:) :: ToString c + => String -> (String, c) -> Test +(=:) = test org + +spcSep :: [Inlines] -> Inlines +spcSep = mconcat . intersperse space + +simpleTable' :: Int + -> [Blocks] + -> [[Blocks]] + -> Blocks +simpleTable' n = table "" (take n $ repeat (AlignDefault, 0.0)) + +tests :: [Test] +tests = + [ testGroup "Inlines" $ + [ "Plain String" =: + "Hello, World" =?> + para (spcSep [ "Hello,", "World" ]) + + , "Emphasis" =: + "/Planet Punk/" =?> + para (emph . spcSep $ ["Planet", "Punk"]) + + , "Strong" =: + "*Cider*" =?> + para (strong "Cider") + + , "Strong Emphasis" =: + "/*strength*/" =?> + para (emph . strong $ "strength") + + , "Emphasized Strong preceded by space" =: + " */super/*" =?> + para (strong . emph $ "super") + + , "Strikeout" =: + "+Kill Bill+" =?> + para (strikeout . spcSep $ [ "Kill", "Bill" ]) + + , "Verbatim" =: + "=Robot.rock()=" =?> + para (code "Robot.rock()") + + , "Code" =: + "~word for word~" =?> + para (code "word for word") + + , "Math $..$" =: + "$E=mc^2$" =?> + para (math "E=mc^2") + + , "Math $$..$$" =: + "$$E=mc^2$$" =?> + para (displayMath "E=mc^2") + + , "Math \\[..\\]" =: + "\\[E=ℎν\\]" =?> + para (displayMath "E=ℎν") + + , "Math \\(..\\)" =: + "\\(σ_x σ_p ≥ \\frac{ℏ}{2}\\)" =?> + para (math "σ_x σ_p ≥ \\frac{ℏ}{2}") + + , "Symbol" =: + "A * symbol" =?> + para (str "A" <> space <> str "*" <> space <> "symbol") + + , "Superscript simple expression" =: + "2^-λ" =?> + para (str "2" <> superscript "-λ") + + , "Superscript multi char" =: + "2^{n-1}" =?> + para (str "2" <> superscript "n-1") + + , "Subscript simple expression" =: + "a_n" =?> + para (str "a" <> subscript "n") + + , "Subscript multi char" =: + "a_{n+1}" =?> + para (str "a" <> subscript "n+1") + + , "Linebreak" =: + "line \\\\ \nbreak" =?> + para ("line" <> linebreak <> "break") + + , "Inline note" =: + "[fn::Schreib mir eine E-Mail]" =?> + para (note $ para "Schreib mir eine E-Mail") + + , "Markup-chars not occuring on word break are symbols" =: + unlines [ "this+that+ +so+on" + , "seven*eight* nine*" + , "+not+funny+" + ] =?> + para ("this+that+ +so+on" <> softbreak <> + "seven*eight* nine*" <> softbreak <> + strikeout "not+funny") + + , "No empty markup" =: + "// ** __ ++ == ~~ $$" =?> + para (spcSep [ "//", "**", "__", "++", "==", "~~", "$$" ]) + + , "Adherence to Org's rules for markup borders" =: + "/t/& a/ / ./r/ (*l*) /e/! /b/." =?> + para (spcSep [ emph $ "t/&" <> space <> "a" + , "/" + , "./r/" + , "(" <> (strong "l") <> ")" + , (emph "e") <> "!" + , (emph "b") <> "." + ]) + + , "Quotes are forbidden border chars" =: + "/'nope/ *nope\"*" =?> + para ("/'nope/" <> space <> "*nope\"*") + + , "Commata are forbidden border chars" =: + "/nada,/" =?> + para "/nada,/" + + , "Markup should work properly after a blank line" =: + unlines ["foo", "", "/bar/"] =?> + (para $ text "foo") <> (para $ emph $ text "bar") + + , "Inline math must stay within three lines" =: + unlines [ "$a", "b", "c$", "$d", "e", "f", "g$" ] =?> + para ((math "a\nb\nc") <> softbreak <> + "$d" <> softbreak <> "e" <> softbreak <> + "f" <> softbreak <> "g$") + + , "Single-character math" =: + "$a$ $b$! $c$?" =?> + para (spcSep [ math "a" + , "$b$!" + , (math "c") <> "?" + ]) + + , "Markup may not span more than two lines" =: + "/this *is +totally\nnice+ not*\nemph/" =?> + para ("/this" <> space <> + strong ("is" <> space <> + strikeout ("totally" <> + softbreak <> "nice") <> + space <> "not") <> + softbreak <> "emph/") + + , "Sub- and superscript expressions" =: + unlines [ "a_(a(b)(c)d)" + , "e^(f(g)h)" + , "i_(jk)l)" + , "m^()n" + , "o_{p{q{}r}}" + , "s^{t{u}v}" + , "w_{xy}z}" + , "1^{}2" + , "3_{{}}" + , "4^(a(*b(c*)d))" + ] =?> + para (mconcat $ intersperse softbreak + [ "a" <> subscript "(a(b)(c)d)" + , "e" <> superscript "(f(g)h)" + , "i" <> (subscript "(jk)") <> "l)" + , "m" <> (superscript "()") <> "n" + , "o" <> subscript "p{q{}r}" + , "s" <> superscript "t{u}v" + , "w" <> (subscript "xy") <> "z}" + , "1" <> (superscript "") <> "2" + , "3" <> subscript "{}" + , "4" <> superscript ("(a(" <> strong "b(c" <> ")d))") + ]) + , "Verbatim text can contain equal signes (=)" =: + "=is_subst = True=" =?> + para (code "is_subst = True") + + , testGroup "Images" + [ "Image" =: + "[[./sunset.jpg]]" =?> + (para $ image "./sunset.jpg" "" "") + + , "Image with explicit file: prefix" =: + "[[file:sunrise.jpg]]" =?> + (para $ image "sunrise.jpg" "" "") + + , "Multiple images within a paragraph" =: + unlines [ "[[file:sunrise.jpg]]" + , "[[file:sunset.jpg]]" + ] =?> + (para $ (image "sunrise.jpg" "" "") + <> softbreak + <> (image "sunset.jpg" "" "")) + + , "Image with html attributes" =: + unlines [ "#+ATTR_HTML: :width 50%" + , "[[file:guinea-pig.gif]]" + ] =?> + (para $ imageWith ("", [], [("width", "50%")]) "guinea-pig.gif" "" "") + ] + + , "Explicit link" =: + "[[http://zeitlens.com/][pseudo-random /nonsense/]]" =?> + (para $ link "http://zeitlens.com/" "" + ("pseudo-random" <> space <> emph "nonsense")) + + , "Self-link" =: + "[[http://zeitlens.com/]]" =?> + (para $ link "http://zeitlens.com/" "" "http://zeitlens.com/") + + , "Absolute file link" =: + "[[/url][hi]]" =?> + (para $ link "file:///url" "" "hi") + + , "Link to file in parent directory" =: + "[[../file.txt][moin]]" =?> + (para $ link "../file.txt" "" "moin") + + , "Empty link (for gitit interop)" =: + "[[][New Link]]" =?> + (para $ link "" "" "New Link") + + , "Image link" =: + "[[sunset.png][file:dusk.svg]]" =?> + (para $ link "sunset.png" "" (image "dusk.svg" "" "")) + + , "Image link with non-image target" =: + "[[http://example.com][./logo.png]]" =?> + (para $ link "http://example.com" "" (image "./logo.png" "" "")) + + , "Plain link" =: + "Posts on http://zeitlens.com/ can be funny at times." =?> + (para $ spcSep [ "Posts", "on" + , link "http://zeitlens.com/" "" "http://zeitlens.com/" + , "can", "be", "funny", "at", "times." + ]) + + , "Angle link" =: + "Look at <http://moltkeplatz.de> for fnords." =?> + (para $ spcSep [ "Look", "at" + , link "http://moltkeplatz.de" "" "http://moltkeplatz.de" + , "for", "fnords." + ]) + + , "Absolute file link" =: + "[[file:///etc/passwd][passwd]]" =?> + (para $ link "file:///etc/passwd" "" "passwd") + + , "File link" =: + "[[file:target][title]]" =?> + (para $ link "target" "" "title") + + , "Anchor" =: + "<<anchor>> Link here later." =?> + (para $ spanWith ("anchor", [], []) mempty <> + "Link" <> space <> "here" <> space <> "later.") + + , "Inline code block" =: + "src_emacs-lisp{(message \"Hello\")}" =?> + (para $ codeWith ( "" + , [ "commonlisp", "rundoc-block" ] + , [ ("rundoc-language", "emacs-lisp") ]) + "(message \"Hello\")") + + , "Inline code block with arguments" =: + "src_sh[:export both :results output]{echo 'Hello, World'}" =?> + (para $ codeWith ( "" + , [ "bash", "rundoc-block" ] + , [ ("rundoc-language", "sh") + , ("rundoc-export", "both") + , ("rundoc-results", "output") + ] + ) + "echo 'Hello, World'") + + , "Inline code block with toggle" =: + "src_sh[:toggle]{echo $HOME}" =?> + (para $ codeWith ( "" + , [ "bash", "rundoc-block" ] + , [ ("rundoc-language", "sh") + , ("rundoc-toggle", "yes") + ] + ) + "echo $HOME") + + , "Citation" =: + "[@nonexistent]" =?> + let citation = Citation + { citationId = "nonexistent" + , citationPrefix = [] + , citationSuffix = [] + , citationMode = NormalCitation + , citationNoteNum = 0 + , citationHash = 0} + in (para $ cite [citation] "[@nonexistent]") + + , "Citation containing text" =: + "[see @item1 p. 34-35]" =?> + let citation = Citation + { citationId = "item1" + , citationPrefix = [Str "see"] + , citationSuffix = [Space ,Str "p.",Space,Str "34-35"] + , citationMode = NormalCitation + , citationNoteNum = 0 + , citationHash = 0} + in (para $ cite [citation] "[see @item1 p. 34-35]") + + , "Org-ref simple citation" =: + "cite:pandoc" =?> + let citation = Citation + { citationId = "pandoc" + , citationPrefix = mempty + , citationSuffix = mempty + , citationMode = AuthorInText + , citationNoteNum = 0 + , citationHash = 0 + } + in (para $ cite [citation] "cite:pandoc") + + , "Org-ref simple citation succeeded by comma" =: + "cite:pandoc," =?> + let citation = Citation + { citationId = "pandoc" + , citationPrefix = mempty + , citationSuffix = mempty + , citationMode = AuthorInText + , citationNoteNum = 0 + , citationHash = 0 + } + in (para $ cite [citation] "cite:pandoc" <> str ",") + + , "Org-ref simple citep citation" =: + "citep:pandoc" =?> + let citation = Citation + { citationId = "pandoc" + , citationPrefix = mempty + , citationSuffix = mempty + , citationMode = NormalCitation + , citationNoteNum = 0 + , citationHash = 0 + } + in (para $ cite [citation] "citep:pandoc") + + , "Org-ref extended citation" =: + "[[citep:Dominik201408][See page 20::, for example]]" =?> + let citation = Citation + { citationId = "Dominik201408" + , citationPrefix = toList "See page 20" + , citationSuffix = toList ", for example" + , citationMode = NormalCitation + , citationNoteNum = 0 + , citationHash = 0 + } + in (para $ cite [citation] "[[citep:Dominik201408][See page 20::, for example]]") + + , testGroup "Berkeley-style citations" $ + let pandocCite = Citation + { citationId = "Pandoc" + , citationPrefix = mempty + , citationSuffix = mempty + , citationMode = NormalCitation + , citationNoteNum = 0 + , citationHash = 0 + } + pandocInText = pandocCite { citationMode = AuthorInText } + dominikCite = Citation + { citationId = "Dominik201408" + , citationPrefix = mempty + , citationSuffix = mempty + , citationMode = NormalCitation + , citationNoteNum = 0 + , citationHash = 0 + } + dominikInText = dominikCite { citationMode = AuthorInText } + in [ + "Berkeley-style in-text citation" =: + "See @Dominik201408." =?> + (para $ "See " + <> cite [dominikInText] "@Dominik201408" + <> ".") + + , "Berkeley-style parenthetical citation list" =: + "[(cite): see; @Dominik201408;also @Pandoc; and others]" =?> + let pandocCite' = pandocCite { + citationPrefix = toList "also" + , citationSuffix = toList "and others" + } + dominikCite' = dominikCite { + citationPrefix = toList "see" + } + in (para $ cite [dominikCite', pandocCite'] "") + + , "Berkeley-style plain citation list" =: + "[cite: See; @Dominik201408; and @Pandoc; and others]" =?> + let pandocCite' = pandocInText { + citationPrefix = toList "and" + } + in (para $ "See " + <> cite [dominikInText] "" + <> "," <> space + <> cite [pandocCite'] "" + <> "," <> space <> "and others") + ] + + , "Inline LaTeX symbol" =: + "\\dots" =?> + para "…" + + , "Inline LaTeX command" =: + "\\textit{Emphasised}" =?> + para (emph "Emphasised") + + , "Inline LaTeX command with spaces" =: + "\\emph{Emphasis mine}" =?> + para (emph "Emphasis mine") + + , "Inline LaTeX math symbol" =: + "\\tau" =?> + para (emph "τ") + + , "Unknown inline LaTeX command" =: + "\\notacommand{foo}" =?> + para (rawInline "latex" "\\notacommand{foo}") + + , "Export snippet" =: + "@@html:<kbd>M-x org-agenda</kbd>@@" =?> + para (rawInline "html" "<kbd>M-x org-agenda</kbd>") + + , "MathML symbol in LaTeX-style" =: + "There is a hackerspace in Lübeck, Germany, called nbsp (unicode symbol: '\\nbsp')." =?> + para ("There is a hackerspace in Lübeck, Germany, called nbsp (unicode symbol: ' ').") + + , "MathML symbol in LaTeX-style, including braces" =: + "\\Aacute{}stor" =?> + para "Ástor" + + , "MathML copy sign" =: + "\\copy" =?> + para "©" + + , "MathML symbols, space separated" =: + "\\ForAll \\Auml" =?> + para "∀ Ä" + + , "LaTeX citation" =: + "\\cite{Coffee}" =?> + let citation = Citation + { citationId = "Coffee" + , citationPrefix = [] + , citationSuffix = [] + , citationMode = NormalCitation + , citationNoteNum = 0 + , citationHash = 0} + in (para . cite [citation] $ rawInline "latex" "\\cite{Coffee}") + ] + + , testGroup "Meta Information" $ + [ "Comment" =: + "# Nothing to see here" =?> + (mempty::Blocks) + + , "Not a comment" =: + "#-tag" =?> + para "#-tag" + + , "Comment surrounded by Text" =: + unlines [ "Before" + , "# Comment" + , "After" + ] =?> + mconcat [ para "Before" + , para "After" + ] + + , "Title" =: + "#+TITLE: Hello, World" =?> + let titleInline = toList $ "Hello," <> space <> "World" + meta = setMeta "title" (MetaInlines titleInline) $ nullMeta + in Pandoc meta mempty + + , "Author" =: + "#+author: Albert /Emacs-Fanboy/ Krewinkel" =?> + let author = toList . spcSep $ [ "Albert", emph "Emacs-Fanboy", "Krewinkel" ] + meta = setMeta "author" (MetaList [MetaInlines author]) $ nullMeta + in Pandoc meta mempty + + , "Multiple authors" =: + "#+author: James Dewey Watson, Francis Harry Compton Crick " =?> + let watson = MetaInlines $ toList "James Dewey Watson" + crick = MetaInlines $ toList "Francis Harry Compton Crick" + meta = setMeta "author" (MetaList [watson, crick]) $ nullMeta + in Pandoc meta mempty + + , "Date" =: + "#+Date: Feb. *28*, 2014" =?> + let date = toList . spcSep $ [ "Feb.", (strong "28") <> ",", "2014" ] + meta = setMeta "date" (MetaInlines date) $ nullMeta + in Pandoc meta mempty + + , "Description" =: + "#+DESCRIPTION: Explanatory text" =?> + let description = "Explanatory text" + meta = setMeta "description" (MetaString description) $ nullMeta + in Pandoc meta mempty + + , "Properties drawer" =: + unlines [ " :PROPERTIES:" + , " :setting: foo" + , " :END:" + ] =?> + (mempty::Blocks) + + , "LaTeX_headers options are translated to header-includes" =: + "#+LaTeX_header: \\usepackage{tikz}" =?> + let latexInlines = rawInline "latex" "\\usepackage{tikz}" + inclList = MetaList [MetaInlines (toList latexInlines)] + meta = setMeta "header-includes" inclList nullMeta + in Pandoc meta mempty + + , "LaTeX_class option is translated to documentclass" =: + "#+LATEX_CLASS: article" =?> + let meta = setMeta "documentclass" (MetaString "article") nullMeta + in Pandoc meta mempty + + , "LaTeX_class_options is translated to classoption" =: + "#+LATEX_CLASS_OPTIONS: [a4paper]" =?> + let meta = setMeta "classoption" (MetaString "a4paper") nullMeta + in Pandoc meta mempty + + , "LaTeX_class_options is translated to classoption" =: + "#+html_head: <meta/>" =?> + let html = rawInline "html" "<meta/>" + inclList = MetaList [MetaInlines (toList html)] + meta = setMeta "header-includes" inclList nullMeta + in Pandoc meta mempty + + , "later meta definitions take precedence" =: + unlines [ "#+AUTHOR: this will not be used" + , "#+author: Max" + ] =?> + let author = MetaInlines [Str "Max"] + meta = setMeta "author" (MetaList [author]) $ nullMeta + in Pandoc meta mempty + + , "Logbook drawer" =: + unlines [ " :LogBook:" + , " - State \"DONE\" from \"TODO\" [2014-03-03 Mon 11:00]" + , " :END:" + ] =?> + (mempty::Blocks) + + , "Drawer surrounded by text" =: + unlines [ "Before" + , ":PROPERTIES:" + , ":END:" + , "After" + ] =?> + para "Before" <> para "After" + + , "Drawer markers must be the only text in the line" =: + unlines [ " :LOGBOOK: foo" + , " :END: bar" + ] =?> + para (":LOGBOOK: foo" <> softbreak <> ":END: bar") + + , "Drawers can be arbitrary" =: + unlines [ ":FOO:" + , "/bar/" + , ":END:" + ] =?> + divWith (mempty, ["FOO", "drawer"], mempty) (para $ emph "bar") + + , "Anchor reference" =: + unlines [ "<<link-here>> Target." + , "" + , "[[link-here][See here!]]" + ] =?> + (para (spanWith ("link-here", [], []) mempty <> "Target.") <> + para (link "#link-here" "" ("See" <> space <> "here!"))) + + , "Search links are read as emph" =: + "[[Wally][Where's Wally?]]" =?> + (para (emph $ "Where's" <> space <> "Wally?")) + + , "Link to nonexistent anchor" =: + unlines [ "<<link-here>> Target." + , "" + , "[[link$here][See here!]]" + ] =?> + (para (spanWith ("link-here", [], []) mempty <> "Target.") <> + para (emph ("See" <> space <> "here!"))) + + , "Link abbreviation" =: + unlines [ "#+LINK: wp https://en.wikipedia.org/wiki/%s" + , "[[wp:Org_mode][Wikipedia on Org-mode]]" + ] =?> + (para (link "https://en.wikipedia.org/wiki/Org_mode" "" + ("Wikipedia" <> space <> "on" <> space <> "Org-mode"))) + + , "Link abbreviation, defined after first use" =: + unlines [ "[[zl:non-sense][Non-sense articles]]" + , "#+LINK: zl http://zeitlens.com/tags/%s.html" + ] =?> + (para (link "http://zeitlens.com/tags/non-sense.html" "" + ("Non-sense" <> space <> "articles"))) + + , "Link abbreviation, URL encoded arguments" =: + unlines [ "#+link: expl http://example.com/%h/foo" + , "[[expl:Hello, World!][Moin!]]" + ] =?> + (para (link "http://example.com/Hello%2C%20World%21/foo" "" "Moin!")) + + , "Link abbreviation, append arguments" =: + unlines [ "#+link: expl http://example.com/" + , "[[expl:foo][bar]]" + ] =?> + (para (link "http://example.com/foo" "" "bar")) + + + , testGroup "export options" + + [ "disable simple sub/superscript syntax" =: + unlines [ "#+OPTIONS: ^:nil" + , "a^b" + ] =?> + para "a^b" + + , "directly select drawers to be exported" =: + unlines [ "#+OPTIONS: d:(\"IMPORTANT\")" + , ":IMPORTANT:" + , "23" + , ":END:" + , ":BORING:" + , "very boring" + , ":END:" + ] =?> + divWith (mempty, ["IMPORTANT", "drawer"], mempty) (para "23") + + , "exclude drawers from being exported" =: + unlines [ "#+OPTIONS: d:(not \"BORING\")" + , ":IMPORTANT:" + , "5" + , ":END:" + , ":BORING:" + , "very boring" + , ":END:" + ] =?> + divWith (mempty, ["IMPORTANT", "drawer"], mempty) (para "5") + + , "don't include archive trees" =: + unlines [ "#+OPTIONS: arch:nil" + , "* old :ARCHIVE:" + ] =?> + (mempty ::Blocks) + + , "include complete archive trees" =: + unlines [ "#+OPTIONS: arch:t" + , "* old :ARCHIVE:" + , " boring" + ] =?> + let tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) mempty + in mconcat [ headerWith ("old", [], mempty) 1 ("old" <> tagSpan "ARCHIVE") + , para "boring" + ] + + , "include archive tree header only" =: + unlines [ "#+OPTIONS: arch:headline" + , "* old :ARCHIVE:" + , " boring" + ] =?> + let tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) mempty + in headerWith ("old", [], mempty) 1 ("old" <> tagSpan "ARCHIVE") + + , "limit headline depth" =: + unlines [ "#+OPTIONS: H:2" + , "* section" + , "** subsection" + , "*** list item 1" + , "*** list item 2" + ] =?> + mconcat [ headerWith ("section", [], []) 1 "section" + , headerWith ("subsection", [], []) 2 "subsection" + , orderedList [ para "list item 1", para "list item 2" ] + ] + + , "disable author export" =: + unlines [ "#+OPTIONS: author:nil" + , "#+AUTHOR: ShyGuy" + ] =?> + Pandoc nullMeta mempty + + , "disable creator export" =: + unlines [ "#+OPTIONS: creator:nil" + , "#+creator: The Architect" + ] =?> + Pandoc nullMeta mempty + + , "disable email export" =: + unlines [ "#+OPTIONS: email:nil" + , "#+email: no-mail-please@example.com" + ] =?> + Pandoc nullMeta mempty + + , "disable inclusion of todo keywords" =: + unlines [ "#+OPTIONS: todo:nil" + , "** DONE todo export" + ] =?> + headerWith ("todo-export", [], []) 2 "todo export" + ] + ] + + , testGroup "Basic Blocks" $ + [ "Paragraph" =: + "Paragraph\n" =?> + para "Paragraph" + + , testGroup "headers" $ + [ "First Level Header" =: + "* Headline\n" =?> + headerWith ("headline", [], []) 1 "Headline" + + , "Third Level Header" =: + "*** Third Level Headline\n" =?> + headerWith ("third-level-headline", [], []) + 3 + ("Third" <> space <> "Level" <> space <> "Headline") + + , "Compact Headers with Paragraph" =: + unlines [ "* First Level" + , "** Second Level" + , " Text" + ] =?> + mconcat [ headerWith ("first-level", [], []) + 1 + ("First" <> space <> "Level") + , headerWith ("second-level", [], []) + 2 + ("Second" <> space <> "Level") + , para "Text" + ] + + , "Separated Headers with Paragraph" =: + unlines [ "* First Level" + , "" + , "** Second Level" + , "" + , " Text" + ] =?> + mconcat [ headerWith ("first-level", [], []) + 1 + ("First" <> space <> "Level") + , headerWith ("second-level", [], []) + 2 + ("Second" <> space <> "Level") + , para "Text" + ] + + , "Headers not preceded by a blank line" =: + unlines [ "** eat dinner" + , "Spaghetti and meatballs tonight." + , "** walk dog" + ] =?> + mconcat [ headerWith ("eat-dinner", [], []) + 2 + ("eat" <> space <> "dinner") + , para $ spcSep [ "Spaghetti", "and", "meatballs", "tonight." ] + , headerWith ("walk-dog", [], []) + 2 + ("walk" <> space <> "dog") + ] + + , testGroup "Todo keywords" + [ "Header with known todo keyword" =: + "* TODO header" =?> + let todoSpan = spanWith ("", ["todo", "TODO"], []) "TODO" + in headerWith ("header", [], []) 1 (todoSpan <> space <> "header") + + , "Header marked as done" =: + "* DONE header" =?> + let todoSpan = spanWith ("", ["done", "DONE"], []) "DONE" + in headerWith ("header", [], []) 1 (todoSpan <> space <> "header") + + , "Header with unknown todo keyword" =: + "* WAITING header" =?> + headerWith ("waiting-header", [], []) 1 "WAITING header" + + , "Custom todo keywords" =: + unlines [ "#+TODO: WAITING CANCELLED" + , "* WAITING compile" + , "* CANCELLED lunch" + ] =?> + let todoSpan = spanWith ("", ["todo", "WAITING"], []) "WAITING" + doneSpan = spanWith ("", ["done", "CANCELLED"], []) "CANCELLED" + in headerWith ("compile", [], []) 1 (todoSpan <> space <> "compile") + <> headerWith ("lunch", [], []) 1 (doneSpan <> space <> "lunch") + + , "Custom todo keywords with multiple done-states" =: + unlines [ "#+TODO: WAITING | DONE CANCELLED " + , "* WAITING compile" + , "* CANCELLED lunch" + , "* DONE todo-feature" + ] =?> + let waiting = spanWith ("", ["todo", "WAITING"], []) "WAITING" + cancelled = spanWith ("", ["done", "CANCELLED"], []) "CANCELLED" + done = spanWith ("", ["done", "DONE"], []) "DONE" + in headerWith ("compile", [], []) 1 (waiting <> space <> "compile") + <> headerWith ("lunch", [], []) 1 (cancelled <> space <> "lunch") + <> headerWith ("todo-feature", [], []) 1 (done <> space <> "todo-feature") + ] + + , "Tagged headers" =: + unlines [ "* Personal :PERSONAL:" + , "** Call Mom :@PHONE:" + , "** Call John :@PHONE:JOHN: " + ] =?> + let tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) mempty + in mconcat [ headerWith ("personal", [], []) + 1 + ("Personal" <> tagSpan "PERSONAL") + , headerWith ("call-mom", [], []) + 2 + ("Call Mom" <> tagSpan "@PHONE") + , headerWith ("call-john", [], []) + 2 + ("Call John" <> tagSpan "@PHONE" <> tagSpan "JOHN") + ] + + , "Untagged header containing colons" =: + "* This: is not: tagged" =?> + headerWith ("this-is-not-tagged", [], []) 1 "This: is not: tagged" + + , "Header starting with strokeout text" =: + unlines [ "foo" + , "" + , "* +thing+ other thing" + ] =?> + mconcat [ para "foo" + , headerWith ("thing-other-thing", [], []) + 1 + ((strikeout "thing") <> " other thing") + ] + + , "Comment Trees" =: + unlines [ "* COMMENT A comment tree" + , " Not much going on here" + , "** This will be dropped" + , "* Comment tree above" + ] =?> + headerWith ("comment-tree-above", [], []) 1 "Comment tree above" + + , "Nothing but a COMMENT header" =: + "* COMMENT Test" =?> + (mempty::Blocks) + + , "Tree with :noexport:" =: + unlines [ "* Should be ignored :archive:noexport:old:" + , "** Old stuff" + , " This is not going to be exported" + ] =?> + (mempty::Blocks) + + , "Subtree with :noexport:" =: + unlines [ "* Exported" + , "** This isn't exported :noexport:" + , "*** This neither" + , "** But this is" + ] =?> + mconcat [ headerWith ("exported", [], []) 1 "Exported" + , headerWith ("but-this-is", [], []) 2 "But this is" + ] + + , "Preferences are treated as header attributes" =: + unlines [ "* foo" + , " :PROPERTIES:" + , " :custom_id: fubar" + , " :bar: baz" + , " :END:" + ] =?> + headerWith ("fubar", [], [("bar", "baz")]) 1 "foo" + + + , "Headers marked with a unnumbered property get a class of the same name" =: + unlines [ "* Not numbered" + , " :PROPERTIES:" + , " :UNNUMBERED: t" + , " :END:" + ] =?> + headerWith ("not-numbered", ["unnumbered"], []) 1 "Not numbered" + ] + , "Paragraph starting with an asterisk" =: + "*five" =?> + para "*five" + + , "Paragraph containing asterisk at beginning of line" =: + unlines [ "lucky" + , "*star" + ] =?> + para ("lucky" <> softbreak <> "*star") + + , "Example block" =: + unlines [ ": echo hello" + , ": echo dear tester" + ] =?> + codeBlockWith ("", ["example"], []) "echo hello\necho dear tester\n" + + , "Example block surrounded by text" =: + unlines [ "Greetings" + , ": echo hello" + , ": echo dear tester" + , "Bye" + ] =?> + mconcat [ para "Greetings" + , codeBlockWith ("", ["example"], []) + "echo hello\necho dear tester\n" + , para "Bye" + ] + + , "Horizontal Rule" =: + unlines [ "before" + , "-----" + , "after" + ] =?> + mconcat [ para "before" + , horizontalRule + , para "after" + ] + + , "Not a Horizontal Rule" =: + "----- five dashes" =?> + (para $ spcSep [ "-----", "five", "dashes" ]) + + , "Comment Block" =: + unlines [ "#+BEGIN_COMMENT" + , "stuff" + , "bla" + , "#+END_COMMENT"] =?> + (mempty::Blocks) + + , testGroup "Figures" $ + [ "Figure" =: + unlines [ "#+caption: A very courageous man." + , "#+name: goodguy" + , "[[file:edward.jpg]]" + ] =?> + para (image "edward.jpg" "fig:goodguy" "A very courageous man.") + + , "Figure with no name" =: + unlines [ "#+caption: I've been through the desert on this" + , "[[file:horse.png]]" + ] =?> + para (image "horse.png" "fig:" "I've been through the desert on this") + + , "Figure with `fig:` prefix in name" =: + unlines [ "#+caption: Used as a metapher in evolutionary biology." + , "#+name: fig:redqueen" + , "[[./the-red-queen.jpg]]" + ] =?> + para (image "./the-red-queen.jpg" "fig:redqueen" + "Used as a metapher in evolutionary biology.") + + , "Figure with HTML attributes" =: + unlines [ "#+CAPTION: mah brain just explodid" + , "#+NAME: lambdacat" + , "#+ATTR_HTML: :style color: blue :role button" + , "[[file:lambdacat.jpg]]" + ] =?> + let kv = [("style", "color: blue"), ("role", "button")] + name = "fig:lambdacat" + caption = "mah brain just explodid" + in para (imageWith (mempty, mempty, kv) "lambdacat.jpg" name caption) + + , "Labelled figure" =: + unlines [ "#+CAPTION: My figure" + , "#+LABEL: fig:myfig" + , "[[file:blub.png]]" + ] =?> + let attr = ("fig:myfig", mempty, mempty) + in para (imageWith attr "blub.png" "fig:" "My figure") + + , "Figure with empty caption" =: + unlines [ "#+CAPTION:" + , "[[file:guess.jpg]]" + ] =?> + para (image "guess.jpg" "fig:" "") + ] + + , "Footnote" =: + unlines [ "A footnote[1]" + , "" + , "[1] First paragraph" + , "" + , "second paragraph" + ] =?> + para (mconcat + [ "A", space, "footnote" + , note $ mconcat [ para ("First" <> space <> "paragraph") + , para ("second" <> space <> "paragraph") + ] + ]) + + , "Two footnotes" =: + unlines [ "Footnotes[fn:1][fn:2]" + , "" + , "[fn:1] First note." + , "" + , "[fn:2] Second note." + ] =?> + para (mconcat + [ "Footnotes" + , note $ para ("First" <> space <> "note.") + , note $ para ("Second" <> space <> "note.") + ]) + + , "Footnote followed by header" =: + unlines [ "Another note[fn:yay]" + , "" + , "[fn:yay] This is great!" + , "" + , "** Headline" + ] =?> + mconcat + [ para (mconcat + [ "Another", space, "note" + , note $ para ("This" <> space <> "is" <> space <> "great!") + ]) + , headerWith ("headline", [], []) 2 "Headline" + ] + ] + + , testGroup "Lists" $ + [ "Simple Bullet Lists" =: + ("- Item1\n" ++ + "- Item2\n") =?> + bulletList [ plain "Item1" + , plain "Item2" + ] + + , "Indented Bullet Lists" =: + (" - Item1\n" ++ + " - Item2\n") =?> + bulletList [ plain "Item1" + , plain "Item2" + ] + + , "Unindented *" =: + ("- Item1\n" ++ + "* Item2\n") =?> + bulletList [ plain "Item1" + ] <> + headerWith ("item2", [], []) 1 "Item2" + + , "Multi-line Bullet Lists" =: + ("- *Fat\n" ++ + " Tony*\n" ++ + "- /Sideshow\n" ++ + " Bob/") =?> + bulletList [ plain $ strong ("Fat" <> softbreak <> "Tony") + , plain $ emph ("Sideshow" <> softbreak <> "Bob") + ] + + , "Nested Bullet Lists" =: + ("- Discovery\n" ++ + " + One More Time\n" ++ + " + Harder, Better, Faster, Stronger\n" ++ + "- Homework\n" ++ + " + Around the World\n"++ + "- Human After All\n" ++ + " + Technologic\n" ++ + " + Robot Rock\n") =?> + bulletList [ mconcat + [ plain "Discovery" + , bulletList [ plain ("One" <> space <> + "More" <> space <> + "Time") + , plain ("Harder," <> space <> + "Better," <> space <> + "Faster," <> space <> + "Stronger") + ] + ] + , mconcat + [ plain "Homework" + , bulletList [ plain ("Around" <> space <> + "the" <> space <> + "World") + ] + ] + , mconcat + [ plain ("Human" <> space <> "After" <> space <> "All") + , bulletList [ plain "Technologic" + , plain ("Robot" <> space <> "Rock") + ] + ] + ] + + , "Bullet List with Decreasing Indent" =: + (" - Discovery\n\ + \ - Human After All\n") =?> + mconcat [ bulletList [ plain "Discovery" ] + , bulletList [ plain ("Human" <> space <> "After" <> space <> "All")] + ] + + , "Header follows Bullet List" =: + (" - Discovery\n\ + \ - Human After All\n\ + \* Homework") =?> + mconcat [ bulletList [ plain "Discovery" + , plain ("Human" <> space <> "After" <> space <> "All") + ] + , headerWith ("homework", [], []) 1 "Homework" + ] + + , "Bullet List Unindented with trailing Header" =: + ("- Discovery\n\ + \- Homework\n\ + \* NotValidListItem") =?> + mconcat [ bulletList [ plain "Discovery" + , plain "Homework" + ] + , headerWith ("notvalidlistitem", [], []) 1 "NotValidListItem" + ] + + , "Simple Ordered List" =: + ("1. Item1\n" ++ + "2. Item2\n") =?> + let listStyle = (1, DefaultStyle, DefaultDelim) + listStructure = [ plain "Item1" + , plain "Item2" + ] + in orderedListWith listStyle listStructure + + , "Simple Ordered List with Parens" =: + ("1) Item1\n" ++ + "2) Item2\n") =?> + let listStyle = (1, DefaultStyle, DefaultDelim) + listStructure = [ plain "Item1" + , plain "Item2" + ] + in orderedListWith listStyle listStructure + + , "Indented Ordered List" =: + (" 1. Item1\n" ++ + " 2. Item2\n") =?> + let listStyle = (1, DefaultStyle, DefaultDelim) + listStructure = [ plain "Item1" + , plain "Item2" + ] + in orderedListWith listStyle listStructure + + , "Nested Ordered Lists" =: + ("1. One\n" ++ + " 1. One-One\n" ++ + " 2. One-Two\n" ++ + "2. Two\n" ++ + " 1. Two-One\n"++ + " 2. Two-Two\n") =?> + let listStyle = (1, DefaultStyle, DefaultDelim) + listStructure = [ mconcat + [ plain "One" + , orderedList [ plain "One-One" + , plain "One-Two" + ] + ] + , mconcat + [ plain "Two" + , orderedList [ plain "Two-One" + , plain "Two-Two" + ] + ] + ] + in orderedListWith listStyle listStructure + + , "Ordered List in Bullet List" =: + ("- Emacs\n" ++ + " 1. Org\n") =?> + bulletList [ (plain "Emacs") <> + (orderedList [ plain "Org"]) + ] + + , "Bullet List in Ordered List" =: + ("1. GNU\n" ++ + " - Freedom\n") =?> + orderedList [ (plain "GNU") <> bulletList [ (plain "Freedom") ] ] + + , "Definition List" =: + unlines [ "- PLL :: phase-locked loop" + , "- TTL ::" + , " transistor-transistor logic" + , "- PSK :: phase-shift keying" + , "" + , " a digital modulation scheme" + ] =?> + definitionList [ ("PLL", [ plain $ "phase-locked" <> space <> "loop" ]) + , ("TTL", [ plain $ "transistor-transistor" <> space <> + "logic" ]) + , ("PSK", [ mconcat + [ para $ "phase-shift" <> space <> "keying" + , para $ spcSep [ "a", "digital" + , "modulation", "scheme" ] + ] + ]) + ] + , "Definition list with multi-word term" =: + " - Elijah Wood :: He plays Frodo" =?> + definitionList [ ("Elijah" <> space <> "Wood", [plain $ "He" <> space <> "plays" <> space <> "Frodo"])] + , "Compact definition list" =: + unlines [ "- ATP :: adenosine 5' triphosphate" + , "- DNA :: deoxyribonucleic acid" + , "- PCR :: polymerase chain reaction" + , "" + ] =?> + definitionList + [ ("ATP", [ plain $ spcSep [ "adenosine", "5'", "triphosphate" ] ]) + , ("DNA", [ plain $ spcSep [ "deoxyribonucleic", "acid" ] ]) + , ("PCR", [ plain $ spcSep [ "polymerase", "chain", "reaction" ] ]) + ] + + , "Definition List With Trailing Header" =: + "- definition :: list\n\ + \- cool :: defs\n\ + \* header" =?> + mconcat [ definitionList [ ("definition", [plain "list"]) + , ("cool", [plain "defs"]) + ] + , headerWith ("header", [], []) 1 "header" + ] + + , "Definition lists double-colon markers must be surrounded by whitespace" =: + "- std::cout" =?> + bulletList [ plain "std::cout" ] + + , "Loose bullet list" =: + unlines [ "- apple" + , "" + , "- orange" + , "" + , "- peach" + ] =?> + bulletList [ para "apple" + , para "orange" + , para "peach" + ] + + , "Recognize preceding paragraphs in non-list contexts" =: + unlines [ "CLOSED: [2015-10-19 Mon 15:03]" + , "- Note taken on [2015-10-19 Mon 13:24]" + ] =?> + mconcat [ para "CLOSED: [2015-10-19 Mon 15:03]" + , bulletList [ plain "Note taken on [2015-10-19 Mon 13:24]" ] + ] + ] + + , testGroup "Tables" + [ "Single cell table" =: + "|Test|" =?> + simpleTable' 1 mempty [[plain "Test"]] + + , "Multi cell table" =: + "| One | Two |" =?> + simpleTable' 2 mempty [ [ plain "One", plain "Two" ] ] + + , "Multi line table" =: + unlines [ "| One |" + , "| Two |" + , "| Three |" + ] =?> + simpleTable' 1 mempty + [ [ plain "One" ] + , [ plain "Two" ] + , [ plain "Three" ] + ] + + , "Empty table" =: + "||" =?> + simpleTable' 1 mempty [[mempty]] + + , "Glider Table" =: + unlines [ "| 1 | 0 | 0 |" + , "| 0 | 1 | 1 |" + , "| 1 | 1 | 0 |" + ] =?> + simpleTable' 3 mempty + [ [ plain "1", plain "0", plain "0" ] + , [ plain "0", plain "1", plain "1" ] + , [ plain "1", plain "1", plain "0" ] + ] + + , "Table between Paragraphs" =: + unlines [ "Before" + , "| One | Two |" + , "After" + ] =?> + mconcat [ para "Before" + , simpleTable' 2 mempty [ [ plain "One", plain "Two" ] ] + , para "After" + ] + + , "Table with Header" =: + unlines [ "| Species | Status |" + , "|--------------+--------------|" + , "| cervisiae | domesticated |" + , "| paradoxus | wild |" + ] =?> + simpleTable [ plain "Species", plain "Status" ] + [ [ plain "cervisiae", plain "domesticated" ] + , [ plain "paradoxus", plain "wild" ] + ] + + , "Table with final hline" =: + unlines [ "| cervisiae | domesticated |" + , "| paradoxus | wild |" + , "|--------------+--------------|" + ] =?> + simpleTable' 2 mempty + [ [ plain "cervisiae", plain "domesticated" ] + , [ plain "paradoxus", plain "wild" ] + ] + + , "Table in a box" =: + unlines [ "|---------|---------|" + , "| static | Haskell |" + , "| dynamic | Lisp |" + , "|---------+---------|" + ] =?> + simpleTable' 2 mempty + [ [ plain "static", plain "Haskell" ] + , [ plain "dynamic", plain "Lisp" ] + ] + + , "Table with empty cells" =: + "|||c|" =?> + simpleTable' 3 mempty [[mempty, mempty, plain "c"]] + + , "Table with empty rows" =: + unlines [ "| first |" + , "| |" + , "| third |" + ] =?> + simpleTable' 1 mempty [[plain "first"], [mempty], [plain "third"]] + + , "Table with alignment row" =: + unlines [ "| Numbers | Text | More |" + , "| <c> | <r> | |" + , "| 1 | One | foo |" + , "| 2 | Two | bar |" + ] =?> + table "" (zip [AlignCenter, AlignRight, AlignDefault] [0, 0, 0]) + [] + [ [ plain "Numbers", plain "Text", plain "More" ] + , [ plain "1" , plain "One" , plain "foo" ] + , [ plain "2" , plain "Two" , plain "bar" ] + ] + + , "Pipe within text doesn't start a table" =: + "Ceci n'est pas une | pipe " =?> + para (spcSep [ "Ceci", "n'est", "pas", "une", "|", "pipe" ]) + + , "Missing pipe at end of row" =: + "|incomplete-but-valid" =?> + simpleTable' 1 mempty [ [ plain "incomplete-but-valid" ] ] + + , "Table with differing row lengths" =: + unlines [ "| Numbers | Text " + , "|-" + , "| <c> | <r> |" + , "| 1 | One | foo |" + , "| 2" + ] =?> + table "" (zip [AlignCenter, AlignRight] [0, 0]) + [ plain "Numbers", plain "Text" ] + [ [ plain "1" , plain "One" , plain "foo" ] + , [ plain "2" ] + ] + + , "Table with caption" =: + unlines [ "#+CAPTION: Hitchhiker's Multiplication Table" + , "| x | 6 |" + , "| 9 | 42 |" + ] =?> + table "Hitchhiker's Multiplication Table" + [(AlignDefault, 0), (AlignDefault, 0)] + [] + [ [ plain "x", plain "6" ] + , [ plain "9", plain "42" ] + ] + ] + + , testGroup "Blocks and fragments" + [ "Source block" =: + unlines [ " #+BEGIN_SRC haskell" + , " main = putStrLn greeting" + , " where greeting = \"moin\"" + , " #+END_SRC" ] =?> + let attr' = ("", ["haskell"], []) + code' = "main = putStrLn greeting\n" ++ + " where greeting = \"moin\"\n" + in codeBlockWith attr' code' + + , "Source block with indented code" =: + unlines [ " #+BEGIN_SRC haskell" + , " main = putStrLn greeting" + , " where greeting = \"moin\"" + , " #+END_SRC" ] =?> + let attr' = ("", ["haskell"], []) + code' = "main = putStrLn greeting\n" ++ + " where greeting = \"moin\"\n" + in codeBlockWith attr' code' + + , "Source block with tab-indented code" =: + unlines [ "\t#+BEGIN_SRC haskell" + , "\tmain = putStrLn greeting" + , "\t where greeting = \"moin\"" + , "\t#+END_SRC" ] =?> + let attr' = ("", ["haskell"], []) + code' = "main = putStrLn greeting\n" ++ + " where greeting = \"moin\"\n" + in codeBlockWith attr' code' + + , "Empty source block" =: + unlines [ " #+BEGIN_SRC haskell" + , " #+END_SRC" ] =?> + let attr' = ("", ["haskell"], []) + code' = "" + in codeBlockWith attr' code' + + , "Source block between paragraphs" =: + unlines [ "Low German greeting" + , " #+BEGIN_SRC haskell" + , " main = putStrLn greeting" + , " where greeting = \"Moin!\"" + , " #+END_SRC" ] =?> + let attr' = ("", ["haskell"], []) + code' = "main = putStrLn greeting\n" ++ + " where greeting = \"Moin!\"\n" + in mconcat [ para $ spcSep [ "Low", "German", "greeting" ] + , codeBlockWith attr' code' + ] + , "Source block with rundoc/babel arguments" =: + unlines [ "#+BEGIN_SRC emacs-lisp :exports both" + , "(progn (message \"Hello, World!\")" + , " (+ 23 42))" + , "#+END_SRC" ] =?> + let classes = [ "commonlisp" -- as kate doesn't know emacs-lisp syntax + , "rundoc-block" + ] + params = [ ("rundoc-language", "emacs-lisp") + , ("rundoc-exports", "both") + ] + code' = unlines [ "(progn (message \"Hello, World!\")" + , " (+ 23 42))" ] + in codeBlockWith ("", classes, params) code' + + , "Source block with results and :exports both" =: + unlines [ "#+BEGIN_SRC emacs-lisp :exports both" + , "(progn (message \"Hello, World!\")" + , " (+ 23 42))" + , "#+END_SRC" + , "" + , "#+RESULTS:" + , ": 65"] =?> + let classes = [ "commonlisp" -- as kate doesn't know emacs-lisp syntax + , "rundoc-block" + ] + params = [ ("rundoc-language", "emacs-lisp") + , ("rundoc-exports", "both") + ] + code' = unlines [ "(progn (message \"Hello, World!\")" + , " (+ 23 42))" ] + results' = "65\n" + in codeBlockWith ("", classes, params) code' + <> + codeBlockWith ("", ["example"], []) results' + + , "Source block with results and :exports code" =: + unlines [ "#+BEGIN_SRC emacs-lisp :exports code" + , "(progn (message \"Hello, World!\")" + , " (+ 23 42))" + , "#+END_SRC" + , "" + , "#+RESULTS:" + , ": 65" ] =?> + let classes = [ "commonlisp" -- as kate doesn't know emacs-lisp syntax + , "rundoc-block" + ] + params = [ ("rundoc-language", "emacs-lisp") + , ("rundoc-exports", "code") + ] + code' = unlines [ "(progn (message \"Hello, World!\")" + , " (+ 23 42))" ] + in codeBlockWith ("", classes, params) code' + + , "Source block with results and :exports results" =: + unlines [ "#+BEGIN_SRC emacs-lisp :exports results" + , "(progn (message \"Hello, World!\")" + , " (+ 23 42))" + , "#+END_SRC" + , "" + , "#+RESULTS:" + , ": 65" ] =?> + let results' = "65\n" + in codeBlockWith ("", ["example"], []) results' + + , "Source block with results and :exports none" =: + unlines [ "#+BEGIN_SRC emacs-lisp :exports none" + , "(progn (message \"Hello, World!\")" + , " (+ 23 42))" + , "#+END_SRC" + , "" + , "#+RESULTS:" + , ": 65" ] =?> + (mempty :: Blocks) + + , "Source block with toggling header arguments" =: + unlines [ "#+BEGIN_SRC sh :noeval" + , "echo $HOME" + , "#+END_SRC" + ] =?> + let classes = [ "bash", "rundoc-block" ] + params = [ ("rundoc-language", "sh"), ("rundoc-noeval", "yes") ] + in codeBlockWith ("", classes, params) "echo $HOME\n" + + , "Example block" =: + unlines [ "#+begin_example" + , "A chosen representation of" + , "a rule." + , "#+eND_exAMPle" + ] =?> + codeBlockWith ("", ["example"], []) + "A chosen representation of\na rule.\n" + + , "HTML block" =: + unlines [ "#+BEGIN_HTML" + , "<aside>HTML5 is pretty nice.</aside>" + , "#+END_HTML" + ] =?> + rawBlock "html" "<aside>HTML5 is pretty nice.</aside>\n" + + , "Quote block" =: + unlines [ "#+BEGIN_QUOTE" + , "/Niemand/ hat die Absicht, eine Mauer zu errichten!" + , "#+END_QUOTE" + ] =?> + blockQuote (para (spcSep [ emph "Niemand", "hat", "die", "Absicht," + , "eine", "Mauer", "zu", "errichten!" + ])) + + , "Verse block" =: + unlines [ "The first lines of Goethe's /Faust/:" + , "#+begin_verse" + , "Habe nun, ach! Philosophie," + , "Juristerei und Medizin," + , "Und leider auch Theologie!" + , "Durchaus studiert, mit heißem Bemühn." + , "#+end_verse" + ] =?> + mconcat + [ para $ spcSep [ "The", "first", "lines", "of" + , "Goethe's", emph "Faust" <> ":"] + , lineBlock + [ "Habe nun, ach! Philosophie," + , "Juristerei und Medizin," + , "Und leider auch Theologie!" + , "Durchaus studiert, mit heißem Bemühn." + ] + ] + + , "Verse block with blank lines" =: + unlines [ "#+BEGIN_VERSE" + , "foo" + , "" + , "bar" + , "#+END_VERSE" + ] =?> + lineBlock [ "foo", mempty, "bar" ] + + , "Verse block with varying indentation" =: + unlines [ "#+BEGIN_VERSE" + , " hello darkness" + , "my old friend" + , "#+END_VERSE" + ] =?> + lineBlock [ "\160\160hello darkness", "my old friend" ] + + , "Raw block LaTeX" =: + unlines [ "#+BEGIN_LaTeX" + , "The category $\\cat{Set}$ is adhesive." + , "#+END_LaTeX" + ] =?> + rawBlock "latex" "The category $\\cat{Set}$ is adhesive.\n" + + , "Raw LaTeX line" =: + "#+LATEX: \\let\\foo\\bar" =?> + rawBlock "latex" "\\let\\foo\\bar" + + , "Raw Beamer line" =: + "#+beamer: \\pause" =?> + rawBlock "beamer" "\\pause" + + , "Raw HTML line" =: + "#+HTML: <aside>not important</aside>" =?> + rawBlock "html" "<aside>not important</aside>" + + , "Export block HTML" =: + unlines [ "#+BEGIN_export html" + , "<samp>Hello, World!</samp>" + , "#+END_export" + ] =?> + rawBlock "html" "<samp>Hello, World!</samp>\n" + + , "LaTeX fragment" =: + unlines [ "\\begin{equation}" + , "X_i = \\begin{cases}" + , " G_{\\alpha(i)} & \\text{if }\\alpha(i-1) = \\alpha(i)\\\\" + , " C_{\\alpha(i)} & \\text{otherwise}" + , " \\end{cases}" + , "\\end{equation}" + ] =?> + rawBlock "latex" + (unlines [ "\\begin{equation}" + , "X_i = \\begin{cases}" + , " G_{\\alpha(i)} & \\text{if }\\alpha(i-1) =" ++ + " \\alpha(i)\\\\" + , " C_{\\alpha(i)} & \\text{otherwise}" + , " \\end{cases}" + , "\\end{equation}" + ]) + + , "Code block with caption" =: + unlines [ "#+CAPTION: Functor laws in Haskell" + , "#+NAME: functor-laws" + , "#+BEGIN_SRC haskell" + , "fmap id = id" + , "fmap (p . q) = (fmap p) . (fmap q)" + , "#+END_SRC" + ] =?> + divWith + nullAttr + (mappend + (plain $ spanWith ("", ["label"], []) + (spcSep [ "Functor", "laws", "in", "Haskell" ])) + (codeBlockWith ("functor-laws", ["haskell"], []) + (unlines [ "fmap id = id" + , "fmap (p . q) = (fmap p) . (fmap q)" + ]))) + + , "Convert blank lines in blocks to single newlines" =: + unlines [ "#+begin_html" + , "" + , "<span>boring</span>" + , "" + , "#+end_html" + ] =?> + rawBlock "html" "\n<span>boring</span>\n\n" + + , "Accept `ATTR_HTML` attributes for generic block" =: + unlines [ "#+ATTR_HTML: :title hello, world :id test :class fun code" + , "#+BEGIN_TEST" + , "nonsense" + , "#+END_TEST" + ] =?> + let attr = ("test", ["fun", "code", "TEST"], [("title", "hello, world")]) + in divWith attr (para "nonsense") + + , "Non-letter chars in source block parameters" =: + unlines [ "#+BEGIN_SRC C :tangle xxxx.c :city Zürich" + , "code body" + , "#+END_SRC" + ] =?> + let classes = [ "c", "rundoc-block" ] + params = [ ("rundoc-language", "C") + , ("rundoc-tangle", "xxxx.c") + , ("rundoc-city", "Zürich") + ] + in codeBlockWith ( "", classes, params) "code body\n" + ] + + , testGroup "Smart punctuation" + [ test orgSmart "quote before ellipses" + ("'...hi'" + =?> para (singleQuoted "…hi")) + + , test orgSmart "apostrophe before emph" + ("D'oh! A l'/aide/!" + =?> para ("D’oh! A l’" <> emph "aide" <> "!")) + + , test orgSmart "apostrophe in French" + ("À l'arrivée de la guerre, le thème de l'«impossibilité du socialisme»" + =?> para "À l’arrivée de la guerre, le thème de l’«impossibilité du socialisme»") + + , test orgSmart "Quotes cannot occur at the end of emphasized text" + ("/say \"yes\"/" =?> + para ("/say" <> space <> doubleQuoted "yes" <> "/")) + + , test orgSmart "Dashes are allowed at the borders of emphasis'" + ("/foo---/" =?> + para (emph "foo—")) + + , test orgSmart "Single quotes can be followed by emphasized text" + ("Singles on the '/meat market/'" =?> + para ("Singles on the " <> (singleQuoted $ emph "meat market"))) + + , test orgSmart "Double quotes can be followed by emphasized text" + ("Double income, no kids: \"/DINK/\"" =?> + para ("Double income, no kids: " <> (doubleQuoted $ emph "DINK"))) + ] + ] diff --git a/test/Tests/Readers/RST.hs b/test/Tests/Readers/RST.hs new file mode 100644 index 000000000..464720496 --- /dev/null +++ b/test/Tests/Readers/RST.hs @@ -0,0 +1,174 @@ +{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-} +module Tests.Readers.RST (tests) where + +import Text.Pandoc.Definition +import Test.Framework +import Tests.Helpers +import Text.Pandoc.Arbitrary() +import Text.Pandoc.Builder +import Text.Pandoc + +rst :: String -> Pandoc +rst = purely $ readRST def{ readerStandalone = True } + +infix 4 =: +(=:) :: ToString c + => String -> (String, c) -> Test +(=:) = test rst + +tests :: [Test] +tests = [ "line block with blank line" =: + "| a\n|\n| b" =?> lineBlock [ "a", mempty, "\160b" ] + , testGroup "field list" + [ "general" =: unlines + [ "para" + , "" + , ":Hostname: media08" + , ":IP address: 10.0.0.19" + , ":Size: 3ru" + , ":Version: 1" + , ":Indentation: Since the field marker may be quite long, the second" + , " and subsequent lines of the field body do not have to line up" + , " with the first line, but they must be indented relative to the" + , " field name marker, and they must line up with each other." + , ":Parameter i: integer" + , ":Final: item" + , " on two lines" ] + =?> ( doc + $ para "para" <> + definitionList [ (str "Hostname", [para "media08"]) + , (text "IP address", [para "10.0.0.19"]) + , (str "Size", [para "3ru"]) + , (str "Version", [para "1"]) + , (str "Indentation", [para "Since the field marker may be quite long, the second\nand subsequent lines of the field body do not have to line up\nwith the first line, but they must be indented relative to the\nfield name marker, and they must line up with each other."]) + , (text "Parameter i", [para "integer"]) + , (str "Final", [para "item\non two lines"]) + ]) + , "metadata" =: unlines + [ "=====" + , "Title" + , "=====" + , "--------" + , "Subtitle" + , "--------" + , "" + , ":Version: 1" + ] + =?> ( setMeta "version" (para "1") + $ setMeta "title" ("Title" :: Inlines) + $ setMeta "subtitle" ("Subtitle" :: Inlines) + $ doc mempty ) + , "with inline markup" =: unlines + [ ":*Date*: today" + , "" + , ".." + , "" + , ":*one*: emphasis" + , ":two_: reference" + , ":`three`_: another one" + , ":``four``: literal" + , "" + , ".. _two: http://example.com" + , ".. _three: http://example.org" + ] + =?> ( setMeta "date" (str "today") + $ doc + $ definitionList [ (emph "one", [para "emphasis"]) + , (link "http://example.com" "" "two", [para "reference"]) + , (link "http://example.org" "" "three", [para "another one"]) + , (code "four", [para "literal"]) + ]) + ] + , "URLs with following punctuation" =: + ("http://google.com, http://yahoo.com; http://foo.bar.baz.\n" ++ + "http://foo.bar/baz_(bam) (http://foo.bar)") =?> + para (link "http://google.com" "" "http://google.com" <> ", " <> + link "http://yahoo.com" "" "http://yahoo.com" <> "; " <> + link "http://foo.bar.baz" "" "http://foo.bar.baz" <> ". " <> + softbreak <> + link "http://foo.bar/baz_(bam)" "" "http://foo.bar/baz_(bam)" + <> " (" <> link "http://foo.bar" "" "http://foo.bar" <> ")") + , "Reference names with special characters" =: + ("A-1-B_2_C:3:D+4+E.5.F_\n\n" ++ + ".. _A-1-B_2_C:3:D+4+E.5.F: https://example.com\n") =?> + para (link "https://example.com" "" "A-1-B_2_C:3:D+4+E.5.F") + , "Code directive with class and number-lines" =: unlines + [ ".. code::python" + , " :number-lines: 34" + , " :class: class1 class2 class3" + , "" + , " def func(x):" + , " return y" + ] =?> + ( doc $ codeBlockWith + ( "" + , ["sourceCode", "python", "numberLines", "class1", "class2", "class3"] + , [ ("startFrom", "34") ] + ) + "def func(x):\n return y" + ) + , "Code directive with number-lines, no line specified" =: unlines + [ ".. code::python" + , " :number-lines: " + , "" + , " def func(x):" + , " return y" + ] =?> + ( doc $ codeBlockWith + ( "" + , ["sourceCode", "python", "numberLines"] + , [ ("startFrom", "") ] + ) + "def func(x):\n return y" + ) + , testGroup "literal / line / code blocks" + [ "indented literal block" =: unlines + [ "::" + , "" + , " block quotes" + , "" + , " can go on for many lines" + , "but must stop here"] + =?> (doc $ + codeBlock "block quotes\n\ncan go on for many lines" <> + para "but must stop here") + , "line block with 3 lines" =: "| a\n| b\n| c" + =?> lineBlock ["a", "b", "c"] + , "quoted literal block using >" =: "::\n\n> quoted\n> block\n\nOrdinary paragraph" + =?> codeBlock "> quoted\n> block" <> para "Ordinary paragraph" + , "quoted literal block using | (not a line block)" =: "::\n\n| quoted\n| block\n\nOrdinary paragraph" + =?> codeBlock "| quoted\n| block" <> para "Ordinary paragraph" + , "class directive with single paragraph" =: ".. class:: special\n\nThis is a \"special\" paragraph." + =?> divWith ("", ["special"], []) (para "This is a \"special\" paragraph.") + , "class directive with two paragraphs" =: ".. class:: exceptional remarkable\n\n First paragraph.\n\n Second paragraph." + =?> divWith ("", ["exceptional", "remarkable"], []) (para "First paragraph." <> para "Second paragraph.") + , "class directive around literal block" =: ".. class:: classy\n\n::\n\n a\n b" + =?> divWith ("", ["classy"], []) (codeBlock "a\nb")] + , testGroup "interpreted text roles" + [ "literal role prefix" =: ":literal:`a`" =?> para (code "a") + , "literal role postfix" =: "`a`:literal:" =?> para (code "a") + , "literal text" =: "``text``" =?> para (code "text") + , "code role" =: ":code:`a`" =?> para (codeWith ("", ["sourceCode"], []) "a") + , "inherited code role" =: ".. role:: codeLike(code)\n\n:codeLike:`a`" + =?> para (codeWith ("", ["codeLike", "sourceCode"], []) "a") + , "custom code role with language field" + =: ".. role:: lhs(code)\n :language: haskell\n\n:lhs:`a`" + =?> para (codeWith ("", ["lhs", "haskell","sourceCode"], []) "a") + , "custom role with unspecified parent role" + =: ".. role:: classy\n\n:classy:`text`" + =?> para (spanWith ("", ["classy"], []) "text") + , "role with recursive inheritance" + =: ".. role:: haskell(code)\n.. role:: lhs(haskell)\n\n:lhs:`text`" + =?> para (codeWith ("", ["lhs", "haskell", "sourceCode"], []) "text") + , "unknown role" =: ":unknown:`text`" =?> para (str "text") + ] + , testGroup "footnotes" + [ "remove space before note" =: unlines + [ "foo [1]_" + , "" + , ".. [1]" + , " bar" + ] =?> + (para $ "foo" <> (note $ para "bar")) + ] + ] diff --git a/test/Tests/Readers/Txt2Tags.hs b/test/Tests/Readers/Txt2Tags.hs new file mode 100644 index 000000000..46831d86f --- /dev/null +++ b/test/Tests/Readers/Txt2Tags.hs @@ -0,0 +1,436 @@ +{-# LANGUAGE OverloadedStrings #-} +module Tests.Readers.Txt2Tags (tests) where + +import Text.Pandoc.Definition +import Test.Framework +import Tests.Helpers +import Text.Pandoc.Arbitrary() +import Text.Pandoc.Builder +import Text.Pandoc +import Data.List (intersperse) +import Text.Pandoc.Class + + +t2t :: String -> Pandoc +-- t2t = handleError . readTxt2Tags (T2TMeta "date" "mtime" "in" "out") def +t2t = purely $ \s -> do + putCommonState + def { stInputFiles = Just ["in"] + , stOutputFile = Just "out" + } + readTxt2Tags def s + +infix 4 =: +(=:) :: ToString c + => String -> (String, c) -> Test +(=:) = test t2t + +spcSep :: [Inlines] -> Inlines +spcSep = mconcat . intersperse space + +simpleTable' :: Int + -> [Blocks] + -> [[Blocks]] + -> Blocks +simpleTable' n = table "" (take n $ repeat (AlignCenter, 0.0)) + +tests :: [Test] +tests = + [ testGroup "Inlines" $ + [ "Plain String" =: + "Hello, World" =?> + para (spcSep [ "Hello,", "World" ]) + + , "Emphasis" =: + "//Planet Punk//" =?> + para (emph . spcSep $ ["Planet", "Punk"]) + + , "Strong" =: + "**Cider**" =?> + para (strong "Cider") + + , "Strong Emphasis" =: + "//**strength**//" =?> + para (emph . strong $ "strength") + + , "Strikeout" =: + "--Kill Bill--" =?> + para (strikeout . spcSep $ [ "Kill", "Bill" ]) + + , "Verbatim" =: + "``Robot.rock()``" =?> + para (code "Robot.rock()") + + , "Symbol" =: + "A * symbol" =?> + para (str "A" <> space <> str "*" <> space <> "symbol") + + , "No empty markup" =: + "//// **** ____ ---- ```` \"\"\"\" ''''" =?> + para (spcSep [ "////", "****", "____", "----", "````", "\"\"\"\"", "''''" ]) + + , "Inline markup is greedy" =: + "***** ///// _____ ----- ````` \"\"\"\"\" '''''" =?> + para (spcSep [strong "*", emph "/", emph "_" + , strikeout "-", code "`", text "\"" + , rawInline "html" "'"]) + , "Markup must be greedy" =: + "********** ////////// __________ ---------- `````````` \"\"\"\"\"\"\"\"\"\" ''''''''''" =?> + para (spcSep [strong "******", emph "//////", emph "______" + , strikeout "------", code "``````", text "\"\"\"\"\"\"" + , rawInline "html" "''''''"]) + , "Inlines must be glued" =: + "** a** **a ** ** a **" =?> + para (text "** a** **a ** ** a **") + + , "Macros: Date" =: + "%%date" =?> + para "1970-01-01" + , "Macros: Mod Time" =: + "%%mtime" =?> + para (str "") + , "Macros: Infile" =: + "%%infile" =?> + para "in" + , "Macros: Outfile" =: + "%%outfile" =?> + para "out" + , "Autolink" =: + "http://www.google.com" =?> + para (link "http://www.google.com" "" (str "http://www.google.com")) + , "Image" =: + "[image.jpg]" =?> + para (image "image.jpg" "" mempty) + + , "Link" =: + "[title http://google.com]" =?> + para (link "http://google.com" "" (str "title")) + + , "Image link" =: + "[[image.jpg] abc]" =?> + para (link "abc" "" (image "image.jpg" "" mempty)) + , "Invalid link: No trailing space" =: + "[title invalid ]" =?> + para (text "[title invalid ]") + + + ] + + , testGroup "Basic Blocks" $ + ["Paragraph, lines grouped together" =: + "A paragraph\n A blank line ends the \n current paragraph\n" + =?> para "A paragraph\n A blank line ends the\n current paragraph" + , "Paragraph, ignore leading and trailing spaces" =: + " Leading and trailing spaces are ignored. \n" =?> + para "Leading and trailing spaces are ignored." + , "Comment line in paragraph" =: + "A comment line can be placed inside a paragraph.\n% this comment will be ignored \nIt will not affect it.\n" + =?> para "A comment line can be placed inside a paragraph.\nIt will not affect it." + , "Paragraph" =: + "Paragraph\n" =?> + para "Paragraph" + + , "First Level Header" =: + "+ Headline +\n" =?> + header 1 "Headline" + + , "Third Level Header" =: + "=== Third Level Headline ===\n" =?> + header 3 ("Third" <> space <> + "Level" <> space <> + "Headline") + + , "Header with label" =: + "= header =[label]" =?> + headerWith ("label", [], []) 1 ("header") + + , "Invalid header, mismatched delimiters" =: + "== header =" =?> + para (text "== header =") + + , "Invalid header, spaces in label" =: + "== header ==[ haha ]" =?> + para (text "== header ==[ haha ]") + + , "Invalid header, invalid label character" =: + "== header ==[lab/el]" =?> + para (text "== header ==[lab/el]") + , "Headers not preceded by a blank line" =: + unlines [ "++ eat dinner ++" + , "Spaghetti and meatballs tonight." + , "== walk dog ==" + ] =?> + mconcat [ header 2 ("eat" <> space <> "dinner") + , para $ spcSep [ "Spaghetti", "and", "meatballs", "tonight." ] + , header 2 ("walk" <> space <> "dog") + ] + + , "Paragraph starting with an equals" =: + "=five" =?> + para "=five" + + , "Paragraph containing asterisk at beginning of line" =: + unlines [ "lucky" + , "*star" + ] =?> + para ("lucky" <> softbreak <> "*star") + + , "Horizontal Rule" =: + unlines [ "before" + , replicate 20 '-' + , replicate 20 '=' + , replicate 20 '_' + , "after" + ] =?> + mconcat [ para "before" + , horizontalRule + , horizontalRule + , horizontalRule + , para "after" + ] + + , "Comment Block" =: + unlines [ "%%%" + , "stuff" + , "bla" + , "%%%"] =?> + (mempty::Blocks) + + + ] + + , testGroup "Lists" $ + [ "Simple Bullet Lists" =: + ("- Item1\n" ++ + "- Item2\n") =?> + bulletList [ plain "Item1" + , plain "Item2" + ] + + , "Indented Bullet Lists" =: + (" - Item1\n" ++ + " - Item2\n") =?> + bulletList [ plain "Item1" + , plain "Item2" + ] + + + + , "Nested Bullet Lists" =: + ("- Discovery\n" ++ + " + One More Time\n" ++ + " + Harder, Better, Faster, Stronger\n" ++ + "- Homework\n" ++ + " + Around the World\n"++ + "- Human After All\n" ++ + " + Technologic\n" ++ + " + Robot Rock\n") =?> + bulletList [ mconcat + [ plain "Discovery" + , orderedList [ plain ("One" <> space <> + "More" <> space <> + "Time") + , plain ("Harder," <> space <> + "Better," <> space <> + "Faster," <> space <> + "Stronger") + ] + ] + , mconcat + [ plain "Homework" + , orderedList [ plain ("Around" <> space <> + "the" <> space <> + "World") + ] + ] + , mconcat + [ plain ("Human" <> space <> "After" <> space <> "All") + , orderedList [ plain "Technologic" + , plain ("Robot" <> space <> "Rock") + ] + ] + ] + + , "Simple Ordered List" =: + ("+ Item1\n" ++ + "+ Item2\n") =?> + let listStyle = (1, DefaultStyle, DefaultDelim) + listStructure = [ plain "Item1" + , plain "Item2" + ] + in orderedListWith listStyle listStructure + + + , "Indented Ordered List" =: + (" + Item1\n" ++ + " + Item2\n") =?> + let listStyle = (1, DefaultStyle, DefaultDelim) + listStructure = [ plain "Item1" + , plain "Item2" + ] + in orderedListWith listStyle listStructure + + , "Nested Ordered Lists" =: + ("+ One\n" ++ + " + One-One\n" ++ + " + One-Two\n" ++ + "+ Two\n" ++ + " + Two-One\n"++ + " + Two-Two\n") =?> + let listStyle = (1, DefaultStyle, DefaultDelim) + listStructure = [ mconcat + [ plain "One" + , orderedList [ plain "One-One" + , plain "One-Two" + ] + ] + , mconcat + [ plain "Two" + , orderedList [ plain "Two-One" + , plain "Two-Two" + ] + ] + ] + in orderedListWith listStyle listStructure + + , "Ordered List in Bullet List" =: + ("- Emacs\n" ++ + " + Org\n") =?> + bulletList [ (plain "Emacs") <> + (orderedList [ plain "Org"]) + ] + + , "Bullet List in Ordered List" =: + ("+ GNU\n" ++ + " - Freedom\n") =?> + orderedList [ (plain "GNU") <> bulletList [ (plain "Freedom") ] ] + + , "Definition List" =: + unlines [ ": PLL" + , " phase-locked loop" + , ": TTL" + , " transistor-transistor logic" + , ": PSK" + , " a digital" + ] =?> + definitionList [ ("PLL", [ plain $ "phase-locked" <> space <> "loop" ]) + , ("TTL", [ plain $ "transistor-transistor" <> space <> "logic" ]) + , ("PSK", [ plain $ "a" <> space <> "digital" ]) + ] + + + , "Loose bullet list" =: + unlines [ "- apple" + , "" + , "- orange" + , "" + , "- peach" + ] =?> + bulletList [ para "apple" + , para "orange" + , para "peach" + ] + ] + + , testGroup "Tables" + [ "Single cell table" =: + "| Test " =?> + simpleTable' 1 mempty [[plain "Test"]] + + , "Multi cell table" =: + "| One | Two |" =?> + simpleTable' 2 mempty [ [ plain "One", plain "Two" ] ] + + , "Multi line table" =: + unlines [ "| One |" + , "| Two |" + , "| Three |" + ] =?> + simpleTable' 1 mempty + [ [ plain "One" ] + , [ plain "Two" ] + , [ plain "Three" ] + ] + + , "Empty table" =: + "| |" =?> + simpleTable' 1 mempty [[mempty]] + + , "Glider Table" =: + unlines [ "| 1 | 0 | 0 |" + , "| 0 | 1 | 1 |" + , "| 1 | 1 | 0 |" + ] =?> + simpleTable' 3 mempty + [ [ plain "1", plain "0", plain "0" ] + , [ plain "0", plain "1", plain "1" ] + , [ plain "1", plain "1", plain "0" ] + ] + + + , "Table with Header" =: + unlines [ "|| Species | Status |" + , "| cervisiae | domesticated |" + , "| paradoxus | wild |" + ] =?> + simpleTable [ plain "Species", plain "Status" ] + [ [ plain "cervisiae", plain "domesticated" ] + , [ plain "paradoxus", plain "wild" ] + ] + + , "Table alignment determined by spacing" =: + unlines [ "| Numbers | Text | More |" + , "| 1 | One | foo |" + , "| 2 | Two | bar |" + ] =?> + table "" (zip [AlignCenter, AlignRight, AlignDefault] [0, 0, 0]) + [] + [ [ plain "Numbers", plain "Text", plain "More" ] + , [ plain "1" , plain "One" , plain "foo" ] + , [ plain "2" , plain "Two" , plain "bar" ] + ] + + , "Pipe within text doesn't start a table" =: + "Ceci n'est pas une | pipe " =?> + para (spcSep [ "Ceci", "n'est", "pas", "une", "|", "pipe" ]) + + + , "Table with differing row lengths" =: + unlines [ "|| Numbers | Text " + , "| 1 | One | foo |" + , "| 2 " + ] =?> + table "" (zip [AlignCenter, AlignLeft, AlignLeft] [0, 0, 0]) + [ plain "Numbers", plain "Text" , plain mempty ] + [ [ plain "1" , plain "One" , plain "foo" ] + , [ plain "2" , plain mempty , plain mempty ] + ] + + ] + + , testGroup "Blocks and fragments" + [ "Source block" =: + unlines [ "```" + , "main = putStrLn greeting" + , " where greeting = \"moin\"" + , "```" ] =?> + let code' = "main = putStrLn greeting\n" ++ + " where greeting = \"moin\"\n" + in codeBlock code' + + , "tagged block" =: + unlines [ "'''" + , "<aside>HTML5 is pretty nice.</aside>" + , "'''" + ] =?> + rawBlock "html" "<aside>HTML5 is pretty nice.</aside>\n" + + , "Quote block" =: + unlines ["\t//Niemand// hat die Absicht, eine Mauer zu errichten!" + ] =?> + blockQuote (para (spcSep [ emph "Niemand", "hat", "die", "Absicht," + , "eine", "Mauer", "zu", "errichten!" + ])) + + ] + ] |