module Tests.Old (tests) where
import Data.Algorithm.Diff
import Prelude hiding (readFile)
import System.Exit
import System.FilePath (joinPath, splitDirectories, (<.>), (</>))
import System.IO.Temp (withTempFile)
import System.Process (runProcess, waitForProcess)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.Golden.Advanced (goldenTest)
import Tests.Helpers hiding (test)
import qualified Text.Pandoc.UTF8 as UTF8
tests :: [TestTree]
tests = [ testGroup "markdown"
[ testGroup "writer"
$ writerTests "markdown" ++ lhsWriterTests "markdown"
, testGroup "reader"
[ test "basic" ["-r", "markdown", "-w", "native", "-s"]
"testsuite.txt" "testsuite.native"
, test "tables" ["-r", "markdown", "-w", "native", "--columns=80"]
"tables.txt" "tables.native"
, test "pipe tables" ["-r", "markdown", "-w", "native", "--columns=80"]
"pipe-tables.txt" "pipe-tables.native"
, test "more" ["-r", "markdown", "-w", "native", "-s"]
"markdown-reader-more.txt" "markdown-reader-more.native"
, lhsReaderTest "markdown+lhs"
]
, testGroup "citations"
[ test "citations" ["-r", "markdown", "-w", "native"]
"markdown-citations.txt" "markdown-citations.native"
]
]
, testGroup "rst"
[ testGroup "writer" (writerTests "rst" ++ lhsWriterTests "rst")
, testGroup "reader"
[ test "basic" ["-r", "rst+smart", "-w", "native",
"-s", "--columns=80"] "rst-reader.rst" "rst-reader.native"
, test "tables" ["-r", "rst", "-w", "native", "--columns=80"]
"tables.rst" "tables-rstsubset.native"
, lhsReaderTest "rst+lhs"
]
]
, testGroup "latex"
[ testGroup "writer" (writerTests "latex" ++ lhsWriterTests "latex")
, testGroup "reader"
[ test "basic" ["-r", "latex+raw_tex", "-w", "native", "-s"]
"latex-reader.latex" "latex-reader.native"
, lhsReaderTest "latex+lhs"
]
]
, testGroup "html"
[ testGroup "writer" (writerTests "html4" ++ writerTests "html5" ++
lhsWriterTests "html")
, test "reader" ["-r", "html", "-w", "native", "-s"]
"html-reader.html" "html-reader.native"
]
, testGroup "s5"
[ s5WriterTest "basic" ["-s"] "s5"
, s5WriterTest "fancy" ["-s","-m","-i"] "s5"
, s5WriterTest "fragment" [] "html4"
, s5WriterTest "inserts" ["-s", "-H", "insert",
"-B", "insert", "-A", "insert", "-c", "main.css"] "html4"
]
, testGroup "textile"
[ testGroup "writer" $ writerTests "textile"
, test "reader" ["-r", "textile", "-w", "native", "-s"]
"textile-reader.textile" "textile-reader.native"
]
, testGroup "docbook"
[ testGroup "writer" $ writerTests "docbook4"
, test "reader" ["-r", "docbook", "-w", "native", "-s"]
"docbook-reader.docbook" "docbook-reader.native"
, test "reader" ["-r", "docbook", "-w", "native", "-s"]
"docbook-xref.docbook" "docbook-xref.native"
]
, testGroup "docbook5"
[ testGroup "writer" $ writerTests "docbook5"
]
, testGroup "jats"
[ testGroup "writer" $ writerTests "jats"
, test "reader" ["-r", "jats", "-w", "native", "-s"]
"jats-reader.xml" "jats-reader.native"
]
, testGroup "native"
[ testGroup "writer" $ writerTests "native"
, test "reader" ["-r", "native", "-w", "native", "-s"]
"testsuite.native" "testsuite.native"
]
, testGroup "fb2"
[ fb2WriterTest "basic" [] "fb2/basic.markdown" "fb2/basic.fb2"
, fb2WriterTest "titles" [] "fb2/titles.markdown" "fb2/titles.fb2"
, fb2WriterTest "images" [] "fb2/images.markdown" "fb2/images.fb2"
, fb2WriterTest "images-embedded" [] "fb2/images-embedded.html" "fb2/images-embedded.fb2"
, fb2WriterTest "math" [] "fb2/math.markdown" "fb2/math.fb2"
, fb2WriterTest "tables" [] "tables.native" "tables.fb2"
, fb2WriterTest "testsuite" [] "testsuite.native" "writer.fb2"
]
, testGroup "mediawiki"
[ testGroup "writer" $ writerTests "mediawiki"
, test "reader" ["-r", "mediawiki", "-w", "native", "-s"]
"mediawiki-reader.wiki" "mediawiki-reader.native"
]
, testGroup "vimwiki"
[ test "reader" ["-r", "vimwiki", "-w", "native", "-s"]
"vimwiki-reader.wiki" "vimwiki-reader.native"
]
, testGroup "dokuwiki"
[ testGroup "writer" $ writerTests "dokuwiki"
, test "inline_formatting" ["-r", "native", "-w", "dokuwiki", "-s"]
"dokuwiki_inline_formatting.native" "dokuwiki_inline_formatting.dokuwiki"
, test "multiblock table" ["-r", "native", "-w", "dokuwiki", "-s"]
"dokuwiki_multiblock_table.native" "dokuwiki_multiblock_table.dokuwiki"
, test "external images" ["-r", "native", "-w", "dokuwiki", "-s"]
"dokuwiki_external_images.native" "dokuwiki_external_images.dokuwiki"
]
, testGroup "opml"
[ test "basic" ["-r", "native", "-w", "opml", "--columns=78", "-s"]
"testsuite.native" "writer.opml"
, test "reader" ["-r", "opml", "-w", "native", "-s"]
"opml-reader.opml" "opml-reader.native"
]
, testGroup "haddock"
[ testGroup "writer" $ writerTests "haddock"
, test "reader" ["-r", "haddock", "-w", "native", "-s"]
"haddock-reader.haddock" "haddock-reader.native"
]
, testGroup "txt2tags"
[ test "reader" ["-r", "t2t", "-w", "native", "-s"]
"txt2tags.t2t" "txt2tags.native" ]
, testGroup "epub" [
test "features" ["-r", "epub", "-w", "native"]
"epub/features.epub" "epub/features.native"
, test "wasteland" ["-r", "epub", "-w", "native"]
"epub/wasteland.epub" "epub/wasteland.native"
, test "formatting" ["-r", "epub", "-w", "native"]
"epub/formatting.epub" "epub/formatting.native"
]
, testGroup "twiki"
[ test "reader" ["-r", "twiki", "-w", "native", "-s"]
"twiki-reader.twiki" "twiki-reader.native" ]
, testGroup "tikiwiki"
[ test "reader" ["-r", "tikiwiki", "-w", "native", "-s"]
"tikiwiki-reader.tikiwiki" "tikiwiki-reader.native" ]
, testGroup "other writers" $ map (\f -> testGroup f $ writerTests f)
[ "opendocument" , "context" , "texinfo", "icml", "tei"
, "man" , "plain" , "rtf", "org", "asciidoc", "zimwiki"
]
, testGroup "writers-lang-and-dir"
[ test "latex" ["-f", "native", "-t", "latex", "-s"]
"writers-lang-and-dir.native" "writers-lang-and-dir.latex"
, test "context" ["-f", "native", "-t", "context", "-s"]
"writers-lang-and-dir.native" "writers-lang-and-dir.context"
]
, testGroup "muse"
[ testGroup "writer" $ writerTests "muse"
]
, testGroup "ms"
[ testGroup "writer" $ writerTests "ms"
]
, testGroup "creole"
[ test "reader" ["-r", "creole", "-w", "native", "-s"]
"creole-reader.txt" "creole-reader.native"
]
, testGroup "custom writer"
[ test "basic" ["-f", "native", "-t", "../data/sample.lua"]
"testsuite.native" "writer.custom"
, test "tables" ["-f", "native", "-t", "../data/sample.lua"]
"tables.native" "tables.custom"
]
]
-- makes sure file is fully closed after reading
readFile' :: FilePath -> IO String
readFile' f = do s <- UTF8.readFile f
return $! (length s `seq` s)
lhsWriterTests :: String -> [TestTree]
lhsWriterTests format
= [ t "lhs to normal" format
, t "lhs to lhs" (format ++ "+lhs")
]
where
t n f = test n ["--wrap=preserve", "-r", "native", "-s", "-w", f]
"lhs-test.native" ("lhs-test" <.> f)
lhsReaderTest :: String -> TestTree
lhsReaderTest format =
test "lhs" ["-r", format, "-w", "native"]
("lhs-test" <.> format) norm
where norm = if format == "markdown+lhs"
then "lhs-test-markdown.native"
else "lhs-test.native"
writerTests :: String -> [TestTree]
writerTests format
= [ test "basic" (opts ++ ["-s"]) "testsuite.native" ("writer" <.> format)
, test "tables" opts "tables.native" ("tables" <.> format)
]
where
opts = ["-r", "native", "-w", format, "--columns=78",
"--variable", "pandoc-version="]
s5WriterTest :: String -> [String] -> String -> TestTree
s5WriterTest modifier opts format
= test (format ++ " writer (" ++ modifier ++ ")")
(["-r", "native", "-w", format] ++ opts)
"s5.native" ("s5-" ++ modifier <.> "html")
fb2WriterTest :: String -> [String] -> String -> String -> TestTree
fb2WriterTest title opts inputfile normfile =
testWithNormalize (ignoreBinary . formatXML)
title (["-t", "fb2"]++opts) inputfile normfile
where
formatXML xml = splitTags $ zip xml (drop 1 xml)
splitTags [] = []
splitTags [end] = fst end : snd end : []
splitTags (('>','<'):rest) = ">\n" ++ splitTags rest
splitTags ((c,_):rest) = c : splitTags rest
ignoreBinary = unlines . filter (not . startsWith "<binary ") . lines
startsWith tag str = all (uncurry (==)) $ zip tag str
-- | Run a test without normalize function, return True if test passed.
test :: String -- ^ Title of test
-> [String] -- ^ Options to pass to pandoc
-> String -- ^ Input filepath
-> FilePath -- ^ Norm (for test results) filepath
-> TestTree
test = testWithNormalize id
-- | Run a test with normalize function, return True if test passed.
testWithNormalize :: (String -> String) -- ^ Normalize function for output
-> String -- ^ Title of test
-> [String] -- ^ Options to pass to pandoc
-> String -- ^ Input filepath
-> FilePath -- ^ Norm (for test results) filepath
-> TestTree
testWithNormalize normalizer testname opts inp norm =
goldenTest testname getExpected getActual
(compareValues norm options) updateGolden
where getExpected = normalizer <$> readFile' norm
getActual =
withTempFile "." "pandoc-test" $ \outputPath hOut -> do
withTempFile "." "pandoc-test" $ \errorPath hErr -> do
pandocPath <- findPandoc
let mbDynlibDir = findDynlibDir (reverse $
splitDirectories pandocPath)
let dynlibEnv = case mbDynlibDir of
Nothing -> []
Just d -> [("DYLD_LIBRARY_PATH", d),
("LD_LIBRARY_PATH", d)]
let env = dynlibEnv ++
[("TMP","."),("LANG","en_US.UTF-8"),("HOME", "./"),
("pandoc_datadir","..")]
ph <- runProcess pandocPath options Nothing
(Just env) Nothing (Just hOut) (Just hErr)
ec <- waitForProcess ph
if ec == ExitSuccess
then
-- filter \r so the tests will work on Windows machines
(filter (/='\r') . normalizer) <$> readFile' outputPath
else do
errcontents <- UTF8.readFile errorPath
fail $ "Pandoc failed with " ++ show ec ++
if null errcontents
then ""
else '\n':errcontents
updateGolden = UTF8.writeFile norm
options = ["--quiet"] ++ [inp] ++ opts
compareValues :: FilePath -> [String] -> String -> String -> IO (Maybe String)
compareValues norm options expected actual = do
pandocPath <- findPandoc
let cmd = pandocPath ++ " " ++ unwords options
let dash = replicate 72 '-'
let diff = getDiff (lines actual) (lines expected)
if expected == actual
then return Nothing
else return $ Just $
'\n' : dash ++
"\n--- " ++ norm ++
"\n+++ " ++ cmd ++ "\n" ++
showDiff (1,1) diff ++ dash
findDynlibDir :: [FilePath] -> Maybe FilePath
findDynlibDir [] = Nothing
findDynlibDir ("build":xs) = Just $ joinPath (reverse xs) </> "build"
findDynlibDir (_:xs) = findDynlibDir xs