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
170
171
172
173
174
175
|
{-# 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
( GenericUnitInfo (..)
, GenUnitInfo
, UnitInfo
, UnitKey (..)
, UnitKeyInfo
, mkUnitKeyInfo
, mapUnitInfo
, mkUnit
, expandedUnitInfoId
, definiteUnitInfoId
, 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
-- | Information about an installed unit
--
-- We parameterize on the unit identifier:
-- * UnitKey: identifier used in the database (cf 'UnitKeyInfo')
-- * UnitId: identifier used to generate code (cf 'UnitInfo')
--
-- These two identifiers are different for wired-in packages. See Note [The
-- identifier lexicon] in GHC.Types.Module
type GenUnitInfo unit = GenericUnitInfo (Indefinite unit) PackageId PackageName unit ModuleName (GenModule (GenUnit unit))
-- | A unit key in the database
newtype UnitKey = UnitKey FastString
unitKeyFS :: UnitKey -> FastString
unitKeyFS (UnitKey fs) = fs
-- | Information about an installed unit (units are identified by their database
-- UnitKey)
type UnitKeyInfo = GenUnitInfo UnitKey
-- | Information about an installed unit (units are identified by their internal
-- UnitId)
type UnitInfo = GenUnitInfo UnitId
-- | Convert a DbUnitInfo (read from a package database) into `UnitKeyInfo`
mkUnitKeyInfo :: DbUnitInfo -> UnitKeyInfo
mkUnitKeyInfo = mapGenericUnitInfo
mkUnitKey'
mkIndefUnitKey'
mkPackageIdentifier'
mkPackageName'
mkModuleName'
mkModule'
where
mkPackageIdentifier' = PackageId . mkFastStringByteString
mkPackageName' = PackageName . mkFastStringByteString
mkUnitKey' = UnitKey . mkFastStringByteString
mkModuleName' = mkModuleNameFS . mkFastStringByteString
mkIndefUnitKey' cid = Indefinite (mkUnitKey' cid) Nothing
mkVirtUnitKey' i = case i of
DbInstUnitId cid insts -> mkGenVirtUnit unitKeyFS (mkIndefUnitKey' cid) (fmap (bimap mkModuleName' mkModule') insts)
DbUnitId uid -> RealUnit (Definite (mkUnitKey' uid))
mkModule' m = case m of
DbModule uid n -> mkModule (mkVirtUnitKey' uid) (mkModuleName' n)
DbModuleVar n -> mkHoleModule (mkModuleName' n)
-- | Map over the unit parameter
mapUnitInfo :: (u -> v) -> (v -> FastString) -> GenUnitInfo u -> GenUnitInfo v
mapUnitInfo f gunitFS = mapGenericUnitInfo
f -- unit identifier
(fmap f) -- indefinite unit identifier
id -- package identifier
id -- package name
id -- module name
(fmap (mapGenUnit f gunitFS)) -- instantiating modules
-- 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
mkUnit :: UnitInfo -> Unit
mkUnit p =
if unitIsIndefinite p
then mkVirtUnit (unitInstanceOf p) (unitInstantiations p)
else RealUnit (Definite (unitId p))
expandedUnitInfoId :: UnitInfo -> Unit
expandedUnitInfoId p =
mkVirtUnit (unitInstanceOf p) (unitInstantiations p)
definiteUnitInfoId :: UnitInfo -> Maybe DefUnitId
definiteUnitInfoId p =
case mkUnit p of
RealUnit def_uid -> Just def_uid
_ -> Nothing
|
