[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 (file)
--- 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 (file)
--- 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 (file)
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))))