diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,2 +1,5 @@ +Version 0.0.2.0 2017-05-30 by luispedro + * Add conduit version + Version 0.0.1.0 2017-05-29 by luispedro * First version diff --git a/Data/Conduit/SafeWrite.hs b/Data/Conduit/SafeWrite.hs new file mode 100644 --- /dev/null +++ b/Data/Conduit/SafeWrite.hs @@ -0,0 +1,46 @@ +module Data.Conduit.SafeWrite + ( safeSinkFile + ) where + +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) +import System.IO (hClose, openTempFile) +import System.Directory (renameFile, removeFile) +import Control.Monad (unless) +import Control.Monad.Trans.Resource +import Control.Monad.IO.Class (liftIO) + +import System.IO.SafeWrite (syncFile) + +-- | Write to file |finalname| using a temporary file and atomic move. +-- +-- The file is only written if the sink runs to completion without errors. Any +-- form of early termination will cause the output to be removed. +safeSinkFile :: (MonadResource m) => + FilePath -- ^ Final filename + -> C.Sink B.ByteString m () +safeSinkFile finalname = C.bracketP + acquire + deleteTempOnError + writeMove + where + acquire = do + (tname, th) <- openTempFile (takeDirectory finalname) finalname + completed <- newIORef False + return (tname, th, completed) + writeMove (tname, th, completed) = do + CC.sinkHandle th + liftIO $ do + hClose th + syncFile tname + renameFile tname finalname + writeIORef completed True + deleteTempOnError (tname, th, completed) = do + completed' <- readIORef completed + unless completed' $ do + hClose th + removeFile tname + diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -8,15 +8,30 @@ 3. Close and sync the file. 4. Atomically rename the file to its final destination. + ## Example +Direct use: + import System.IO.SafeWrite ... main = do withOutputFile "output.txt" $ \hout -> do hPutStrLn hout "Hello World" +Through [conduit](https://www.stackage.org/package/conduit): + import qualified Data.Conduit as C + import Data.Conduit ((.|)) + import Data.Conduit.SafeWrite + + main = C.runConduitRes $ + C.yield "Hello World" .| safeSinkFile "hello.txt" + +In any case, only successful termination of the process will result in the +output file being written. Early termination by throwing an exception will +cause the temporary file to be removed and no output will be produced. + ## Author -Luis Pedro Coelho [Email](mailto:luis@luispedro.org) +Luis Pedro Coelho | [Email](mailto:luis@luispedro.org) | [Twitter](https://twitter.com/luispedrocoelho) diff --git a/System/IO/SafeWrite/Tests.hs b/System/IO/SafeWrite/Tests.hs --- a/System/IO/SafeWrite/Tests.hs +++ b/System/IO/SafeWrite/Tests.hs @@ -1,17 +1,21 @@ -{-# LANGUAGE TemplateHaskell, QuasiQuotes #-} +{-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes #-} module Main where -import Test.Framework.TH -import Test.HUnit -import Test.Framework.Providers.HUnit +import Test.Framework.TH +import Test.HUnit +import Test.Framework.Providers.HUnit -import Control.Exception (throwIO) -import System.IO.Error (isDoesNotExistError, catchIOError) -import System.Directory (doesFileExist, removeFile) -import System.IO (hPutStrLn) +import qualified Data.Conduit as C +import Data.Conduit ((.|)) +import Control.Monad.IO.Class (liftIO) +import Control.Exception (throwIO) +import System.IO.Error (isDoesNotExistError, catchIOError) +import System.Directory (doesFileExist, removeFile) +import System.IO (hPutStrLn) import System.IO.SafeWrite +import Data.Conduit.SafeWrite main :: IO () main = do @@ -39,3 +43,36 @@ throwIO $ userError "Something bad happened") `catchIOError` \_ -> return () (not <$> doesFileExist outname) >>= assertBool "Output file was created despite exception being raised" +case_no_intermediate_output = do + withOutputFile outname $ \h -> do + hPutStrLn h "Hello Worlld" + partial <- doesFileExist outname + assertBool "Partial file should not exist before internal action ends" (not partial) + (doesFileExist outname) >>= assertBool "Output file was not created" + removeFile outname + +case_conduit_create_output = do + C.runConduitRes $ + C.yield "Hello World" .| safeSinkFile outname + (doesFileExist outname) >>= assertBool "Output file was not created" + removeFile outname + +case_conduit_not_create_on_exception = do + (C.runConduitRes $ + (do + C.yield "Hello World" + liftIO . throwIO $ userError "Something bad happened" + ) .| safeSinkFile outname + ) `catchIOError` \_ -> return () + (not <$> doesFileExist outname) >>= assertBool "Output file was created despite exception being raised" + +case_conduit_no_intermediate_output = do + C.runConduitRes $ + (do + C.yield "Hello World" + liftIO $ do + partial <- doesFileExist outname + assertBool "Partial file should not exist before conduit upstream ends" (not partial) + ) .| safeSinkFile outname + (doesFileExist outname) >>= assertBool "Output file was not created at the end of conduit processing" + removeFile outname diff --git a/safeio.cabal b/safeio.cabal --- a/safeio.cabal +++ b/safeio.cabal @@ -1,5 +1,5 @@ name: safeio -version: 0.0.1.0 +version: 0.0.2.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. @@ -15,12 +15,17 @@ library default-language: Haskell2010 - exposed-modules: System.IO.SafeWrite + exposed-modules: System.IO.SafeWrite, + Data.Conduit.SafeWrite ghc-options: -Wall build-depends: base > 4 && < 5, + bytestring, + conduit >= 1.0, + conduit-combinators, directory, filepath, + resourcet, unix Test-Suite safeiotest @@ -32,8 +37,13 @@ hs-source-dirs: . build-depends: base > 4 && < 5, + base > 4 && < 5, + bytestring, + conduit >= 1.0, + conduit-combinators, directory, filepath, + resourcet, unix, HUnit, test-framework,