In ghc-pkg, send warnings to stderr

[ghc-hetmet.git] / utils / ghc-pkg / Main.hs

diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs
index ae7aca3..51f1563 100644 (file)
--- a/utils/ghc-pkg/Main.hs
+++ b/utils/ghc-pkg/Main.hs
@@ -52,9 +52,13 @@ import qualified Data.ByteString.Lazy as B
 import qualified Data.Binary as Bin
 import qualified Data.Binary.Get as Bin
 
-#if __GLASGOW_HASKELL__ < 612
+#if __GLASGOW_HASKELL__ < 612 || defined(mingw32_HOST_OS)
+-- mingw32 needs these for getExecDir, GHC <6.12 needs them for openNewFile
 import Foreign
 import Foreign.C
+#endif
+
+#if __GLASGOW_HASKELL__ < 612
 import System.Posix.Internals
 #if __GLASGOW_HASKELL__ >= 611
 import GHC.IO.Handle.FD (fdToHandle)
@@ -568,7 +572,7 @@ readParseDatabase verbosity mb_user_conf use_cache path
               case e_tcache of
                 Left ex -> do
                      when (verbosity > Normal) $
-                        putStrLn ("warning: cannot read cache file " ++ cache ++ ": " ++ show ex)
+                        warn ("warning: cannot read cache file " ++ cache ++ ": " ++ show ex)
                      ignore_cache
                 Right tcache
                   | tcache >= tdir -> do
@@ -579,8 +583,8 @@ readParseDatabase verbosity mb_user_conf use_cache path
                      return PackageDB { location = path, packages = pkgs' }
                   | otherwise -> do
                      when (verbosity >= Normal) $ do
-                        putStrLn ("WARNING: cache is out of date: " ++ cache)
-                        putStrLn "  use 'ghc-pkg recache' to fix."
+                        warn ("WARNING: cache is out of date: " ++ cache)
+                        warn "  use 'ghc-pkg recache' to fix."
                      ignore_cache
             where
                  ignore_cache = do
@@ -729,7 +733,7 @@ changeDBDir verbosity cmds db = do
   do_cmd (AddPackage p) = do
     let file = location db </> display (installedPackageId p) <.> "conf"
     when (verbosity > Normal) $ putStrLn ("writing " ++ file)
-    writeFileAtomic file utf8 (showInstalledPackageInfo p)
+    writeFileUtf8Atomic file (showInstalledPackageInfo p)
   do_cmd (ModifyPackage p) = 
     do_cmd (AddPackage p)
 
@@ -856,7 +860,7 @@ listPackages verbosity my_flags mPackageName mModuleName = do
 
   when (not (null broken) && not simple_output && verbosity /= Silent) $ do
      prog <- getProgramName
-     putStrLn ("WARNING: there are broken packages.  Run '" ++ prog ++ " check' for more details.")
+     warn ("WARNING: there are broken packages.  Run '" ++ prog ++ " check' for more details.")
 
   if simple_output then show_simple stack else do
 
@@ -1151,7 +1155,7 @@ writeNewConfig verbosity filename ipis = do
   let shown = concat $ intersperse ",\n "
                      $ map (show . convertPackageInfoOut) ipis
       fileContents = "[" ++ shown ++ "\n]"
-  writeFileAtomic filename utf8 fileContents
+  writeFileUtf8Atomic filename fileContents
     `catch` \e ->
       if isPermissionError e
       then die (filename ++ ": you don't have permission to modify this file")
@@ -1344,7 +1348,7 @@ checkGHCiLib dirs batch_lib_dir batch_lib_file lib auto_build
   | otherwise  = do
       m <- doesFileExistOnPath ghci_lib_file dirs
       when (isNothing m && ghci_lib_file /= "HSrts.o") $
-        hPutStrLn stderr ("warning: can't find GHCi lib " ++ ghci_lib_file)
+        warn ("warning: can't find GHCi lib " ++ ghci_lib_file)
  where
     ghci_lib_file = lib <.> "o"
 
@@ -1451,6 +1455,11 @@ dieOrForceAll :: Force -> String -> IO ()
 dieOrForceAll ForceAll s = ignoreError s
 dieOrForceAll _other s   = dieForcible s
 
+warn :: String -> IO ()
+warn s = do
+  hFlush stdout
+  hPutStrLn stderr s
+
 ignoreError :: String -> IO ()
 ignoreError s = reportError (s ++ " (ignoring)")
 
@@ -1557,10 +1566,12 @@ writeBinaryFileAtomic targetFile obj =
      hSetBinaryMode h True
      B.hPutStr h (Bin.encode obj)
 
-writeFileAtomic :: FilePath -> TextEncoding -> String -> IO ()
-writeFileAtomic targetFile encoding content =
+writeFileUtf8Atomic :: FilePath -> String -> IO ()
+writeFileUtf8Atomic targetFile content =
   withFileAtomic targetFile $ \h -> do
-     hSetEncoding h encoding
+#if __GLASGOW_HASKELL__ >= 612
+     hSetEncoding h utf8
+#endif
      hPutStr h content
 
 -- copied from Cabal's Distribution.Simple.Utils, except that we want