content: {- |
     Module      : Tests.Old
     Copyright   : © 2006-2024 John MacFarlane
     License     : GNU GPL, version 2 or above
  
     Maintainer  : John MacFarlane <jgm@berkeley@edu>
     Stability   : alpha
     Portability : portable
  
  "Old" style tests (comparing output to golden files).
  -}
  module Tests.Old (tests) where
  
  import Data.Algorithm.Diff
  import System.Exit
  import System.FilePath ((<.>), (</>))
  import System.Environment (getExecutablePath)
  import Text.Pandoc.Process (pipeProcess)
  import Test.Tasty (TestTree, testGroup)
  import Test.Tasty.Golden.Advanced (goldenTest)
  import Tests.Helpers hiding (test)
  import qualified Text.Pandoc.UTF8 as UTF8
  import qualified Data.Text as T
  
  tests :: FilePath -> [TestTree]
  tests pandocPath =
    [ testGroup "markdown"
      [ testGroup "writer"
        $ writerTests' "markdown" ++ lhsWriterTests' "markdown" ++ extWriterTests' "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"
          (extWriterTests' "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" $ mconcat
        [ extWriterTests' "html4"
        , extWriterTests' "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","--mathjax","-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 "djot"
      [ testGroup "writer" $ writerTests' "djot"
      , test' "reader" ["-f", "djot", "-t" ,"native", "-s"]
         "djot-reader.djot" "djot-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-chapter.docbook" "docbook-chapter.native"
      , test' "reader" ["-r", "docbook", "-w", "native", "-s"]
        "docbook-xref.docbook" "docbook-xref.native"
      ]
    , testGroup "docbook5"
      [ testGroup "writer" $ writerTests' "docbook5"
      ]
    , testGroup "jats"
      [ testGroup "writer"
        [ testGroup "jats_archiving" $
          extWriterTests' "jats_archiving"
        , testGroup "jats_articleauthoring" $
          writerTests' "jats_articleauthoring"
        , testGroup "jats_publishing" $
          writerTests' "jats_publishing"
        ]
      , test' "reader" ["-r", "jats", "-w", "native", "-s"]
        "jats-reader.xml" "jats-reader.native"
      ]
    , testGroup "jira"
      [ testGroup "writer" $ writerTests' "jira"
      , test' "reader" ["-r", "jira", "-w", "native", "-s"]
        "jira-reader.jira" "jira-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' "meta" [] "fb2/meta.markdown" "fb2/meta.fb2"
      , fb2WriterTest' "tables" [] "tables.native" "tables.fb2"
      , fb2WriterTest' "testsuite" [] "testsuite.native" "writer.fb2"
      ]
    , testGroup "mediawiki"
      [ testGroup "writer" $ mconcat [
        writerTests' "mediawiki"
        , extWriterTests' "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=80", "-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", "-s"]
          "epub/features.epub" "epub/features.native"
      , test' "wasteland" ["-r", "epub", "-w", "native", "-s"]
          "epub/wasteland.epub" "epub/wasteland.native"
      , test' "formatting" ["-r", "epub", "-w", "native", "-s"]
          "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" , "asciidoc", "asciidoc_legacy"
      , "xwiki", "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"
      [ test' "basic"  ["-f", "native", "-t", "ms", "--columns=80",
                        "--variable", "pandoc-version=",
                        "--pdf-engine", "pdfroff", "-s"]
        "testsuite.native" "writer.ms"
      , test' "tables" ["-f", "native", "-t", "ms", "--columns=80",
                        "--variable", "pandoc-version=",
                        "--pdf-engine", "pdfroff"]
        "tables.native"  "tables.ms"
      ]
    , testGroup "typst"
      [ testGroup "writer" $ writerTests' "typst" ++ extWriterTests' "typst"
      , testGroup "reader"
         [ test' "typst-reader" ["-r", "typst", "-w", "native", "-s"]
            "typst-reader.typ" "typst-reader.native"
         ]
      ]
  
    , testGroup "creole"
      [ test' "reader" ["-r", "creole", "-w", "native", "-s"]
        "creole-reader.txt" "creole-reader.native"
      ]
    , testGroup "man"
      [ test' "reader" ["-r", "man", "-w", "native", "-s"]
        "man-reader.man" "man-reader.native"
      ]
    , testGroup "org"
      [ test' "reader" ["-r", "org", "-w", "native", "-s"]
        "org-select-tags.org" "org-select-tags.native"
      , testGroup "writer" $ writerTests' "org"
      ]
    , testGroup "rtf"
      [ testGroup "writer" $ writerTests' "rtf" ]
    , testGroup "endnotexml"
      [ test' "reader" ["-r", "endnotexml", "-w", "native", "-s"]
          "endnotexml-reader.xml" "endnotexml-reader.native" ]
    , testGroup "ipynb"
      [ test' "reader" ["-f", "ipynb-raw_html-raw_tex+raw_attribute",
                        "-t", "native", "-s"]
        "ipynb/simple.ipynb" "ipynb/simple.out.native"
      , test' "writer" ["-f", "native",
                        "--markdown-headings=setext", "-t",
                        "ipynb-raw_html-raw_tex+raw_attribute", "-s"]
        "ipynb/simple.in.native" "ipynb/simple.ipynb"
      , test' "reader" ["-t", "native", "-f", "ipynb",
                        "--ipynb-output=all"]
        "ipynb/mime.ipynb" "ipynb/mime.native"
      , test' "writer" ["-f", "native", "-t", "ipynb",
                        "--wrap=preserve"]
        "ipynb/mime.native" "ipynb/mime.out.ipynb"
      , test' "reader" ["-f", "ipynb", "-t", "html"]
        "ipynb/rank.ipynb" "ipynb/rank.out.html"
      ]
    , testGroup "markua" [ testGroup "writer" $ writerTests' "markua"]
    , testGroup "ansi"
        [ test' "ansi" ["-f", "markdown", "-t", "ansi"]
          "ansi-test.txt" "ansi-test.ansi"
        ]
    , testGroup "pod"
        [ test' "pod" ["-f", "pod", "-t", "native"]
          "pod-reader.pod" "pod-reader.native"
        ]
    , testGroup "vimdoc" [ testGroup "writer" $
        writerTests' "vimdoc" ++
          [ test' "vimdoc-specific definition lists"
              ["-s", "-r", "markdown", "-w", "vimdoc", "--toc", "--columns=78"]
              "vimdoc/definition-lists.markdown" "vimdoc/definition-lists.vimdoc"
          , test' "linking to docs"
              ["-s", "-r", "markdown", "-w", "vimdoc", "--toc", "--columns=78"]
              "vimdoc/vim-online-doc.markdown" "vimdoc/vim-online-doc.vimdoc"
          , test' "unnumbered TOC up to level 2 headers"
              ["-s", "-r", "markdown", "-w", "vimdoc", "--toc", "--columns=78",
               "--toc-depth=2"]
              "vimdoc/headers.markdown" "vimdoc/headers.vimdoc"
          , test' "numbered TOC"
              ["-s", "-r", "markdown", "-w", "vimdoc", "--toc", "--columns=78",
               "-N"]
              "vimdoc/headers.markdown" "vimdoc/headers-numbered.vimdoc"
          ]
      ]
    ]
   where
      test'           = test pandocPath
      writerTests'    = writerTests pandocPath
      s5WriterTest'   = s5WriterTest pandocPath
      fb2WriterTest'  = fb2WriterTest pandocPath
      lhsWriterTests' = lhsWriterTests pandocPath
      lhsReaderTest'  = lhsReaderTest pandocPath
      extWriterTests' = extendedWriterTests pandocPath
  
  -- makes sure file is fully closed after reading
  readFile' :: FilePath -> IO String
  readFile' f = do s <- UTF8.readFile f
                   return $! (T.length s `seq` T.unpack s)
  
  lhsWriterTests :: FilePath -> String -> [TestTree]
  lhsWriterTests pandocPath format
    = [ t "lhs to normal" format
      , t "lhs to lhs"    (format ++ "+lhs")
      ]
    where
      t n f = test pandocPath
               n ["--wrap=preserve", "-r", "native",
                "--markdown-headings=setext", "-w", f]
               "lhs-test.native" ("lhs-test" <.> f)
  
  lhsReaderTest :: FilePath -> String -> TestTree
  lhsReaderTest pandocPath format =
    test pandocPath "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 :: FilePath -> String -> [TestTree]
  writerTests pandocPath format
    = [ test pandocPath
          "basic"  (opts ++ ["-s"]) "testsuite.native" ("writer" <.> format)
      , test pandocPath
         "tables" opts             "tables.native"    ("tables" <.> format)
      ]
    where
      opts = ["-r", "native", "-w", format, "--columns=80",
              "--variable", "pandoc-version="]
  
  extendedWriterTests :: FilePath -> String -> [TestTree]
  extendedWriterTests pandocPath format
    = writerTests pandocPath format ++
      let testForTable name =
            test pandocPath
                 (name ++ " table")
                 opts
                 ("tables" </> name <.> "native")
                 ("tables" </> name <.> format)
      in map testForTable ["planets", "nordics", "students"]
    where
      opts = ["-r", "native", "-w", format, "--columns=80",
              "--variable", "pandoc-version="]
  
  s5WriterTest :: FilePath -> String -> [String] -> String -> TestTree
  s5WriterTest pandocPath modifier opts format
    = test pandocPath (format ++ " writer (" ++ modifier ++ ")")
      (["-r", "native", "-w", format] ++ opts)
      "s5.native"  ("s5-" ++ modifier <.> "html")
  
  fb2WriterTest :: FilePath -> String -> [String] -> String -> String -> TestTree
  fb2WriterTest pandocPath title opts inputfile normfile =
    testWithNormalize (ignoreBinary . formatXML) pandocPath
                      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 :: FilePath  -- ^ Path of pandoc executable
       -> 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
                     -> FilePath  -- ^ Path to pandoc executable
                     -> String    -- ^ Title of test
                     -> [String]  -- ^ Options to pass to pandoc
                     -> String    -- ^ Input filepath
                     -> FilePath  -- ^ Norm (for test results) filepath
                     -> TestTree
  testWithNormalize normalizer pandocPath testname opts inp norm =
    goldenTest testname getExpected getActual
      (compareValues norm options) updateGolden
    where getExpected = normalizer <$> readFile' norm
          getActual   = do
                env <- setupEnvironment pandocPath
                (ec, out) <- pipeProcess (Just env) pandocPath
                               ("--emulate":options) mempty
                if ec == ExitSuccess
                   then return $ filter (/='\r') . normalizer
                               $ UTF8.toStringLazy out
                     -- filter \r so the tests will work on Windows machines
                   else fail $ "Pandoc failed with error code " ++ show ec
          updateGolden = UTF8.writeFile norm . T.pack
          options = ["--quiet"] ++ [inp] ++ opts
  
  compareValues :: FilePath -> [String] -> String -> String -> IO (Maybe String)
  compareValues norm options expected actual = do
    testExePath <- getExecutablePath
    let cmd  = testExePath ++ " --emulate " ++ 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
  