Save.hs

-- | Saving and restoring games and player diaries.
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)  -- horrors

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

-- | Name of the save game.
saveFile :: Config.CP -> IO FilePath
saveFile config = ConfigIO.getFile config "files" "saveFile"

-- | Name of the backup of the save game.
bkpFile :: Config.CP -> IO FilePath
bkpFile config = do
  sfile <- saveFile config
  return $ sfile ++ ".bkp"

-- | Name of the persistent player diary.
diaryFile :: Config.CP -> IO FilePath
diaryFile config = ConfigIO.getFile config "files" "diaryFile"

-- | Save a simple serialized version of the current player diary.
saveDiary :: Config.CP -> Diary -> IO ()
saveDiary config diary = do
  dfile <- diaryFile config
  encodeEOF dfile diary

saveLock :: MVar ()
{-# NOINLINE saveLock #-}
saveLock = unsafePerformIO newEmptyMVar

-- | Save a simple serialized version of the current state.
-- Protected by a lock to avoid corrupting the file.
saveGameFile :: State -> IO ()
saveGameFile state = do
  putMVar saveLock ()
  sfile <- saveFile (sconfig state)
  encodeEOF sfile state
  takeMVar saveLock

-- | Try to create a directory. Hide errors due to,
-- e.g., insufficient permissions, because the game can run
-- in the current directory just as well.
tryCreateDir :: FilePath -> IO ()
tryCreateDir dir =
  Ex.catch
    (createDirectory dir)
    (\ e -> case e :: Ex.IOException of _ -> return ())

-- TODO: perhaps take the target "scores" file name from config.
-- TODO: perhaps source and "config", too, to be able to change all
-- in one place.
-- | Try to copy over data files. Hide errors due to,
-- e.g., insufficient permissions, because the game can run
-- without data files just as well.
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 ())

-- | Restore a saved game, if it exists. Initialize directory structure,
-- if needed.
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
  -- If the directory can't be created, the current directory will be used.
  unless ab $ do
    tryCreateDir appData
    -- Possibly copy over data files. No problem if it fails.
    tryCopyDataFiles pathsDataFile appData
  -- If the diary file does not exist, create an empty diary.
  -- TODO: when diary gets corrupted, start a new one, too.
  diary <-
    do dfile <- diaryFile config
       db <- doesFileExist dfile
       if db
         then strictDecodeEOF dfile
         else defaultDiary
  -- If the savefile exists but we get IO errors, we show them,
  -- back up the savefile and move it out of the way and start a new game.
  -- If the savefile was randomly corrupted or made read-only,
  -- that should solve the problem. If the problems are more serious,
  -- the other functions will most probably also throw exceptions,
  -- this time without trying to fix it up.
  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))

-- | Move the savegame file to a backup slot.
mvBkp :: Config.CP -> IO ()
mvBkp config = do
  sfile <- saveFile config
  bfile <- bkpFile config
  renameFile sfile bfile

-- | Save the diary and a backup of the save game file, in case of crashes.
-- This is only a backup, so no problem is the game is shut down
-- before saving finishes, so we don't wait on the mvar. However,
-- if a previous save is already in progress, we skip this save.
saveGameBkp :: State -> Diary -> IO ()
saveGameBkp state diary = do
  b <- tryPutMVar saveLock ()
  let config = sconfig state
  when b $
    void $ forkIO $ do
      saveDiary config diary  -- save the diary often in case of crashes
      sfile <- saveFile config
      encodeEOF sfile state
      mvBkp (sconfig state)
      takeMVar saveLock

-- | Remove the backup of the savegame and save the player diary.
-- Should be called before any non-error exit from the game.
-- Sometimes the backup file does not exist and it's OK.
-- We don't bother reporting any other removal exceptions, either,
-- because the backup file is relatively unimportant.
-- We wait on the mvar, because saving the diary at game shutdown is important.
rmBkpSaveDiary :: Config.CP -> Diary -> IO ()
rmBkpSaveDiary config diary = do
  putMVar saveLock ()
  saveDiary config diary  -- save the diary often in case of crashes
  bfile <- bkpFile config
  bb <- doesFileExist bfile
  when bb $ removeFile bfile
  takeMVar saveLock