[project @ 2001-03-01 17:07:49 by simonpj]
[ghc-hetmet.git] / ghc / compiler / main / PackageMaintenance.hs
index 7d93662..bd296d4 100644 (file)
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: PackageMaintenance.hs,v 1.1 2000/10/11 11:54:58 simonmar Exp $
+-- $Id: PackageMaintenance.hs,v 1.6 2000/12/18 20:42:14 qrczak Exp $
 --
 -- GHC Driver program
 --
@@ -7,11 +7,14 @@
 --
 -----------------------------------------------------------------------------
 
-module PackageMaintenance where
+module PackageMaintenance 
+     ( listPackages, newPackage, deletePackage 
+     ) where
 
 import CmStaticInfo
 import DriverState
 import DriverUtil
+import Panic
 
 import Exception
 import IOExts
@@ -27,7 +30,7 @@ import Monad
 
 listPackages :: IO ()
 listPackages = do 
-  details <- readIORef package_details
+  details <- readIORef v_Package_details
   hPutStr stdout (listPkgs details)
   hPutChar stdout '\n'
   exitWith ExitSuccess
@@ -35,7 +38,7 @@ listPackages = do
 newPackage :: IO ()
 newPackage = do
   checkConfigAccess
-  details <- readIORef package_details
+  details <- readIORef v_Package_details
   hPutStr stdout "Reading package info from stdin... "
   stuff <- getContents
   let new_pkg = read stuff :: Package
@@ -46,7 +49,7 @@ newPackage = do
        then throwDyn (OtherError ("package `" ++ name new_pkg ++ 
                                        "' already installed"))
        else do
-  conf_file <- readIORef package_config
+  conf_file <- readIORef v_Path_package_config
   savePackageConfig conf_file
   maybeRestoreOldConfig conf_file $ do
   writeNewConfig conf_file ( ++ [new_pkg])
@@ -55,11 +58,11 @@ newPackage = do
 deletePackage :: String -> IO ()
 deletePackage pkg = do  
   checkConfigAccess
-  details <- readIORef package_details
+  details <- readIORef v_Package_details
   if (pkg `notElem` map name details)
        then throwDyn (OtherError ("package `" ++ pkg ++ "' not installed"))
        else do
-  conf_file <- readIORef package_config
+  conf_file <- readIORef v_Path_package_config
   savePackageConfig conf_file
   maybeRestoreOldConfig conf_file $ do
   writeNewConfig conf_file (filter ((/= pkg) . name))
@@ -67,7 +70,7 @@ deletePackage pkg = do
 
 checkConfigAccess :: IO ()
 checkConfigAccess = do
-  conf_file <- readIORef package_config
+  conf_file <- readIORef v_Path_package_config
   access <- getPermissions conf_file
   unless (writable access)
        (throwDyn (OtherError "you don't have permission to modify the package configuration file"))
@@ -78,7 +81,7 @@ maybeRestoreOldConfig conf_file io
         hPutStr stdout "\nWARNING: an error was encountered while the new \n\ 
                       \configuration was being written.  Attempting to \n\ 
                       \restore the old configuration... "
-        system ("cp " ++ conf_file ++ ".old " ++ conf_file)
+        kludgedSystem ("cp " ++ conf_file ++ ".old " ++ conf_file) "Restoring old configuration"
         hPutStrLn stdout "done."
        throw e
     )
@@ -86,7 +89,7 @@ maybeRestoreOldConfig conf_file io
 writeNewConfig :: String -> ([Package] -> [Package]) -> IO ()
 writeNewConfig conf_file fn = do
   hPutStr stdout "Writing new package config file... "
-  old_details <- readIORef package_details
+  old_details <- readIORef v_Package_details
   h <- openFile conf_file WriteMode
   hPutStr h (dumpPackages (fn old_details))
   hClose h
@@ -98,7 +101,7 @@ savePackageConfig conf_file = do
     -- 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...
-  system ("mv " ++ conf_file ++ " " ++ conf_file ++ ".old")
+  kludgedSystem ("mv " ++ conf_file ++ " " ++ conf_file ++ ".old") "Saving package configuration"
   hPutStrLn stdout "done."
 
 -----------------------------------------------------------------------------