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
158
159
160
161
162
163
164
165
166
167
168
169
|
{-# LANGUAGE CPP, RecordWildCards, FlexibleInstances, MultiParamTypeClasses #-}
-- |
-- Package configuration information: essentially the interface to Cabal, with
-- some utilities
--
-- (c) The University of Glasgow, 2004
--
module GHC.Unit.Info (
-- $package_naming
-- * UnitId
packageConfigId,
expandedUnitInfoId,
definiteUnitInfoId,
installedUnitInfoId,
-- * The UnitInfo type: information about a unit
UnitInfo,
toUnitInfo,
GenericUnitInfo(..),
ComponentId(..),
PackageId(..),
PackageName(..),
Version(..),
unitPackageNameString,
unitPackageIdString,
pprUnitInfo,
) where
#include "HsVersions.h"
import GHC.Prelude
import GHC.PackageDb
import Data.Version
import Data.Bifunctor
import GHC.Data.FastString
import GHC.Utils.Outputable
import GHC.Types.Module as Module
import GHC.Types.Unique
-- -----------------------------------------------------------------------------
-- Our UnitInfo type is the GenericUnitInfo from ghc-boot,
-- which is similar to a subset of the InstalledPackageInfo type from Cabal.
type UnitInfo = GenericUnitInfo
ComponentId
PackageId
PackageName
Module.InstalledUnitId
Module.ModuleName
Module.Module
-- | Convert a DbUnitInfo (read from a package database) into `UnitInfo`
toUnitInfo :: DbUnitInfo -> UnitInfo
toUnitInfo = mapGenericUnitInfo
mkUnitId'
mkComponentId'
mkPackageIdentifier'
mkPackageName'
mkModuleName'
mkModule'
where
mkPackageIdentifier' = PackageId . mkFastStringByteString
mkPackageName' = PackageName . mkFastStringByteString
mkUnitId' = InstalledUnitId . mkFastStringByteString
mkModuleName' = mkModuleNameFS . mkFastStringByteString
mkComponentId' cid = ComponentId (mkFastStringByteString cid) Nothing
mkInstUnitId' i = case i of
DbInstUnitId cid insts -> newUnitId (mkComponentId' cid) (fmap (bimap mkModuleName' mkModule') insts)
DbUnitId uid -> DefiniteUnitId (DefUnitId (mkUnitId' uid))
mkModule' m = case m of
DbModule uid n -> mkModule (mkInstUnitId' uid) (mkModuleName' n)
DbModuleVar n -> mkHoleModule (mkModuleName' n)
-- 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 PackageId = PackageId FastString deriving (Eq, Ord)
newtype PackageName = PackageName
{ unPackageName :: FastString
}
deriving (Eq, Ord)
instance Uniquable PackageId where
getUnique (PackageId n) = getUnique n
instance Uniquable PackageName where
getUnique (PackageName n) = getUnique n
instance Outputable PackageId where
ppr (PackageId str) = ftext str
instance Outputable PackageName where
ppr (PackageName str) = ftext str
unitPackageIdString :: UnitInfo -> String
unitPackageIdString pkg = unpackFS str
where
PackageId str = unitPackageId pkg
unitPackageNameString :: UnitInfo -> String
unitPackageNameString pkg = unpackFS str
where
PackageName str = unitPackageName pkg
pprUnitInfo :: UnitInfo -> SDoc
pprUnitInfo GenericUnitInfo {..} =
vcat [
field "name" (ppr unitPackageName),
field "version" (text (showVersion unitPackageVersion)),
field "id" (ppr unitId),
field "exposed" (ppr unitIsExposed),
field "exposed-modules" (ppr unitExposedModules),
field "hidden-modules" (fsep (map ppr unitHiddenModules)),
field "trusted" (ppr unitIsTrusted),
field "import-dirs" (fsep (map text unitImportDirs)),
field "library-dirs" (fsep (map text unitLibraryDirs)),
field "dynamic-library-dirs" (fsep (map text unitLibraryDynDirs)),
field "hs-libraries" (fsep (map text unitLibraries)),
field "extra-libraries" (fsep (map text unitExtDepLibsSys)),
field "extra-ghci-libraries" (fsep (map text unitExtDepLibsGhc)),
field "include-dirs" (fsep (map text unitIncludeDirs)),
field "includes" (fsep (map text unitIncludes)),
field "depends" (fsep (map ppr unitDepends)),
field "cc-options" (fsep (map text unitCcOptions)),
field "ld-options" (fsep (map text unitLinkerOptions)),
field "framework-dirs" (fsep (map text unitExtDepFrameworkDirs)),
field "frameworks" (fsep (map text unitExtDepFrameworks)),
field "haddock-interfaces" (fsep (map text unitHaddockInterfaces)),
field "haddock-html" (fsep (map text unitHaddockHTMLs))
]
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 unitIsIndefinite p
then newUnitId (unitInstanceOf p) (unitInstantiations p)
else DefiniteUnitId (DefUnitId (unitId p))
expandedUnitInfoId :: UnitInfo -> UnitId
expandedUnitInfoId p =
newUnitId (unitInstanceOf p) (unitInstantiations p)
definiteUnitInfoId :: UnitInfo -> Maybe DefUnitId
definiteUnitInfoId p =
case packageConfigId p of
DefiniteUnitId def_uid -> Just def_uid
_ -> Nothing
|
