From a0bb273a89f36e348381db91beeaa6f4639467db Mon Sep 17 00:00:00 2001
From: Simon Jakobi <simon.jakobi@gmail.com>
Date: Mon, 2 Dec 2019 16:14:42 +0100
Subject: [PATCH] Use atomic-write for inplace file modifications (#1580)

Fixes #498.
---
 dhall/src/Dhall/Format.hs |  6 ++++--
 dhall/src/Dhall/Freeze.hs |  9 ++++++---
 dhall/src/Dhall/Main.hs   | 35 +++++++++++++++++++----------------
 3 files changed, 29 insertions(+), 21 deletions(-)

diff --git a/dhall/src/Dhall/Format.hs b/dhall/src/Dhall/Format.hs
index 20aafea..d42c0cb 100644
--- a/dhall/src/Dhall/Format.hs
+++ b/dhall/src/Dhall/Format.hs
@@ -23,6 +23,7 @@ import qualified Control.Exception
 import qualified Data.Text.IO
 import qualified Dhall.Pretty
 import qualified Dhall.Util
+import qualified System.AtomicWrite.Writer.LazyText        as AtomicWrite.LazyText
 import qualified System.Console.ANSI
 import qualified System.IO
 
@@ -68,8 +69,9 @@ format (Format {..}) = do
 
             case inplace of
                 InputFile file -> do
-                    System.IO.withFile file System.IO.WriteMode (\handle -> do
-                        Pretty.Terminal.renderIO handle (Pretty.unAnnotateS docStream))
+                    AtomicWrite.LazyText.atomicWriteFile
+                        file
+                        (Pretty.Text.renderLazy docStream)
 
                 StandardInput -> do
                     supportsANSI <- System.Console.ANSI.hSupportsANSI System.IO.stdout
diff --git a/dhall/src/Dhall/Freeze.hs b/dhall/src/Dhall/Freeze.hs
index 9b093dd..9f222da 100644
--- a/dhall/src/Dhall/Freeze.hs
+++ b/dhall/src/Dhall/Freeze.hs
@@ -26,12 +26,14 @@ import qualified Control.Exception
 import qualified Control.Monad.Trans.State.Strict          as State
 import qualified Data.Text.Prettyprint.Doc                 as Pretty
 import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty
+import qualified Data.Text.Prettyprint.Doc.Render.Text     as Pretty.Text
 import qualified Dhall.Core
 import qualified Dhall.Import
 import qualified Dhall.Optics
 import qualified Dhall.Pretty
 import qualified Dhall.TypeCheck
 import qualified Dhall.Util
+import qualified System.AtomicWrite.Writer.LazyText        as AtomicWrite.LazyText
 import qualified System.FilePath
 import qualified System.IO
 
@@ -94,9 +96,10 @@ writeExpr inplace (header, expr) characterSet = do
     let unAnnotated = Pretty.unAnnotateS stream
 
     case inplace of
-        InputFile f ->
-            System.IO.withFile f System.IO.WriteMode (\handle -> do
-                Pretty.renderIO handle unAnnotated)
+        InputFile file ->
+            AtomicWrite.LazyText.atomicWriteFile
+                file
+                (Pretty.Text.renderLazy unAnnotated)
 
         StandardInput -> do
             supportsANSI <- System.Console.ANSI.hSupportsANSI System.IO.stdout
diff --git a/dhall/src/Dhall/Main.hs b/dhall/src/Dhall/Main.hs
index 6d8ce0f..47fce3d 100644
--- a/dhall/src/Dhall/Main.hs
+++ b/dhall/src/Dhall/Main.hs
@@ -55,6 +55,7 @@ import qualified Data.Text
 import qualified Data.Text.IO
 import qualified Data.Text.Prettyprint.Doc                 as Pretty
 import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty
+import qualified Data.Text.Prettyprint.Doc.Render.Text     as Pretty.Text
 import qualified Dhall
 import qualified Dhall.Binary
 import qualified Dhall.Core
@@ -72,6 +73,7 @@ import qualified Dhall.TypeCheck
 import qualified Dhall.Util
 import qualified GHC.IO.Encoding
 import qualified Options.Applicative
+import qualified System.AtomicWrite.Writer.LazyText        as AtomicWrite.LazyText
 import qualified System.Console.ANSI
 import qualified System.Exit                               as Exit
 import qualified System.IO
@@ -500,6 +502,12 @@ command (Options {..}) = do
 
             renderDoc h doc
 
+    let writeDocToFile :: FilePath -> Doc ann -> IO ()
+        writeDocToFile file doc = do
+            let stream = Dhall.Pretty.layout (doc <> "\n")
+
+            AtomicWrite.LazyText.atomicWriteFile file (Pretty.Text.renderLazy stream)
+
     when (not $ ignoreSemanticCache mode) Dhall.Import.warnAboutMissingCaches
 
     handle $ case mode of
@@ -534,8 +542,11 @@ command (Options {..}) = do
 
             case output of
                 StandardOutput -> render System.IO.stdout annotatedExpression
+
                 OutputFile file_ ->
-                    System.IO.withFile file_ System.IO.WriteMode $ \h -> render h annotatedExpression
+                    writeDocToFile
+                        file_
+                        (Dhall.Pretty.prettyCharacterSet characterSet annotatedExpression)
 
         Resolve { resolveMode = Just Dot, ..} -> do
             expression <- getExpression file
@@ -666,23 +677,15 @@ command (Options {..}) = do
         Lint {..} -> do
             (Header header, expression) <- getExpressionAndHeader inplace
 
+            let lintedExpression = Dhall.Lint.lint expression
+
+            let doc =   Pretty.pretty header
+                    <>  Dhall.Pretty.prettyCharacterSet characterSet lintedExpression
+
             case inplace of
-                InputFile file -> do
-                    let lintedExpression = Dhall.Lint.lint expression
+                InputFile file -> writeDocToFile file doc
 
-                    let doc =   Pretty.pretty header
-                            <>  Dhall.Pretty.prettyCharacterSet characterSet lintedExpression
-
-                    System.IO.withFile file System.IO.WriteMode (\h -> do
-                        renderDoc h doc )
-
-                StandardInput -> do
-                    let lintedExpression = Dhall.Lint.lint expression
-
-                    let doc =   Pretty.pretty header
-                            <>  Dhall.Pretty.prettyCharacterSet characterSet lintedExpression
-
-                    renderDoc System.IO.stdout doc
+                StandardInput -> renderDoc System.IO.stdout doc
 
         Encode {..} -> do
             expression <- getExpression file