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