-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Simple.Test
-- Copyright   :  Thomas Tuegel 2010
-- License     :  BSD3
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- This is the entry point into testing a built package. It performs the
-- \"@.\/setup test@\" action. It runs test suites designated in the package
-- description and reports on the results.

module Distribution.Simple.Test
    ( test
    ) where

import qualified Distribution.PackageDescription as PD
         ( PackageDescription(..), BuildInfo(buildable)
         , TestSuite(..)
         , TestSuiteInterface(..), testType, hasTests )
import Distribution.Simple.Compiler ( compilerInfo )
import Distribution.Simple.Hpc ( markupPackage )
import Distribution.Simple.InstallDirs
    ( fromPathTemplate, initialPathTemplateEnv, substPathTemplate
    , PathTemplate )
import qualified Distribution.Simple.LocalBuildInfo as LBI
    ( LocalBuildInfo(..) )
import Distribution.Simple.Setup ( TestFlags(..), fromFlag, configCoverage )
import Distribution.Simple.UserHooks ( Args )
import qualified Distribution.Simple.Test.ExeV10 as ExeV10
import qualified Distribution.Simple.Test.LibV09 as LibV09
import Distribution.Simple.Test.Log
import Distribution.Simple.Utils ( die, notice )
import Distribution.TestSuite ( Result(..) )
import Distribution.Text

import Control.Monad ( when, unless, filterM )
import System.Directory
    ( createDirectoryIfMissing, doesFileExist, getDirectoryContents
    , removeFile )
import System.Exit ( ExitCode(..), exitFailure, exitWith )
import System.FilePath ( (</>) )

-- |Perform the \"@.\/setup test@\" action.
test :: Args                    -- ^positional command-line arguments
     -> PD.PackageDescription   -- ^information from the .cabal file
     -> LBI.LocalBuildInfo      -- ^information from the configure step
     -> TestFlags               -- ^flags sent to test
     -> IO ()
test args pkg_descr lbi flags = do
    let verbosity = fromFlag $ testVerbosity flags
        machineTemplate = fromFlag $ testMachineLog flags
        distPref = fromFlag $ testDistPref flags
        testLogDir = distPref </> "test"
        testNames = args
        pkgTests = PD.testSuites pkg_descr
        enabledTests = [ t | t <- pkgTests
                           , PD.testEnabled t
                           , PD.buildable (PD.testBuildInfo t) ]

        doTest :: (PD.TestSuite, Maybe TestSuiteLog) -> IO TestSuiteLog
        doTest (suite, _) =
            case PD.testInterface suite of
              PD.TestSuiteExeV10 _ _ ->
                  ExeV10.runTest pkg_descr lbi flags suite

              PD.TestSuiteLibV09 _ _ ->
                  LibV09.runTest pkg_descr lbi flags suite

              _ -> return TestSuiteLog
                  { testSuiteName = PD.testName suite
                  , testLogs = TestLog
                      { testName = PD.testName suite
                      , testOptionsReturned = []
                      , testResult =
                          Error $ "No support for running test suite type: "
                                  ++ show (disp $ PD.testType suite)
                      }
                  , logFile = ""
                  }

    when (not $ PD.hasTests pkg_descr) $ do
        notice verbosity "Package has no test suites."
        exitWith ExitSuccess

    when (PD.hasTests pkg_descr && null enabledTests) $
        die $ "No test suites enabled. Did you remember to configure with "
              ++ "\'--enable-tests\'?"

    testsToRun <- case testNames of
            [] -> return $ zip enabledTests $ repeat Nothing
            names -> flip mapM names $ \tName ->
                let testMap = zip enabledNames enabledTests
                    enabledNames = map PD.testName enabledTests
                    allNames = map PD.testName pkgTests
                in case lookup tName testMap of
                    Just t -> return (t, Nothing)
                    _ | tName `elem` allNames ->
                          die $ "Package configured with test suite "
                                ++ tName ++ " disabled."
                      | otherwise -> die $ "no such test: " ++ tName

    createDirectoryIfMissing True testLogDir

    -- Delete ordinary files from test log directory.
    getDirectoryContents testLogDir
        >>= filterM doesFileExist . map (testLogDir </>)
        >>= mapM_ removeFile

    let totalSuites = length testsToRun
    notice verbosity $ "Running " ++ show totalSuites ++ " test suites..."
    suites <- mapM doTest testsToRun
    let packageLog = (localPackageLog pkg_descr lbi) { testSuites = suites }
        packageLogFile = (</>) testLogDir
            $ packageLogPath machineTemplate pkg_descr lbi
    allOk <- summarizePackage verbosity packageLog
    writeFile packageLogFile $ show packageLog

    let isCoverageEnabled = fromFlag $ configCoverage $ LBI.configFlags lbi
    when isCoverageEnabled $
        markupPackage verbosity lbi distPref (display $ PD.package pkg_descr) $
            map fst testsToRun

    unless allOk exitFailure

packageLogPath :: PathTemplate
               -> PD.PackageDescription
               -> LBI.LocalBuildInfo
               -> FilePath
packageLogPath template pkg_descr lbi =
    fromPathTemplate $ substPathTemplate env template
    where
        env = initialPathTemplateEnv
                (PD.package pkg_descr) (LBI.pkgKey lbi)
                (compilerInfo $ LBI.compiler lbi) (LBI.hostPlatform lbi)