X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=libraries%2Fbin-package-db%2FDistribution%2FInstalledPackageInfo%2FBinary.hs;h=47bb8f46909cb9abb508fbb3e8305f7216c2015b;hb=6cec61d14a324285dbb8ce73d4c7215f1f8d6766;hp=0f599298a50840928450ee6969cc3a130234071b;hpb=f72409f0f893470e7f3a5fbb32b133393d543c01;p=ghc-hetmet.git

diff --git a/libraries/bin-package-db/Distribution/InstalledPackageInfo/Binary.hs b/libraries/bin-package-db/Distribution/InstalledPackageInfo/Binary.hs
index 0f59929..47bb8f4 100644
--- a/libraries/bin-package-db/Distribution/InstalledPackageInfo/Binary.hs
+++ b/libraries/bin-package-db/Distribution/InstalledPackageInfo/Binary.hs
@@ -1,5 +1,8 @@
 {-# LANGUAGE RecordWildCards, TypeSynonymInstances, StandaloneDeriving, GeneralizedNewtypeDeriving #-}
-{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-name-shadowing #-}
+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+-- This module deliberately defines orphan instances for now. Should
+-- become unnecessary once we move to using the binary package properly:
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Distribution.InstalledPackageInfo.Binary
@@ -19,9 +22,24 @@ import Distribution.Package hiding (depends)
 import Distribution.License
 import Distribution.InstalledPackageInfo as IPI
 import Data.Binary as Bin
+import Control.Exception as Exception
 
 readBinPackageDB :: Binary m => FilePath -> IO [InstalledPackageInfo_ m]
-readBinPackageDB file = Bin.decodeFile file
+readBinPackageDB file
+    = do xs <- Bin.decodeFile file
+         _ <- Exception.evaluate $ length xs
+         return xs
+      `catchUserError`
+      (\err -> error ("While parsing " ++ show file ++ ": " ++ err))
+
+catchUserError :: IO a -> (String -> IO a) -> IO a
+#ifdef BASE3
+catchUserError io f = io `Exception.catch` \e -> case e of
+                                                 ErrorCall err -> f err
+                                                 _ -> throw e
+#else
+catchUserError io f = io `Exception.catch` \(ErrorCall err) -> f err
+#endif
 
 writeBinPackageDB :: Binary m => FilePath -> [InstalledPackageInfo_ m] -> IO ()
 writeBinPackageDB file ipis = Bin.encodeFile file ipis
@@ -41,6 +59,7 @@ putInstalledPackageInfo ipi = do
   put (stability ipi)
   put (homepage ipi)
   put (pkgUrl ipi)
+  put (synopsis ipi)
   put (description ipi)
   put (category ipi)
   put (exposed ipi)
@@ -73,6 +92,7 @@ getInstalledPackageInfo = do
   stability <- get
   homepage <- get
   pkgUrl <- get
+  synopsis <- get
   description <- get
   category <- get
   exposed <- get