2 % (c) The University of Glasgow, 2000
4 \section{Package manipulation}
9 InstalledPackageInfo(..),
11 PackageIdentifier(..),
16 PackageName, -- Instance of Outputable
17 mkPackageName, packageIdName, packageConfigName, packageNameString,
18 basePackage, rtsPackage, haskell98Package, thPackage, -- :: PackageName
20 PackageConfigMap, emptyPkgMap, lookupPkg,
21 extendPackageConfigMap, getPackageDetails, getPackageConfigMap,
25 #include "HsVersions.h"
27 import Distribution.InstalledPackageInfo
28 import Distribution.Package
30 import CmdLineOpts ( dynFlag, verbosity )
31 import ErrUtils ( dumpIfSet )
32 import Outputable ( docToSDoc )
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.
44 type PackageConfig = InstalledPackageInfo
45 defaultPackageConfig = emptyInstalledPackageInfo
47 -- -----------------------------------------------------------------------------
50 type PackageName = FastString -- No encoding at all
52 mkPackageName :: String -> PackageName
53 mkPackageName = mkFastString
55 packageIdName :: PackageIdentifier -> PackageName
56 packageIdName = mkPackageName . showPackageId
58 packageConfigName :: PackageConfig -> PackageName
59 packageConfigName = packageIdName . package
61 packageNameString :: PackageName -> String
62 packageNameString = unpackFS
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
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)
75 -- -----------------------------------------------------------------------------
76 -- A PackageConfigMap maps a PackageName to a PackageConfig
78 type PackageConfigMap = UniqFM PackageConfig
80 lookupPkg :: PackageConfigMap -> PackageName -> Maybe PackageConfig
82 emptyPkgMap :: PackageConfigMap
84 emptyPkgMap = emptyUFM
87 extendPkgMap :: PackageConfigMap -> [PackageConfig] -> PackageConfigMap
88 extendPkgMap pkg_map new_pkgs
89 = foldl add pkg_map new_pkgs
91 add pkg_map p = addToUFM pkg_map (packageConfigName p) p
93 GLOBAL_VAR(v_Package_details, emptyPkgMap, PackageConfigMap)
95 getPackageConfigMap :: IO PackageConfigMap
96 getPackageConfigMap = readIORef v_Package_details
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)
103 getPackageDetails :: [PackageName] -> IO [PackageConfig]
104 getPackageDetails ps = do
105 pkg_details <- getPackageConfigMap
106 return [ pkg | Just pkg <- map (lookupPkg pkg_details) ps ]
109 -- -----------------------------------------------------------------------------
110 -- Displaying packages
112 showPackages :: PackageConfigMap -> IO ()
113 -- Show package info on console, if verbosity is >= 3
115 = do { verb <- dynFlag verbosity
116 ; dumpIfSet (verb >= 3) "Packages"
117 (docToSDoc (vcat (map (text.showInstalledPackageInfo) ps)))