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