    -- | Saving and restoring game state, used by both server and clients.
    module Game.LambdaHack.Common.Save
      ( ChanSave, saveToChan, wrapInSaves, restoreGame
      , compatibleVersion, delayPrint
      , saveNameCli, saveNameSer, bkpAllSaves
    #ifdef EXPOSE_INTERNAL
        -- * Internal operations
      , loopSave
    #endif
      ) where

    import Prelude ()

    import Game.LambdaHack.Core.Prelude

    import           Control.Concurrent
    import           Control.Concurrent.Async
    import qualified Control.Exception as Ex
    import           Data.Binary
    import qualified Data.Text as T
    import qualified Data.Text.IO as T
    import           Data.Version
    import           System.FilePath
    import           System.IO (hFlush, stdout)
    import qualified System.Random.SplitMix32 as SM

    import Game.LambdaHack.Common.ClientOptions
    import Game.LambdaHack.Common.File
    import Game.LambdaHack.Common.Kind
    import Game.LambdaHack.Common.Misc
    import Game.LambdaHack.Common.Types
    import Game.LambdaHack.Content.RuleKind
    import Game.LambdaHack.Core.Random

    type ChanSave a = MVar (Maybe a)

    saveToChan :: ChanSave a -> a -> IO ()
    saveToChan :: forall a. ChanSave a -> a -> IO ()
    saveToChan ChanSave a
    toSave a
    s = do
      -- Wipe out previous candidates for saving.
      IO (Maybe (Maybe a)) -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO (Maybe (Maybe a)) -> IO ()) -> IO (Maybe (Maybe a)) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ ChanSave a -> IO (Maybe (Maybe a))
    forall a. MVar a -> IO (Maybe a)
    tryTakeMVar ChanSave a
    toSave
      ChanSave a -> Maybe a -> IO ()
    forall a. MVar a -> a -> IO ()
    putMVar ChanSave a
    toSave (Maybe a -> IO ()) -> Maybe a -> IO ()
    forall a b. (a -> b) -> a -> b
    $ a -> Maybe a
    forall a. a -> Maybe a
    Just a
    s

    -- | Repeatedly save serialized snapshots of current state.
    --
    -- Running with @-N2@ ca reduce @Max pause@ from 0.2s to 0.01s
    -- and @bytes copied during GC@ 10-fold, but framerate nor the frequency
    -- of not making a backup save are unaffected (at standard backup settings),
    -- even with null frontend, because saving takes so few resources.
    -- So, generally, backup save settings are relevant only due to latency
    -- impact on very slow computers or in JS.
    loopSave :: Binary a => COps -> (a -> FilePath) -> ChanSave a -> IO ()
    loopSave :: forall a. Binary a => COps -> (a -> String) -> ChanSave a -> IO ()
    loopSave COps
    cops a -> String
    stateToFileName ChanSave a
    toSave =
      IO ()
    loop
     where
      loop :: IO ()
    loop = do
        -- Wait until anyting to save.
        ms <- ChanSave a -> IO (Maybe a)
    forall a. MVar a -> IO a
    takeMVar ChanSave a
    toSave
        case ms of
          Just a
    s -> do
            dataDir <- IO String
    appDataDir
            tryCreateDir (dataDir </> "saves")
            let fileName = a -> String
    stateToFileName a
    s
            yield  -- minimize UI lag due to saving
            encodeEOF (dataDir </> "saves" </> fileName)
                      (rexeVersion $ corule cops)
                      s
            -- Wait until the save finished. During that time, the mvar
            -- is continually updated to newest state values.
            loop
          Maybe a
    Nothing -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()  -- exit

    wrapInSaves :: Binary a
                => COps -> (a -> FilePath) -> (ChanSave a -> IO ()) -> IO ()
    {-# INLINE wrapInSaves #-}
    wrapInSaves :: forall a.
    Binary a =>
    COps -> (a -> String) -> (ChanSave a -> IO ()) -> IO ()
    wrapInSaves COps
    cops a -> String
    stateToFileName ChanSave a -> IO ()
    exe = do
      -- We don't merge this with the other calls to waitForChildren,
      -- because, e.g., for server, we don't want to wait for clients to exit,
      -- if the server crashes (but we wait for the save to finish).
      toSave <- IO (ChanSave a)
    forall a. IO (MVar a)
    newEmptyMVar
      a <- async $ loopSave cops stateToFileName toSave
      link a
      let fin = do
            -- Wait until the last save (if any) starts
            -- and tell the save thread to end.
            ChanSave a -> Maybe a -> IO ()
    forall a. MVar a -> a -> IO ()
    putMVar ChanSave a
    toSave Maybe a
    forall a. Maybe a
    Nothing
            -- Wait 0.5s to flush debug and then until the save thread ends.
            Int -> IO ()
    threadDelay Int
    500000
            Async () -> IO ()
    forall a. Async a -> IO a
    wait Async ()
    a
      exe toSave `Ex.finally` fin
      -- The creation of, e.g., the initial client state, is outside the 'finally'
      -- clause, but this is OK, since no saves are ordered until 'runActionCli'.
      -- We save often, not only in the 'finally' section, in case of
      -- power outages, kill -9, GHC runtime crashes, etc. For internal game
      -- crashes, C-c, etc., the finalizer would be enough.
      -- If we implement incremental saves, saving often will help
      -- to spread the cost, to avoid a long pause at game exit.

    -- | Restore a saved game, if it exists. Initialize directory structure
    -- and copy over data files, if needed.
    restoreGame :: Binary a
                => RuleContent -> ClientOptions -> FilePath -> IO (Maybe a)
    restoreGame :: forall a.
    Binary a =>
    RuleContent -> ClientOptions -> String -> IO (Maybe a)
    restoreGame RuleContent
    corule ClientOptions
    clientOptions String
    fileName = do
      -- Create user data directory and copy files, if not already there.
      dataDir <- IO String
    appDataDir
      tryCreateDir dataDir
      let path = String
    dataDir String -> String -> String
    </> String
    "saves" String -> String -> String
    </> String
    fileName
      saveExists <- doesFileExist path
      -- If the savefile exists but we get IO or decoding errors,
      -- we show them and start a new game. If the savefile was randomly
      -- corrupted or made read-only, that should solve the problem.
      -- OTOH, serious IO problems (e.g. failure to create a user data directory)
      -- terminate the program with an exception.
      res <- Ex.try $
        if saveExists then do
          let vExe1 = RuleContent -> Version
    rexeVersion RuleContent
    corule
          (vExe2, s) <- strictDecodeEOF path
          if compatibleVersion vExe1 vExe2
          then return $! s `seq` Just s
          else do
            let msg = Text
    "Savefile" Text -> Text -> Text
    <+> String -> Text
    T.pack String
    path
                      Text -> Text -> Text
    <+> Text
    "from an incompatible version"
                      Text -> Text -> Text
    <+> String -> Text
    T.pack (Version -> String
    showVersion Version
    vExe2)
                      Text -> Text -> Text
    <+> Text
    "detected while trying to restore"
                      Text -> Text -> Text
    <+> String -> Text
    T.pack (Version -> String
    showVersion Version
    vExe1)
                      Text -> Text -> Text
    <+> Text
    "game."
            fail $ T.unpack msg
        else return Nothing
      let handler :: Ex.SomeException -> IO (Maybe a)
          handler SomeException
    e = do
            moveAside <- RuleContent -> ClientOptions -> IO Bool
    bkpAllSaves RuleContent
    corule ClientOptions
    clientOptions
            let msg = Text
    "Restore failed."
                      Text -> Text -> Text
    <+> (if Bool
    moveAside
                          then Text
    "The wrong file has been moved aside."
                          else Text
    "")
                      Text -> Text -> Text
    <+> Text
    "The error message is:"
                      Text -> Text -> Text
    <+> ([Text] -> Text
    T.unwords ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> [Text]
    T.lines) (SomeException -> Text
    forall a. Show a => a -> Text
    tshow SomeException
    e)
            delayPrint msg
            return Nothing
      either handler return res

    -- Minor version discrepancy permitted.
    compatibleVersion :: Version -> Version -> Bool
    compatibleVersion :: Version -> Version -> Bool
    compatibleVersion Version
    v1 Version
    v2 = Int -> [Int] -> [Int]
    forall a. Int -> [a] -> [a]
    take Int
    3 (Version -> [Int]
    versionBranch Version
    v1) [Int] -> [Int] -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int -> [Int] -> [Int]
    forall a. Int -> [a] -> [a]
    take Int
    3 (Version -> [Int]
    versionBranch Version
    v2)

    delayPrint :: Text -> IO ()
    delayPrint :: Text -> IO ()
    delayPrint Text
    t = do
      smgen <- IO SMGen
    SM.newSMGen
      let (delay, _) = nextRandom 10000 smgen
      threadDelay $ 100 * delay  -- try not to interleave saves with other clients
      T.hPutStr stdout $! t <> "\n"  -- hPutStrLn not atomic enough
      hFlush stdout

    saveNameCli :: RuleContent -> FactionId -> String
    saveNameCli :: RuleContent -> FactionId -> String
    saveNameCli RuleContent
    corule FactionId
    side =
      let gameShortName :: String
    gameShortName =
            case String -> [String]
    words (String -> [String]) -> String -> [String]
    forall a b. (a -> b) -> a -> b
    $ RuleContent -> String
    rtitle RuleContent
    corule of
              String
    w : [String]
    _ -> String
    w
              [String]
    _ -> String
    "Game"
      in String
    gameShortName
         String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ".team_" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show (FactionId -> Int
    forall a. Enum a => a -> Int
    fromEnum FactionId
    side)
         String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ".sav"

    saveNameSer :: RuleContent -> String
    saveNameSer :: RuleContent -> String
    saveNameSer RuleContent
    corule =
      let gameShortName :: String
    gameShortName =
            case String -> [String]
    words (String -> [String]) -> String -> [String]
    forall a b. (a -> b) -> a -> b
    $ RuleContent -> String
    rtitle RuleContent
    corule of
              String
    w : [String]
    _ -> String
    w
              [String]
    _ -> String
    "Game"
      in String
    gameShortName String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ".server.sav"

    bkpAllSaves :: RuleContent -> ClientOptions -> IO Bool
    bkpAllSaves :: RuleContent -> ClientOptions -> IO Bool
    bkpAllSaves RuleContent
    corule ClientOptions
    clientOptions = do
      dataDir <- IO String
    appDataDir
      let benchmark = ClientOptions -> Bool
    sbenchmark ClientOptions
    clientOptions
          defPrefix = ClientOptions -> String
    ssavePrefixCli ClientOptions
    defClientOptions
          moveAside = Bool -> Bool
    not Bool
    benchmark Bool -> Bool -> Bool
    && ClientOptions -> String
    ssavePrefixCli ClientOptions
    clientOptions String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    defPrefix
          bkpOneSave String
    name = do
            let pathSave :: String -> String
    pathSave String
    bkp = String
    dataDir String -> String -> String
    </> String
    "saves" String -> String -> String
    </> String
    bkp String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    defPrefix String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    name
            b <- String -> IO Bool
    doesFileExist (String -> String
    pathSave String
    "")
            when b $ renameFile (pathSave "") (pathSave "bkp.")
          bkpAll = do
            String -> IO ()
    bkpOneSave (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ RuleContent -> String
    saveNameSer RuleContent
    corule
            [Int] -> (Int -> IO ()) -> IO ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    t a -> (a -> m ()) -> m ()
    forM_ [-Int
    199..Int
    199] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Int
    n ->
              String -> IO ()
    bkpOneSave (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ RuleContent -> FactionId -> String
    saveNameCli RuleContent
    corule (Int -> FactionId
    forall a. Enum a => Int -> a
    toEnum Int
    n)
      when moveAside bkpAll
      return moveAside