Main.hs

{-# LANGUAGE OverloadedStrings #-}

module Tests.Test.HUnitPlus.Main where

import Data.List
import Distribution.TestSuite
import System.Directory
import Test.HUnitPlus.Main
import Test.HUnitPlus.Base
import qualified Data.Text as Strict

makeMainTest :: (String, IO (), IO (), Bool, [TestSuite], Opts) -> Test
makeMainTest (name, setup, cleanup, shouldPass, suites, opts) =
  let
    runTest =
      do
        setup
        out <- topLevel suites opts
        cleanup
        case out of
          Left msgs ->
            if not shouldPass
              then return (Finished Pass)
              else return (Finished (Fail ("Expected test to pass, " ++
                                           "but failed with\n" ++
                                           intercalate "\n" (map Strict.unpack msgs))))
          Right _ ->
            if shouldPass
              then return (Finished Pass)
              else return (Finished (Fail "Expected test to fail"))
    testInstance = TestInstance { name = name, tags = [], options = [],
                                  setOption = (\_ _ -> return testInstance),
                                  run = runTest }
  in
    Test testInstance

makeTestDir :: IO ()
makeTestDir = createDirectory "TestDir"

delTestDir :: IO ()
delTestDir = removeDirectory "TestDir"

delXMLReport :: IO ()
delXMLReport = removeFile "TestDir/report.xml" >> delTestDir

delTxtReport :: IO ()
delTxtReport = removeFile "TestDir/report.txt" >> delTestDir

delTxtXMLReport :: IO ()
delTxtXMLReport = removeFile "TestDir/report.xml" >>
                  removeFile "TestDir/report.txt" >>
                  delTestDir

quietOpts = opts { consmode = [Quiet] }

filterOpts = [ (False, False), (True, False), (False, True), (True, True) ]

makeSuiteData suitename =
  map (\filters -> (TestSuite { suiteName = "suitename",
                                suiteConcurrently = False,
                                suiteOptions = [],
                                suiteTests = suiteTestList },
                    filters))filterOpts

suiteCombos =
  foldl (\accum suite1case ->
          (foldl (\accum suite2case -> [suite1case, suite2case] : accum)
                 accum (makeSuiteData "Suite2")))
        [] (makeSuiteData "Suite1")

suitePairCombos = foldl (\accum a ->
                          foldl (\accum b -> (a, b) : accum)
                                accum suiteCombos)
                        [] suiteCombos

makeFilter :: String -> (Bool, Bool) -> [String]
makeFilter suitename (False, False) = []
makeFilter suitename (True, False) = ["[" ++ suitename ++ "]Pass"]
makeFilter suitename (False, True) = ["[" ++ suitename ++ "]Fail"]
makeFilter suitename (True, True) = ["[" ++ suitename ++ "]Pass",
                                     "[" ++ suitename ++ "]Fail"]

makeFilters suitedata =
  foldl (\accum (TestSuite { suiteName = suitename }, filters) ->
          makeFilter (Strict.unpack suitename) filters ++ accum) [] suitedata

shouldPass suitedata = not (all (\(_, (a, b)) -> not a && not b) suitedata) ||
                       not (any (\(_, (_, fail)) -> fail) suitedata)

suiteTestList = [ "Pass" ~: assertSuccess, "Fail" ~: assertFailure "Fail" ]

makeName suitedata =
  intercalate "__"
    (foldl (\accum (TestSuite { suiteName = name }, (pass, fail)) ->
             (Strict.unpack name ++ "_" ++ show pass ++ "_" ++ show fail) : accum)
           [] suitedata)

makeCmdOptTest suitedata =
  ("cmdopt___" ++ makeName suitedata, return (), return (), shouldPass suitedata,
   map fst suitedata, quietOpts { filters = makeFilters suitedata })

makeTestlistTest suitedata =
  let
    createFilterFile =
      do
        createDirectory "TestDir"
        writeFile "TestDir/testlist" (intercalate "\n" (makeFilters suitedata))

    delFilterFile = removeFile "TestDir/testlist" >> delTestDir
  in
    ("testlist___" ++ makeName suitedata, createFilterFile, delFilterFile,
     shouldPass suitedata, map fst suitedata,
     quietOpts { testlist = ["TestDir/testlist"] })

makeCmdOptTestlistTest (cmdoptdata, testlistdata) =
  let
    createFilterFile =
      do
        createDirectory "TestDir"
        writeFile "TestDir/testlist"
                  (intercalate "\n" (makeFilters testlistdata))

    delFilterFile = removeFile "TestDir/testlist" >> delTestDir
  in
    ("cmdopt_testlist____" ++ makeName cmdoptdata ++ "___" ++
     makeName testlistdata, createFilterFile, delFilterFile,
     shouldPass cmdoptdata && shouldPass testlistdata, map fst cmdoptdata,
     quietOpts { testlist = ["TestDir/testlist"],
                 filters = makeFilters cmdoptdata })

makeDualTestlistTest (suitedata1, suitedata2) =
  let
    createFilterFile =
      do
        createDirectory "TestDir"
        writeFile "TestDir/testlist1" (intercalate "\n" (makeFilters suitedata1))
        writeFile "TestDir/testlist2" (intercalate "\n" (makeFilters suitedata2))

    delFilterFile =
      do
        removeFile "TestDir/testlist1"
        removeFile "TestDir/testlist2"
        delTestDir
  in
    ("dual_testlist____" ++ makeName suitedata1 ++ "___" ++ makeName suitedata2,
     createFilterFile, delFilterFile,
     shouldPass suitedata1 && shouldPass suitedata2, [],
     quietOpts { testlist = ["TestDir/testlist1", "TestDir/testlist2"] })

mainTests = [
    ("multiple_console_mode", return (), return (), False, [],
     opts { consmode = [Quiet, Terminal] }),
    ("multiple_xml_report", return (), return (), False, [],
     opts { xmlreport = ["report1.xml", "report2.xml"] }),
    ("multiple_txt_report", return (), return (), False, [],
     opts { txtreport = ["report1.txt", "report2.txt"] }),
    ("multiple_xml_txt_report", return (), return (), False, [],
     opts { xmlreport = ["report1.xml", "report2.xml"],
            txtreport = ["report1.txt", "report2.txt"] }),
    ("nonexistent_xml_report", makeTestDir, delTestDir, False, [],
     opts { xmlreport = ["TestDir/nonexistent/report.xml"] }),
    ("nonexistent_txt_report", makeTestDir, delTestDir, False, [],
     opts { txtreport = ["TestDir/nonexistent/report.txt"] }),
    ("nonexistent_txt_xml_report", makeTestDir, delTestDir, False, [],
     opts { txtreport = ["TestDir/nonexistent/report.txt"],
            xmlreport = ["TestDir/nonexistent/report.xml"] }),
    ("nonexistent_testlist", makeTestDir, delTestDir, False, [],
     opts { xmlreport = ["TestDir/nonexistent/testlist"] }),
    ("run_quiet_no_xml_no_txt", return (), return (), True, [], quietOpts),
    ("run_terminal_no_xml_no_txt", return (), return (), True, [],
     opts { consmode = [Terminal] }),
    ("run_text_no_xml_no_txt", return (), return (), True, [],
     opts { consmode = [Text] }),
    ("run_verbose_no_xml_no_txt", return (), return (), True, [],
     opts { consmode = [Verbose] }),
    ("run_quiet_xml_no_txt", makeTestDir, delXMLReport, True, [],
     opts { consmode = [Quiet], xmlreport = ["TestDir/report.xml"] }),
    ("run_terminal_xml_no_txt", makeTestDir, delXMLReport, True, [],
     opts { consmode = [Terminal], xmlreport = ["TestDir/report.xml"] }),
    ("run_text_xml_no_txt", makeTestDir, delXMLReport, True, [],
     opts { consmode = [Text], xmlreport = ["TestDir/report.xml"] }),
    ("run_verbose_xml_no_txt", makeTestDir, delXMLReport, True, [],
     opts { consmode = [Verbose], xmlreport = ["TestDir/report.xml"] }),
    ("run_quiet_no_xml_txt", makeTestDir, delTxtReport, True, [],
     opts { consmode = [Quiet], txtreport = ["TestDir/report.txt"] }),
    ("run_terminal_no_xml_txt", makeTestDir, delTxtReport, True, [],
     opts { consmode = [Terminal], txtreport = ["TestDir/report.txt"] }),
    ("run_text_no_xml_txt", makeTestDir, delTxtReport, True, [],
     opts { consmode = [Text], txtreport = ["TestDir/report.txt"] }),
    ("run_verbose_no_xml_txt", makeTestDir, delTxtReport, True, [],
     opts { consmode = [Verbose], txtreport = ["TestDir/report.txt"] }),
    ("run_quiet_xml_no_txt", makeTestDir, delTxtXMLReport, True, [],
     opts { consmode = [Quiet], xmlreport = ["TestDir/report.xml"],
            txtreport = ["TestDir/report.txt"] }),
    ("run_terminal_xml_no_txt", makeTestDir, delTxtXMLReport, True, [],
     opts { consmode = [Terminal], xmlreport = ["TestDir/report.xml"],
            txtreport = ["TestDir/report.txt"] }),
    ("run_text_xml_no_txt", makeTestDir, delTxtXMLReport, True, [],
     opts { consmode = [Text], xmlreport = ["TestDir/report.xml"],
            txtreport = ["TestDir/report.txt"] }),
    ("run_verbose_xml_no_txt", makeTestDir, delTxtXMLReport, True, [],
     opts { consmode = [Verbose], xmlreport = ["TestDir/report.xml"],
            txtreport = ["TestDir/report.txt"] })
  ] ++
  map makeCmdOptTest suiteCombos ++
  map makeTestlistTest suiteCombos ++
  map makeCmdOptTestlistTest suitePairCombos ++
  map makeDualTestlistTest suitePairCombos

tests :: Test
tests = testGroup "Main" (map makeMainTest mainTests)