Support for abi-depends for computing shadowing.
[ghc.git] / libraries / ghc-boot / GHC / PackageDb.hs
1 {-# LANGUAGE ConstraintKinds #-}
2 {-# LANGUAGE MultiParamTypeClasses #-}
3 {-# LANGUAGE FunctionalDependencies #-}
4 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
5 -----------------------------------------------------------------------------
6 -- |
7 -- Module : GHC.PackageDb
8 -- Copyright : (c) The University of Glasgow 2009, Duncan Coutts 2014
9 --
10 -- Maintainer : ghc-devs@haskell.org
11 -- Portability : portable
12 --
13 -- This module provides the view of GHC's database of registered packages that
14 -- is shared between GHC the compiler\/library, and the ghc-pkg program. It
15 -- defines the database format that is shared between GHC and ghc-pkg.
16 --
17 -- The database format, and this library are constructed so that GHC does not
18 -- have to depend on the Cabal library. The ghc-pkg program acts as the
19 -- gateway between the external package format (which is defined by Cabal) and
20 -- the internal package format which is specialised just for GHC.
21 --
22 -- GHC the compiler only needs some of the information which is kept about
23 -- registerd packages, such as module names, various paths etc. On the other
24 -- hand ghc-pkg has to keep all the information from Cabal packages and be able
25 -- to regurgitate it for users and other tools.
26 --
27 -- The first trick is that we duplicate some of the information in the package
28 -- database. We essentially keep two versions of the datbase in one file, one
29 -- version used only by ghc-pkg which keeps the full information (using the
30 -- serialised form of the 'InstalledPackageInfo' type defined by the Cabal
31 -- library); and a second version written by ghc-pkg and read by GHC which has
32 -- just the subset of information that GHC needs.
33 --
34 -- The second trick is that this module only defines in detail the format of
35 -- the second version -- the bit GHC uses -- and the part managed by ghc-pkg
36 -- is kept in the file but here we treat it as an opaque blob of data. That way
37 -- this library avoids depending on Cabal.
38 --
39 module GHC.PackageDb (
40 InstalledPackageInfo(..),
41 DbModule(..),
42 DbUnitId(..),
43 BinaryStringRep(..),
44 DbUnitIdModuleRep(..),
45 emptyInstalledPackageInfo,
46 readPackageDbForGhc,
47 readPackageDbForGhcPkg,
48 writePackageDb
49 ) where
50
51 import Data.Version (Version(..))
52 import qualified Data.ByteString as BS
53 import qualified Data.ByteString.Char8 as BS.Char8
54 import qualified Data.ByteString.Lazy as BS.Lazy
55 import qualified Data.ByteString.Lazy.Internal as BS.Lazy (defaultChunkSize)
56 import Data.Binary as Bin
57 import Data.Binary.Put as Bin
58 import Data.Binary.Get as Bin
59 import Control.Exception as Exception
60 import Control.Monad (when)
61 import System.FilePath
62 import System.IO
63 import System.IO.Error
64 import GHC.IO.Exception (IOErrorType(InappropriateType))
65 import System.Directory
66
67
68 -- | This is a subset of Cabal's 'InstalledPackageInfo', with just the bits
69 -- that GHC is interested in. See Cabal's documentation for a more detailed
70 -- description of all of the fields.
71 --
72 data InstalledPackageInfo compid srcpkgid srcpkgname instunitid unitid modulename mod
73 = InstalledPackageInfo {
74 unitId :: instunitid,
75 componentId :: compid,
76 instantiatedWith :: [(modulename, mod)],
77 sourcePackageId :: srcpkgid,
78 packageName :: srcpkgname,
79 packageVersion :: Version,
80 abiHash :: String,
81 depends :: [instunitid],
82 -- | Like 'depends', but each dependency is annotated with the
83 -- ABI hash we expect the dependency to respect.
84 abiDepends :: [(instunitid, String)],
85 importDirs :: [FilePath],
86 hsLibraries :: [String],
87 extraLibraries :: [String],
88 extraGHCiLibraries :: [String],
89 libraryDirs :: [FilePath],
90 libraryDynDirs :: [FilePath],
91 frameworks :: [String],
92 frameworkDirs :: [FilePath],
93 ldOptions :: [String],
94 ccOptions :: [String],
95 includes :: [String],
96 includeDirs :: [FilePath],
97 haddockInterfaces :: [FilePath],
98 haddockHTMLs :: [FilePath],
99 exposedModules :: [(modulename, Maybe mod)],
100 hiddenModules :: [modulename],
101 indefinite :: Bool,
102 exposed :: Bool,
103 trusted :: Bool
104 }
105 deriving (Eq, Show)
106
107 -- | A convenience constraint synonym for common constraints over parameters
108 -- to 'InstalledPackageInfo'.
109 type RepInstalledPackageInfo compid srcpkgid srcpkgname instunitid unitid modulename mod =
110 (BinaryStringRep srcpkgid, BinaryStringRep srcpkgname,
111 BinaryStringRep modulename, BinaryStringRep compid,
112 BinaryStringRep instunitid,
113 DbUnitIdModuleRep instunitid compid unitid modulename mod)
114
115 -- | A type-class for the types which can be converted into 'DbModule'/'DbUnitId'.
116 -- There is only one type class because these types are mutually recursive.
117 -- NB: The functional dependency helps out type inference in cases
118 -- where types would be ambiguous.
119 class DbUnitIdModuleRep instunitid compid unitid modulename mod
120 | mod -> unitid, unitid -> mod, mod -> modulename, unitid -> compid, unitid -> instunitid
121 where
122 fromDbModule :: DbModule instunitid compid unitid modulename mod -> mod
123 toDbModule :: mod -> DbModule instunitid compid unitid modulename mod
124 fromDbUnitId :: DbUnitId instunitid compid unitid modulename mod -> unitid
125 toDbUnitId :: unitid -> DbUnitId instunitid compid unitid modulename mod
126
127 -- | @ghc-boot@'s copy of 'Module', i.e. what is serialized to the database.
128 -- Use 'DbUnitIdModuleRep' to convert it into an actual 'Module'.
129 -- It has phantom type parameters as this is the most convenient way
130 -- to avoid undecidable instances.
131 data DbModule instunitid compid unitid modulename mod
132 = DbModule {
133 dbModuleUnitId :: unitid,
134 dbModuleName :: modulename
135 }
136 | DbModuleVar {
137 dbModuleVarName :: modulename
138 }
139 deriving (Eq, Show)
140
141 -- | @ghc-boot@'s copy of 'UnitId', i.e. what is serialized to the database.
142 -- Use 'DbUnitIdModuleRep' to convert it into an actual 'UnitId'.
143 -- It has phantom type parameters as this is the most convenient way
144 -- to avoid undecidable instances.
145 data DbUnitId instunitid compid unitid modulename mod
146 = DbUnitId compid [(modulename, mod)]
147 | DbInstalledUnitId instunitid
148 deriving (Eq, Show)
149
150 class BinaryStringRep a where
151 fromStringRep :: BS.ByteString -> a
152 toStringRep :: a -> BS.ByteString
153
154 emptyInstalledPackageInfo :: RepInstalledPackageInfo a b c d e f g
155 => InstalledPackageInfo a b c d e f g
156 emptyInstalledPackageInfo =
157 InstalledPackageInfo {
158 unitId = fromStringRep BS.empty,
159 componentId = fromStringRep BS.empty,
160 instantiatedWith = [],
161 sourcePackageId = fromStringRep BS.empty,
162 packageName = fromStringRep BS.empty,
163 packageVersion = Version [] [],
164 abiHash = "",
165 depends = [],
166 abiDepends = [],
167 importDirs = [],
168 hsLibraries = [],
169 extraLibraries = [],
170 extraGHCiLibraries = [],
171 libraryDirs = [],
172 libraryDynDirs = [],
173 frameworks = [],
174 frameworkDirs = [],
175 ldOptions = [],
176 ccOptions = [],
177 includes = [],
178 includeDirs = [],
179 haddockInterfaces = [],
180 haddockHTMLs = [],
181 exposedModules = [],
182 hiddenModules = [],
183 indefinite = False,
184 exposed = False,
185 trusted = False
186 }
187
188 -- | Read the part of the package DB that GHC is interested in.
189 --
190 readPackageDbForGhc :: RepInstalledPackageInfo a b c d e f g =>
191 FilePath -> IO [InstalledPackageInfo a b c d e f g]
192 readPackageDbForGhc file =
193 decodeFromFile file getDbForGhc
194 where
195 getDbForGhc = do
196 _version <- getHeader
197 _ghcPartLen <- get :: Get Word32
198 ghcPart <- get
199 -- the next part is for ghc-pkg, but we stop here.
200 return ghcPart
201
202 -- | Read the part of the package DB that ghc-pkg is interested in
203 --
204 -- Note that the Binary instance for ghc-pkg's representation of packages
205 -- is not defined in this package. This is because ghc-pkg uses Cabal types
206 -- (and Binary instances for these) which this package does not depend on.
207 --
208 readPackageDbForGhcPkg :: Binary pkgs => FilePath -> IO pkgs
209 readPackageDbForGhcPkg file =
210 decodeFromFile file getDbForGhcPkg
211 where
212 getDbForGhcPkg = do
213 _version <- getHeader
214 -- skip over the ghc part
215 ghcPartLen <- get :: Get Word32
216 _ghcPart <- skip (fromIntegral ghcPartLen)
217 -- the next part is for ghc-pkg
218 ghcPkgPart <- get
219 return ghcPkgPart
220
221 -- | Write the whole of the package DB, both parts.
222 --
223 writePackageDb :: (Binary pkgs, RepInstalledPackageInfo a b c d e f g) =>
224 FilePath -> [InstalledPackageInfo a b c d e f g] -> pkgs -> IO ()
225 writePackageDb file ghcPkgs ghcPkgPart =
226 writeFileAtomic file (runPut putDbForGhcPkg)
227 where
228 putDbForGhcPkg = do
229 putHeader
230 put ghcPartLen
231 putLazyByteString ghcPart
232 put ghcPkgPart
233 where
234 ghcPartLen :: Word32
235 ghcPartLen = fromIntegral (BS.Lazy.length ghcPart)
236 ghcPart = encode ghcPkgs
237
238 getHeader :: Get (Word32, Word32)
239 getHeader = do
240 magic <- getByteString (BS.length headerMagic)
241 when (magic /= headerMagic) $
242 fail "not a ghc-pkg db file, wrong file magic number"
243
244 majorVersion <- get :: Get Word32
245 -- The major version is for incompatible changes
246
247 minorVersion <- get :: Get Word32
248 -- The minor version is for compatible extensions
249
250 when (majorVersion /= 1) $
251 fail "unsupported ghc-pkg db format version"
252 -- If we ever support multiple major versions then we'll have to change
253 -- this code
254
255 -- The header can be extended without incrementing the major version,
256 -- we ignore fields we don't know about (currently all).
257 headerExtraLen <- get :: Get Word32
258 skip (fromIntegral headerExtraLen)
259
260 return (majorVersion, minorVersion)
261
262 putHeader :: Put
263 putHeader = do
264 putByteString headerMagic
265 put majorVersion
266 put minorVersion
267 put headerExtraLen
268 where
269 majorVersion = 1 :: Word32
270 minorVersion = 0 :: Word32
271 headerExtraLen = 0 :: Word32
272
273 headerMagic :: BS.ByteString
274 headerMagic = BS.Char8.pack "\0ghcpkg\0"
275
276
277 -- TODO: we may be able to replace the following with utils from the binary
278 -- package in future.
279
280 -- | Feed a 'Get' decoder with data chunks from a file.
281 --
282 decodeFromFile :: FilePath -> Get a -> IO a
283 decodeFromFile file decoder =
284 withBinaryFile file ReadMode $ \hnd ->
285 feed hnd (runGetIncremental decoder)
286 where
287 feed hnd (Partial k) = do chunk <- BS.hGet hnd BS.Lazy.defaultChunkSize
288 if BS.null chunk
289 then feed hnd (k Nothing)
290 else feed hnd (k (Just chunk))
291 feed _ (Done _ _ res) = return res
292 feed _ (Fail _ _ msg) = ioError err
293 where
294 err = mkIOError InappropriateType loc Nothing (Just file)
295 `ioeSetErrorString` msg
296 loc = "GHC.PackageDb.readPackageDb"
297
298 -- Copied from Cabal's Distribution.Simple.Utils.
299 writeFileAtomic :: FilePath -> BS.Lazy.ByteString -> IO ()
300 writeFileAtomic targetPath content = do
301 let (targetDir, targetFile) = splitFileName targetPath
302 Exception.bracketOnError
303 (openBinaryTempFileWithDefaultPermissions targetDir $ targetFile <.> "tmp")
304 (\(tmpPath, handle) -> hClose handle >> removeFile tmpPath)
305 (\(tmpPath, handle) -> do
306 BS.Lazy.hPut handle content
307 hClose handle
308 renameFile tmpPath targetPath)
309
310 instance (RepInstalledPackageInfo a b c d e f g) =>
311 Binary (InstalledPackageInfo a b c d e f g) where
312 put (InstalledPackageInfo
313 unitId componentId instantiatedWith sourcePackageId
314 packageName packageVersion
315 abiHash depends abiDepends importDirs
316 hsLibraries extraLibraries extraGHCiLibraries
317 libraryDirs libraryDynDirs
318 frameworks frameworkDirs
319 ldOptions ccOptions
320 includes includeDirs
321 haddockInterfaces haddockHTMLs
322 exposedModules hiddenModules
323 indefinite exposed trusted) = do
324 put (toStringRep sourcePackageId)
325 put (toStringRep packageName)
326 put packageVersion
327 put (toStringRep unitId)
328 put (toStringRep componentId)
329 put (map (\(mod_name, mod) -> (toStringRep mod_name, toDbModule mod))
330 instantiatedWith)
331 put abiHash
332 put (map toStringRep depends)
333 put (map (\(k,v) -> (toStringRep k, v)) abiDepends)
334 put importDirs
335 put hsLibraries
336 put extraLibraries
337 put extraGHCiLibraries
338 put libraryDirs
339 put libraryDynDirs
340 put frameworks
341 put frameworkDirs
342 put ldOptions
343 put ccOptions
344 put includes
345 put includeDirs
346 put haddockInterfaces
347 put haddockHTMLs
348 put (map (\(mod_name, mb_mod) -> (toStringRep mod_name, fmap toDbModule mb_mod))
349 exposedModules)
350 put (map toStringRep hiddenModules)
351 put indefinite
352 put exposed
353 put trusted
354
355 get = do
356 sourcePackageId <- get
357 packageName <- get
358 packageVersion <- get
359 unitId <- get
360 componentId <- get
361 instantiatedWith <- get
362 abiHash <- get
363 depends <- get
364 abiDepends <- get
365 importDirs <- get
366 hsLibraries <- get
367 extraLibraries <- get
368 extraGHCiLibraries <- get
369 libraryDirs <- get
370 libraryDynDirs <- get
371 frameworks <- get
372 frameworkDirs <- get
373 ldOptions <- get
374 ccOptions <- get
375 includes <- get
376 includeDirs <- get
377 haddockInterfaces <- get
378 haddockHTMLs <- get
379 exposedModules <- get
380 hiddenModules <- get
381 indefinite <- get
382 exposed <- get
383 trusted <- get
384 return (InstalledPackageInfo
385 (fromStringRep unitId)
386 (fromStringRep componentId)
387 (map (\(mod_name, mod) -> (fromStringRep mod_name, fromDbModule mod))
388 instantiatedWith)
389 (fromStringRep sourcePackageId)
390 (fromStringRep packageName) packageVersion
391 abiHash
392 (map fromStringRep depends)
393 (map (\(k,v) -> (fromStringRep k, v)) abiDepends)
394 importDirs
395 hsLibraries extraLibraries extraGHCiLibraries
396 libraryDirs libraryDynDirs
397 frameworks frameworkDirs
398 ldOptions ccOptions
399 includes includeDirs
400 haddockInterfaces haddockHTMLs
401 (map (\(mod_name, mb_mod) ->
402 (fromStringRep mod_name, fmap fromDbModule mb_mod))
403 exposedModules)
404 (map fromStringRep hiddenModules)
405 indefinite exposed trusted)
406
407 instance (BinaryStringRep modulename, BinaryStringRep compid,
408 BinaryStringRep instunitid,
409 DbUnitIdModuleRep instunitid compid unitid modulename mod) =>
410 Binary (DbModule instunitid compid unitid modulename mod) where
411 put (DbModule dbModuleUnitId dbModuleName) = do
412 putWord8 0
413 put (toDbUnitId dbModuleUnitId)
414 put (toStringRep dbModuleName)
415 put (DbModuleVar dbModuleVarName) = do
416 putWord8 1
417 put (toStringRep dbModuleVarName)
418 get = do
419 b <- getWord8
420 case b of
421 0 -> do dbModuleUnitId <- get
422 dbModuleName <- get
423 return (DbModule (fromDbUnitId dbModuleUnitId)
424 (fromStringRep dbModuleName))
425 _ -> do dbModuleVarName <- get
426 return (DbModuleVar (fromStringRep dbModuleVarName))
427
428 instance (BinaryStringRep modulename, BinaryStringRep compid,
429 BinaryStringRep instunitid,
430 DbUnitIdModuleRep instunitid compid unitid modulename mod) =>
431 Binary (DbUnitId instunitid compid unitid modulename mod) where
432 put (DbInstalledUnitId instunitid) = do
433 putWord8 0
434 put (toStringRep instunitid)
435 put (DbUnitId dbUnitIdComponentId dbUnitIdInsts) = do
436 putWord8 1
437 put (toStringRep dbUnitIdComponentId)
438 put (map (\(mod_name, mod) -> (toStringRep mod_name, toDbModule mod)) dbUnitIdInsts)
439 get = do
440 b <- getWord8
441 case b of
442 0 -> do
443 instunitid <- get
444 return (DbInstalledUnitId (fromStringRep instunitid))
445 _ -> do
446 dbUnitIdComponentId <- get
447 dbUnitIdInsts <- get
448 return (DbUnitId
449 (fromStringRep dbUnitIdComponentId)
450 (map (\(mod_name, mod) -> ( fromStringRep mod_name
451 , fromDbModule mod))
452 dbUnitIdInsts))