09991092ee92bf90f710f171e2a1fb199d748ee2
[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.
70 --
71 data InstalledPackageInfo compid srcpkgid srcpkgname instunitid unitid modulename mod
72 = InstalledPackageInfo {
73 unitId :: instunitid,
74 componentId :: compid,
75 instantiatedWith :: [(modulename, mod)],
76 sourcePackageId :: srcpkgid,
77 packageName :: srcpkgname,
78 packageVersion :: Version,
79 abiHash :: String,
80 depends :: [instunitid],
81 importDirs :: [FilePath],
82 hsLibraries :: [String],
83 extraLibraries :: [String],
84 extraGHCiLibraries :: [String],
85 libraryDirs :: [FilePath],
86 libraryDynDirs :: [FilePath],
87 frameworks :: [String],
88 frameworkDirs :: [FilePath],
89 ldOptions :: [String],
90 ccOptions :: [String],
91 includes :: [String],
92 includeDirs :: [FilePath],
93 haddockInterfaces :: [FilePath],
94 haddockHTMLs :: [FilePath],
95 exposedModules :: [(modulename, Maybe mod)],
96 hiddenModules :: [modulename],
97 indefinite :: Bool,
98 exposed :: Bool,
99 trusted :: Bool
100 }
101 deriving (Eq, Show)
102
103 -- | A convenience constraint synonym for common constraints over parameters
104 -- to 'InstalledPackageInfo'.
105 type RepInstalledPackageInfo compid srcpkgid srcpkgname instunitid unitid modulename mod =
106 (BinaryStringRep srcpkgid, BinaryStringRep srcpkgname,
107 BinaryStringRep modulename, BinaryStringRep compid,
108 BinaryStringRep instunitid,
109 DbUnitIdModuleRep instunitid compid unitid modulename mod)
110
111 -- | A type-class for the types which can be converted into 'DbModule'/'DbUnitId'.
112 -- There is only one type class because these types are mutually recursive.
113 -- NB: The functional dependency helps out type inference in cases
114 -- where types would be ambiguous.
115 class DbUnitIdModuleRep instunitid compid unitid modulename mod
116 | mod -> unitid, unitid -> mod, mod -> modulename, unitid -> compid, unitid -> instunitid
117 where
118 fromDbModule :: DbModule instunitid compid unitid modulename mod -> mod
119 toDbModule :: mod -> DbModule instunitid compid unitid modulename mod
120 fromDbUnitId :: DbUnitId instunitid compid unitid modulename mod -> unitid
121 toDbUnitId :: unitid -> DbUnitId instunitid compid unitid modulename mod
122
123 -- | @ghc-boot@'s copy of 'Module', i.e. what is serialized to the database.
124 -- Use 'DbUnitIdModuleRep' to convert it into an actual 'Module'.
125 -- It has phantom type parameters as this is the most convenient way
126 -- to avoid undecidable instances.
127 data DbModule instunitid compid unitid modulename mod
128 = DbModule {
129 dbModuleUnitId :: unitid,
130 dbModuleName :: modulename
131 }
132 | DbModuleVar {
133 dbModuleVarName :: modulename
134 }
135 deriving (Eq, Show)
136
137 -- | @ghc-boot@'s copy of 'UnitId', i.e. what is serialized to the database.
138 -- Use 'DbUnitIdModuleRep' to convert it into an actual 'UnitId'.
139 -- It has phantom type parameters as this is the most convenient way
140 -- to avoid undecidable instances.
141 data DbUnitId instunitid compid unitid modulename mod
142 = DbUnitId compid [(modulename, mod)]
143 | DbInstalledUnitId instunitid
144 deriving (Eq, Show)
145
146 class BinaryStringRep a where
147 fromStringRep :: BS.ByteString -> a
148 toStringRep :: a -> BS.ByteString
149
150 emptyInstalledPackageInfo :: RepInstalledPackageInfo a b c d e f g
151 => InstalledPackageInfo a b c d e f g
152 emptyInstalledPackageInfo =
153 InstalledPackageInfo {
154 unitId = fromStringRep BS.empty,
155 componentId = fromStringRep BS.empty,
156 instantiatedWith = [],
157 sourcePackageId = fromStringRep BS.empty,
158 packageName = fromStringRep BS.empty,
159 packageVersion = Version [] [],
160 abiHash = "",
161 depends = [],
162 importDirs = [],
163 hsLibraries = [],
164 extraLibraries = [],
165 extraGHCiLibraries = [],
166 libraryDirs = [],
167 libraryDynDirs = [],
168 frameworks = [],
169 frameworkDirs = [],
170 ldOptions = [],
171 ccOptions = [],
172 includes = [],
173 includeDirs = [],
174 haddockInterfaces = [],
175 haddockHTMLs = [],
176 exposedModules = [],
177 hiddenModules = [],
178 indefinite = False,
179 exposed = False,
180 trusted = False
181 }
182
183 -- | Read the part of the package DB that GHC is interested in.
184 --
185 readPackageDbForGhc :: RepInstalledPackageInfo a b c d e f g =>
186 FilePath -> IO [InstalledPackageInfo a b c d e f g]
187 readPackageDbForGhc file =
188 decodeFromFile file getDbForGhc
189 where
190 getDbForGhc = do
191 _version <- getHeader
192 _ghcPartLen <- get :: Get Word32
193 ghcPart <- get
194 -- the next part is for ghc-pkg, but we stop here.
195 return ghcPart
196
197 -- | Read the part of the package DB that ghc-pkg is interested in
198 --
199 -- Note that the Binary instance for ghc-pkg's representation of packages
200 -- is not defined in this package. This is because ghc-pkg uses Cabal types
201 -- (and Binary instances for these) which this package does not depend on.
202 --
203 readPackageDbForGhcPkg :: Binary pkgs => FilePath -> IO pkgs
204 readPackageDbForGhcPkg file =
205 decodeFromFile file getDbForGhcPkg
206 where
207 getDbForGhcPkg = do
208 _version <- getHeader
209 -- skip over the ghc part
210 ghcPartLen <- get :: Get Word32
211 _ghcPart <- skip (fromIntegral ghcPartLen)
212 -- the next part is for ghc-pkg
213 ghcPkgPart <- get
214 return ghcPkgPart
215
216 -- | Write the whole of the package DB, both parts.
217 --
218 writePackageDb :: (Binary pkgs, RepInstalledPackageInfo a b c d e f g) =>
219 FilePath -> [InstalledPackageInfo a b c d e f g] -> pkgs -> IO ()
220 writePackageDb file ghcPkgs ghcPkgPart =
221 writeFileAtomic file (runPut putDbForGhcPkg)
222 where
223 putDbForGhcPkg = do
224 putHeader
225 put ghcPartLen
226 putLazyByteString ghcPart
227 put ghcPkgPart
228 where
229 ghcPartLen :: Word32
230 ghcPartLen = fromIntegral (BS.Lazy.length ghcPart)
231 ghcPart = encode ghcPkgs
232
233 getHeader :: Get (Word32, Word32)
234 getHeader = do
235 magic <- getByteString (BS.length headerMagic)
236 when (magic /= headerMagic) $
237 fail "not a ghc-pkg db file, wrong file magic number"
238
239 majorVersion <- get :: Get Word32
240 -- The major version is for incompatible changes
241
242 minorVersion <- get :: Get Word32
243 -- The minor version is for compatible extensions
244
245 when (majorVersion /= 1) $
246 fail "unsupported ghc-pkg db format version"
247 -- If we ever support multiple major versions then we'll have to change
248 -- this code
249
250 -- The header can be extended without incrementing the major version,
251 -- we ignore fields we don't know about (currently all).
252 headerExtraLen <- get :: Get Word32
253 skip (fromIntegral headerExtraLen)
254
255 return (majorVersion, minorVersion)
256
257 putHeader :: Put
258 putHeader = do
259 putByteString headerMagic
260 put majorVersion
261 put minorVersion
262 put headerExtraLen
263 where
264 majorVersion = 1 :: Word32
265 minorVersion = 0 :: Word32
266 headerExtraLen = 0 :: Word32
267
268 headerMagic :: BS.ByteString
269 headerMagic = BS.Char8.pack "\0ghcpkg\0"
270
271
272 -- TODO: we may be able to replace the following with utils from the binary
273 -- package in future.
274
275 -- | Feed a 'Get' decoder with data chunks from a file.
276 --
277 decodeFromFile :: FilePath -> Get a -> IO a
278 decodeFromFile file decoder =
279 withBinaryFile file ReadMode $ \hnd ->
280 feed hnd (runGetIncremental decoder)
281 where
282 feed hnd (Partial k) = do chunk <- BS.hGet hnd BS.Lazy.defaultChunkSize
283 if BS.null chunk
284 then feed hnd (k Nothing)
285 else feed hnd (k (Just chunk))
286 feed _ (Done _ _ res) = return res
287 feed _ (Fail _ _ msg) = ioError err
288 where
289 err = mkIOError InappropriateType loc Nothing (Just file)
290 `ioeSetErrorString` msg
291 loc = "GHC.PackageDb.readPackageDb"
292
293 -- Copied from Cabal's Distribution.Simple.Utils.
294 writeFileAtomic :: FilePath -> BS.Lazy.ByteString -> IO ()
295 writeFileAtomic targetPath content = do
296 let (targetDir, targetFile) = splitFileName targetPath
297 Exception.bracketOnError
298 (openBinaryTempFileWithDefaultPermissions targetDir $ targetFile <.> "tmp")
299 (\(tmpPath, handle) -> hClose handle >> removeFile tmpPath)
300 (\(tmpPath, handle) -> do
301 BS.Lazy.hPut handle content
302 hClose handle
303 renameFile tmpPath targetPath)
304
305 instance (RepInstalledPackageInfo a b c d e f g) =>
306 Binary (InstalledPackageInfo a b c d e f g) where
307 put (InstalledPackageInfo
308 unitId componentId instantiatedWith sourcePackageId
309 packageName packageVersion
310 abiHash depends importDirs
311 hsLibraries extraLibraries extraGHCiLibraries
312 libraryDirs libraryDynDirs
313 frameworks frameworkDirs
314 ldOptions ccOptions
315 includes includeDirs
316 haddockInterfaces haddockHTMLs
317 exposedModules hiddenModules
318 indefinite exposed trusted) = do
319 put (toStringRep sourcePackageId)
320 put (toStringRep packageName)
321 put packageVersion
322 put (toStringRep unitId)
323 put (toStringRep componentId)
324 put (map (\(mod_name, mod) -> (toStringRep mod_name, toDbModule mod))
325 instantiatedWith)
326 put abiHash
327 put (map toStringRep depends)
328 put importDirs
329 put hsLibraries
330 put extraLibraries
331 put extraGHCiLibraries
332 put libraryDirs
333 put libraryDynDirs
334 put frameworks
335 put frameworkDirs
336 put ldOptions
337 put ccOptions
338 put includes
339 put includeDirs
340 put haddockInterfaces
341 put haddockHTMLs
342 put (map (\(mod_name, mb_mod) -> (toStringRep mod_name, fmap toDbModule mb_mod))
343 exposedModules)
344 put (map toStringRep hiddenModules)
345 put indefinite
346 put exposed
347 put trusted
348
349 get = do
350 sourcePackageId <- get
351 packageName <- get
352 packageVersion <- get
353 unitId <- get
354 componentId <- get
355 instantiatedWith <- get
356 abiHash <- get
357 depends <- get
358 importDirs <- get
359 hsLibraries <- get
360 extraLibraries <- get
361 extraGHCiLibraries <- get
362 libraryDirs <- get
363 libraryDynDirs <- get
364 frameworks <- get
365 frameworkDirs <- get
366 ldOptions <- get
367 ccOptions <- get
368 includes <- get
369 includeDirs <- get
370 haddockInterfaces <- get
371 haddockHTMLs <- get
372 exposedModules <- get
373 hiddenModules <- get
374 indefinite <- get
375 exposed <- get
376 trusted <- get
377 return (InstalledPackageInfo
378 (fromStringRep unitId)
379 (fromStringRep componentId)
380 (map (\(mod_name, mod) -> (fromStringRep mod_name, fromDbModule mod))
381 instantiatedWith)
382 (fromStringRep sourcePackageId)
383 (fromStringRep packageName) packageVersion
384 abiHash
385 (map fromStringRep depends)
386 importDirs
387 hsLibraries extraLibraries extraGHCiLibraries
388 libraryDirs libraryDynDirs
389 frameworks frameworkDirs
390 ldOptions ccOptions
391 includes includeDirs
392 haddockInterfaces haddockHTMLs
393 (map (\(mod_name, mb_mod) ->
394 (fromStringRep mod_name, fmap fromDbModule mb_mod))
395 exposedModules)
396 (map fromStringRep hiddenModules)
397 indefinite exposed trusted)
398
399 instance (BinaryStringRep modulename, BinaryStringRep compid,
400 BinaryStringRep instunitid,
401 DbUnitIdModuleRep instunitid compid unitid modulename mod) =>
402 Binary (DbModule instunitid compid unitid modulename mod) where
403 put (DbModule dbModuleUnitId dbModuleName) = do
404 putWord8 0
405 put (toDbUnitId dbModuleUnitId)
406 put (toStringRep dbModuleName)
407 put (DbModuleVar dbModuleVarName) = do
408 putWord8 1
409 put (toStringRep dbModuleVarName)
410 get = do
411 b <- getWord8
412 case b of
413 0 -> do dbModuleUnitId <- get
414 dbModuleName <- get
415 return (DbModule (fromDbUnitId dbModuleUnitId)
416 (fromStringRep dbModuleName))
417 _ -> do dbModuleVarName <- get
418 return (DbModuleVar (fromStringRep dbModuleVarName))
419
420 instance (BinaryStringRep modulename, BinaryStringRep compid,
421 BinaryStringRep instunitid,
422 DbUnitIdModuleRep instunitid compid unitid modulename mod) =>
423 Binary (DbUnitId instunitid compid unitid modulename mod) where
424 put (DbInstalledUnitId instunitid) = do
425 putWord8 0
426 put (toStringRep instunitid)
427 put (DbUnitId dbUnitIdComponentId dbUnitIdInsts) = do
428 putWord8 1
429 put (toStringRep dbUnitIdComponentId)
430 put (map (\(mod_name, mod) -> (toStringRep mod_name, toDbModule mod)) dbUnitIdInsts)
431 get = do
432 b <- getWord8
433 case b of
434 0 -> do
435 instunitid <- get
436 return (DbInstalledUnitId (fromStringRep instunitid))
437 _ -> do
438 dbUnitIdComponentId <- get
439 dbUnitIdInsts <- get
440 return (DbUnitId
441 (fromStringRep dbUnitIdComponentId)
442 (map (\(mod_name, mod) -> ( fromStringRep mod_name
443 , fromDbModule mod))
444 dbUnitIdInsts))