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 "

    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