source/Felix/Output/Atomic.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29

{-# LANGUAGE NoImplicitPrelude #-}

-- | Sibling-temporary replacement for generated byte artifacts.
module Felix.Output.Atomic (writeBytesAtomically) where

import Base

import Data.ByteString (ByteString)
import Data.ByteString qualified as ByteString
import System.Directory qualified as Directory
import System.FilePath.Posix qualified as Posix

writeBytesAtomically :: FilePath -> ByteString -> IO ()
writeBytesAtomically destination bytes = do
    let directory = Posix.takeDirectory destination
        template = Posix.takeFileName destination <> ".tmp"
    bracketOnError
        (openBinaryTempFileWithDefaultPermissions directory template)
        cleanupTemporary
        \(temporary, handle) -> do
            ByteString.hPut handle bytes
            hFlush handle
            hClose handle
            Directory.renameFile temporary destination

cleanupTemporary :: (FilePath, Handle) -> IO ()
cleanupTemporary (temporary, handle) = do
    void (tryIOError (hClose handle))
    void (tryIOError (Directory.removeFile temporary))