Save.hs

-- | Saving and loading characters and games
-- (c) JP Moresmau 2009
module MoresmauJP.Rpg.Save where

import Control.Monad
import Control.Monad.Trans

import Data.List
import Data.Maybe
import Data.Time

import MoresmauJP.Maze1.Maze 
import MoresmauJP.Rpg.Character
import MoresmauJP.Rpg.MazeObjects

import System.Directory
import System.FilePath
import System.IO
import System.Locale

import Text.Printf

data RPGState = RPGState {
	rpgCharacter::(Maybe Character)
	,mgs::(Maybe RPGGameState)
	,fp:: FilePath}
	deriving (Show,Read,Eq)

data RPGGameState = RPGGameState {
	mazegameworld::GameWorld
	,objects::MazeObjects
	,tickCount::Int
	}
	deriving (Show,Read,Eq)

data BackupState = BackupState {
	bckDate::UTCTime,
	bckCharacter::Character,
	bckGame::Maybe RPGGameState
	}	
	deriving (Show,Read)

backupExtension="sav"

toBackupState :: RPGState -> IO(BackupState)
toBackupState (RPGState {rpgCharacter=Nothing})=error "toBackupState: empty game state"
toBackupState (RPGState {rpgCharacter=(Just char),mgs=mgs})=do
	t<-getCurrentTime
	return (BackupState t char mgs)  

fromBackupState :: RPGState -> BackupState -> RPGState
fromBackupState rs  bs = rs{rpgCharacter=(Just $ bckCharacter bs), mgs=(bckGame bs)}

getFile :: String -> String -> RPGState -> IO(FilePath)
getFile name ext (RPGState {fp=fp})= do
	createDirectoryIfMissing True fp
	let fileName=fp </> (makeValid $ (addExtension name ext))
	return fileName	

getGameFileForName :: RPGState -> Name -> IO(FilePath)
getGameFileForName rs name=getFile name backupExtension rs

getGameFileForCharacter :: RPGState -> Character -> IO(FilePath)
getGameFileForCharacter rs c=getGameFileForName rs (name c)
 
getBackupFileForCharacter :: RPGState -> Character -> IO(FilePath)
getBackupFileForCharacter rs c=checkBackupFile rs (name c) 1
		
checkBackupFile rs name ix = do
	f<-getFile (addExtension name (show ix)) backupExtension rs
	ex<-doesFileExist f
	if not ex 
		then return f
		else checkBackupFile rs name (ix+1)
		
saveCurrent :: RPGState -> IO (Either String (String,String))
saveCurrent (RPGState {rpgCharacter=Nothing})=return $ Right ("Nothing to save","")
saveCurrent rs@(RPGState {rpgCharacter=Just c1})=do
	if isOutOfService c1
		then do
			catch (
				do
					fileNameC<-getFile (name c1) backupExtension rs
					removeFile fileNameC
					return $ Right ("Character erased","")
				)
				(\e -> return (Left ("Could not erase character: " ++ (show e))))
		else do	
			saveCurrentGame rs
			

saveCurrentGame :: RPGState -> IO (Either String (String,String))
saveCurrentGame (RPGState {rpgCharacter=Nothing})=error "saveCurrentGame: no character"
saveCurrentGame (RPGState {mgs=Nothing})=error "saveCurrentGame: no game state"
saveCurrentGame rs@(RPGState {rpgCharacter=Just c1})=do 
	fileNameG<-getGameFileForCharacter rs c1 
	saveGame rs fileNameG
	
listFiles :: RPGState -> String -> IO ([FilePath])
listFiles (RPGState {fp=fp}) ext =do  
	createDirectoryIfMissing True fp
	fps<-getDirectoryContents fp
	return $ (map (makeRelative fp)) $  filter (isSuffixOf ext) fps	
	
listGames :: RPGState -> Name -> IO ([Either String (FilePath,String)])
listGames rs name= do
	files<-listFiles rs backupExtension 
	let myFiles=filter (isPrefixOf name) files
	foldM (\list x->do
		m<-withBackup rs x (\bs->do
			if isJust $ bckGame bs 
				then return $ Just (dropExtension x,formatTime defaultTimeLocale (iso8601DateFormat $ Just "%R") $ bckDate bs) 
				else return Nothing
				)
		case m of
			Right (Just x)-> return ((Right x):list)
			Right (Nothing)-> return list
			Left a-> return ((Left a):list)
			) [] myFiles
	
