module Test
where

import Slurp

import System.Cmd
import System.Exit
import System.Random

import Control.Monad.State

import Data.Map	(Map)
import qualified Data.Map	as Map

import Data.Set (Set)
import qualified Data.Set	as Set


-- | Build an assembly file from these bits
makeFile 
	:: Bits 	-- map holding the bits
	-> String	-- output file

makeFile bits
 = let	bs	= Map.elems bits
    in	concat $ map unlines bs


-- | Test a source file by compiling it with the provided grind.sh script.
--	This only tests if it crashes, we should really check the output as well.
testFile 
	:: String 	-- .s source
	-> String 	-- .o file
	-> String 	-- binary
	-> IO Bool
	
testFile src obj bin
 = do	system $ "sh grind.sh " ++ src ++ " " ++ obj ++ " " ++ bin
 	ret	<- system bin
	
	case ret of
	 ExitSuccess	-> return True
	 ExitFailure _	-> return False


-- | Test a single bits file
testBits :: Bits -> IO Bool
testBits bits
 = do	-- putStr "Writing back\n"
	let file	= makeFile bits
	writeFile "grind.s" file
	testFile  "grind.s" "grind.o" "./grind"


-----------------------------------------------------
-- | The tester monad
data TestS
	= TestS

	-- the bad / dubious pieces we're currently testing out
	{ stateDubious	:: Set String }

type TestM = StateT TestS IO

-- Get one of the bits at random
getRandomBit :: Bits -> TestM (String, [String])
getRandomBit bits
 = do	let len		= Map.size bits
 	n		<- liftIO $ randomRIO (0, len-1)
	
	let name	= Map.keys bits !! n
	let Just bit	= Map.lookup name bits

	return	(name, bit)


-- | Do some tests on these bits.
--	Substitute the suspected bad bits for the good ones, testing as we go.
--
grindBits :: Bits -> Bits -> IO ()
grindBits bitsGood bitsBad
 = do	gen	<- getStdGen
	let state	
		= TestS 
		{ stateDubious	= Set.empty }
		
 	_	<- runStateT (grindStart bitsGood bitsBad) state
	return ()


grindStart :: Bits -> Bits -> TestM ()
grindStart  bitsGood bitsBad
 = do	
 	liftIO $ putStr "\n-- Testing good bits ------------------\n"
 	rGood	<- liftIO $ testBits bitsGood
	grindReportTest rGood

 	liftIO $ putStr "\n-- Testing bad  bits ------------------\n"
 	rBad	<- liftIO $ testBits bitsBad
	grindReportTest rBad
 
 	grindLoop bitsGood bitsBad


grindLoop :: Bits -> Bits -> TestM ()
grindLoop bitsGood bitsBad
 = do	
	-- add a bit from the bad set
--	let (name, bit) : _
--		= Map.toList bitsBad

	(name, bit)	<- getRandomBit bitsBad

 	liftIO $ putStr $ "\n-- Adding " ++ name ++ "\n"

	let bitsDubious	= Map.insert name bit bitsGood

	-- test the combination	
	rTest	<- liftIO $ testBits bitsDubious
	grindReportTest rTest
 
 	when (not rTest)
	 $ error "test failed. stopping\n"
 
 	-- otherwise remove the tested bit from the bad set
	let bitsBad'	= Map.delete name bitsBad

	liftIO $ putStr $ "\n-- still to go: " ++ (show $ Map.size bitsBad') ++ "\n"
	
	grindLoop bitsDubious bitsBad'

 
grindReportTest :: Bool -> TestM ()
grindReportTest b
 = case b of
 	True	-> liftIO $ putStr "\n-- ok\n"
	False	-> liftIO $ putStr "\n-- failed\n"