    -- | Saving/loading to files, with serialization and compression.
    module Game.LambdaHack.Common.HSFile
      ( encodeEOF, strictDecodeEOF
      , tryCreateDir, doesFileExist, tryWriteFile, readFile, renameFile
    #ifdef EXPOSE_INTERNAL
        -- * Internal operations
      , encodeData
    #endif
      ) where

    import Prelude ()

    import Game.LambdaHack.Core.Prelude

    import qualified Codec.Compression.Zlib as Z
    import qualified Control.Exception as Ex
    import           Data.Binary
    import qualified Data.ByteString.Lazy as LBS
    import qualified Data.Text.IO as T
    import           Data.Version
    import           System.Directory
    import           System.FilePath
    import           System.IO
      ( IOMode (..)
      , hClose
      , hSetEncoding
      , localeEncoding
      , openBinaryFile
      , readFile
      , utf8
      , withBinaryFile
      , withFile
      )

    -- | Serialize and save data.
    -- Note that LBS.writeFile opens the file in binary mode.
    encodeData :: Binary a => FilePath -> a -> IO ()
    encodeData :: forall a. Binary a => String -> a -> IO ()
    encodeData String
    path a
    a = do
      let tmpPath :: String
    tmpPath = String
    path String -> String -> String
    <.> String
    "tmp"
      IO Handle -> (Handle -> IO ()) -> (Handle -> IO ()) -> IO ()
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    Ex.bracketOnError
        (String -> IOMode -> IO Handle
    openBinaryFile String
    tmpPath IOMode
    WriteMode)
        (\Handle
    h -> Handle -> IO ()
    hClose Handle
    h IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> String -> IO ()
    removeFile String
    tmpPath)
        (\Handle
    h -> do
           Handle -> ByteString -> IO ()
    LBS.hPut Handle
    h (ByteString -> IO ()) -> (a -> ByteString) -> a -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> ByteString
    forall a. Binary a => a -> ByteString
    encode (a -> IO ()) -> a -> IO ()
    forall a b. (a -> b) -> a -> b
    $ a
    a
           Handle -> IO ()
    hClose Handle
    h
           String -> String -> IO ()
    renameFile String
    tmpPath String
    path
        )

    -- | Serialize, compress and save data with an EOF marker.
    -- The @OK@ is used as an EOF marker to ensure any apparent problems with
    -- corrupted files are reported to the user ASAP.
    encodeEOF :: Binary b => FilePath -> Version -> b -> IO ()
    encodeEOF :: forall b. Binary b => String -> Version -> b -> IO ()
    encodeEOF String
    path Version
    v b
    b =
      String -> (Version, (ByteString, String)) -> IO ()
    forall a. Binary a => String -> a -> IO ()
    encodeData String
    path (Version
    v, (ByteString -> ByteString
    Z.compress (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ b -> ByteString
    forall a. Binary a => a -> ByteString
    encode b
    b, String
    "OK" :: String))

    -- | Read, decompress and deserialize data with an EOF marker.
    -- The @OK@ EOF marker ensures any easily detectable file corruption
    -- is discovered and reported before any value is decoded from
    -- the second component and before the file handle is closed.
    -- OTOH, binary encoding corruption is not discovered until a version
    -- check elswere ensures that binary formats are compatible.
    strictDecodeEOF :: Binary b => FilePath -> IO (Version, b)
    strictDecodeEOF :: forall b. Binary b => String -> IO (Version, b)
    strictDecodeEOF String
    path =
      String -> IOMode -> (Handle -> IO (Version, b)) -> IO (Version, b)
    forall r. String -> IOMode -> (Handle -> IO r) -> IO r
    withBinaryFile String
    path IOMode
    ReadMode ((Handle -> IO (Version, b)) -> IO (Version, b))
    -> (Handle -> IO (Version, b)) -> IO (Version, b)
    forall a b. (a -> b) -> a -> b
    $ \Handle
    h -> do
        c1 <- Handle -> IO ByteString
    LBS.hGetContents Handle
    h
        let (v1, (c2, s)) = decode c1
        return $! if s == ("OK" :: String)
                  then (v1, decode $ Z.decompress c2)
                  else error $ "Fatal error: corrupted file " ++ path

    -- | Try to create a directory, if it doesn't exist. We catch exceptions
    -- in case many clients try to do the same thing at the same time.
    tryCreateDir :: FilePath -> IO ()
    tryCreateDir :: String -> IO ()
    tryCreateDir String
    dir = do
      dirExists <- String -> IO Bool
    doesDirectoryExist String
    dir
      unless dirExists $
        Ex.handle (\(IOException
    _ :: Ex.IOException) -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())
                  (createDirectory dir)

    -- | Try to write a file, given content, if the file not already there.
    -- We catch exceptions in case many clients and/or the server try to do
    -- the same thing at the same time. Using `Text.IO` to avoid UTF conflicts
    -- with OS or filesystem.
    tryWriteFile :: FilePath -> Text -> IO ()
    tryWriteFile :: String -> Text -> IO ()
    tryWriteFile String
    path Text
    content = do
      fileExists <- String -> IO Bool
    doesFileExist String
    path
      unless fileExists $ do
        -- With some luck, locale was already corrected in Main.hs, but just
        -- in case, we make sure not to save UTF files in too primitve encodings.
        let enc = TextEncoding
    localeEncoding
        Ex.handle (\(IOException
    ex :: Ex.IOException) -> String -> IO ()
    forall a. Show a => a -> IO ()
    print (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ IOException -> String
    forall a. Show a => a -> String
    show IOException
    ex) $
          withFile path WriteMode $ \Handle
    h -> do
            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (TextEncoding -> String
    forall a. Show a => a -> String
    show TextEncoding
    enc String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [String
    "ASCII", String
    "ISO-8859-1", String
    "ISO-8859-2"]) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
              Handle -> TextEncoding -> IO ()
    hSetEncoding Handle
    h TextEncoding
    utf8
            Handle -> Text -> IO ()
    T.hPutStr Handle
    h Text
    content