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         InstalledPackageInfo(..),
  10         Version(..),
  11         PackageIdentifier(..),
  12         defaultPackageConfig,
  13         packageDependents,
  14         showPackages,
  15
  16         PackageName,            -- Instance of Outputable
  17         mkPackageName, packageIdName, packageConfigName, packageNameString,
  18         basePackage, rtsPackage, haskell98Package, thPackage, -- :: PackageName
  19
  20         PackageConfigMap, emptyPkgMap, lookupPkg,
  21         extendPackageConfigMap, getPackageDetails, getPackageConfigMap,
  22     )
  23 where
  24
  25 #include "HsVersions.h"
  26
  27 import Distribution.InstalledPackageInfo
  28 import Distribution.Package
  29 import Data.Version
  30 import CmdLineOpts      ( dynFlag, verbosity )
  31 import ErrUtils         ( dumpIfSet )
  32 import Outputable       ( docToSDoc )
  33 import FastString
  34 import UniqFM
  35 import Util
  36 import Pretty
  37
  38 import DATA_IOREF
  39
  40 -- -----------------------------------------------------------------------------
  41 -- Our PackageConfig type is just InstalledPackageInfo from Cabal.  Later we
  42 -- might need to extend it with some GHC-specific stuff, but for now it's fine.
  43
  44 type PackageConfig = InstalledPackageInfo
  45 defaultPackageConfig = emptyInstalledPackageInfo
  46
  47 -- -----------------------------------------------------------------------------
  48 -- Package names
  49
  50 type PackageName = FastString   -- No encoding at all
  51
  52 mkPackageName :: String -> PackageName
  53 mkPackageName = mkFastString
  54
  55 packageIdName :: PackageIdentifier -> PackageName
  56 packageIdName = mkPackageName . showPackageId
  57
  58 packageConfigName :: PackageConfig -> PackageName
  59 packageConfigName = packageIdName . package
  60
  61 packageNameString :: PackageName -> String
  62 packageNameString = unpackFS
  63
  64 rtsPackage, basePackage, haskell98Package, thPackage :: PackageName
  65 basePackage      = FSLIT("base")
  66 rtsPackage       = FSLIT("rts")
  67 haskell98Package = FSLIT("haskell98")
  68 thPackage        = FSLIT("template-haskell")    -- Template Haskell libraries in here
  69
  70 packageDependents :: PackageConfig -> [PackageName]
  71 -- Impedence matcher, because PackageConfig has Strings
  72 -- not PackageNames at the moment.  Sigh.
  73 packageDependents pkg = map packageIdName (depends pkg)
  74
  75 -- -----------------------------------------------------------------------------
  76 -- A PackageConfigMap maps a PackageName to a PackageConfig
  77
  78 type PackageConfigMap = UniqFM PackageConfig
  79
  80 lookupPkg    :: PackageConfigMap -> PackageName -> Maybe PackageConfig
  81
  82 emptyPkgMap  :: PackageConfigMap
  83
  84 emptyPkgMap  = emptyUFM
  85 lookupPkg    = lookupUFM
  86
  87 extendPkgMap :: PackageConfigMap -> [PackageConfig] -> PackageConfigMap
  88 extendPkgMap pkg_map new_pkgs
  89   = foldl add pkg_map new_pkgs
  90   where
  91     add pkg_map p = addToUFM pkg_map (packageConfigName p) p
  92
  93 GLOBAL_VAR(v_Package_details, emptyPkgMap, PackageConfigMap)
  94
  95 getPackageConfigMap :: IO PackageConfigMap
  96 getPackageConfigMap = readIORef v_Package_details
  97
  98 extendPackageConfigMap :: [PackageConfig] -> IO ()
  99 extendPackageConfigMap pkg_configs = do
 100   old_pkg_map <- readIORef v_Package_details
 101   writeIORef v_Package_details (extendPkgMap old_pkg_map pkg_configs)
 102
 103 getPackageDetails :: [PackageName] -> IO [PackageConfig]
 104 getPackageDetails ps = do
 105   pkg_details <- getPackageConfigMap
 106   return [ pkg | Just pkg <- map (lookupPkg pkg_details) ps ]
 107
 108
 109 -- -----------------------------------------------------------------------------
 110 -- Displaying packages
 111
 112 showPackages :: PackageConfigMap -> IO ()
 113 -- Show package info on console, if verbosity is >= 3
 114 showPackages pkg_map
 115   = do  { verb <- dynFlag verbosity
 116         ; dumpIfSet (verb >= 3) "Packages"
 117                     (docToSDoc (vcat (map (text.showInstalledPackageInfo) ps)))
 118         }
 119   where
 120     ps = eltsUFM pkg_map
 121
 122 \end{code}