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           Data.IORef (newIORef, writeIORef, readIORef, IORef)
import           System.IO (Handle)
import           Control.Monad.Trans.Resource
import           Control.Monad (unless)
import           Control.Monad.IO.Class (liftIO, MonadIO(..))

import           System.IO.SafeWrite (allocateTempFile, finalizeTempFile)

-- | 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.
--
-- This function is deprecated in favor of 'Data.Conduit.Binary.SinkFileCautious'
safeSinkFile :: (MonadResource m) =>
                    FilePath -- ^ Final filename
                    -> C.ConduitT B.ByteString C.Void m ()
safeSinkFile :: forall (m :: * -> *).
MonadResource m =>
FilePath -> ConduitT ByteString Void m ()
safeSinkFile FilePath
finalname = forall (m :: * -> *) i o a.
MonadResource m =>
FilePath -> (Handle -> ConduitM i o m a) -> ConduitM i o m a
atomicConduitUseFile FilePath
finalname forall (m :: * -> *) o.
MonadIO m =>
Handle -> ConduitT ByteString o m ()
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 :: forall (m :: * -> *) i o a.
MonadResource m =>
FilePath -> (Handle -> ConduitM i o m a) -> ConduitM i o m a
atomicConduitUseFile FilePath
finalname Handle -> ConduitM i o m a
cond = forall (m :: * -> *) a i o r.
MonadResource m =>
IO a -> (a -> IO ()) -> (a -> ConduitT i o m r) -> ConduitT i o m r
C.bracketP
                            IO ((FilePath, Handle), IORef Bool)
acquire 
                            ((FilePath, Handle), IORef Bool) -> IO ()
deleteTempOnError
                            ((FilePath, Handle), IORef Bool) -> ConduitM i o m a
action
    where
        acquire :: IO ((FilePath, Handle), IORef Bool)
        acquire :: IO ((FilePath, Handle), IORef Bool)
acquire = ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (FilePath, Handle)
allocateTempFile FilePath
finalname forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (IORef a)
newIORef Bool
False)
        action :: ((FilePath, Handle), IORef Bool) -> ConduitM i o m a
action (tdata :: (FilePath, Handle)
tdata@(FilePath
_, Handle
th), IORef Bool
completed) = do
            a
r <- Handle -> ConduitM i o m a
cond Handle
th
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
                FilePath -> Bool -> (FilePath, Handle) -> IO ()
finalizeTempFile FilePath
finalname Bool
True (FilePath, Handle)
tdata
                forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
completed Bool
True
            forall (m :: * -> *) a. Monad m => a -> m a
return a
r
        deleteTempOnError :: ((FilePath, Handle), IORef Bool) -> IO ()
        deleteTempOnError :: ((FilePath, Handle), IORef Bool) -> IO ()
deleteTempOnError ((FilePath, Handle)
tdata, IORef Bool
completed) = do
            forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
unlessM (forall a. IORef a -> IO a
readIORef IORef Bool
completed) forall a b. (a -> b) -> a -> b
$
                forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> Bool -> (FilePath, Handle) -> IO ()
finalizeTempFile FilePath
finalname Bool
False (FilePath, Handle)
tdata

        unlessM :: m Bool -> m () -> m ()
unlessM m Bool
c m ()
act = m Bool
c forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless m ()
act