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 (description ipi)
  63   put (category ipi)
  64   put (exposed ipi)
  65   put (exposedModules ipi)
  66   put (hiddenModules 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   description <- get
  95   category <- get
  96   exposed <- get
  97   exposedModules <- get
  98   hiddenModules <- get
  99   importDirs <- get
 100   libraryDirs <- get
 101   hsLibraries <- get
 102   extraLibraries <- get
 103   extraGHCiLibraries <- get
 104   includeDirs <- get
 105   includes <- get
 106   depends <- get
 107   hugsOptions <- get
 108   ccOptions <- get
 109   ldOptions <- get
 110   frameworkDirs <- get
 111   frameworks <- get
 112   haddockInterfaces <- get
 113   haddockHTMLs <- get
 114   return InstalledPackageInfo{..}
 115
 116 instance Binary PackageIdentifier where
 117   put pid = do put (pkgName pid); put (pkgVersion pid)
 118   get = do
 119     pkgName <- get
 120     pkgVersion <- get
 121     return PackageIdentifier{..}
 122
 123 instance Binary License where
 124   put (GPL v)              = do putWord8 0; put v
 125   put (LGPL v)             = do putWord8 1; put v
 126   put BSD3                 = do putWord8 2
 127   put BSD4                 = do putWord8 3
 128   put MIT                  = do putWord8 4
 129   put PublicDomain         = do putWord8 5
 130   put AllRightsReserved    = do putWord8 6
 131   put OtherLicense         = do putWord8 7
 132   put (UnknownLicense str) = do putWord8 8; put str
 133
 134   get = do
 135     n <- getWord8
 136     case n of
 137       0 -> do v <- get; return (GPL v)
 138       1 -> do v <- get; return (LGPL v)
 139       2 -> return BSD3
 140       3 -> return BSD4
 141       4 -> return MIT
 142       5 -> return PublicDomain
 143       6 -> return AllRightsReserved
 144       7 -> return OtherLicense
 145       _ -> do str <- get; return (UnknownLicense str)
 146
 147 instance Binary Version where
 148   put v = do put (versionBranch v); put (versionTags v)
 149   get = do versionBranch <- get; versionTags <- get; return Version{..}
 150
 151 deriving instance Binary PackageName
 152 deriving instance Binary InstalledPackageId