rearrange slightly to make this compile again.
{-# OPTIONS -#include "hschooks.h" #-}
-----------------------------------------------------------------------------
--- $Id: DriverFlags.hs,v 1.46 2001/03/05 10:05:58 simonmar Exp $
+-- $Id: DriverFlags.hs,v 1.47 2001/03/08 09:50:18 simonmar Exp $
--
-- Driver flags
--
import PackageMaintenance
import DriverState
import DriverUtil
-import TmpFiles ( v_TmpDir )
+import TmpFiles ( v_TmpDir, kludgedSystem )
import CmdLineOpts
import Config
import Util
-----------------------------------------------------------------------------
--- $Id: DriverUtil.hs,v 1.18 2001/03/07 10:28:40 rrt Exp $
+-- $Id: DriverUtil.hs,v 1.19 2001/03/08 09:50:18 simonmar Exp $
--
-- Utils for the driver
--
import Util
import Panic
-import TmpFiles ( v_TmpDir )
import IOExts
import Exception
import IO
import System
-import Directory ( removeFile )
import List
import Char
import Monad
remove_spaces :: String -> String
remove_spaces = reverse . dropWhile isSpace . reverse . dropWhile isSpace
-
--- system that works feasibly under Windows (i.e. passes the command line to sh,
--- because system() under Windows doesn't look at SHELL, and always uses CMD.EXE)
-kludgedSystem cmd phase_name
- = do
-#ifndef mingw32_TARGET_OS
- exit_code <- system cmd `catchAllIO`
- (\_ -> throwDyn (PhaseFailed phase_name (ExitFailure 1)))
-#else
- pid <- myGetProcessID
- tmp_dir <- readIORef v_TmpDir
- let tmp = tmp_dir++"/sh"++show pid
- h <- openFile tmp WriteMode
- hPutStrLn h cmd
- hClose h
- exit_code <- system ("sh - " ++ tmp) `catchAllIO`
- (\_ -> removeFile tmp >>
- throwDyn (PhaseFailed phase_name (ExitFailure 1)))
- removeFile tmp
-#endif
- return exit_code
-----------------------------------------------------------------------------
--- $Id: PackageMaintenance.hs,v 1.7 2001/03/06 11:23:46 simonmar Exp $
+-- $Id: PackageMaintenance.hs,v 1.8 2001/03/08 09:50:18 simonmar Exp $
--
-- GHC Driver program
--
import CmStaticInfo
import DriverState
import DriverUtil
+import DriverFlags ( runSomething )
import Panic
import Exception
hPutStr stdout "\nWARNING: an error was encountered while the new \n\
\configuration was being written. Attempting to \n\
\restore the old configuration... "
- kludgedSystem ("cp " ++ conf_file ++ ".old " ++ conf_file) "Restoring old configuration"
+ runSomething ("cp " ++ conf_file ++ ".old " ++ conf_file) "Restoring old configuration"
hPutStrLn stdout "done."
throw e
)
-- mv rather than cp because we've already done an hGetContents
-- on this file so we won't be able to open it for writing
-- unless we move the old one out of the way...
- kludgedSystem ("mv " ++ conf_file ++ " " ++ conf_file ++ ".old") "Saving package configuration"
+ runSomething ("mv " ++ conf_file ++ " " ++ conf_file ++ ".old") "Saving package configuration"
hPutStrLn stdout "done."
-----------------------------------------------------------------------------
-----------------------------------------------------------------------------
--- $Id: TmpFiles.hs,v 1.15 2001/02/12 13:33:47 simonmar Exp $
+-- $Id: TmpFiles.hs,v 1.16 2001/03/08 09:50:18 simonmar Exp $
--
-- Temporary file management
--
newTempName, -- :: Suffix -> IO FilePath
addFilesToClean, -- :: [FilePath] -> IO ()
removeTmpFiles, -- :: Int -> [FilePath] -> IO ()
- v_TmpDir
+ v_TmpDir,
+ kludgedSystem
) where
-- main
+import DriverUtil
import Config
+import Panic
import Util
-import DriverUtil
-- hslibs
import Exception
(\_ -> when verbose (hPutStrLn stderr
("Warning: can't remove tmp file " ++ f)))
mapM_ blowAway fs
+
+
+-- system that works feasibly under Windows (i.e. passes the command line to sh,
+-- because system() under Windows doesn't look at SHELL, and always uses CMD.EXE)
+kludgedSystem cmd phase_name
+ = do
+#ifndef mingw32_TARGET_OS
+ exit_code <- system cmd `catchAllIO`
+ (\_ -> throwDyn (PhaseFailed phase_name (ExitFailure 1)))
+#else
+ pid <- myGetProcessID
+ tmp_dir <- readIORef v_TmpDir
+ let tmp = tmp_dir++"/sh"++show pid
+ h <- openFile tmp WriteMode
+ hPutStrLn h cmd
+ hClose h
+ exit_code <- system ("sh - " ++ tmp) `catchAllIO`
+ (\_ -> removeFile tmp >>
+ throwDyn (PhaseFailed phase_name (ExitFailure 1)))
+ removeFile tmp
+#endif
+ return exit_code