Make dataToQa aware of Data instances which use functions to implement toConstr
[ghc.git] / libraries / ghc-boot / GHC / PackageDb.hs
1 {-# LANGUAGE CPP #-}
2 -- This module deliberately defines orphan instances for now (Binary Version).
3 {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-name-shadowing #-}
4 -----------------------------------------------------------------------------
5 -- |
6 -- Module : GHC.PackageDb
7 -- Copyright : (c) The University of Glasgow 2009, Duncan Coutts 2014
8 --
9 -- Maintainer : ghc-devs@haskell.org
10 -- Portability : portable
11 --
12 -- This module provides the view of GHC's database of registered packages that
13 -- is shared between GHC the compiler\/library, and the ghc-pkg program. It
14 -- defines the database format that is shared between GHC and ghc-pkg.
15 --
16 -- The database format, and this library are constructed so that GHC does not
17 -- have to depend on the Cabal library. The ghc-pkg program acts as the
18 -- gateway between the external package format (which is defined by Cabal) and
19 -- the internal package format which is specialised just for GHC.
20 --
21 -- GHC the compiler only needs some of the information which is kept about
22 -- registerd packages, such as module names, various paths etc. On the other
23 -- hand ghc-pkg has to keep all the information from Cabal packages and be able
24 -- to regurgitate it for users and other tools.
25 --
26 -- The first trick is that we duplicate some of the information in the package
27 -- database. We essentially keep two versions of the datbase in one file, one
28 -- version used only by ghc-pkg which keeps the full information (using the
29 -- serialised form of the 'InstalledPackageInfo' type defined by the Cabal
30 -- library); and a second version written by ghc-pkg and read by GHC which has
31 -- just the subset of information that GHC needs.
32 --
33 -- The second trick is that this module only defines in detail the format of
34 -- the second version -- the bit GHC uses -- and the part managed by ghc-pkg
35 -- is kept in the file but here we treat it as an opaque blob of data. That way
36 -- this library avoids depending on Cabal.
37 --
38 module GHC.PackageDb (
39 InstalledPackageInfo(..),
40 ExposedModule(..),
41 OriginalModule(..),
42 BinaryStringRep(..),
43 emptyInstalledPackageInfo,
44 readPackageDbForGhc,
45 readPackageDbForGhcPkg,
46 writePackageDb
47 ) where
48
49 import Data.Version (Version(..))
50 import qualified Data.ByteString as BS
51 import qualified Data.ByteString.Char8 as BS.Char8
52 import qualified Data.ByteString.Lazy as BS.Lazy
53 import qualified Data.ByteString.Lazy.Internal as BS.Lazy (defaultChunkSize)
54 import Data.Binary as Bin
55 import Data.Binary.Put as Bin
56 import Data.Binary.Get as Bin
57 import Control.Exception as Exception
58 import Control.Monad (when)
59 import System.FilePath
60 import System.IO
61 import System.IO.Error
62 import GHC.IO.Exception (IOErrorType(InappropriateType))
63 import System.Directory
64
65
66 -- | This is a subset of Cabal's 'InstalledPackageInfo', with just the bits
67 -- that GHC is interested in.
68 --
69 data InstalledPackageInfo instpkgid srcpkgid srcpkgname pkgkey modulename
70 = InstalledPackageInfo {
71 installedPackageId :: instpkgid,
72 sourcePackageId :: srcpkgid,
73 packageName :: srcpkgname,
74 packageVersion :: Version,
75 packageKey :: pkgkey,
76 depends :: [instpkgid],
77 importDirs :: [FilePath],
78 hsLibraries :: [String],
79 extraLibraries :: [String],
80 extraGHCiLibraries :: [String],
81 libraryDirs :: [FilePath],
82 frameworks :: [String],
83 frameworkDirs :: [FilePath],
84 ldOptions :: [String],
85 ccOptions :: [String],
86 includes :: [String],
87 includeDirs :: [FilePath],
88 haddockInterfaces :: [FilePath],
89 haddockHTMLs :: [FilePath],
90 exposedModules :: [ExposedModule instpkgid modulename],
91 hiddenModules :: [modulename],
92 instantiatedWith :: [(modulename,OriginalModule instpkgid modulename)],
93 exposed :: Bool,
94 trusted :: Bool
95 }
96 deriving (Eq, Show)
97
98 -- | An original module is a fully-qualified module name (installed package ID
99 -- plus module name) representing where a module was *originally* defined
100 -- (i.e., the 'exposedReexport' field of the original ExposedModule entry should
101 -- be 'Nothing'). Invariant: an OriginalModule never points to a reexport.
102 data OriginalModule instpkgid modulename
103 = OriginalModule {
104 originalPackageId :: instpkgid,
105 originalModuleName :: modulename
106 }
107 deriving (Eq, Show)
108
109 -- | Represents a module name which is exported by a package, stored in the
110 -- 'exposedModules' field. A module export may be a reexport (in which
111 -- case 'exposedReexport' is filled in with the original source of the module),
112 -- and may be a signature (in which case 'exposedSignature is filled in with
113 -- what the signature was compiled against). Thus:
114 --
115 -- * @ExposedModule n Nothing Nothing@ represents an exposed module @n@ which
116 -- was defined in this package.
117 --
118 -- * @ExposedModule n (Just o) Nothing@ represents a reexported module @n@
119 -- which was originally defined in @o@.
120 --
121 -- * @ExposedModule n Nothing (Just s)@ represents an exposed signature @n@
122 -- which was compiled against the implementation @s@.
123 --
124 -- * @ExposedModule n (Just o) (Just s)@ represents a reexported signature
125 -- which was originally defined in @o@ and was compiled against the
126 -- implementation @s@.
127 --
128 -- We use two 'Maybe' data types instead of an ADT with four branches or
129 -- four fields because this representation allows us to treat
130 -- reexports/signatures uniformly.
131 data ExposedModule instpkgid modulename
132 = ExposedModule {
133 exposedName :: modulename,
134 exposedReexport :: Maybe (OriginalModule instpkgid modulename),
135 exposedSignature :: Maybe (OriginalModule instpkgid modulename)
136 }
137 deriving (Eq, Show)
138
139 class BinaryStringRep a where
140 fromStringRep :: BS.ByteString -> a
141 toStringRep :: a -> BS.ByteString
142
143 emptyInstalledPackageInfo :: (BinaryStringRep a, BinaryStringRep b,
144 BinaryStringRep c, BinaryStringRep d)
145 => InstalledPackageInfo a b c d e
146 emptyInstalledPackageInfo =
147 InstalledPackageInfo {
148 installedPackageId = fromStringRep BS.empty,
149 sourcePackageId = fromStringRep BS.empty,
150 packageName = fromStringRep BS.empty,
151 packageVersion = Version [] [],
152 packageKey = fromStringRep BS.empty,
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 installedPackageId sourcePackageId
303 packageName packageVersion packageKey
304 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 installedPackageId)
313 put (toStringRep sourcePackageId)
314 put (toStringRep packageName)
315 put packageVersion
316 put (toStringRep packageKey)
317 put (map toStringRep depends)
318 put importDirs
319 put hsLibraries
320 put extraLibraries
321 put extraGHCiLibraries
322 put libraryDirs
323 put frameworks
324 put frameworkDirs
325 put ldOptions
326 put ccOptions
327 put includes
328 put includeDirs
329 put haddockInterfaces
330 put haddockHTMLs
331 put exposedModules
332 put (map toStringRep hiddenModules)
333 put (map (\(k,v) -> (toStringRep k, v)) instantiatedWith)
334 put exposed
335 put trusted
336
337 get = do
338 installedPackageId <- get
339 sourcePackageId <- get
340 packageName <- get
341 packageVersion <- get
342 packageKey <- get
343 depends <- get
344 importDirs <- get
345 hsLibraries <- get
346 extraLibraries <- get
347 extraGHCiLibraries <- get
348 libraryDirs <- get
349 frameworks <- get
350 frameworkDirs <- get
351 ldOptions <- get
352 ccOptions <- get
353 includes <- get
354 includeDirs <- get
355 haddockInterfaces <- get
356 haddockHTMLs <- get
357 exposedModules <- get
358 hiddenModules <- get
359 instantiatedWith <- get
360 exposed <- get
361 trusted <- get
362 return (InstalledPackageInfo
363 (fromStringRep installedPackageId)
364 (fromStringRep sourcePackageId)
365 (fromStringRep packageName) packageVersion
366 (fromStringRep packageKey)
367 (map fromStringRep depends)
368 importDirs
369 hsLibraries extraLibraries extraGHCiLibraries libraryDirs
370 frameworks frameworkDirs
371 ldOptions ccOptions
372 includes includeDirs
373 haddockInterfaces haddockHTMLs
374 exposedModules
375 (map fromStringRep hiddenModules)
376 (map (\(k,v) -> (fromStringRep k, v)) instantiatedWith)
377 exposed trusted)
378
379 instance Binary Version where
380 put (Version a b) = do
381 put a
382 put b
383 get = do
384 a <- get
385 b <- get
386 return (Version a b)
387
388 instance (BinaryStringRep a, BinaryStringRep b) =>
389 Binary (OriginalModule a b) where
390 put (OriginalModule originalPackageId originalModuleName) = do
391 put (toStringRep originalPackageId)
392 put (toStringRep originalModuleName)
393 get = do
394 originalPackageId <- get
395 originalModuleName <- get
396 return (OriginalModule (fromStringRep originalPackageId)
397 (fromStringRep originalModuleName))
398
399 instance (BinaryStringRep a, BinaryStringRep b) =>
400 Binary (ExposedModule a b) where
401 put (ExposedModule exposedName exposedReexport exposedSignature) = do
402 put (toStringRep exposedName)
403 put exposedReexport
404 put exposedSignature
405 get = do
406 exposedName <- get
407 exposedReexport <- get
408 exposedSignature <- get
409 return (ExposedModule (fromStringRep exposedName)
410 exposedReexport
411 exposedSignature)