module Distribution.Simple.Test.Log
       ( PackageLog(..)
       , TestLogs(..)
       , TestSuiteLog(..)
       , countTestResults
       , localPackageLog
       , summarizePackage
       , summarizeSuiteFinish, summarizeSuiteStart
       , summarizeTest
       , suiteError, suiteFailed, suitePassed
       , testSuiteLogPath
       ) where

import Distribution.Package ( PackageId )
import qualified Distribution.PackageDescription as PD
import Distribution.Simple.Compiler ( Compiler(..), compilerInfo, CompilerId )
import Distribution.Simple.InstallDirs
    ( fromPathTemplate, initialPathTemplateEnv, PathTemplateVariable(..)
    , substPathTemplate , toPathTemplate, PathTemplate )
import qualified Distribution.Simple.LocalBuildInfo as LBI
import Distribution.Simple.Setup ( TestShowDetails(..) )
import Distribution.Simple.Utils ( notice )
import Distribution.System ( Platform )
import Distribution.TestSuite ( Options, Result(..) )
import Distribution.Verbosity ( Verbosity )

import Control.Monad ( when )
import Data.Char ( toUpper )

-- | Logs all test results for a package, broken down first by test suite and
-- then by test case.
data PackageLog = PackageLog
    { package :: PackageId
    , compiler :: CompilerId
    , platform :: Platform
    , testSuites :: [TestSuiteLog]
    }
    deriving (Read, Show, Eq)

-- | A 'PackageLog' with package and platform information specified.
localPackageLog :: PD.PackageDescription -> LBI.LocalBuildInfo -> PackageLog
localPackageLog pkg_descr lbi = PackageLog
    { package = PD.package pkg_descr
    , compiler = compilerId $ LBI.compiler lbi
    , platform = LBI.hostPlatform lbi
    , testSuites = []
    }

-- | Logs test suite results, itemized by test case.
data TestSuiteLog = TestSuiteLog
    { testSuiteName :: String
    , testLogs :: TestLogs
    , logFile :: FilePath    -- path to human-readable log file
    }
    deriving (Read, Show, Eq)

data TestLogs
    = TestLog
        { testName              :: String
        , testOptionsReturned   :: Options
        , testResult            :: Result
        }
    | GroupLogs String [TestLogs]
    deriving (Read, Show, Eq)

-- | Count the number of pass, fail, and error test results in a 'TestLogs'
-- tree.
countTestResults :: TestLogs
                 -> (Int, Int, Int) -- ^ Passes, fails, and errors,
                                    -- respectively.
countTestResults = go (0, 0, 0)
  where
    go (p, f, e) (TestLog { testResult = r }) =
        case r of
            Pass -> (p + 1, f, e)
            Fail _ -> (p, f + 1, e)
            Error _ -> (p, f, e + 1)
    go (p, f, e) (GroupLogs _ ts) = foldl go (p, f, e) ts

-- | From a 'TestSuiteLog', determine if the test suite passed.
suitePassed :: TestLogs -> Bool
suitePassed l =
    case countTestResults l of
        (_, 0, 0) -> True
        _ -> False

-- | From a 'TestSuiteLog', determine if the test suite failed.
suiteFailed :: TestLogs -> Bool
suiteFailed l =
    case countTestResults l of
        (_, 0, _) -> False
        _ -> True

-- | From a 'TestSuiteLog', determine if the test suite encountered errors.
suiteError :: TestLogs -> Bool
suiteError l =
    case countTestResults l of
        (_, _, 0) -> False
        _ -> True

resultString :: TestLogs -> String
resultString l | suiteError l = "error"
               | suiteFailed l = "fail"
               | otherwise = "pass"

testSuiteLogPath :: PathTemplate
                 -> PD.PackageDescription
                 -> LBI.LocalBuildInfo
                 -> String -- ^ test suite name
                 -> TestLogs -- ^ test suite results
                 -> FilePath
testSuiteLogPath template pkg_descr lbi name result =
    fromPathTemplate $ substPathTemplate env template
    where
        env = initialPathTemplateEnv
                (PD.package pkg_descr) (LBI.pkgKey lbi)
                (compilerInfo $ LBI.compiler lbi) (LBI.hostPlatform lbi)
                ++  [ (TestSuiteNameVar, toPathTemplate name)
                    , (TestSuiteResultVar, toPathTemplate $ resultString result)
                    ]

-- | Print a summary to the console after all test suites have been run
-- indicating the number of successful test suites and cases.  Returns 'True' if
-- all test suites passed and 'False' otherwise.
summarizePackage :: Verbosity -> PackageLog -> IO Bool
summarizePackage verbosity packageLog = do
    let counts = map (countTestResults . testLogs) $ testSuites packageLog
        (passed, failed, errors) = foldl1 addTriple counts
        totalCases = passed + failed + errors
        passedSuites = length
                       $ filter (suitePassed . testLogs)
                       $ testSuites packageLog
        totalSuites = length $ testSuites packageLog
    notice verbosity $ show passedSuites ++ " of " ++ show totalSuites
        ++ " test suites (" ++ show passed ++ " of "
        ++ show totalCases ++ " test cases) passed."
    return $! passedSuites == totalSuites
  where
    addTriple (p1, f1, e1) (p2, f2, e2) = (p1 + p2, f1 + f2, e1 + e2)

-- | Print a summary of a single test case's result to the console, supressing
-- output for certain verbosity or test filter levels.
summarizeTest :: Verbosity -> TestShowDetails -> TestLogs -> IO ()
summarizeTest _ _ (GroupLogs {}) = return ()
summarizeTest verbosity details t =
    when shouldPrint $ notice verbosity $ "Test case " ++ testName t
        ++ ": " ++ show (testResult t)
    where shouldPrint = (details > Never) && (notPassed || details == Always)
          notPassed = testResult t /= Pass

-- | Print a summary of the test suite's results on the console, suppressing
-- output for certain verbosity or test filter levels.
summarizeSuiteFinish :: TestSuiteLog -> String
summarizeSuiteFinish testLog = unlines
    [ "Test suite " ++ testSuiteName testLog ++ ": " ++ resStr
    , "Test suite logged to: " ++ logFile testLog
    ]
    where resStr = map toUpper (resultString $ testLogs testLog)

summarizeSuiteStart :: String -> String
summarizeSuiteStart n = "Test suite " ++ n ++ ": RUNNING...\n"