Save.hs

{-# LANGUAGE OverloadedStrings #-}
-- | 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 Data.Text (Text)
import qualified Data.Text as T

import Game.LambdaHack.Utils.File
import Game.LambdaHack.State
import Game.LambdaHack.Msg
import Game.LambdaHack.Config

-- | Save a simple serialized version of the current player diary.
saveDiary :: FilePath -> Diary -> IO ()
saveDiary configDiaryFile diary = encodeEOF configDiaryFile 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 :: ConfigUI -> State -> IO ()
saveGameFile ConfigUI{configSaveFile} state = do
  putMVar saveLock ()
  encodeEOF configSaveFile 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 ())

-- | 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 :: ConfigUI -> (FilePath -> IO FilePath) -> IO ()
tryCopyDataFiles ConfigUI{ configScoresFile
                         , configRulesCfgFile
                         , configUICfgFile } pathsDataFile = do
  rulesFile  <- pathsDataFile $ takeFileName configRulesCfgFile <.> ".default"
  uiFile     <- pathsDataFile $ takeFileName configUICfgFile    <.> ".default"
  scoresFile <- pathsDataFile $ takeFileName configScoresFile
  let newRulesFile  = configRulesCfgFile <.> ".ini"
      newUIFile     = configUICfgFile    <.> ".ini"
      newScoresFile = configScoresFile
  Ex.catch
    (copyFile rulesFile newRulesFile >>
     copyFile uiFile newUIFile >>
     copyFile scoresFile newScoresFile)
    (\ e -> case e :: Ex.IOException of _ -> return ())

-- | Restore a saved game, if it exists. Initialize directory structure,
-- if needed.
restoreGame :: ConfigUI -> (FilePath -> IO FilePath) -> Text
            -> IO (Either (State, Diary, Msg) (Diary, Msg))
restoreGame config@ConfigUI{ configAppDataDir
                           , configDiaryFile
                           , configSaveFile
                           , configBkpFile } pathsDataFile title = do
  ab <- doesDirectoryExist configAppDataDir
  -- If the directory can't be created, the current directory will be used.
  unless ab $ do
    tryCreateDir configAppDataDir
    -- Possibly copy over data files. No problem if it fails.
    tryCopyDataFiles config pathsDataFile
  -- If the diary file does not exist, create an empty diary.
  -- TODO: when diary gets corrupted, start a new one, too.
  diary <-
    do db <- doesFileExist configDiaryFile
       if db
         then strictDecodeEOF configDiaryFile
         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.
  sb <- doesFileExist configSaveFile
  bb <- doesFileExist configBkpFile
  Ex.catch
    (if sb
       then do
         renameFile configSaveFile configBkpFile
         state <- strictDecodeEOF configBkpFile
         let msg = "Welcome back to" <+> title <> "."
         return $ Left (state, diary, msg)
       else
         if bb
           then do
             state <- strictDecodeEOF configBkpFile
             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:"
                             <+> (T.unwords . T.lines) (showT e)
                   in return $ Right (diary, msg))

-- | 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 :: ConfigUI -> State -> Diary -> IO ()
saveGameBkp ConfigUI{ configDiaryFile
                    , configSaveFile
                    , configBkpFile } state diary = do
  b <- tryPutMVar saveLock ()
  when b $
    void $ forkIO $ do
      saveDiary configDiaryFile diary  -- save diary often in case of crashes
      encodeEOF configSaveFile state
      renameFile configSaveFile configBkpFile
      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 :: ConfigUI -> Diary -> IO ()
rmBkpSaveDiary ConfigUI{ configDiaryFile
                       , configBkpFile } diary = do
  putMVar saveLock ()
  saveDiary configDiaryFile diary  -- save diary often in case of crashes
  bb <- doesFileExist configBkpFile
  when bb $ removeFile configBkpFile
  takeMVar saveLock