1{-# LANGUAGE CPP, RecordWildCards, FlexibleInstances, MultiParamTypeClasses #-}
2
3-- |
4-- Package configuration information: essentially the interface to Cabal, with
5-- some utilities
6--
7-- (c) The University of Glasgow, 2004
8--
9module PackageConfig (
10        -- $package_naming
11
12        -- * UnitId
13        packageConfigId,
14        expandedPackageConfigId,
15        definitePackageConfigId,
16        installedPackageConfigId,
17
18        -- * The PackageConfig type: information about a package
19        PackageConfig,
20        InstalledPackageInfo(..),
21        ComponentId(..),
22        SourcePackageId(..),
23        PackageName(..),
24        Version(..),
25        defaultPackageConfig,
26        sourcePackageIdString,
27        packageNameString,
28        pprPackageConfig,
29    ) where
30
31#include "HsVersions.h"
32
33import GhcPrelude
34
35import GHC.PackageDb
36import Data.Version
37
38import FastString
39import Outputable
40import Module
41import Unique
42
43-- -----------------------------------------------------------------------------
44-- Our PackageConfig type is the InstalledPackageInfo from ghc-boot,
45-- which is similar to a subset of the InstalledPackageInfo type from Cabal.
46
47type PackageConfig = InstalledPackageInfo
48                       ComponentId
49                       SourcePackageId
50                       PackageName
51                       Module.InstalledUnitId
52                       Module.UnitId
53                       Module.ModuleName
54                       Module.Module
55
56-- TODO: there's no need for these to be FastString, as we don't need the uniq
57--       feature, but ghc doesn't currently have convenient support for any
58--       other compact string types, e.g. plain ByteString or Text.
59
60newtype SourcePackageId    = SourcePackageId    FastString deriving (Eq, Ord)
61newtype PackageName        = PackageName        FastString deriving (Eq, Ord)
62
63instance BinaryStringRep SourcePackageId where
64  fromStringRep = SourcePackageId . mkFastStringByteString
65  toStringRep (SourcePackageId s) = bytesFS s
66
67instance BinaryStringRep PackageName where
68  fromStringRep = PackageName . mkFastStringByteString
69  toStringRep (PackageName s) = bytesFS s
70
71instance Uniquable SourcePackageId where
72  getUnique (SourcePackageId n) = getUnique n
73
74instance Uniquable PackageName where
75  getUnique (PackageName n) = getUnique n
76
77instance Outputable SourcePackageId where
78  ppr (SourcePackageId str) = ftext str
79
80instance Outputable PackageName where
81  ppr (PackageName str) = ftext str
82
83defaultPackageConfig :: PackageConfig
84defaultPackageConfig = emptyInstalledPackageInfo
85
86sourcePackageIdString :: PackageConfig -> String
87sourcePackageIdString pkg = unpackFS str
88  where
89    SourcePackageId str = sourcePackageId pkg
90
91packageNameString :: PackageConfig -> String
92packageNameString pkg = unpackFS str
93  where
94    PackageName str = packageName pkg
95
96pprPackageConfig :: PackageConfig -> SDoc
97pprPackageConfig InstalledPackageInfo {..} =
98    vcat [
99      field "name"                 (ppr packageName),
100      field "version"              (text (showVersion packageVersion)),
101      field "id"                   (ppr unitId),
102      field "exposed"              (ppr exposed),
103      field "exposed-modules"      (ppr exposedModules),
104      field "hidden-modules"       (fsep (map ppr hiddenModules)),
105      field "trusted"              (ppr trusted),
106      field "import-dirs"          (fsep (map text importDirs)),
107      field "library-dirs"         (fsep (map text libraryDirs)),
108      field "dynamic-library-dirs" (fsep (map text libraryDynDirs)),
109      field "hs-libraries"         (fsep (map text hsLibraries)),
110      field "extra-libraries"      (fsep (map text extraLibraries)),
111      field "extra-ghci-libraries" (fsep (map text extraGHCiLibraries)),
112      field "include-dirs"         (fsep (map text includeDirs)),
113      field "includes"             (fsep (map text includes)),
114      field "depends"              (fsep (map ppr  depends)),
115      field "cc-options"           (fsep (map text ccOptions)),
116      field "ld-options"           (fsep (map text ldOptions)),
117      field "framework-dirs"       (fsep (map text frameworkDirs)),
118      field "frameworks"           (fsep (map text frameworks)),
119      field "haddock-interfaces"   (fsep (map text haddockInterfaces)),
120      field "haddock-html"         (fsep (map text haddockHTMLs))
121    ]
122  where
123    field name body = text name <> colon <+> nest 4 body
124
125-- -----------------------------------------------------------------------------
126-- UnitId (package names, versions and dep hash)
127
128-- $package_naming
129-- #package_naming#
130-- Mostly the compiler deals in terms of 'UnitId's, which are md5 hashes
131-- of a package ID, keys of its dependencies, and Cabal flags. You're expected
132-- to pass in the unit id in the @-this-unit-id@ flag. However, for
133-- wired-in packages like @base@ & @rts@, we don't necessarily know what the
134-- version is, so these are handled specially; see #wired_in_packages#.
135
136-- | Get the GHC 'UnitId' right out of a Cabalish 'PackageConfig'
137installedPackageConfigId :: PackageConfig -> InstalledUnitId
138installedPackageConfigId = unitId
139
140packageConfigId :: PackageConfig -> UnitId
141packageConfigId p =
142    if indefinite p
143        then newUnitId (componentId p) (instantiatedWith p)
144        else DefiniteUnitId (DefUnitId (unitId p))
145
146expandedPackageConfigId :: PackageConfig -> UnitId
147expandedPackageConfigId p =
148    newUnitId (componentId p) (instantiatedWith p)
149
150definitePackageConfigId :: PackageConfig -> Maybe DefUnitId
151definitePackageConfigId p =
152    case packageConfigId p of
153        DefiniteUnitId def_uid -> Just def_uid
154        _ -> Nothing
155