[project @ 2001-06-15 15:55:05 by simonpj]
[ghc-hetmet.git] / ghc / compiler / main / Packages.lhs
1 %
2 % (c) The University of Glasgow, 2000
3 %
4 \section{Package manipulation}
5
6 \begin{code}
7 module Packages ( PackageConfig(..), 
8                   defaultPackageConfig,
9                   mungePackagePaths,
10                   showPackages
11                 )
12 where
13
14 #include "HsVersions.h"
15 import Pretty
16
17 import CmdLineOpts      ( dynFlag, verbosity )
18 import DriverUtil       ( my_prefix_match )
19 import ErrUtils         ( dumpIfSet )
20 import Outputable       ( docToSDoc, trace )
21 \end{code}
22
23 \begin{code}
24 #define WANT_PRETTY
25 -- Yes, do generate pretty-printing stuff for packages
26
27 -- There's a blob of code shared with ghc-pkg, 
28 -- so we just include it from there 
29 #include "../utils/ghc-pkg/Package.hs"
30 \end{code}
31
32 %*********************************************************
33 %*                                                       *
34 \subsection{Load the config file}
35 %*                                                       *
36 %*********************************************************
37
38 \begin{code}
39 mungePackagePaths :: String -> [PackageConfig] -> [PackageConfig]
40 -- Replace the string "$libdir" at the beginning of a path
41 -- with the current libdir (obtained from the -B option).
42 mungePackagePaths top_dir ps = map munge_pkg ps
43  where 
44   munge_pkg p = p{ import_dirs  = munge_paths (import_dirs p),
45                    include_dirs = munge_paths (include_dirs p),
46                    library_dirs = munge_paths (library_dirs p) }
47
48   munge_paths = map munge_path
49
50   munge_path p 
51           | Just p' <- my_prefix_match "$libdir" p = top_dir ++ p'
52           | otherwise                              = trace ("not: " ++ p) p
53 \end{code}
54
55
56 %*********************************************************
57 %*                                                       *
58 \subsection{Display results}
59 %*                                                       *
60 %*********************************************************
61
62 \begin{code}
63 showPackages :: [PackageConfig] -> IO ()
64 -- Show package info on console, if verbosity is >=2
65 showPackages ps
66   = do  { verb <- dynFlag verbosity
67         ; dumpIfSet (verb >= 2) "Packages"
68                     (docToSDoc (vcat (map dumpPkgGuts ps)))
69         }
70 \end{code}