[project @ 2005-01-10 12:34:21 by simonmar]
[ghc-hetmet.git] / ghc / utils / ghc-pkg / Main.hs
index 466806a..0bc8d44 100644 (file)
@@ -23,8 +23,10 @@ import Distribution.ParseUtils       ( showError )
 import Distribution.Package
 import Distribution.Version
 import Compat.Directory        ( getAppUserDataDirectory )
+import Compat.RawSystem        ( rawSystem )
 import Control.Exception       ( evaluate )
 import qualified Control.Exception as Exception
+import System.FilePath         ( joinFileName, splitFileName )
 
 import Prelude
 
@@ -46,14 +48,11 @@ import Data.Char    ( isSpace )
 import Monad
 import Directory
 import System  ( getArgs, getProgName,
-                 system, exitWith,
-                 ExitCode(..)
+                 exitWith, ExitCode(..)
                )
 import System.IO
 import Data.List ( isPrefixOf, isSuffixOf, intersperse )
 
-#include "../../includes/ghcconfig.h"
-
 #ifdef mingw32_HOST_OS
 import Foreign
 
@@ -77,7 +76,7 @@ main = do
           bye (usageInfo (usageHeader prog) flags)
        (cli,_,[]) | FlagVersion `elem` cli ->
           bye ourCopyright
-       (cli@(_:_),nonopts,[]) ->
+       (cli,nonopts,[]) ->
           runit cli nonopts
        (_,_,errors) -> tryOldCmdLine errors args
 
@@ -574,8 +573,8 @@ checkHSLib dirs auto_ghci_libs force lib = do
   let batch_lib_file = "lib" ++ lib ++ ".a"
   bs <- mapM (doesLibExistIn batch_lib_file) dirs
   case [ dir | (exists,dir) <- zip bs dirs, exists ] of
-       [] -> dieOrForce force ("cannot find `" ++ batch_lib_file ++
-                                "' on library path") 
+       [] -> dieOrForce force ("cannot find " ++ batch_lib_file ++
+                                " on library path") 
        (dir:_) -> checkGHCiLib dirs dir batch_lib_file lib auto_ghci_libs
 
 doesLibExistIn :: String -> String -> IO Bool
@@ -589,7 +588,7 @@ checkGHCiLib dirs batch_lib_dir batch_lib_file lib auto_build
   | otherwise  = do
       bs <- mapM (doesLibExistIn ghci_lib_file) dirs
       case [dir | (exists,dir) <- zip bs dirs, exists] of
-        []    -> hPutStrLn stderr ("warning: can't find GHCi lib `" ++ ghci_lib_file ++ "'")
+        []    -> hPutStrLn stderr ("warning: can't find GHCi lib " ++ ghci_lib_file)
        (_:_) -> return ()
   where
     ghci_lib_file = lib ++ ".o"
@@ -601,17 +600,14 @@ autoBuildGHCiLib :: String -> String -> String -> IO ()
 autoBuildGHCiLib dir batch_file ghci_file = do
   let ghci_lib_file  = dir ++ '/':ghci_file
       batch_lib_file = dir ++ '/':batch_file
-  hPutStr stderr ("building GHCi library `" ++ ghci_lib_file ++ "'...")
+  hPutStr stderr ("building GHCi library " ++ ghci_lib_file ++ "...")
 #if defined(darwin_TARGET_OS)
-  r <- system("ld -r -x -o " ++ ghci_lib_file ++ 
-                " -all_load " ++ batch_lib_file)
+  r <- rawSystem "ld" ["-r","-x","-o",ghci_lib_file,"-all_load",batch_lib_file]
 #elif defined(mingw32_HOST_OS)
   execDir <- getExecDir "/bin/ghc-pkg.exe"
-  r <- system (maybe "" (++"/gcc-lib/") execDir++"ld -r -x -o " ++ 
-               ghci_lib_file ++ " --whole-archive " ++ batch_lib_file)
+  r <- rawSystem (maybe "" (++"/gcc-lib/") execDir++"ld") ["-r","-x","-o",ghci_lib_file,"--whole-archive",batch_lib_file]
 #else
-  r <- system("ld -r -x -o " ++ ghci_lib_file ++ 
-                " --whole-archive " ++ batch_lib_file)
+  r <- rawSystem "ld" ["-r","-x","-o",ghci_lib_file,"--whole-archive",batch_lib_file]
 #endif
   when (r /= ExitSuccess) $ exitWith r
   hPutStrLn stderr (" done.")
@@ -939,46 +935,5 @@ getExecDir :: String -> IO (Maybe String)
 getExecDir _ = return Nothing
 #endif
 
--- -----------------------------------------------------------------------------
--- Utils from Krasimir's FilePath library, copied here for now
-
 directoryOf :: FilePath -> FilePath
 directoryOf = fst.splitFileName
-
-splitFileName :: FilePath -> (String, String)
-splitFileName p = (reverse (path2++drive), reverse fname)
-  where
-#ifdef mingw32_TARGET_OS
-    (path,drive) = break (== ':') (reverse p)
-#else
-    (path,drive) = (reverse p,"")
-#endif
-    (fname,path1) = break isPathSeparator path
-    path2 = case path1 of
-      []                           -> "."
-      [_]                          -> path1   -- don't remove the trailing slash if 
-                                              -- there is only one character
-      (c:path) | isPathSeparator c -> path
-      _                            -> path1
-
-joinFileName :: String -> String -> FilePath
-joinFileName ""  fname = fname
-joinFileName "." fname = fname
-joinFileName dir fname
-  | isPathSeparator (last dir) = dir++fname
-  | otherwise                  = dir++pathSeparator:fname
-
-isPathSeparator :: Char -> Bool
-isPathSeparator ch =
-#ifdef mingw32_TARGET_OS
-  ch == '/' || ch == '\\'
-#else
-  ch == '/'
-#endif
-
-pathSeparator :: Char
-#ifdef mingw32_TARGET_OS
-pathSeparator = '\\'
-#else
-pathSeparator = '/'
-#endif