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