Add support for --read-interface again

1 files changed, 21 insertions, 1 deletions

diff --git a/src/Haddock/Packages.hs b/src/Haddock/Packages.hs
index d722bdfe..ba3ee841 100644
--- a/src/Haddock/Packages.hs
+++ b/src/Haddock/Packages.hs
@@ -8,6 +8,7 @@
 module Haddock.Packages (
   HaddockPackage(..),
   getHaddockPackages,
+  getHaddockPackages',
   combineLinkEnvs
 ) where
 
@@ -15,6 +16,7 @@ module Haddock.Packages (
 import Haddock.Types
 import Haddock.Exception
 import Haddock.InterfaceFile
+import qualified Distribution.Haddock as D
 
 import Data.Maybe
 import qualified Data.Map as Map
@@ -38,6 +40,24 @@ data HaddockPackage = HaddockPackage {
 }
 
 
+getHaddockPackages' :: [(FilePath, FilePath)] -> IO [HaddockPackage]
+getHaddockPackages' pairs = do
+  mbPackages <- mapM tryReadIface pairs
+  return (catMaybes mbPackages)
+  where
+    -- try to get a HaddockPackage, warn if we can't
+    tryReadIface (html, iface) = do
+      eIface <- D.readInterfaceFile iface
+      case eIface of
+        Left err -> do
+          putStrLn ("Warning: Cannot read " ++ iface ++ ":")
+          putStrLn ("   " ++ show err)
+          putStrLn "Skipping this interface."
+          return Nothing
+        Right iface -> return $ Just $
+                       HaddockPackage (ifModules iface) (ifLinkEnv iface) html
+
+
 -- | Try to read the installed Haddock information for the given packages, 
 -- if it exists. Print a warning on stdout if it couldn't be found for a 
 -- package.
@@ -65,7 +85,7 @@ getPackage pkgInfo = do
   iface     <- readInterfaceFile ifacePath
   
   return $ HaddockPackage {
-    pdModules  = packageModules pkgInfo,
+    pdModules  = ifModules iface,
     pdLinkEnv  = ifLinkEnv iface,
     pdHtmlPath = html
   }