Switch from -this-package-key to -this-unit-id.
[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 srcpkgid srcpkgname unitid modulename
68 = InstalledPackageInfo {
69 unitId :: unitid,
70 sourcePackageId :: srcpkgid,
71 packageName :: srcpkgname,
72 packageVersion :: Version,
73 abiHash :: String,
74 depends :: [unitid],
75 importDirs :: [FilePath],
76 hsLibraries :: [String],
77 extraLibraries :: [String],
78 extraGHCiLibraries :: [String],
79 libraryDirs :: [FilePath],
80 frameworks :: [String],
81 frameworkDirs :: [FilePath],
82 ldOptions :: [String],
83 ccOptions :: [String],
84 includes :: [String],
85 includeDirs :: [FilePath],
86 haddockInterfaces :: [FilePath],
87 haddockHTMLs :: [FilePath],
88 exposedModules :: [ExposedModule unitid modulename],
89 hiddenModules :: [modulename],
90 exposed :: Bool,
91 trusted :: Bool
92 }
93 deriving (Eq, Show)
94
95 -- | An original module is a fully-qualified module name (installed package ID
96 -- plus module name) representing where a module was *originally* defined
97 -- (i.e., the 'exposedReexport' field of the original ExposedModule entry should
98 -- be 'Nothing'). Invariant: an OriginalModule never points to a reexport.
99 data OriginalModule unitid modulename
100 = OriginalModule {
101 originalPackageId :: unitid,
102 originalModuleName :: modulename
103 }
104 deriving (Eq, Show)
105
106 -- | Represents a module name which is exported by a package, stored in the
107 -- 'exposedModules' field. A module export may be a reexport (in which case
108 -- 'exposedReexport' is filled in with the original source of the module).
109 -- Thus:
110 --
111 -- * @ExposedModule n Nothing@ represents an exposed module @n@ which
112 -- was defined in this package.
113 --
114 -- * @ExposedModule n (Just o)@ represents a reexported module @n@
115 -- which was originally defined in @o@.
116 --
117 -- We use a 'Maybe' data types instead of an ADT with two branches because this
118 -- representation allows us to treat reexports uniformly.
119 data ExposedModule unitid modulename
120 = ExposedModule {
121 exposedName :: modulename,
122 exposedReexport :: Maybe (OriginalModule unitid modulename)
123 }
124 deriving (Eq, Show)
125
126 class BinaryStringRep a where
127 fromStringRep :: BS.ByteString -> a
128 toStringRep :: a -> BS.ByteString
129
130 emptyInstalledPackageInfo :: (BinaryStringRep a, BinaryStringRep b,
131 BinaryStringRep c)
132 => InstalledPackageInfo a b c d
133 emptyInstalledPackageInfo =
134 InstalledPackageInfo {
135 unitId = fromStringRep BS.empty,
136 sourcePackageId = fromStringRep BS.empty,
137 packageName = fromStringRep BS.empty,
138 packageVersion = Version [] [],
139 abiHash = "",
140 depends = [],
141 importDirs = [],
142 hsLibraries = [],
143 extraLibraries = [],
144 extraGHCiLibraries = [],
145 libraryDirs = [],
146 frameworks = [],
147 frameworkDirs = [],
148 ldOptions = [],
149 ccOptions = [],
150 includes = [],
151 includeDirs = [],
152 haddockInterfaces = [],
153 haddockHTMLs = [],
154 exposedModules = [],
155 hiddenModules = [],
156 exposed = False,
157 trusted = False
158 }
159
160 -- | Read the part of the package DB that GHC is interested in.
161 --
162 readPackageDbForGhc :: (BinaryStringRep a, BinaryStringRep b, BinaryStringRep c,
163 BinaryStringRep d) =>
164 FilePath -> IO [InstalledPackageInfo a b c d]
165 readPackageDbForGhc file =
166 decodeFromFile file getDbForGhc
167 where
168 getDbForGhc = do
169 _version <- getHeader
170 _ghcPartLen <- get :: Get Word32
171 ghcPart <- get
172 -- the next part is for ghc-pkg, but we stop here.
173 return ghcPart
174
175 -- | Read the part of the package DB that ghc-pkg is interested in
176 --
177 -- Note that the Binary instance for ghc-pkg's representation of packages
178 -- is not defined in this package. This is because ghc-pkg uses Cabal types
179 -- (and Binary instances for these) which this package does not depend on.
180 --
181 readPackageDbForGhcPkg :: Binary pkgs => FilePath -> IO pkgs
182 readPackageDbForGhcPkg file =
183 decodeFromFile file getDbForGhcPkg
184 where
185 getDbForGhcPkg = do
186 _version <- getHeader
187 -- skip over the ghc part
188 ghcPartLen <- get :: Get Word32
189 _ghcPart <- skip (fromIntegral ghcPartLen)
190 -- the next part is for ghc-pkg
191 ghcPkgPart <- get
192 return ghcPkgPart
193
194 -- | Write the whole of the package DB, both parts.
195 --
196 writePackageDb :: (Binary pkgs, BinaryStringRep a, BinaryStringRep b,
197 BinaryStringRep c, BinaryStringRep d) =>
198 FilePath -> [InstalledPackageInfo a b c d] -> pkgs -> IO ()
199 writePackageDb file ghcPkgs ghcPkgPart =
200 writeFileAtomic file (runPut putDbForGhcPkg)
201 where
202 putDbForGhcPkg = do
203 putHeader
204 put ghcPartLen
205 putLazyByteString ghcPart
206 put ghcPkgPart
207 where
208 ghcPartLen :: Word32
209 ghcPartLen = fromIntegral (BS.Lazy.length ghcPart)
210 ghcPart = encode ghcPkgs
211
212 getHeader :: Get (Word32, Word32)
213 getHeader = do
214 magic <- getByteString (BS.length headerMagic)
215 when (magic /= headerMagic) $
216 fail "not a ghc-pkg db file, wrong file magic number"
217
218 majorVersion <- get :: Get Word32
219 -- The major version is for incompatible changes
220
221 minorVersion <- get :: Get Word32
222 -- The minor version is for compatible extensions
223
224 when (majorVersion /= 1) $
225 fail "unsupported ghc-pkg db format version"
226 -- If we ever support multiple major versions then we'll have to change
227 -- this code
228
229 -- The header can be extended without incrementing the major version,
230 -- we ignore fields we don't know about (currently all).
231 headerExtraLen <- get :: Get Word32
232 skip (fromIntegral headerExtraLen)
233
234 return (majorVersion, minorVersion)
235
236 putHeader :: Put
237 putHeader = do
238 putByteString headerMagic
239 put majorVersion
240 put minorVersion
241 put headerExtraLen
242 where
243 majorVersion = 1 :: Word32
244 minorVersion = 0 :: Word32
245 headerExtraLen = 0 :: Word32
246
247 headerMagic :: BS.ByteString
248 headerMagic = BS.Char8.pack "\0ghcpkg\0"
249
250
251 -- TODO: we may be able to replace the following with utils from the binary
252 -- package in future.
253
254 -- | Feed a 'Get' decoder with data chunks from a file.
255 --
256 decodeFromFile :: FilePath -> Get a -> IO a
257 decodeFromFile file decoder =
258 withBinaryFile file ReadMode $ \hnd ->
259 feed hnd (runGetIncremental decoder)
260 where
261 feed hnd (Partial k) = do chunk <- BS.hGet hnd BS.Lazy.defaultChunkSize
262 if BS.null chunk
263 then feed hnd (k Nothing)
264 else feed hnd (k (Just chunk))
265 feed _ (Done _ _ res) = return res
266 feed _ (Fail _ _ msg) = ioError err
267 where
268 err = mkIOError InappropriateType loc Nothing (Just file)
269 `ioeSetErrorString` msg
270 loc = "GHC.PackageDb.readPackageDb"
271
272 -- Copied from Cabal's Distribution.Simple.Utils.
273 writeFileAtomic :: FilePath -> BS.Lazy.ByteString -> IO ()
274 writeFileAtomic targetPath content = do
275 let (targetDir, targetFile) = splitFileName targetPath
276 Exception.bracketOnError
277 (openBinaryTempFileWithDefaultPermissions targetDir $ targetFile <.> "tmp")
278 (\(tmpPath, handle) -> hClose handle >> removeFile tmpPath)
279 (\(tmpPath, handle) -> do
280 BS.Lazy.hPut handle content
281 hClose handle
282 renameFile tmpPath targetPath)
283
284 instance (BinaryStringRep a, BinaryStringRep b, BinaryStringRep c,
285 BinaryStringRep d) =>
286 Binary (InstalledPackageInfo a b c d) where
287 put (InstalledPackageInfo
288 unitId sourcePackageId
289 packageName packageVersion
290 abiHash depends importDirs
291 hsLibraries extraLibraries extraGHCiLibraries libraryDirs
292 frameworks frameworkDirs
293 ldOptions ccOptions
294 includes includeDirs
295 haddockInterfaces haddockHTMLs
296 exposedModules hiddenModules
297 exposed trusted) = do
298 put (toStringRep sourcePackageId)
299 put (toStringRep packageName)
300 put packageVersion
301 put (toStringRep unitId)
302 put abiHash
303 put (map toStringRep depends)
304 put importDirs
305 put hsLibraries
306 put extraLibraries
307 put extraGHCiLibraries
308 put libraryDirs
309 put frameworks
310 put frameworkDirs
311 put ldOptions
312 put ccOptions
313 put includes
314 put includeDirs
315 put haddockInterfaces
316 put haddockHTMLs
317 put exposedModules
318 put (map toStringRep hiddenModules)
319 put exposed
320 put trusted
321
322 get = do
323 sourcePackageId <- get
324 packageName <- get
325 packageVersion <- get
326 unitId <- get
327 abiHash <- get
328 depends <- get
329 importDirs <- get
330 hsLibraries <- get
331 extraLibraries <- get
332 extraGHCiLibraries <- get
333 libraryDirs <- get
334 frameworks <- get
335 frameworkDirs <- get
336 ldOptions <- get
337 ccOptions <- get
338 includes <- get
339 includeDirs <- get
340 haddockInterfaces <- get
341 haddockHTMLs <- get
342 exposedModules <- get
343 hiddenModules <- get
344 exposed <- get
345 trusted <- get
346 return (InstalledPackageInfo
347 (fromStringRep unitId)
348 (fromStringRep sourcePackageId)
349 (fromStringRep packageName) packageVersion
350 abiHash
351 (map fromStringRep depends)
352 importDirs
353 hsLibraries extraLibraries extraGHCiLibraries libraryDirs
354 frameworks frameworkDirs
355 ldOptions ccOptions
356 includes includeDirs
357 haddockInterfaces haddockHTMLs
358 exposedModules
359 (map fromStringRep hiddenModules)
360 exposed trusted)
361
362 instance (BinaryStringRep a, BinaryStringRep b) =>
363 Binary (OriginalModule a b) where
364 put (OriginalModule originalPackageId originalModuleName) = do
365 put (toStringRep originalPackageId)
366 put (toStringRep originalModuleName)
367 get = do
368 originalPackageId <- get
369 originalModuleName <- get
370 return (OriginalModule (fromStringRep originalPackageId)
371 (fromStringRep originalModuleName))
372
373 instance (BinaryStringRep a, BinaryStringRep b) =>
374 Binary (ExposedModule a b) where
375 put (ExposedModule exposedName exposedReexport) = do
376 put (toStringRep exposedName)
377 put exposedReexport
378 get = do
379 exposedName <- get
380 exposedReexport <- get
381 return (ExposedModule (fromStringRep exposedName)
382 exposedReexport)