From 414f810c7c1d9aedeaa45e0998537395e7f4a907 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sat, 29 Jun 2024 16:39:57 +0200
Subject: Move platform-specific code to separate directory

---
 erebos.cabal                        |  9 +++++++--
 src/Erebos/Storage/Internal.hs      | 35 ++++++++++++-----------------------
 src/unix/Erebos/Storage/Platform.hs | 20 ++++++++++++++++++++
 3 files changed, 39 insertions(+), 25 deletions(-)
 create mode 100644 src/unix/Erebos/Storage/Platform.hs

diff --git a/erebos.cabal b/erebos.cabal
index bc3000d..45e6526 100644
--- a/erebos.cabal
+++ b/erebos.cabal
@@ -1,4 +1,4 @@
-Cabal-Version:       2.2
+Cabal-Version:       3.0
 
 Name:                erebos
 Version:             0.1.4
@@ -117,6 +117,7 @@ library
     other-modules:
         Erebos.Flow
         Erebos.Storage.List
+        Erebos.Storage.Platform
         Erebos.Util
 
     c-sources:
@@ -157,10 +158,14 @@ library
         stm >=2.5 && <2.6,
         text >= 1.2 && <2.2,
         time >= 1.8 && <1.14,
-        unix >=2.7 && <2.9,
         uuid >=1.3 && <1.4,
         zlib >=0.6 && <0.8
 
+    if true
+        hs-source-dirs: src/unix
+        build-depends:
+            unix ^>= { 2.7, 2.8 },
+
 executable erebos
     import: common
     default-language:    Haskell2010
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"
diff --git a/src/unix/Erebos/Storage/Platform.hs b/src/unix/Erebos/Storage/Platform.hs
new file mode 100644
index 0000000..2198f61
--- /dev/null
+++ b/src/unix/Erebos/Storage/Platform.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE CPP #-}
+
+module Erebos.Storage.Platform (
+    createFileExclusive,
+) where
+
+import System.IO
+import System.Posix.Files
+import System.Posix.IO
+
+createFileExclusive :: FilePath -> IO Handle
+createFileExclusive path = fdToHandle =<< do
+#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
-- 
cgit v1.2.3