safeio 0.0.3.0 → 0.0.4.0

raw patch · 5 files changed

+70/−32 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog +3/−0
• Data/Conduit/SafeWrite.hs +27/−24
• System/IO/SafeWrite.hs +21/−6
• System/IO/SafeWrite/Tests.hs +15/−0
• safeio.cabal +4/−2

@@ -1,3 +1,6 @@+Version 0.0.4.0 2017-09-07 by luispedro+	* Add atomicConduitUseFile+ Version 0.0.3.0 2017-07-29 by luispedro 	* Fix issue with creating files in separate directories 

@@ -1,19 +1,18 @@ module Data.Conduit.SafeWrite     ( safeSinkFile+    , atomicConduitUseFile     ) where +import qualified Data.ByteString as B import qualified Data.Conduit as C import qualified Data.Conduit.Combinators as CC-import qualified Data.ByteString as B-import           Data.IORef (newIORef, writeIORef, readIORef)-import           System.FilePath (takeDirectory, takeBaseName)-import           System.IO (hClose, openTempFile)-import           System.Directory (renameFile, removeFile)-import           Control.Monad (unless)+import           Data.IORef (newIORef, writeIORef, readIORef, IORef)+import           System.IO (Handle) import           Control.Monad.Trans.Resource-import           Control.Monad.IO.Class (liftIO)+import           Control.Monad (unless)+import           Control.Monad.IO.Class (liftIO, MonadIO(..)) -import           System.IO.SafeWrite (syncFile)+import           System.IO.SafeWrite (allocateTempFile, finalizeTempFile)  -- | Write to file |finalname| using a temporary file and atomic move. --@@ -22,25 +21,29 @@ safeSinkFile :: (MonadResource m) =>                     FilePath -- ^ Final filename                     -> C.Sink B.ByteString m ()-safeSinkFile finalname = C.bracketP+safeSinkFile finalname = atomicConduitUseFile finalname CC.sinkHandle++-- | Conduit using a Handle in an atomic way+atomicConduitUseFile :: (MonadResource m) =>+                    FilePath -- ^ Final filename+                    -> (Handle -> C.ConduitM i o m a) -- ^ Conduit which uses a Handle+                    -> C.ConduitM i o m a+atomicConduitUseFile finalname cond = C.bracketP                             acquire                              deleteTempOnError-                            writeMove+                            action     where-        acquire = do-            (tname, th) <- openTempFile (takeDirectory finalname) (takeBaseName finalname)-            completed <- newIORef False-            return (tname, th, completed)-        writeMove (tname, th, completed) = do-            CC.sinkHandle th+        acquire :: IO ((FilePath, Handle), IORef Bool)+        acquire = ((,) <$> allocateTempFile finalname <*> newIORef False)+        action (tdata@(_, th), completed) = do+            r <- cond th             liftIO $ do-                hClose th-                syncFile tname-                renameFile tname finalname+                finalizeTempFile finalname True tdata                 writeIORef completed True-        deleteTempOnError (tname, th, completed) = do-            completed' <- readIORef completed-            unless completed' $ do-                hClose th-                removeFile tname+            return r+        deleteTempOnError :: ((FilePath, Handle), IORef Bool) -> IO ()+        deleteTempOnError (tdata, completed) = do+            unlessM (readIORef completed) $+                liftIO $ finalizeTempFile finalname False tdata +        unlessM c act = c >>= flip unless act

@@ -1,12 +1,14 @@ module System.IO.SafeWrite     ( withOutputFile     , syncFile+    , allocateTempFile+    , finalizeTempFile     ) where  import           System.FilePath (takeDirectory, takeBaseName) import           System.Posix.IO (openFd, defaultFileFlags, closeFd, OpenMode(..)) import           System.Posix.Unistd (fileSynchronise)-import           Control.Exception (bracket, onException)+import           Control.Exception (bracket, bracketOnError) import           System.IO (Handle, hClose, openTempFile) import           System.Directory (renameFile, removeFile) @@ -37,12 +39,25 @@             FilePath -- ^ Final desired file path             -> (Handle -> IO a) -- ^ action to execute             -> IO a-withOutputFile finalname act = do-    (tname, th) <- openTempFile (takeDirectory finalname) (takeBaseName finalname)-    (do-        r <- act th+withOutputFile finalname act =+    bracketOnError+        (allocateTempFile finalname)+        (finalizeTempFile finalname False)+        (\tdata@(_, th) -> do+            r <- act th+            finalizeTempFile finalname True tdata+            return r)++allocateTempFile :: FilePath -> IO (FilePath, Handle)+allocateTempFile finalname = openTempFile (takeDirectory finalname) (takeBaseName finalname)++finalizeTempFile :: FilePath -> Bool -> (FilePath, Handle) -> IO ()+finalizeTempFile finalname ok (tname, th)+    | ok = do         hClose th         syncFile tname         renameFile tname finalname-        return r) `onException` (hClose th >> removeFile tname)+    | otherwise = do+        hClose th+        removeFile tname 

@@ -6,7 +6,9 @@ import           Test.HUnit import           Test.Framework.Providers.HUnit +import qualified Data.ByteString as B import qualified Data.Conduit as C+import qualified Data.Conduit.Combinators as CC import           Data.Conduit ((.|)) import           Control.Monad.IO.Class (liftIO) import           Control.Exception (throwIO)@@ -68,6 +70,18 @@     (doesFileExist outname) >>= assertBool "Output file was not created"     removeFile outname +case_conduit_create_output_pass = do+        C.runConduitRes $+            C.yield "Hello World"+                .| atomicConduitUseFile outname writeout+                .| CC.sinkNull+        (doesFileExist outname) >>= assertBool "Output file was not created"+        removeFile outname+    where+        writeout h = C.awaitForever $ \line -> do+            C.yield line+            liftIO $ B.hPutStrLn h (B.take 8 line)+ case_conduit_not_create_on_exception = do     (C.runConduitRes $         (do@@ -76,6 +90,7 @@             ) .| safeSinkFile outname         ) `catchIOError` \_ -> return ()     (not <$> doesFileExist outname) >>= assertBool "Output file was created despite exception being raised"+  case_conduit_no_intermediate_output = do     C.runConduitRes $

@@ -1,5 +1,5 @@ name:               safeio-version:            0.0.3.0+version:            0.0.4.0 synopsis:           Write output to disk atomically description:        This package implements utilities to perform atomic output                     so as to avoid the problem of partial intermediate files.@@ -32,7 +32,9 @@   default-language: Haskell2010   type: exitcode-stdio-1.0   main-is: System/IO/SafeWrite/Tests.hs-  other-modules: System.IO.SafeWrite+  other-modules:+        System.IO.SafeWrite+        Data.Conduit.SafeWrite   ghc-options: -Wall   hs-source-dirs: .   build-depends: