SaveTests.hs

-- | Saving and loading hunit tests
-- (c) JP Moresmau 2009
module MoresmauJP.Rpg.SaveTests where

import Control.Monad

import qualified Data.Map as M

import MoresmauJP.Maze1.Maze 
import MoresmauJP.Rpg.Character
import MoresmauJP.Rpg.MazeObjects
import MoresmauJP.Rpg.Save
import MoresmauJP.Rpg.CharacterTests
import MoresmauJP.Util.Random

import System.Directory
import System.FilePath
import System.Random
import Test.HUnit

saveTests = TestList [testNormalCharacterFlow,testNormalGameFlow,
	testBackupGameFlow,testBackupAndCurrent,testSaveCurrentOOS]

testNormalCharacterFlow = TestLabel "testNormalCharacterFlow" (TestCase (do
	rpg<-getTestRpg
	let name="JP"
	let c=createTestChar name
	e<-saveCharacter rpg c
	assertBool "e is not Right" (case e of 
		(Right _)-> True
		_ -> False)
	characterExists<-doesCharacterExists rpg name
	assertBool "character does not exist" characterExists
	currentGameExists<-doesCurrentGameExists rpg name
	assertBool "game does exist" (not currentGameExists)
	chars<-listCharacters rpg
	assertEqual "not 1 character" 1 (length chars)
	assertEqual "not JP" name (head chars) 
	games<-listGames rpg name
	assertEqual ("game found "++show (head games)) 0 (length games)
	ed<-deleteCharacter rpg name
	assertBool "ed is not Right" (case ed of 
		(Right _)-> True
		_ -> False)
	characterExists2<-doesCharacterExists rpg name
	assertBool "character still exists" (not characterExists2)
	currentGameExists2<-doesCurrentGameExists rpg name
	assertBool "game does exist" (not currentGameExists2)
	chars2<-listCharacters rpg
	assertEqual "not 1 character" 0 (length chars2)
	))
	
testNormalGameFlow = TestLabel "testNormalGameFlow" (TestCase (do
	rpg<-getTestRpg
	let name="JP"
	let c=createTestChar name
	saveCharacter rpg c
	sg<-getStdGen
	gw<-evalRandT (generateGameWorld (10,5)) (ProductionRandom sg)
	let mgs=RPGGameState (gw) (MazeObjects M.empty M.empty) 0
	let rpg2=rpg{rpgCharacter=Just c,mgs=Just mgs}
	e<-saveCurrent rpg2
	assertBool ("e is not Right "++(show e)) (case e of 
		(Right _)-> True
		_ -> False)
	games<-listGames rpg name
	assertEqual "not 1 game found" 1 (length games)
	assertBool "head hames is not Right" (case (head games) of 
		(Right _)-> True
		_ -> False)
	let (Right (n,_))=head games
	assertEqual "not name" name n
	
	lb<-loadBackup rpg name
	assertBool "lb is not Right" (case (lb) of 
		(Right _)-> True
		_ -> False)
	
	eD<-deleteGame rpg2 name
	assertBool ("eD is not Right: "++(show eD)) (case eD of 
		(Right _)-> True
		_ -> False)
	currentGameExists<-doesCurrentGameExists rpg name
	assertBool "game does exist" (not currentGameExists)
	chars<-listCharacters rpg
	assertEqual "not 1 character" 1 (length chars)
	assertEqual "not JP" name (head chars) 
	games<-listGames rpg name
	assertEqual ("game found "++show (head games)) 0 (length games)
	
	lb2<-loadBackup rpg name
	assertBool "lb2 is not Left" (case lb2 of 
		(Right _)-> False
		(Left _) -> True)
	
	
	))
	
testBackupGameFlow = TestLabel "testBackupGameFlow" (TestCase (do
	tmp<-getTemporaryDirectory
	let dir=combine tmp "rpg"
	removeDirectoryRecursive dir
	let rpg=RPGState Nothing Nothing dir
	let name="JP"
	let c=createTestChar name
	saveCharacter rpg c
	sg<-getStdGen
	gw<-evalRandT (generateGameWorld (10,5)) (ProductionRandom sg)
	let mgs=RPGGameState (gw) (MazeObjects M.empty M.empty) 0
	let rpg2=RPGState (Just c) (Just mgs) dir
	e<-saveBackup rpg2
	assertBool ("e is not Right "++(show e)) (case e of 
		(Right _)-> True
		_ -> False)
	games<-listGames rpg name
	assertEqual "not 1 games found" 1 (length games)
	assertBool "head hames is not Right" (case (head games) of 
		(Right _)-> True
		_ -> False)
	let Right (n,_)=head games
	assertEqual "not name.1" (name++".1") n
	currentGameExists<-doesCurrentGameExists rpg name
	assertBool "game does exist" (not currentGameExists)
	chars<-listCharacters rpg
	assertEqual "not 1 character" 1 (length chars)
	assertEqual "not JP" name (head chars) 
	
	lb<-loadBackup rpg n
	assertBool "lb is not Right" (case lb of 
		(Right _)-> True
		_ -> False)
	
	eD<-deleteGame rpg2 n
	assertBool ("eD is not Right: "++(show eD)) (case eD of 
		(Right _)-> True
		_ -> False)
	currentGameExists<-doesCurrentGameExists rpg name
	assertBool "game does exist" (not currentGameExists)
	chars<-listCharacters rpg
	assertEqual "not 1 character" 1 (length chars)
	assertEqual "not JP" name (head chars) 
	games<-listGames rpg name
	assertEqual ("game found "++show (head games)) 0 (length games)
	
	lb2<-loadBackup rpg n
	assertBool "lb2 is not Left" (case lb2 of 
		(Right _)-> False
		(Left _) -> True)
		
	return ()
	))
	
