[project @ 2001-08-21 09:03:32 by rrt]

[ghc-hetmet.git] / ghc / utils / ghc-pkg / Main.hs

diff --git a/ghc/utils/ghc-pkg/Main.hs b/ghc/utils/ghc-pkg/Main.hs
index 139ce87..9d922e9 100644 (file)
--- a/ghc/utils/ghc-pkg/Main.hs
+++ b/ghc/utils/ghc-pkg/Main.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.8 2001/03/27 14:10:34 simonmar Exp $
+-- $Id: Main.hs,v 1.13 2001/08/21 09:03:32 rrt Exp $
 --
 -- Package management tool
 -----------------------------------------------------------------------------
@@ -18,6 +18,12 @@ import Directory
 import System
 import IO
 
+#include "../includes/config.h"
+
+#ifdef mingw32_TARGET_OS
+import Win32DLL
+#endif
+
 main = do
   args <- getArgs
 
@@ -48,12 +54,25 @@ flags = [
        "Remove an installed package"
   ]
 
+#ifdef mingw32_TARGET_OS
+subst a b ls = map (\ x -> if x == a then b else x) ls
+
+unDosifyPath xs = subst '\\' '/' xs
+#endif
+
 runit clis = do
   conf_file <- 
      case [ f | Config f <- clis ] of
-        []  -> die "missing -f option, location of package.conf unknown"
-        [f] -> return f
-        _   -> die (usageInfo usageHeader flags)
+        fs@(_:_)  -> return (last fs)
+#ifndef mingw32_TARGET_OS
+       [] -> die "missing -f option, location of package.conf unknown"
+#else
+       [] -> do h <- getModuleHandle Nothing
+                n <- getModuleFileName h
+--              return (reverse (tail (dropWhile (not . isSlash) 
+                return (reverse (drop (length "/bin/ghc-pkg.exe") (reverse (unDosifyPath n))) ++ "/package.conf")
+--                        (reverse (unDosifyPath n)))) ++ "/package.conf")
+#endif
 
   let toField "import_dirs"     = return import_dirs
       toField "source_dirs"     = return source_dirs
@@ -86,7 +105,6 @@ listPackages :: [PackageConfig] -> IO ()
 listPackages details = do 
   hPutStr stdout (listPkgs details)
   hPutChar stdout '\n'
-  exitWith ExitSuccess
 
 showPackage :: [PackageConfig] -> FilePath -> String
         -> [PackageConfig->[String]] -> IO ()
@@ -110,9 +128,8 @@ addPackage details pkgconf = do
        then die ("package `" ++ name new_pkg ++ "' already installed")
        else do
   savePackageConfig pkgconf
-  maybeRestoreOldConfig pkgconf $ do
-  writeNewConfig pkgconf (details ++ [new_pkg])
-  exitWith ExitSuccess
+  maybeRestoreOldConfig pkgconf $
+    writeNewConfig pkgconf (details ++ [new_pkg])
 
 removePackage :: [PackageConfig] -> FilePath -> String -> IO ()
 removePackage details pkgconf pkg = do  
@@ -121,9 +138,8 @@ removePackage details pkgconf pkg = do
        then die ("package `" ++ pkg ++ "' not installed")
        else do
   savePackageConfig pkgconf
-  maybeRestoreOldConfig pkgconf $ do
-  writeNewConfig pkgconf (filter ((/= pkg) . name) details)
-  exitWith ExitSuccess
+  maybeRestoreOldConfig pkgconf $
+    writeNewConfig pkgconf (filter ((/= pkg) . name) details)
 
 checkConfigAccess :: FilePath -> IO ()
 checkConfigAccess pkgconf = do
@@ -146,7 +162,7 @@ writeNewConfig :: String -> [PackageConfig] -> IO ()
 writeNewConfig conf_file details = do
   hPutStr stdout "Writing new package config file... "
   h <- openFile conf_file WriteMode
-  hPutStr h (dumpPackages details )
+  hPutStrLn h (dumpPackages details)
   hClose h
   hPutStrLn stdout "done."