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

   1 {-# LANGUAGE RecordWildCards, TypeSynonymInstances, StandaloneDeriving, GeneralizedNewtypeDeriving #-}
   2 {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-name-shadowing #-}
   3 -----------------------------------------------------------------------------
   4 -- |
   5 -- Module      :  Distribution.InstalledPackageInfo.Binary
   6 -- Copyright   :  (c) The University of Glasgow 2009
   7 --
   8 -- Maintainer  :  cvs-ghc@haskell.org
   9 -- Portability :  portable
  10 --
  11
  12 module Distribution.InstalledPackageInfo.Binary (
  13        readBinPackageDB,
  14        writeBinPackageDB
  15   ) where
  16
  17 import Distribution.Version
  18 import Distribution.Package hiding (depends)
  19 import Distribution.License
  20 import Distribution.InstalledPackageInfo as IPI
  21 import Data.Binary as Bin
  22 import Control.Exception as Exception
  23
  24 readBinPackageDB :: Binary m => FilePath -> IO [InstalledPackageInfo_ m]
  25 readBinPackageDB file
  26     = do xs <- Bin.decodeFile file
  27          _ <- Exception.evaluate $ length xs
  28          return xs
  29       `catchUserError`
  30       (\err -> error ("While parsing " ++ show file ++ ": " ++ err))
  31
  32 catchUserError :: IO a -> (String -> IO a) -> IO a
  33 #ifdef BASE3
  34 catchUserError io f = io `Exception.catch` \e -> case e of
  35                                                  ErrorCall err -> f err
  36                                                  _ -> throw e
  37 #else
  38 catchUserError io f = io `Exception.catch` \(ErrorCall err) -> f err
  39 #endif
  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 (description ipi)
  60   put (category ipi)
  61   put (exposed ipi)
  62   put (exposedModules ipi)
  63   put (hiddenModules ipi)
  64   put (importDirs ipi)
  65   put (libraryDirs ipi)
  66   put (hsLibraries ipi)
  67   put (extraLibraries ipi)
  68   put (extraGHCiLibraries ipi)
  69   put (includeDirs ipi)
  70   put (includes ipi)
  71   put (IPI.depends ipi)
  72   put (hugsOptions ipi)
  73   put (ccOptions ipi)
  74   put (ldOptions ipi)
  75   put (frameworkDirs ipi)
  76   put (frameworks ipi)
  77   put (haddockInterfaces ipi)
  78   put (haddockHTMLs ipi)
  79
  80 getInstalledPackageInfo :: Binary m => Get (InstalledPackageInfo_ m)
  81 getInstalledPackageInfo = do
  82   sourcePackageId <- get
  83   installedPackageId <- get
  84   license <- get
  85   copyright <- get
  86   maintainer <- get
  87   author <- get
  88   stability <- get
  89   homepage <- get
  90   pkgUrl <- get
  91   description <- get
  92   category <- get
  93   exposed <- get
  94   exposedModules <- get
  95   hiddenModules <- get
  96   importDirs <- get
  97   libraryDirs <- get
  98   hsLibraries <- get
  99   extraLibraries <- get
 100   extraGHCiLibraries <- get
 101   includeDirs <- get
 102   includes <- get
 103   depends <- get
 104   hugsOptions <- get
 105   ccOptions <- get
 106   ldOptions <- get
 107   frameworkDirs <- get
 108   frameworks <- get
 109   haddockInterfaces <- get
 110   haddockHTMLs <- get
 111   return InstalledPackageInfo{..}
 112
 113 instance Binary PackageIdentifier where
 114   put pid = do put (pkgName pid); put (pkgVersion pid)
 115   get = do
 116     pkgName <- get
 117     pkgVersion <- get
 118     return PackageIdentifier{..}
 119
 120 instance Binary License where
 121   put (GPL v)              = do putWord8 0; put v
 122   put (LGPL v)             = do putWord8 1; put v
 123   put BSD3                 = do putWord8 2
 124   put BSD4                 = do putWord8 3
 125   put MIT                  = do putWord8 4
 126   put PublicDomain         = do putWord8 5
 127   put AllRightsReserved    = do putWord8 6
 128   put OtherLicense         = do putWord8 7
 129   put (UnknownLicense str) = do putWord8 8; put str
 130
 131   get = do
 132     n <- getWord8
 133     case n of
 134       0 -> do v <- get; return (GPL v)
 135       1 -> do v <- get; return (LGPL v)
 136       2 -> return BSD3
 137       3 -> return BSD4
 138       4 -> return MIT
 139       5 -> return PublicDomain
 140       6 -> return AllRightsReserved
 141       7 -> return OtherLicense
 142       _ -> do str <- get; return (UnknownLicense str)
 143
 144 instance Binary Version where
 145   put v = do put (versionBranch v); put (versionTags v)
 146   get = do versionBranch <- get; versionTags <- get; return Version{..}
 147
 148 deriving instance Binary PackageName
 149 deriving instance Binary InstalledPackageId