libraries/bin-package-db/Distribution/InstalledPackageInfo/Binary.hs

   1 {-# LANGUAGE RecordWildCards, TypeSynonymInstances, StandaloneDeriving, GeneralizedNewtypeDeriving #-}
   2 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
   3 -- This module deliberately defines orphan instances for now. Should
   4 -- become unnecessary once we move to using the binary package properly:
   5 {-# OPTIONS_GHC -fno-warn-orphans #-}
   6 -----------------------------------------------------------------------------
   7 -- |
   8 -- Module      :  Distribution.InstalledPackageInfo.Binary
   9 -- Copyright   :  (c) The University of Glasgow 2009
  10 --
  11 -- Maintainer  :  cvs-ghc@haskell.org
  12 -- Portability :  portable
  13 --
  14
  15 module Distribution.InstalledPackageInfo.Binary (
  16        readBinPackageDB,
  17        writeBinPackageDB
  18   ) where
  19
  20 import Distribution.Version
  21 import Distribution.Package hiding (depends)
  22 import Distribution.License
  23 import Distribution.InstalledPackageInfo as IPI
  24 import Data.Binary as Bin
  25 import Control.Exception as Exception
  26
  27 readBinPackageDB :: Binary m => FilePath -> IO [InstalledPackageInfo_ m]
  28 readBinPackageDB file
  29     = do xs <- Bin.decodeFile file
  30          _ <- Exception.evaluate $ length xs
  31          return xs
  32       `catchUserError`
  33       (\err -> error ("While parsing " ++ show file ++ ": " ++ err))
  34
  35 catchUserError :: IO a -> (String -> IO a) -> IO a
  36 #ifdef BASE3
  37 catchUserError io f = io `Exception.catch` \e -> case e of
  38                                                  ErrorCall err -> f err
  39                                                  _ -> throw e
  40 #else
  41 catchUserError io f = io `Exception.catch` \(ErrorCall err) -> f err
  42 #endif
  43
  44 writeBinPackageDB :: Binary m => FilePath -> [InstalledPackageInfo_ m] -> IO ()
  45 writeBinPackageDB file ipis = Bin.encodeFile file ipis
  46
  47 instance Binary m => Binary (InstalledPackageInfo_ m) where
  48   put = putInstalledPackageInfo
  49   get = getInstalledPackageInfo
  50
  51 putInstalledPackageInfo :: Binary m => InstalledPackageInfo_ m -> Put
  52 putInstalledPackageInfo ipi = do
  53   put (sourcePackageId ipi)
  54   put (installedPackageId ipi)
  55   put (license ipi)
  56   put (copyright ipi)
  57   put (maintainer ipi)
  58   put (author ipi)
  59   put (stability ipi)
  60   put (homepage ipi)
  61   put (pkgUrl ipi)
  62   put (synopsis ipi)
  63   put (description ipi)
  64   put (category ipi)
  65   put (exposed ipi)
  66   put (exposedModules ipi)
  67   put (hiddenModules 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   license <- get
  89   copyright <- get
  90   maintainer <- get
  91   author <- get
  92   stability <- get
  93   homepage <- get
  94   pkgUrl <- get
  95   synopsis <- get
  96   description <- get
  97   category <- get
  98   exposed <- get
  99   exposedModules <- get
 100   hiddenModules <- get
 101   importDirs <- get
 102   libraryDirs <- get
 103   hsLibraries <- get
 104   extraLibraries <- get
 105   extraGHCiLibraries <- get
 106   includeDirs <- get
 107   includes <- get
 108   depends <- get
 109   hugsOptions <- get
 110   ccOptions <- get
 111   ldOptions <- get
 112   frameworkDirs <- get
 113   frameworks <- get
 114   haddockInterfaces <- get
 115   haddockHTMLs <- get
 116   return InstalledPackageInfo{..}
 117
 118 instance Binary PackageIdentifier where
 119   put pid = do put (pkgName pid); put (pkgVersion pid)
 120   get = do
 121     pkgName <- get
 122     pkgVersion <- get
 123     return PackageIdentifier{..}
 124
 125 instance Binary License where
 126   put (GPL v)              = do putWord8 0; put v
 127   put (LGPL v)             = do putWord8 1; put v
 128   put BSD3                 = do putWord8 2
 129   put BSD4                 = do putWord8 3
 130   put MIT                  = do putWord8 4
 131   put PublicDomain         = do putWord8 5
 132   put AllRightsReserved    = do putWord8 6
 133   put OtherLicense         = do putWord8 7
 134   put (UnknownLicense str) = do putWord8 8; put str
 135
 136   get = do
 137     n <- getWord8
 138     case n of
 139       0 -> do v <- get; return (GPL v)
 140       1 -> do v <- get; return (LGPL v)
 141       2 -> return BSD3
 142       3 -> return BSD4
 143       4 -> return MIT
 144       5 -> return PublicDomain
 145       6 -> return AllRightsReserved
 146       7 -> return OtherLicense
 147       _ -> do str <- get; return (UnknownLicense str)
 148
 149 instance Binary Version where
 150   put v = do put (versionBranch v); put (versionTags v)
 151   get = do versionBranch <- get; versionTags <- get; return Version{..}
 152
 153 deriving instance Binary PackageName
 154 deriving instance Binary InstalledPackageId