Package keys (for linking/type equality) separated from package IDs.
[ghc.git] / libraries / bin-package-db / Distribution / InstalledPackageInfo / Binary.hs
1 {-# LANGUAGE RecordWildCards, Trustworthy, TypeSynonymInstances, StandaloneDeriving,
2 GeneralizedNewtypeDeriving #-}
3 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
4 -- This module deliberately defines orphan instances for now. Should
5 -- become unnecessary once we move to using the binary package properly:
6 {-# OPTIONS_GHC -fno-warn-orphans #-}
7
8 -----------------------------------------------------------------------------
9 -- |
10 -- Module : Distribution.InstalledPackageInfo.Binary
11 -- Copyright : (c) The University of Glasgow 2009
12 --
13 -- Maintainer : ghc-devs@haskell.org
14 -- Portability : portable
15 --
16
17 module Distribution.InstalledPackageInfo.Binary (
18 readBinPackageDB,
19 writeBinPackageDB
20 ) where
21
22 import Distribution.Version
23 import Distribution.Package hiding (depends)
24 import Distribution.License
25 import Distribution.ModuleExport
26 import Distribution.InstalledPackageInfo as IPI
27 import Data.Binary as Bin
28 import Control.Exception as Exception
29
30 readBinPackageDB :: Binary m => FilePath -> IO [InstalledPackageInfo_ m]
31 readBinPackageDB file
32 = do xs <- Bin.decodeFile file
33 _ <- Exception.evaluate $ length xs
34 return xs
35 `catchUserError`
36 (\err -> error ("While parsing " ++ show file ++ ": " ++ err))
37
38 catchUserError :: IO a -> (String -> IO a) -> IO a
39 catchUserError io f = io `Exception.catch` \(ErrorCall err) -> f err
40
41 writeBinPackageDB :: Binary m => FilePath -> [InstalledPackageInfo_ m] -> IO ()
42 writeBinPackageDB file ipis = Bin.encodeFile file ipis
43
44 instance Binary m => Binary (InstalledPackageInfo_ m) where
45 put = putInstalledPackageInfo
46 get = getInstalledPackageInfo
47
48 putInstalledPackageInfo :: Binary m => InstalledPackageInfo_ m -> Put
49 putInstalledPackageInfo ipi = do
50 put (sourcePackageId ipi)
51 put (installedPackageId ipi)
52 put (packageKey ipi)
53 put (license ipi)
54 put (copyright ipi)
55 put (maintainer ipi)
56 put (author ipi)
57 put (stability ipi)
58 put (homepage ipi)
59 put (pkgUrl ipi)
60 put (synopsis ipi)
61 put (description ipi)
62 put (category ipi)
63 put (exposed ipi)
64 put (exposedModules ipi)
65 put (reexportedModules ipi)
66 put (hiddenModules ipi)
67 put (trusted ipi)
68 put (importDirs ipi)
69 put (libraryDirs ipi)
70 put (hsLibraries ipi)
71 put (extraLibraries ipi)
72 put (extraGHCiLibraries ipi)
73 put (includeDirs ipi)
74 put (includes ipi)
75 put (IPI.depends ipi)
76 put (hugsOptions ipi)
77 put (ccOptions ipi)
78 put (ldOptions ipi)
79 put (frameworkDirs ipi)
80 put (frameworks ipi)
81 put (haddockInterfaces ipi)
82 put (haddockHTMLs ipi)
83
84 getInstalledPackageInfo :: Binary m => Get (InstalledPackageInfo_ m)
85 getInstalledPackageInfo = do
86 sourcePackageId <- get
87 installedPackageId <- get
88 packageKey <- get
89 license <- get
90 copyright <- get
91 maintainer <- get
92 author <- get
93 stability <- get
94 homepage <- get
95 pkgUrl <- get
96 synopsis <- get
97 description <- get
98 category <- get
99 exposed <- get
100 exposedModules <- get
101 reexportedModules <- get
102 hiddenModules <- get
103 trusted <- get
104 importDirs <- get
105 libraryDirs <- get
106 hsLibraries <- get
107 extraLibraries <- get
108 extraGHCiLibraries <- get
109 includeDirs <- get
110 includes <- get
111 depends <- get
112 hugsOptions <- get
113 ccOptions <- get
114 ldOptions <- get
115 frameworkDirs <- get
116 frameworks <- get
117 haddockInterfaces <- get
118 haddockHTMLs <- get
119 return InstalledPackageInfo{..}
120
121 instance Binary PackageIdentifier where
122 put pid = do put (pkgName pid); put (pkgVersion pid)
123 get = do
124 pkgName <- get
125 pkgVersion <- get
126 return PackageIdentifier{..}
127
128 instance Binary License where
129 put (GPL v) = do putWord8 0; put v
130 put (LGPL v) = do putWord8 1; put v
131 put BSD3 = do putWord8 2
132 put BSD4 = do putWord8 3
133 put MIT = do putWord8 4
134 put PublicDomain = do putWord8 5
135 put AllRightsReserved = do putWord8 6
136 put OtherLicense = do putWord8 7
137 put (Apache v) = do putWord8 8; put v
138 put (AGPL v) = do putWord8 9; put v
139 put BSD2 = do putWord8 10
140 put (MPL v) = do putWord8 11; put v
141 put (UnknownLicense str) = do putWord8 12; put str
142
143 get = do
144 n <- getWord8
145 case n of
146 0 -> do v <- get; return (GPL v)
147 1 -> do v <- get; return (LGPL v)
148 2 -> return BSD3
149 3 -> return BSD4
150 4 -> return MIT
151 5 -> return PublicDomain
152 6 -> return AllRightsReserved
153 7 -> return OtherLicense
154 8 -> do v <- get; return (Apache v)
155 9 -> do v <- get; return (AGPL v)
156 10 -> return BSD2
157 11 -> do v <- get; return (MPL v)
158 _ -> do str <- get; return (UnknownLicense str)
159
160 instance Binary Version where
161 put v = do put (versionBranch v); put (versionTags v)
162 get = do versionBranch <- get; versionTags <- get; return Version{..}
163
164 deriving instance Binary PackageName
165 deriving instance Binary InstalledPackageId
166
167 instance Binary m => Binary (ModuleExport m) where
168 put (ModuleExport a b c d) = do put a; put b; put c; put d
169 get = do a <- get; b <- get; c <- get; d <- get;
170 return (ModuleExport a b c d)
171
172 instance Binary PackageKey where
173 put (PackageKey a b c) = do putWord8 0; put a; put b; put c
174 put (OldPackageKey a) = do putWord8 1; put a
175 get = do n <- getWord8
176 case n of
177 0 -> do a <- get; b <- get; c <- get; return (PackageKey a b c)
178 1 -> do a <- get; return (OldPackageKey a)
179 _ -> error ("Binary PackageKey: bad branch " ++ show n)