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 (
   8         PackageConfig(..),
   9         defaultPackageConfig,
  10         mungePackagePaths, packageDependents,
  11         showPackages,
  12
  13         PackageName,            -- Instance of Outputable
  14         mkPackageName, packageNameString,
  15         preludePackage, rtsPackage, stdPackage, haskell98Package,       -- :: PackageName
  16
  17         PackageConfigMap, emptyPkgMap, extendPkgMap, lookupPkg
  18     )
  19 where
  20
  21 #include "HsVersions.h"
  22
  23 import Pretty
  24
  25 import CmdLineOpts      ( dynFlag, verbosity )
  26 import DriverUtil       ( my_prefix_match )
  27 import ErrUtils         ( dumpIfSet )
  28 import Outputable       ( docToSDoc )
  29 import FastString
  30 import UniqFM
  31 \end{code}
  32
  33 %*********************************************************
  34 %*                                                       *
  35 \subsection{Basic data types}
  36 %*                                                       *
  37 %*********************************************************
  38
  39 \begin{code}
  40 #define WANT_PRETTY
  41 #define INTERNAL_PRETTY
  42 -- Yes, do generate pretty-printing stuff for packages, and use our
  43 -- own Pretty library rather than Text.PrettyPrint
  44
  45 -- There's a blob of code shared with ghc-pkg,
  46 -- so we just include it from there
  47 -- Primarily it defines
  48 --      PackageConfig (a record)
  49 --      PackageName   (FastString)
  50
  51 #include "../utils/ghc-pkg/Package.hs"
  52 \end{code}
  53
  54 \begin{code}
  55 type PackageName = FastString   -- No encoding at all
  56
  57 mkPackageName :: String -> PackageName
  58 mkPackageName = mkFastString
  59
  60 packageNameString :: PackageName -> String
  61 packageNameString = unpackFS
  62
  63 rtsPackage, preludePackage, haskell98Package :: PackageName
  64 preludePackage   = FSLIT("base")
  65 rtsPackage       = FSLIT("rts")
  66 haskell98Package = FSLIT("haskell98")
  67
  68 packageDependents :: PackageConfig -> [PackageName]
  69 -- Impedence matcher, because PackageConfig has Strings
  70 -- not PackageNames at the moment.  Sigh.
  71 packageDependents pkg = map mkPackageName (package_deps pkg)
  72 \end{code}
  73
  74 A PackageConfigMap maps a PackageName to a PackageConfig
  75
  76 \begin{code}
  77 type PackageConfigMap = UniqFM PackageConfig
  78
  79 lookupPkg    :: PackageConfigMap -> PackageName -> Maybe PackageConfig
  80 emptyPkgMap  :: PackageConfigMap
  81
  82 emptyPkgMap  = emptyUFM
  83 lookupPkg    = lookupUFM
  84
  85 extendPkgMap :: PackageConfigMap -> [PackageConfig] -> PackageConfigMap
  86 extendPkgMap pkg_map new_pkgs
  87   = foldl add pkg_map new_pkgs
  88   where
  89     add pkg_map p = addToUFM pkg_map (mkFastString (name p)) p
  90 \end{code}
  91
  92 %*********************************************************
  93 %*                                                       *
  94 \subsection{Load the config file}
  95 %*                                                       *
  96 %*********************************************************
  97
  98 \begin{code}
  99 mungePackagePaths :: String -> [PackageConfig] -> [PackageConfig]
 100 -- Replace the string "$libdir" at the beginning of a path
 101 -- with the current libdir (obtained from the -B option).
 102 mungePackagePaths top_dir ps = map munge_pkg ps
 103  where
 104   munge_pkg p = p{ import_dirs  = munge_paths (import_dirs p),
 105                    include_dirs = munge_paths (include_dirs p),
 106                    library_dirs = munge_paths (library_dirs p),
 107                    framework_dirs = munge_paths (framework_dirs p) }
 108
 109   munge_paths = map munge_path
 110
 111   munge_path p
 112           | Just p' <- my_prefix_match "$libdir" p = top_dir ++ p'
 113           | otherwise                              = p
 114 \end{code}
 115
 116
 117 %*********************************************************
 118 %*                                                       *
 119 \subsection{Display results}
 120 %*                                                       *
 121 %*********************************************************
 122
 123 \begin{code}
 124 showPackages :: PackageConfigMap -> IO ()
 125 -- Show package info on console, if verbosity is >= 3
 126 showPackages pkg_map
 127   = do  { verb <- dynFlag verbosity
 128         ; dumpIfSet (verb >= 3) "Packages"
 129                     (docToSDoc (vcat (map dumpPkgGuts ps)))
 130         }
 131   where
 132     ps = eltsUFM pkg_map
 133 \end{code}