From 414f810c7c1d9aedeaa45e0998537395e7f4a907 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Sat, 29 Jun 2024 16:39:57 +0200 Subject: Move platform-specific code to separate directory --- src/Erebos/Storage/Internal.hs | 35 ++++++++++++----------------------- 1 file changed, 12 insertions(+), 23 deletions(-) (limited to 'src/Erebos/Storage/Internal.hs') diff --git a/src/Erebos/Storage/Internal.hs b/src/Erebos/Storage/Internal.hs index a61e705..116d7fa 100644 --- a/src/Erebos/Storage/Internal.hs +++ b/src/Erebos/Storage/Internal.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} - module Erebos.Storage.Internal where import Codec.Compression.Zlib @@ -38,8 +36,8 @@ import System.INotify (INotify) import System.IO import System.IO.Error import System.IO.Unsafe (unsafePerformIO) -import System.Posix.Files -import System.Posix.IO + +import Erebos.Storage.Platform data Storage' c = Storage @@ -230,16 +228,7 @@ refPath spath rdgst = intercalate "/" [spath, "objects", BC.unpack alg, pref, re openLockFile :: FilePath -> IO Handle openLockFile path = do createDirectoryIfMissing True (takeDirectory path) - fd <- retry 10 $ -#if MIN_VERSION_unix(2,8,0) - openFd path WriteOnly defaultFileFlags - { creat = Just $ unionFileModes ownerReadMode ownerWriteMode - , exclusive = True - } -#else - openFd path WriteOnly (Just $ unionFileModes ownerReadMode ownerWriteMode) (defaultFileFlags { exclusive = True }) -#endif - fdToHandle fd + retry 10 $ createFileExclusive path where retry :: Int -> IO a -> IO a retry 0 act = act @@ -249,34 +238,34 @@ openLockFile path = do writeFileOnce :: FilePath -> BL.ByteString -> IO () writeFileOnce file content = bracket (openLockFile locked) hClose $ \h -> do - fileExist file >>= \case - True -> removeLink locked + doesFileExist file >>= \case + True -> removeFile locked False -> do BL.hPut h content hFlush h - rename locked file + renameFile locked file where locked = file ++ ".lock" writeFileChecked :: FilePath -> Maybe ByteString -> ByteString -> IO (Either (Maybe ByteString) ()) writeFileChecked file prev content = bracket (openLockFile locked) hClose $ \h -> do - (prev,) <$> fileExist file >>= \case + (prev,) <$> doesFileExist file >>= \case (Nothing, True) -> do current <- B.readFile file - removeLink locked + removeFile locked return $ Left $ Just current (Nothing, False) -> do B.hPut h content hFlush h - rename locked file + renameFile locked file return $ Right () (Just expected, True) -> do current <- B.readFile file if current == expected then do B.hPut h content hFlush h - rename locked file + renameFile locked file return $ return () - else do removeLink locked + else do removeFile locked return $ Left $ Just current (Just _, False) -> do - removeLink locked + removeFile locked return $ Left Nothing where locked = file ++ ".lock" -- cgit v1.2.3