-----------------------------------------------------------------------------
--- $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
--
--
-----------------------------------------------------------------------------
-module PackageMaintenance where
+module PackageMaintenance
+ ( listPackages, newPackage, deletePackage
+ ) where
import CmStaticInfo
import DriverState
import DriverUtil
+import Panic
import Exception
import IOExts
listPackages :: IO ()
listPackages = do
- details <- readIORef package_details
+ details <- readIORef v_Package_details
hPutStr stdout (listPkgs details)
hPutChar stdout '\n'
exitWith ExitSuccess
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
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])
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))
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"))
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
)
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
-- 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."
-----------------------------------------------------------------------------