From: simonmar Date: Thu, 15 Mar 2001 15:53:28 +0000 (+0000) Subject: [project @ 2001-03-15 15:53:28 by simonmar] X-Git-Tag: Approximately_9120_patches~2397 X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=6c42179eb1c7e0643485f99b4b6e24b213c1fa90 [project @ 2001-03-15 15:53:28 by simonmar] Remove package management support into a separate tool (ghc-pkg), and don't duplicate the definition of PackageConfig. --- diff --git a/ghc/compiler/compMan/CmStaticInfo.lhs b/ghc/compiler/compMan/CmStaticInfo.lhs index aac3eaf..0c310f8 100644 --- a/ghc/compiler/compMan/CmStaticInfo.lhs +++ b/ghc/compiler/compMan/CmStaticInfo.lhs @@ -15,35 +15,5 @@ where data GhciMode = Batch | Interactive | OneShot deriving Eq -data PackageConfig - = PackageConfig { - name :: String, - import_dirs :: [String], - source_dirs :: [String], - library_dirs :: [String], - hs_libraries :: [String], - extra_libraries :: [String], - include_dirs :: [String], - c_includes :: [String], - package_deps :: [String], - extra_ghc_opts :: [String], - extra_cc_opts :: [String], - extra_ld_opts :: [String] - } - -defaultPackageConfig - = PackageConfig { - name = error "defaultPackage", - import_dirs = [], - source_dirs = [], - library_dirs = [], - hs_libraries = [], - extra_libraries = [], - include_dirs = [], - c_includes = [], - package_deps = [], - extra_ghc_opts = [], - extra_cc_opts = [], - extra_ld_opts = [] - } +#include "../utils/ghc-pkg/Package.hs" \end{code} diff --git a/ghc/compiler/main/DriverFlags.hs b/ghc/compiler/main/DriverFlags.hs index c503066..d080ab7 100644 --- a/ghc/compiler/main/DriverFlags.hs +++ b/ghc/compiler/main/DriverFlags.hs @@ -1,7 +1,7 @@ {-# OPTIONS -#include "hschooks.h" #-} ----------------------------------------------------------------------------- --- $Id: DriverFlags.hs,v 1.48 2001/03/12 14:06:47 simonpj Exp $ +-- $Id: DriverFlags.hs,v 1.49 2001/03/15 15:53:28 simonmar Exp $ -- -- Driver flags -- @@ -20,7 +20,6 @@ module DriverFlags ( #include "HsVersions.h" -import PackageMaintenance import DriverState import DriverUtil import TmpFiles ( v_TmpDir, kludgedSystem ) @@ -241,10 +240,6 @@ static_flags = , ( "package" , HasArg (addPackage) ) , ( "syslib" , HasArg (addPackage) ) -- for compatibility w/ old vsns - , ( "-list-packages" , NoArg (listPackages) ) - , ( "-add-package" , NoArg (newPackage) ) - , ( "-delete-package" , SepArg (deletePackage) ) - ------- Specific phases -------------------------------------------- , ( "pgmL" , HasArg (writeIORef v_Pgm_L) ) , ( "pgmP" , HasArg (writeIORef v_Pgm_P) ) diff --git a/ghc/compiler/main/PackageMaintenance.hs b/ghc/compiler/main/PackageMaintenance.hs deleted file mode 100644 index 0abf5c1..0000000 --- a/ghc/compiler/main/PackageMaintenance.hs +++ /dev/null @@ -1,139 +0,0 @@ ------------------------------------------------------------------------------ --- $Id: PackageMaintenance.hs,v 1.10 2001/03/12 14:06:47 simonpj Exp $ --- --- GHC Driver program --- --- (c) Simon Marlow 2000 --- ------------------------------------------------------------------------------ - -module PackageMaintenance - ( listPackages, newPackage, deletePackage - ) where - -import CmStaticInfo -import DriverState -import TmpFiles -import Panic - -import Exception -import IOExts -import Pretty - -import IO -import Directory -import System -import Monad - ------------------------------------------------------------------------------ --- Package maintenance - -listPackages :: IO () -listPackages = do - details <- readIORef v_Package_details - hPutStr stdout (listPkgs details) - hPutChar stdout '\n' - exitWith ExitSuccess - -newPackage :: IO () -newPackage = do - error "wibble" {- - checkConfigAccess - details <- readIORef v_Package_details - hPutStr stdout "Reading package info from stdin... " - stuff <- getContents - let new_pkg = read stuff :: PackageConfig - catchAll new_pkg - (\_ -> throwDyn (OtherError "parse error in package info")) - hPutStrLn stdout "done." - if (name new_pkg `elem` map name details) - then throwDyn (OtherError ("package `" ++ name new_pkg ++ - "' already installed")) - else do - conf_file <- readIORef v_Path_package_config - savePackageConfig conf_file - maybeRestoreOldConfig conf_file $ do - writeNewConfig conf_file ( ++ [new_pkg]) - exitWith ExitSuccess --} - -deletePackage :: String -> IO () -deletePackage pkg = do - checkConfigAccess - details <- readIORef v_Package_details - if (pkg `notElem` map name details) - then throwDyn (OtherError ("package `" ++ pkg ++ "' not installed")) - else do - conf_file <- readIORef v_Path_package_config - savePackageConfig conf_file - maybeRestoreOldConfig conf_file $ do - writeNewConfig conf_file (filter ((/= pkg) . name)) - exitWith ExitSuccess - -checkConfigAccess :: IO () -checkConfigAccess = do - 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")) - -maybeRestoreOldConfig :: String -> IO () -> IO () -maybeRestoreOldConfig conf_file io - = catchAllIO io (\e -> do - 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" - hPutStrLn stdout "done." - throw e - ) - -writeNewConfig :: String -> ([PackageConfig] -> [PackageConfig]) -> IO () -writeNewConfig conf_file fn = do - hPutStr stdout "Writing new package config file... " - old_details <- readIORef v_Package_details - h <- openFile conf_file WriteMode - hPutStr h (dumpPackages (fn old_details)) - hClose h - hPutStrLn stdout "done." - -savePackageConfig :: String -> IO () -savePackageConfig conf_file = do - hPutStr stdout "Saving old package config file... " - -- 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" - hPutStrLn stdout "done." - ------------------------------------------------------------------------------ --- Pretty printing package info - -listPkgs :: [PackageConfig] -> String -listPkgs pkgs = render (fsep (punctuate comma (map (text . name) pkgs))) - -dumpPackages :: [PackageConfig] -> String -dumpPackages pkgs = - render (brackets (vcat (punctuate comma (map dumpPkgGuts pkgs)))) - -dumpPkgGuts :: PackageConfig -> Doc -dumpPkgGuts pkg = - text "Package" $$ nest 3 (braces ( - sep (punctuate comma [ - text "name = " <> text (show (name pkg)), - dumpField "import_dirs" (import_dirs pkg), - dumpField "library_dirs" (library_dirs pkg), - dumpField "hs_libraries" (hs_libraries pkg), - dumpField "extra_libraries" (extra_libraries pkg), - dumpField "include_dirs" (include_dirs pkg), - dumpField "c_includes" (c_includes pkg), - dumpField "package_deps" (package_deps pkg), - dumpField "extra_ghc_opts" (extra_ghc_opts pkg), - dumpField "extra_cc_opts" (extra_cc_opts pkg), - dumpField "extra_ld_opts" (extra_ld_opts pkg) - ]))) - -dumpField :: String -> [String] -> Doc -dumpField name val = - hang (text name <+> equals) 2 - (brackets (sep (punctuate comma (map (text . show) val))))