testBackupAndCurrent= TestLabel "testBackupAndCurrent" (TestCase (do
	rpg<-getTestRpg
	let name="JP"
	let c=createTestChar name
	saveCharacter rpg c
	sg<-getStdGen
	gw<-evalRandT (generateGameWorld (10,5)) (ProductionRandom sg)
	let mgs=RPGGameState (gw) (MazeObjects M.empty M.empty) 0
	let rpg2=rpg{rpgCharacter=Just c,mgs=Just mgs}
	e<-saveBackup rpg2
	assertBool ("e is not Right "++(show e)) (case e of 
		(Right _)-> True
		_ -> False)
	let Right(_,nB)=e
	
	gw2<-evalRandT (generateGameWorld (10,5)) (ProductionRandom sg)
	let mgs2=RPGGameState (gw2) (MazeObjects M.empty M.empty) 0
	let rpg3=rpg{rpgCharacter=Just c,mgs=Just mgs2}
	eC<-saveCurrent rpg3
	assertBool ("eC is not Right "++(show eC)) (case eC of 
		(Right _)-> True
		_ -> False)
	let Right(_,nC)=eC
	
	games<-listGames rpg name
	assertEqual "not 2 games found" 2 (length games)
	assertBool "head hames is not Right" (case (head games) of 
		(Right _)-> True
		_ -> False)
	assertBool "second hames is not Right" (case (head $ tail games) of 
		(Right _)-> True
		_ -> False)
		
	lbB<-loadBackup rpg nB
	assertBool "lbB is not Right" (case lbB of 
		(Right _)-> True
		_ -> False)
	
	let Right (_,rpg2a)=lbB
	assertEqual "backup is not right rpg" rpg2 rpg2a
	
	lbC<-loadBackup rpg nC
	assertBool "lbC is not Right" (case lbC of 
		(Right _)-> True
		_ -> False)
	
	let Right (_,rpg3a)=lbC
	assertEqual "Current is not right rpg" rpg3 rpg3a	
	
	eD<-deleteGame rpg2 nB
	assertBool ("eD is not Right: "++(show eD)) (case eD of 
		(Right _)-> True
		_ -> False)
	currentGameExists<-doesCurrentGameExists rpg nB
	assertBool "game does exist" (not currentGameExists)
	chars<-listCharacters rpg
	assertEqual "not 1 character" 1 (length chars)
	assertEqual "not JP" name (head chars) 
	games<-listGames rpg nB
	assertEqual ("game found "++show (head games)) 0 (length games)
	
	lb2<-loadBackup rpg nB
	assertBool "lb2 is not Left" (case lb2 of 
		(Right _)-> False
		(Left _) -> True)
		
	eDC<-deleteGame rpg2 nC
	assertBool ("eDC is not Right: "++(show eDC)) (case eDC of 
		(Right _)-> True
		_ -> False)	
		
	return ()
	
	))


getTestRpg= do
	tmp<-getTemporaryDirectory
	let dir=combine tmp "rpg"
	b<-doesDirectoryExist dir
	when b (removeDirectoryRecursive dir)
	return (RPGState Nothing Nothing dir)

testSaveCurrentOOS= TestLabel "testSaveCurrentOOS" (TestCase (do
	rpg<-getTestRpg
	let name="JP"
	let c=createTestChar name
	saveCharacter rpg c
	sg<-getStdGen
	gw<-evalRandT (generateGameWorld (10,5)) (ProductionRandom sg)
	let mgs=RPGGameState (gw) (MazeObjects M.empty M.empty) 0
	let rpg2=rpg{rpgCharacter=Just c,mgs=Just mgs}
	
	eC<-saveCurrent rpg2
	assertBool ("eC is not Right "++(show eC)) (case eC of 
		(Right _)-> True
		_ -> False)
	let Right(_,nC)=eC
	
	let c2=setCharacteristic' c Current Physical 0

	let rpg3=rpg{rpgCharacter=Just c2}
	
	eC2<-saveCurrent rpg3
	assertBool ("eC2 is not Right "++(show eC2)) (case eC2 of 
		(Right _)-> True
		_ -> False)
	
	currentGameExists<-doesCurrentGameExists rpg nC
	assertBool "game does exist" (not currentGameExists)
	chars<-listCharacters rpg
	assertEqual "not 0 character" 0 (length chars)
	games<-listGames rpg nC
	assertEqual ("game found "++show (head games)) 0 (length games)
	
	))