module Test.MuCheck.Interpreter (evaluateMutants, evalMethod, evalMutant, evalTest, summarizeResults, MutantSummary(..)) where
import qualified Language.Haskell.Interpreter as I
import Control.Monad.Trans (liftIO)
import Control.Monad (liftM)
import Data.Typeable
import Test.MuCheck.Utils.Print (catchOutput)
import Data.Either (partitionEithers)
import System.Directory (createDirectoryIfMissing)
import System.Environment (withArgs)
import Test.MuCheck.TestAdapter
import Test.MuCheck.Utils.Common
import Test.MuCheck.AnalysisSummary
data MutantSummary = MSumError Mutant String [Summary]
| MSumAlive Mutant [Summary]
| MSumKilled Mutant [Summary]
| MSumOther Mutant [Summary]
deriving (Show, Typeable)
evaluateMutants :: (Summarizable a, Show a) => (Mutant -> TestStr -> InterpreterOutput a -> Summary) -> [Mutant] -> [String] -> IO (MAnalysisSummary, [MutantSummary])
evaluateMutants testSummaryFn mutants tests = do
results <- mapM (evalMutant tests) mutants
let singleTestSummaries = map (summarizeResults testSummaryFn tests) $ zip mutants results
ma = fullSummary tests results
return (ma, singleTestSummaries)
summarizeResults :: Summarizable a => (Mutant -> TestStr -> InterpreterOutput a -> Summary) -> [String] -> (Mutant, [InterpreterOutput a]) -> MutantSummary
summarizeResults testSummaryFn tests (mutant, ioresults) = case last results of
Left err -> MSumError mutant (show err) logS
Right out -> myresult out
where results = map _io ioresults
myresult out | isSuccess out = MSumAlive mutant logS
| isFailure out = MSumKilled mutant logS
| otherwise = MSumOther mutant logS
logS :: [Summary]
logS = zipWith (testSummaryFn mutant) tests ioresults
evalMutant :: (Typeable t, Summarizable t) => [TestStr] -> Mutant -> IO [InterpreterOutput t]
evalMutant tests mutant = do
createDirectoryIfMissing True ".mutants"
let mutantFile = ".mutants/" ++ hash mutant ++ ".hs"
writeFile mutantFile mutant
let logF = mutantFile ++ ".log"
stopFast (evalTest mutantFile logF) tests
stopFast :: (Typeable t, Summarizable t) => (String -> IO (InterpreterOutput t)) -> [TestStr] -> IO [InterpreterOutput t]
stopFast _ [] = return []
stopFast fn (x:xs) = do
v <- fn x
case _io v of
Left _ -> return [v]
Right out -> if isSuccess out
then liftM (v :) $ stopFast fn xs
else return [v]
evalTest :: (Typeable a, Summarizable a) => String -> String -> String -> IO (InterpreterOutput a)
evalTest mutantFile logF test = do
val <- withArgs [] $ catchOutput logF $ I.runInterpreter (evalMethod mutantFile test)
return Io {_io = val, _ioLog = logF}
evalMethod :: (I.MonadInterpreter m, Typeable t) => String -> String -> m t
evalMethod fileName evalStr = do
I.loadModules [fileName]
ms <- I.getLoadedModules
I.setTopLevelModules ms
I.interpret evalStr (I.as :: (Typeable a => IO a)) >>= liftIO
fullSummary :: (Show b, Summarizable b) => [TestStr] -> [[InterpreterOutput b]] -> MAnalysisSummary
fullSummary _tests results = MAnalysisSummary {
maNumMutants = length results,
maAlive = length alive,
maKilled = length fails,
maErrors= length errors}
where res = map (map _io) results
lasts = map last res
(errors, completed) = partitionEithers lasts
fails = filter isFailure completed
alive = filter isSuccess completed