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         packageDependents,
  11         showPackages,
  12
  13         PackageName,            -- Instance of Outputable
  14         mkPackageName, packageNameString,
  15         basePackage, rtsPackage, haskell98Package, thPackage, -- :: PackageName
  16
  17         PackageConfigMap, emptyPkgMap, lookupPkg,
  18         extendPackageConfigMap, getPackageDetails, getPackageConfigMap,
  19     )
  20 where
  21
  22 #include "HsVersions.h"
  23
  24 import CmdLineOpts      ( dynFlag, verbosity )
  25 import ErrUtils         ( dumpIfSet )
  26 import Outputable       ( docToSDoc )
  27 import FastString
  28 import UniqFM
  29 import Util
  30 import Pretty
  31
  32 import DATA_IOREF
  33
  34 -- -----------------------------------------------------------------------------
  35 -- The PackageConfig type
  36
  37 #define WANT_PRETTY
  38 #define INTERNAL_PRETTY
  39 -- Yes, do generate pretty-printing stuff for packages, and use our
  40 -- own Pretty library rather than Text.PrettyPrint
  41
  42 -- There's a blob of code shared with ghc-pkg,
  43 -- so we just include it from there
  44 -- Primarily it defines PackageConfig (a record)
  45
  46 #include "../utils/ghc-pkg/Package.hs"
  47
  48 -- -----------------------------------------------------------------------------
  49 -- Package names
  50
  51 type PackageName = FastString   -- No encoding at all
  52
  53 mkPackageName :: String -> PackageName
  54 mkPackageName = mkFastString
  55
  56 packageNameString :: PackageName -> String
  57 packageNameString = unpackFS
  58
  59 rtsPackage, basePackage, haskell98Package, thPackage :: PackageName
  60 basePackage      = FSLIT("base")
  61 rtsPackage       = FSLIT("rts")
  62 haskell98Package = FSLIT("haskell98")
  63 thPackage        = FSLIT("template-haskell")    -- Template Haskell libraries in here
  64
  65 packageDependents :: PackageConfig -> [PackageName]
  66 -- Impedence matcher, because PackageConfig has Strings
  67 -- not PackageNames at the moment.  Sigh.
  68 packageDependents pkg = map mkPackageName (package_deps pkg)
  69
  70 -- -----------------------------------------------------------------------------
  71 -- A PackageConfigMap maps a PackageName to a PackageConfig
  72
  73 type PackageConfigMap = UniqFM PackageConfig
  74
  75 lookupPkg    :: PackageConfigMap -> PackageName -> Maybe PackageConfig
  76
  77 emptyPkgMap  :: PackageConfigMap
  78
  79 emptyPkgMap  = emptyUFM
  80 lookupPkg    = lookupUFM
  81
  82 extendPkgMap :: PackageConfigMap -> [PackageConfig] -> PackageConfigMap
  83 extendPkgMap pkg_map new_pkgs
  84   = foldl add pkg_map new_pkgs
  85   where
  86     add pkg_map p = addToUFM pkg_map (mkFastString (name p)) p
  87
  88 GLOBAL_VAR(v_Package_details, emptyPkgMap, PackageConfigMap)
  89
  90 getPackageConfigMap :: IO PackageConfigMap
  91 getPackageConfigMap = readIORef v_Package_details
  92
  93 extendPackageConfigMap :: [PackageConfig] -> IO ()
  94 extendPackageConfigMap pkg_configs = do
  95   old_pkg_map <- readIORef v_Package_details
  96   writeIORef v_Package_details (extendPkgMap old_pkg_map pkg_configs)
  97
  98 getPackageDetails :: [PackageName] -> IO [PackageConfig]
  99 getPackageDetails ps = do
 100   pkg_details <- getPackageConfigMap
 101   return [ pkg | Just pkg <- map (lookupPkg pkg_details) ps ]
 102
 103
 104 -- -----------------------------------------------------------------------------
 105 -- Displaying packages
 106
 107 showPackages :: PackageConfigMap -> IO ()
 108 -- Show package info on console, if verbosity is >= 3
 109 showPackages pkg_map
 110   = do  { verb <- dynFlag verbosity
 111         ; dumpIfSet (verb >= 3) "Packages"
 112                     (docToSDoc (vcat (map dumpPkgGuts ps)))
 113         }
 114   where
 115     ps = eltsUFM pkg_map
 116
 117 \end{code}