Add rewriteFileLBS and use it to write setup wrapper

Cabal/Distribution/Simple/Utils.hs

@@ -125,6 +125,7 @@ module Distribution.Simple.Utils (
         withFileContents,
         writeFileAtomic,
         rewriteFileEx,
+        rewriteFileLBS,
 
         -- * Unicode
         fromUTF8BS,
@@ -799,7 +800,7 @@ createProcessWithEnv verbosity path args mcwd menv inp out err = withFrozenCallS
 --
 -- The output is assumed to be text in the locale encoding.
 --
-rawSystemStdout :: forall mode. KnownIODataMode mode => Verbosity -> FilePath -> [String] -> IO mode 
+rawSystemStdout :: forall mode. KnownIODataMode mode => Verbosity -> FilePath -> [String] -> IO mode
 rawSystemStdout verbosity path args = withFrozenCallStack $ do
   (output, errors, exitCode) <- rawSystemStdInOut verbosity path args
     Nothing Nothing Nothing (IOData.iodataMode :: IODataMode mode)
@@ -1380,21 +1381,25 @@ withTempDirectoryEx _verbosity opts targetDir template f = withFrozenCallStack $
 --     ASCII-representable. Since Cabal-3.0 the file is assumed to be
 --     UTF-8 encoded.
 rewriteFileEx :: Verbosity -> FilePath -> String -> IO ()
-rewriteFileEx verbosity path newContent =
+rewriteFileEx verbosity path =
+  rewriteFileLBS verbosity path . toUTF8LBS
+
+-- | Same as `rewriteFileEx` but for 'ByteString's.
+rewriteFileLBS :: Verbosity -> FilePath -> BS.ByteString -> IO ()
+rewriteFileLBS verbosity path newContent =
   flip catchIO mightNotExist $ do
     existingContent <- annotateIO verbosity $ BS.readFile path
     _ <- evaluate (BS.length existingContent)
-    unless (existingContent == newContent') $
+    unless (existingContent == newContent) $
       annotateIO verbosity $
-        writeFileAtomic path newContent'
+        writeFileAtomic path newContent
   where
-    newContent' = toUTF8LBS newContent
-
     mightNotExist e | isDoesNotExistError e
-                    = annotateIO verbosity $ writeFileAtomic path newContent'
+                    = annotateIO verbosity $ writeFileAtomic path newContent
                     | otherwise
                     = ioError e
 
+
 -- | The path name that represents the current directory.
 -- In Unix, it's @\".\"@, but this is system-specific.
 -- (E.g. AmigaOS uses the empty string @\"\"@ for the current directory.)

cabal-install/Distribution/Client/SetupWrapper.hs

@@ -1,5 +1,6 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE CPP               #-}
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE OverloadedStrings #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Distribution.Client.SetupWrapper
@@ -87,7 +88,7 @@ import Distribution.Simple.Utils
          ( die', debug, info, infoNoWrap
          , cabalVersion, tryFindPackageDesc, comparing
          , createDirectoryIfMissingVerbose, installExecutableFile
-         , copyFileVerbose, rewriteFileEx )
+         , copyFileVerbose, rewriteFileEx, rewriteFileLBS )
 import Distribution.Client.Utils
          ( inDir, tryCanonicalizePath, withExtraPathEnv
          , existsAndIsMoreRecentThan, moreRecentFile, withEnv, withEnvOverrides
@@ -118,6 +119,8 @@ import qualified System.Process as Process
 import Data.List           ( foldl1' )
 import Distribution.Client.Compat.ExecutablePath  ( getExecutablePath )
 
+import qualified Data.ByteString.Lazy as BS
+
 #ifdef mingw32_HOST_OS
 import Distribution.Simple.Utils
          ( withTempDirectory )
@@ -702,17 +705,15 @@ getExternalSetupMethod verbosity options pkg bt = do
       customSetupLhs  = workingDir options </> "Setup.lhs"
 
   updateSetupScript cabalLibVersion _ =
-    rewriteFileEx verbosity setupHs (buildTypeScript cabalLibVersion)
+    rewriteFileLBS verbosity setupHs (buildTypeScript cabalLibVersion)
 
-  buildTypeScript :: Version -> String
+  buildTypeScript :: Version -> BS.ByteString
   buildTypeScript cabalLibVersion = case bt of
-    Simple    -> "import Distribution.Simple; main = defaultMain\n"
-    Configure -> "import Distribution.Simple; main = defaultMainWithHooks "
-              ++ if cabalLibVersion >= mkVersion [1,3,10]
-                   then "autoconfUserHooks\n"
-                   else "defaultUserHooks\n"
-    Make      -> "import Distribution.Make; main = defaultMain\n"
-    Custom    -> error "buildTypeScript Custom"
+    Simple                                            -> "import Distribution.Simple; main = defaultMain\n"
+    Configure | cabalLibVersion >= mkVersion [1,3,10] -> "import Distribution.Simple; main = defaultMainWithHooks autoconfUserHooks\n"
+              | otherwise                             -> "import Distribution.Simple; main = defaultMainWithHooks defaultUserHooks\n"
+    Make                                              -> "import Distribution.Make; main = defaultMain\n"
+    Custom                                            -> error "buildTypeScript Custom"
 
   installedCabalVersion :: SetupScriptOptions -> Compiler -> ProgramDb
                         -> IO (Version, Maybe InstalledPackageId
@@ -905,7 +906,7 @@ getExternalSetupMethod verbosity options pkg bt = do
       let ghcCmdLine = renderGhcOptions compiler platform ghcOptions
       when (useVersionMacros options') $
         rewriteFileEx verbosity cppMacrosFile
-            (generatePackageVersionMacros (pkgVersion $ package pkg) (map snd selectedDeps))
+          $ generatePackageVersionMacros (pkgVersion $ package pkg) (map snd selectedDeps)
       case useLoggingHandle options of
         Nothing          -> runDbProgram verbosity program progdb ghcCmdLine