deleteCharacter :: RPGState -> String -> IO (Either String String)
deleteCharacter rs@(RPGState {fp=fp}) name=do
	files<-listFiles rs backupExtension 
	let myFiles= filter (isPrefixOf name) files
	catch (do
		mapM_ (removeFile . (combine fp)) myFiles
		return $ Right (printf "Character %s deleted" name)
		)
		(\e->return $ Left (printf "The character couldn't be deleted: %s" (show e))) 

deleteGame :: RPGState -> String -> IO (Either String String)
deleteGame rs name=do
	file<-getFile name backupExtension rs 
	catch (do
		if hasExtension name
			then do
				removeFile file
				return $ Right "Game deleted"
			else
				withBackupCond rs (takeFileName file) 
					(\(BackupState{bckCharacter=c})->do
						l<-saveCharacter rs c
						case l of
							Right _-> return $ Right "Game deleted"
							a->return a)
		
		)
		(\e->return $ Left (printf "The game couldn't be deleted: %s" (show e))) 


listCharacters :: RPGState -> IO ([String])
listCharacters rs= do
	files<-listFiles rs backupExtension 
	return $ filter (not . hasExtension) $ map dropExtension files	
	
saveBackup :: RPGState -> IO (Either String (String,String))
saveBackup (RPGState {rpgCharacter=Nothing}) = return $ Right ("Nothing to save","")
saveBackup rs@(RPGState {rpgCharacter=(Just c1)}) = do
	fileNameB<-getBackupFileForCharacter rs c1
	saveGame rs fileNameB
	
saveGame :: RPGState -> String -> IO (Either String  (String,String))
saveGame rs fileNameB= do	
	catch (
			do
				bs<-toBackupState rs
				writeFile fileNameB (show bs)
				return (Right (printf "Game saved to %s" fileNameB,dropExtension $ takeFileName fileNameB))
			)
			(\e -> return (Left (printf "Could not save game: %s" (show e))))
			
loadBackup :: RPGState -> String -> IO (Either String (String,RPGState))
loadBackup rs name = do
		withBackupCond rs (addExtension name backupExtension)
			(\bs->do
				let game=fromBackupState rs bs
				return $ case (mgs game) of
					Just _->Right ("Game loaded",game)
					Nothing->Left "This backup contains no started game")

doesCharacterExists :: RPGState -> String -> IO (Bool)
doesCharacterExists rs name=do
	fileName<-getFile name backupExtension rs
	doesFileExist fileName 
	
	
doesCurrentGameExists :: RPGState -> String -> IO(Bool)
doesCurrentGameExists rs shortName =do
	fileName<-getFile shortName backupExtension rs
	exists<-doesFileExist fileName
	if exists
		then do
			e<-withBackup rs fileName
				(\bs->do
					let game=fromBackupState rs bs
					return (isJust (mgs game)))
			return $ case e of
				Right b->b
				Left _->False
		else return False 
	
	
saveCharacter :: RPGState -> Character -> IO (Either String String)
saveCharacter rs c=do
	fileName<-getFile (name c) backupExtension rs
	catch (do
		t<-getCurrentTime
		let bs=(BackupState t c Nothing)  
		writeFile fileName (show bs)
		return (Right $ "Character saved to "++fileName)
		)
		(\e -> return (Left $ printf "Could not save character: %s" (show e)))	
		
readF :: (MonadIO m) => RPGState ->  String -> (String -> IO (Either String a)) -> (a -> m b) -> m (Either String b)
readF (RPGState {fp=fp}) shortName act act2 = do
	let sn'=if (takeExtension shortName)==("."++backupExtension)
		then shortName
		else addExtension shortName backupExtension
	let fileName=fp </> sn'
	exists<-liftIO $ doesFileExist fileName
	if exists
		then do 
			a <- liftIO $ catch (do
				a<- withFile fileName ReadMode (\h -> do
						s<-hGetContents h
						(act s)
					)
				return a)
				(\err-> return (Left (printf "The file %s could not be read: %s" fileName (show err))))
			case a of
				Right b -> do
					d<-act2 b
					return $ Right d
				Left c -> return $ Left c
		else return $ Left (printf "File %s does not exist" fileName)		

withBackup rs name m = do
	readF rs name readBackup
		m

withCharacter rs name m = do
	readF rs name readBackup
		(\bs-> m $ bckCharacter bs)

withBackupCond rs name m = do
	ei<-readF rs name readBackup
		m
	return $ case ei of
		Right (Left a)->Left a
		Right (Right a)->Right a
		Left a -> Left a		


readBackup s=do 
	catch (do
		c<-(readIO s)::IO BackupState
		return $ Right c
		)
		(\err-> return (Left (printf "The backup file could not be parsed: %s" (show err))))