module Game.LambdaHack.Common.HSFile
( encodeEOF, strictDecodeEOF
, tryCreateDir, doesFileExist, tryWriteFile, readFile, renameFile
#ifdef EXPOSE_INTERNAL
, 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 Data.Version
import System.Directory
import System.FilePath
import System.IO (IOMode (..), hClose, openBinaryFile, readFile,
withBinaryFile, writeFile)
encodeData :: Binary a => FilePath -> a -> IO ()
encodeData :: FilePath -> a -> IO ()
encodeData path :: FilePath
path a :: a
a = do
let tmpPath :: FilePath
tmpPath = FilePath
path FilePath -> FilePath -> FilePath
<.> "tmp"
IO Handle -> (Handle -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Ex.bracketOnError
(FilePath -> IOMode -> IO Handle
openBinaryFile FilePath
tmpPath IOMode
WriteMode)
(\h :: Handle
h -> Handle -> IO ()
hClose Handle
h IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> IO ()
removeFile FilePath
tmpPath)
(\h :: 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
FilePath -> FilePath -> IO ()
renameFile FilePath
tmpPath FilePath
path
)
encodeEOF :: Binary b => FilePath -> Version -> b -> IO ()
encodeEOF :: FilePath -> Version -> b -> IO ()
encodeEOF path :: FilePath
path v :: Version
v b :: b
b =
FilePath -> (Version, (ByteString, FilePath)) -> IO ()
forall a. Binary a => FilePath -> a -> IO ()
encodeData FilePath
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, "OK" :: String))
strictDecodeEOF :: Binary b => FilePath -> IO (Version, b)
strictDecodeEOF :: FilePath -> IO (Version, b)
strictDecodeEOF path :: FilePath
path =
FilePath
-> IOMode -> (Handle -> IO (Version, b)) -> IO (Version, b)
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile FilePath
path IOMode
ReadMode ((Handle -> IO (Version, b)) -> IO (Version, b))
-> (Handle -> IO (Version, b)) -> IO (Version, b)
forall a b. (a -> b) -> a -> b
$ \h :: Handle
h -> do
ByteString
c1 <- Handle -> IO ByteString
LBS.hGetContents Handle
h
let (v1 :: Version
v1, (c2 :: ByteString
c2, s :: FilePath
s)) = ByteString -> (Version, (ByteString, FilePath))
forall a. Binary a => ByteString -> a
decode ByteString
c1
(Version, b) -> IO (Version, b)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Version, b) -> IO (Version, b))
-> (Version, b) -> IO (Version, b)
forall a b. (a -> b) -> a -> b
$! if FilePath
s FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== ("OK" :: String)
then (Version
v1, ByteString -> b
forall a. Binary a => ByteString -> a
decode (ByteString -> b) -> ByteString -> b
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Z.decompress ByteString
c2)
else FilePath -> (Version, b)
forall a. HasCallStack => FilePath -> a
error (FilePath -> (Version, b)) -> FilePath -> (Version, b)
forall a b. (a -> b) -> a -> b
$ "Fatal error: corrupted file " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
path
tryCreateDir :: FilePath -> IO ()
tryCreateDir :: FilePath -> IO ()
tryCreateDir dir :: FilePath
dir = do
Bool
dirExists <- FilePath -> IO Bool
doesDirectoryExist FilePath
dir
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
dirExists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
(IOException -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
Ex.handle (\(IOException
_ :: Ex.IOException) -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
(FilePath -> IO ()
createDirectory FilePath
dir)
tryWriteFile :: FilePath -> String -> IO ()
tryWriteFile :: FilePath -> FilePath -> IO ()
tryWriteFile path :: FilePath
path content :: FilePath
content = do
Bool
fileExists <- FilePath -> IO Bool
doesFileExist FilePath
path
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
fileExists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
(IOException -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
Ex.handle (\(IOException
_ :: Ex.IOException) -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
(FilePath -> FilePath -> IO ()
writeFile FilePath
path FilePath
content)