Copyright | (c) The University of Glasgow 2009, Duncan Coutts 2014 |
---|---|
Maintainer | ghc-devs@haskell.org |
Portability | portable |
Safe Haskell | None |
Language | Haskell2010 |
This module provides the view of GHC's database of registered packages that is shared between GHC the compiler/library, and the ghc-pkg program. It defines the database format that is shared between GHC and ghc-pkg.
The database format, and this library are constructed so that GHC does not have to depend on the Cabal library. The ghc-pkg program acts as the gateway between the external package format (which is defined by Cabal) and the internal package format which is specialised just for GHC.
GHC the compiler only needs some of the information which is kept about registerd packages, such as module names, various paths etc. On the other hand ghc-pkg has to keep all the information from Cabal packages and be able to regurgitate it for users and other tools.
The first trick is that we duplicate some of the information in the package
database. We essentially keep two versions of the datbase in one file, one
version used only by ghc-pkg which keeps the full information (using the
serialised form of the InstalledPackageInfo
type defined by the Cabal
library); and a second version written by ghc-pkg and read by GHC which has
just the subset of information that GHC needs.
The second trick is that this module only defines in detail the format of the second version -- the bit GHC uses -- and the part managed by ghc-pkg is kept in the file but here we treat it as an opaque blob of data. That way this library avoids depending on Cabal.
- data InstalledPackageInfo srcpkgid srcpkgname unitid modulename = InstalledPackageInfo {
- unitId :: unitid
- sourcePackageId :: srcpkgid
- packageName :: srcpkgname
- packageVersion :: Version
- abiHash :: String
- depends :: [unitid]
- importDirs :: [FilePath]
- hsLibraries :: [String]
- extraLibraries :: [String]
- extraGHCiLibraries :: [String]
- libraryDirs :: [FilePath]
- frameworks :: [String]
- frameworkDirs :: [FilePath]
- ldOptions :: [String]
- ccOptions :: [String]
- includes :: [String]
- includeDirs :: [FilePath]
- haddockInterfaces :: [FilePath]
- haddockHTMLs :: [FilePath]
- exposedModules :: [ExposedModule unitid modulename]
- hiddenModules :: [modulename]
- exposed :: Bool
- trusted :: Bool
- data ExposedModule unitid modulename = ExposedModule {
- exposedName :: modulename
- exposedReexport :: Maybe (OriginalModule unitid modulename)
- data OriginalModule unitid modulename = OriginalModule {
- originalPackageId :: unitid
- originalModuleName :: modulename
- class BinaryStringRep a where
- emptyInstalledPackageInfo :: RepInstalledPackageInfo a b c d => InstalledPackageInfo a b c d
- readPackageDbForGhc :: RepInstalledPackageInfo a b c d => FilePath -> IO [InstalledPackageInfo a b c d]
- readPackageDbForGhcPkg :: Binary pkgs => FilePath -> IO pkgs
- writePackageDb :: (Binary pkgs, RepInstalledPackageInfo a b c d) => FilePath -> [InstalledPackageInfo a b c d] -> pkgs -> IO ()
Documentation
data InstalledPackageInfo srcpkgid srcpkgname unitid modulename Source
This is a subset of Cabal's InstalledPackageInfo
, with just the bits
that GHC is interested in.
InstalledPackageInfo | |
|
(Eq srcpkgid, Eq srcpkgname, Eq unitid, Eq modulename) => Eq (InstalledPackageInfo srcpkgid srcpkgname unitid modulename) | |
(Show srcpkgid, Show srcpkgname, Show unitid, Show modulename) => Show (InstalledPackageInfo srcpkgid srcpkgname unitid modulename) | |
RepInstalledPackageInfo a b c d => Binary (InstalledPackageInfo a b c d) | |
data ExposedModule unitid modulename Source
Represents a module name which is exported by a package, stored in the
exposedModules
field. A module export may be a reexport (in which case
exposedReexport
is filled in with the original source of the module).
Thus:
ExposedModule n Nothing
represents an exposed modulen
which was defined in this package.ExposedModule n (Just o)
represents a reexported modulen
which was originally defined ino
.
We use a Maybe
data types instead of an ADT with two branches because this
representation allows us to treat reexports uniformly.
ExposedModule | |
|
(Eq unitid, Eq modulename) => Eq (ExposedModule unitid modulename) | |
(Show unitid, Show modulename) => Show (ExposedModule unitid modulename) | |
(BinaryStringRep a, BinaryStringRep b) => Binary (ExposedModule a b) | |
data OriginalModule unitid modulename Source
An original module is a fully-qualified module name (installed package ID
plus module name) representing where a module was *originally* defined
(i.e., the exposedReexport
field of the original ExposedModule entry should
be Nothing
). Invariant: an OriginalModule never points to a reexport.
OriginalModule | |
|
(Eq unitid, Eq modulename) => Eq (OriginalModule unitid modulename) | |
(Show unitid, Show modulename) => Show (OriginalModule unitid modulename) | |
(BinaryStringRep a, BinaryStringRep b) => Binary (OriginalModule a b) | |
class BinaryStringRep a where Source
fromStringRep :: ByteString -> a Source
toStringRep :: a -> ByteString Source
emptyInstalledPackageInfo :: RepInstalledPackageInfo a b c d => InstalledPackageInfo a b c d Source
readPackageDbForGhc :: RepInstalledPackageInfo a b c d => FilePath -> IO [InstalledPackageInfo a b c d] Source
Read the part of the package DB that GHC is interested in.
readPackageDbForGhcPkg :: Binary pkgs => FilePath -> IO pkgs Source
Read the part of the package DB that ghc-pkg is interested in
Note that the Binary instance for ghc-pkg's representation of packages is not defined in this package. This is because ghc-pkg uses Cabal types (and Binary instances for these) which this package does not depend on.
writePackageDb :: (Binary pkgs, RepInstalledPackageInfo a b c d) => FilePath -> [InstalledPackageInfo a b c d] -> pkgs -> IO () Source
Write the whole of the package DB, both parts.