module Game.LambdaHack.Action.Save
( saveGameFile, restoreGame, rmBkpSaveDiary, saveGameBkp
) where
import System.Directory
import System.FilePath
import qualified Control.Exception as Ex hiding (handle)
import Control.Monad
import Control.Concurrent
import System.IO.Unsafe (unsafePerformIO)
import Game.LambdaHack.Utils.File
import Game.LambdaHack.State
import qualified Game.LambdaHack.Config as Config
import qualified Game.LambdaHack.Action.ConfigIO as ConfigIO
import Game.LambdaHack.Msg
saveFile :: Config.CP -> IO FilePath
saveFile config = ConfigIO.getFile config "files" "saveFile"
bkpFile :: Config.CP -> IO FilePath
bkpFile config = do
sfile <- saveFile config
return $ sfile ++ ".bkp"
diaryFile :: Config.CP -> IO FilePath
diaryFile config = ConfigIO.getFile config "files" "diaryFile"
saveDiary :: Config.CP -> Diary -> IO ()
saveDiary config diary = do
dfile <- diaryFile config
encodeEOF dfile diary
saveLock :: MVar ()
saveLock = unsafePerformIO newEmptyMVar
saveGameFile :: State -> IO ()
saveGameFile state = do
putMVar saveLock ()
sfile <- saveFile (sconfig state)
encodeEOF sfile state
takeMVar saveLock
tryCreateDir :: FilePath -> IO ()
tryCreateDir dir =
Ex.catch
(createDirectory dir)
(\ e -> case e :: Ex.IOException of _ -> return ())
tryCopyDataFiles :: (FilePath -> IO FilePath) -> FilePath -> IO ()
tryCopyDataFiles pathsDataFile dirNew = do
configFile <- pathsDataFile "config.default"
scoresFile <- pathsDataFile "scores"
let configNew = combine dirNew "config"
scoresNew = combine dirNew "scores"
Ex.catch
(copyFile configFile configNew >>
copyFile scoresFile scoresNew)
(\ e -> case e :: Ex.IOException of _ -> return ())
restoreGame :: (FilePath -> IO FilePath) -> Config.CP -> String
-> IO (Either (State, Diary, Msg) (Diary, Msg))
restoreGame pathsDataFile config title = do
appData <- ConfigIO.appDataDir
ab <- doesDirectoryExist appData
unless ab $ do
tryCreateDir appData
tryCopyDataFiles pathsDataFile appData
diary <-
do dfile <- diaryFile config
db <- doesFileExist dfile
if db
then strictDecodeEOF dfile
else defaultDiary
sfile <- saveFile config
bfile <- bkpFile config
sb <- doesFileExist sfile
bb <- doesFileExist bfile
Ex.catch
(if sb
then do
mvBkp config
state <- strictDecodeEOF bfile
let msg = "Welcome back to " ++ title ++ "."
return $ Left (state, diary, msg)
else
if bb
then do
state <- strictDecodeEOF bfile
let msg = "No savefile found. Restoring from a backup savefile."
return $ Left (state, diary, msg)
else return $ Right (diary, "Welcome to " ++ title ++ "!"))
(\ e -> case e :: Ex.SomeException of
_ -> let msg = "Starting a new game, because restore failed. "
++ "The error message was: "
++ (unwords . lines) (show e)
in return $ Right (diary, msg))
mvBkp :: Config.CP -> IO ()
mvBkp config = do
sfile <- saveFile config
bfile <- bkpFile config
renameFile sfile bfile
saveGameBkp :: State -> Diary -> IO ()
saveGameBkp state diary = do
b <- tryPutMVar saveLock ()
let config = sconfig state
when b $
void $ forkIO $ do
saveDiary config diary
sfile <- saveFile config
encodeEOF sfile state
mvBkp (sconfig state)
takeMVar saveLock
rmBkpSaveDiary :: Config.CP -> Diary -> IO ()
rmBkpSaveDiary config diary = do
putMVar saveLock ()
saveDiary config diary
bfile <- bkpFile config
bb <- doesFileExist bfile
when bb $ removeFile bfile
takeMVar saveLock