<commit_before>
module BuildTest
	( BuildResults(..)
	, buildTest)
where
import Benchmarks
import Config
import BuildBox
import Data.Maybe
import Control.Monad

data BuildResults
	= BuildResults
	{ buildResultTime		:: UTCTime
	, buildResultEnvironment	:: Environment
	, buildResultBench		:: [BenchResult] }
	deriving (Show, Read)

instance Pretty BuildResults where
 ppr results
	= hang (ppr "BuildResults") 2 $ vcat
	[ ppr "time: " <> (ppr $ buildResultTime results)
	, ppr $ buildResultEnvironment results
	, ppr ""
	, vcat 	$ punctuate (ppr "\n") 
		$ map ppr 
		$ buildResultBench results ]

-- | Run regression tests.	
buildTest :: Config -> Environment -> Build ()
buildTest config env
 = do	outLn "* Running regression tests"
	
	-- Get the current time.
	utcTime	<- io $ getCurrentTime

	-- Load the baseline file if it was given.
	mBaseline <- case configAgainstResults config of
			Nothing		-> return Nothing
			Just fileName
			 -> do	file	<- io $ readFile fileName
				return	$ Just file
				
	let resultsPrior
		= maybe []
			(\contents -> buildResultBench $ read contents)
			mBaseline
	let scratchDir 
		= fromMaybe ("buildTest: must specify --scratch") 
		$ configScratchDir config

	-- Run the DPH benchmarks
	benchResultsDPH
	 <- if (configDoTestDPH config)
	     then inDir (scratchDir ++ "/ghc-head/libraries/dph") $
 	  	  do	mapM 	(outRunBenchmarkWith (configIterations config)  resultsPrior)
				(benchmarksDPH config)
	     else return []

	-- Run the Repa benchmarks
	benchResultsRepa
	 <- if (configDoTestRepa config)
	     then inDir (scratchDir ++ "/repa-head") $
 	 	  do	mapM 	(outRunBenchmarkWith (configIterations config)  resultsPrior)
				(benchmarksRepa config)
	     else return []

	-- Run NoSlow benchmarks
	benchResultsNoSlow
	 <- if (configDoTestNoSlow config)
	     then 
		inDir (scratchDir ++ "/NoSlow-head") $
		withTempFile $ \filePath ->
		 do	ssystem  $ "dist/build/noslow/noslow -o " ++ filePath
			liftM parseNoSlowLog $ io $ readFile filePath
		
	     else return []
	

	let benchResults
		= benchResultsDPH ++ benchResultsRepa ++ benchResultsNoSlow

	-- Make the build results.
	let buildResults
		= BuildResults
		{ buildResultTime		= utcTime
		, buildResultEnvironment	= env
		, buildResultBench		= benchResults }

	-- Write results to a file if requested.	
	maybe 	(return ())
		(\(fileName, shouldStamp) -> do
			stamp	<- if shouldStamp
				 	then io $ getStampyTime
					else return ""
					
			
			let fileName'	= fileName ++ stamp
			
			outLn $ "* Writing results to " ++ fileName'
			io $ writeFile fileName' $ show buildResults)
		(configWriteResults config)
	
	-- Mail results to recipient if requested.
	let spaceHack = text . unlines . map (\l -> " " ++ l) . lines . render
	maybe 	(return ())
		(\(from, to) -> do
			outLn $ "* Mailing results to " ++ to 
			mail	<- createMailWithCurrentTime from to "[nightly] DPH Performance Test Succeeded"
				$ render $ vcat
				[ text "DPH Performance Test Succeeded"
				, blank
				, ppr env
				, blank
				, spaceHack $ pprComparisons resultsPrior benchResults
				, blank ]
			
			outLn $ "  - Writing mail file"
			io $ writeFile "repa-bot.mail" $ render $ renderMail mail
				
			outLn $ "  - Sending mail"
			sendMailWithMailer mail defaultMailer				
			return ())
		(configMailFromTo config)


parseNoSlowLog :: String -> [BenchResult]
parseNoSlowLog str
	= map parseNoSlowLine
	$ tail
	$ lines str

parseNoSlowLine :: String -> BenchResult
parseNoSlowLine str
 = let	[name, mean, meanLB, meanUB, _, _, _]
		= words $ map (\c -> if c == ',' then ' ' else c) str
	
   in	BenchResult
		{ benchResultName	= "noslow-" ++ (read name)
		, benchResultRuns	
		   = 	[ BenchRunResult (read mean)   Nothing
			, BenchRunResult (read meanLB) Nothing
			, BenchRunResult (read meanUB) Nothing ] }
	
	
	
	
	<commit_msg>Normalise names of noslow benchmarks<commit_after>
module BuildTest
	( BuildResults(..)
	, buildTest)
where
import Benchmarks
import Config
import BuildBox
import Data.Maybe
import Control.Monad

data BuildResults
	= BuildResults
	{ buildResultTime		:: UTCTime
	, buildResultEnvironment	:: Environment
	, buildResultBench		:: [BenchResult] }
	deriving (Show, Read)

instance Pretty BuildResults where
 ppr results
	= hang (ppr "BuildResults") 2 $ vcat
	[ ppr "time: " <> (ppr $ buildResultTime results)
	, ppr $ buildResultEnvironment results
	, ppr ""
	, vcat 	$ punctuate (ppr "\n") 
		$ map ppr 
		$ buildResultBench results ]

-- | Run regression tests.	
buildTest :: Config -> Environment -> Build ()
buildTest config env
 = do	outLn "* Running regression tests"
	
	-- Get the current time.
	utcTime	<- io $ getCurrentTime

	-- Load the baseline file if it was given.
	mBaseline <- case configAgainstResults config of
			Nothing		-> return Nothing
			Just fileName
			 -> do	file	<- io $ readFile fileName
				return	$ Just file
				
	let resultsPrior
		= maybe []
			(\contents -> buildResultBench $ read contents)
			mBaseline
	let scratchDir 
		= fromMaybe ("buildTest: must specify --scratch") 
		$ configScratchDir config

	-- Run the DPH benchmarks
	benchResultsDPH
	 <- if (configDoTestDPH config)
	     then inDir (scratchDir ++ "/ghc-head/libraries/dph") $
 	  	  do	mapM 	(outRunBenchmarkWith (configIterations config)  resultsPrior)
				(benchmarksDPH config)
	     else return []

	-- Run the Repa benchmarks
	benchResultsRepa
	 <- if (configDoTestRepa config)
	     then inDir (scratchDir ++ "/repa-head") $
 	 	  do	mapM 	(outRunBenchmarkWith (configIterations config)  resultsPrior)
				(benchmarksRepa config)
	     else return []

	-- Run NoSlow benchmarks
	benchResultsNoSlow
	 <- if (configDoTestNoSlow config)
	     then 
		inDir (scratchDir ++ "/NoSlow-head") $
		withTempFile $ \filePath ->
		 do	ssystem  $ "dist/build/noslow/noslow -o " ++ filePath
			liftM parseNoSlowLog $ io $ readFile filePath
		
	     else return []
	

	let benchResults
		= benchResultsDPH ++ benchResultsRepa ++ benchResultsNoSlow

	-- Make the build results.
	let buildResults
		= BuildResults
		{ buildResultTime		= utcTime
		, buildResultEnvironment	= env
		, buildResultBench		= benchResults }

	-- Write results to a file if requested.	
	maybe 	(return ())
		(\(fileName, shouldStamp) -> do
			stamp	<- if shouldStamp
				 	then io $ getStampyTime
					else return ""
					
			
			let fileName'	= fileName ++ stamp
			
			outLn $ "* Writing results to " ++ fileName'
			io $ writeFile fileName' $ show buildResults)
		(configWriteResults config)
	
	-- Mail results to recipient if requested.
	let spaceHack = text . unlines . map (\l -> " " ++ l) . lines . render
	maybe 	(return ())
		(\(from, to) -> do
			outLn $ "* Mailing results to " ++ to 
			mail	<- createMailWithCurrentTime from to "[nightly] DPH Performance Test Succeeded"
				$ render $ vcat
				[ text "DPH Performance Test Succeeded"
				, blank
				, ppr env
				, blank
				, spaceHack $ pprComparisons resultsPrior benchResults
				, blank ]
			
			outLn $ "  - Writing mail file"
			io $ writeFile "repa-bot.mail" $ render $ renderMail mail
				
			outLn $ "  - Sending mail"
			sendMailWithMailer mail defaultMailer				
			return ())
		(configMailFromTo config)


-- | Parse a noslow benchmark results files.
parseNoSlowLog :: String -> [BenchResult]
parseNoSlowLog str
	= map parseNoSlowLine
	$ tail
	$ lines str

parseNoSlowLine :: String -> BenchResult
parseNoSlowLine str
 = let	[name, mean, meanLB, meanUB, _, _, _]
		= words $ map (\c -> if c == ',' then ' ' else c) str
	
   in	BenchResult
		{ benchResultName	= normaliseNoSlowName $ read name
		, benchResultRuns	
		   = 	[ BenchRunResult (read mean)   Nothing
			, BenchRunResult (read meanLB) Nothing
			, BenchRunResult (read meanUB) Nothing ] }
	

-- | Normalise the name of a noslow benchmark to match our format.
normaliseNoSlowName :: String -> String
normaliseNoSlowName name
	= ("noslow." ++)
	$ map (\c -> if c == '/' then '.' else c)
	$ name
{'fraction_non_alphanumeric': 0.0980144176046541, 'fraction_numerical': 0.0002529404325281396, 'mean_word_length': 3.065809768637532, 'pattern_counts': {'":': 0, '<': 21, '<?xml version=': 0, '>': 31, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6788741', 'n_tokens_mistral': 2920, 'n_tokens_neox': 2511, 'n_words': 757}