f4d0a4b1471d49ae96d6c912491c68247a3a697e
[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 (license ipi)
53 put (copyright ipi)
54 put (maintainer ipi)
55 put (author ipi)
56 put (stability ipi)
57 put (homepage ipi)
58 put (pkgUrl ipi)
59 put (synopsis ipi)
60 put (description ipi)
61 put (category ipi)
62 put (exposed ipi)
63 put (exposedModules ipi)
64 put (reexportedModules ipi)
65 put (hiddenModules ipi)
66 put (trusted ipi)
67 put (importDirs ipi)
68 put (libraryDirs ipi)
69 put (hsLibraries ipi)
70 put (extraLibraries ipi)
71 put (extraGHCiLibraries ipi)
72 put (includeDirs ipi)
73 put (includes ipi)
74 put (IPI.depends ipi)
75 put (hugsOptions ipi)
76 put (ccOptions ipi)
77 put (ldOptions ipi)
78 put (frameworkDirs ipi)
79 put (frameworks ipi)
80 put (haddockInterfaces ipi)
81 put (haddockHTMLs ipi)
82
83 getInstalledPackageInfo :: Binary m => Get (InstalledPackageInfo_ m)
84 getInstalledPackageInfo = do
85 sourcePackageId <- get
86 installedPackageId <- get
87 license <- get
88 copyright <- get
89 maintainer <- get
90 author <- get
91 stability <- get
92 homepage <- get
93 pkgUrl <- get
94 synopsis <- get
95 description <- get
96 category <- get
97 exposed <- get
98 exposedModules <- get
99 reexportedModules <- get
100 hiddenModules <- get
101 trusted <- get
102 importDirs <- get
103 libraryDirs <- get
104 hsLibraries <- get
105 extraLibraries <- get
106 extraGHCiLibraries <- get
107 includeDirs <- get
108 includes <- get
109 depends <- get
110 hugsOptions <- get
111 ccOptions <- get
112 ldOptions <- get
113 frameworkDirs <- get
114 frameworks <- get
115 haddockInterfaces <- get
116 haddockHTMLs <- get
117 return InstalledPackageInfo{..}
118
119 instance Binary PackageIdentifier where
120 put pid = do put (pkgName pid); put (pkgVersion pid)
121 get = do
122 pkgName <- get
123 pkgVersion <- get
124 return PackageIdentifier{..}
125
126 instance Binary License where
127 put (GPL v) = do putWord8 0; put v
128 put (LGPL v) = do putWord8 1; put v
129 put BSD3 = do putWord8 2
130 put BSD4 = do putWord8 3
131 put MIT = do putWord8 4
132 put PublicDomain = do putWord8 5
133 put AllRightsReserved = do putWord8 6
134 put OtherLicense = do putWord8 7
135 put (Apache v) = do putWord8 8; put v
136 put (AGPL v) = do putWord8 9; put v
137 put BSD2 = do putWord8 10
138 put (MPL v) = do putWord8 11; put v
139 put (UnknownLicense str) = do putWord8 12; put str
140
141 get = do
142 n <- getWord8
143 case n of
144 0 -> do v <- get; return (GPL v)
145 1 -> do v <- get; return (LGPL v)
146 2 -> return BSD3
147 3 -> return BSD4
148 4 -> return MIT
149 5 -> return PublicDomain
150 6 -> return AllRightsReserved
151 7 -> return OtherLicense
152 8 -> do v <- get; return (Apache v)
153 9 -> do v <- get; return (AGPL v)
154 10 -> return BSD2
155 11 -> do v <- get; return (MPL v)
156 _ -> do str <- get; return (UnknownLicense str)
157
158 instance Binary Version where
159 put v = do put (versionBranch v); put (versionTags v)
160 get = do versionBranch <- get; versionTags <- get; return Version{..}
161
162 deriving instance Binary PackageName
163 deriving instance Binary InstalledPackageId
164
165 instance Binary m => Binary (ModuleExport m) where
166 put (ModuleExport a b c d) = do put a; put b; put c; put d
167 get = do a <- get; b <- get; c <- get; d <- get;
168 return (ModuleExport a b c d)