diff options
| author | davve <davve@dtek.chalmers.se> | 2006-08-20 21:28:11 +0000 | 
|---|---|---|
| committer | davve <davve@dtek.chalmers.se> | 2006-08-20 21:28:11 +0000 | 
| commit | 5fc3c0d7a9edee4d55b887bd44a02c266564d691 (patch) | |
| tree | df5dbdb2194f7acf7daeedaacd92a05ea7da2c7a | |
| parent | a7d3efef2e17273fb28a3d711d00843c1c875a17 (diff) | |
Move interface read/write to its own module + some cleanup
| -rw-r--r-- | haddock.cabal | 1 | ||||
| -rw-r--r-- | src/Interface.hs | 345 | ||||
| -rw-r--r-- | src/Main.hs | 303 | 
3 files changed, 394 insertions, 255 deletions
| diff --git a/haddock.cabal b/haddock.cabal index a9749119..25eb56a7 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -71,5 +71,6 @@ other-modules:  	HaddockTypes  	HaddockUtil  	HaddockVersion +        Interface  	Html  	Main diff --git a/src/Interface.hs b/src/Interface.hs new file mode 100644 index 00000000..0578fe83 --- /dev/null +++ b/src/Interface.hs @@ -0,0 +1,345 @@ +module Interface ( +  Interface, +  dumpInterface, +  readInterface   +) where + +import HaddockUtil   ( noDieMsg, moduleString ) +import Binary2       ( BinHandle, Binary(..), FormatVersion, mkFormatVersion,  +                       openBinMem, writeBinMem, readBinMem, putByte, getByte, +                       getString, putString ) + +import Name          ( Name, nameOccName, nameModule, mkExternalName ) +import OccName       ( OccName, isVarOcc, isDataOcc, isTvOcc, isTcOcc, varName,  +                       dataName, tvName, tcClsName, occNameString, mkOccName ) +import Unique        ( mkUnique ) +import Module        ( Module, mkModule, mkModuleName, modulePackageId )  +import PackageConfig ( packageIdString, stringToPackageId ) +import SrcLoc        ( noSrcLoc )  + +import qualified Data.Map as Map +import Data.Map (Map) + +------------------------------------------------------------------------------ +-- Reading the current interface format +------------------------------------------------------------------------------ + +thisFormatVersion :: FormatVersion +thisFormatVersion = mkFormatVersion 3 + +dumpInterface :: Map Name Name -> [Module] -> FilePath -> IO () +dumpInterface globalDocEnv modules fileName = do +  bh <- openBinMem 100000 +  put_ bh thisFormatVersion +  mapM (put_ bh) modules +  putDocEnv bh globalDocEnv +  writeBinMem bh fileName + +putDocEnv :: BinHandle -> Map Name Name -> IO () +putDocEnv bh env = put_ bh list  +  where  +    list = [ (nameModule o, nameOccName o, nameModule e)  |  +             (o, e) <- Map.toList env ] + +getDocEnv :: BinHandle -> IO (Map Name Name) +getDocEnv bh = do +  list <- get bh +  return (Map.fromList [(mkName mdl1 occ, mkName mdl2 occ) |  +                        (mdl1,occ,mdl2) <- list]) + +mkName mdl occ = mkExternalName (mkUnique 'X' 0) mdl occ Nothing noSrcLoc + +type Interface = ([Module], Map Name Name) + +readInterface :: FilePath -> IO Interface +readInterface fileName = do +  bh <- readBinMem fileName +  formatVersion <- get bh +  case formatVersion of +    v | v == thisFormatVersion -> do +      modules::[Module] <- get bh  +      env <- getDocEnv bh +      return (modules, env) +--    v | v == mkFormatVersion 2 -> do +--      (stuff :: [StoredInterface2]) <- get bh +--      return ([], Map.empty) +--      doc_env <- getDocEnv bh +--      return (map toInterface2 stuff, doc_env) +    otherwise -> do +            noDieMsg ( +               "Warning: The interface file " ++ show fileName  +                  ++ " could not be read.\n" +                  ++ "Interface files from earlier version of Haddock are not " +                  ++ "supported yet.\n") +            return ([],Map.empty) + +encodeNS n  +  | isVarOcc  n = 0 +  | isDataOcc n = 1 +  | isTvOcc   n = 2          +  | isTcOcc   n = 3 + +decodeNS n = case n of  +  0 -> varName +  1 -> dataName +  2 -> tvName +  _ -> tcClsName + +instance Binary OccName where +  put_ bh n = do +    put_ bh (occNameString n) +    putByte bh (encodeNS n) +  get bh = do +    string <- get bh +    ns <- getByte bh +    return (mkOccName (decodeNS ns) string) + +instance Binary Module where +  put_ bh m = do +    put_ bh (moduleString m) +    put_ bh ((packageIdString . modulePackageId) m) +  get bh = do  +    m <- get bh +    p <- get bh +    return (mkModule (stringToPackageId p) (mkModuleName m)) + +------------------------------------------------------------------------------ +-- Reading old interface formats +------------------------------------------------------------------------------ + +type StoredInterface2 = +   (Module2, Maybe Doc2, Maybe String, Bool,  +    [(HsName, Module2)], [(HsName, [HsName])]) + +newtype Module2 = Module2 String +  deriving (Eq,Ord) + +data HsQName +	= Qual Module HsName +	| UnQual HsName +  deriving (Eq,Ord) + +data HsName  +	= HsTyClsName HsIdentifier +	| HsVarName HsIdentifier +  deriving (Eq,Ord) + +data HsIdentifier +	= HsIdent   String +	| HsSymbol  String +	| HsSpecial String +  deriving (Eq,Ord) + +data GenDoc id +  = DocEmpty  +  | DocAppend (GenDoc id) (GenDoc id) +  | DocString String +  | DocParagraph (GenDoc id) +  | DocIdentifier id +  | DocModule String +  | DocEmphasis (GenDoc id) +  | DocMonospaced (GenDoc id) +  | DocUnorderedList [GenDoc id] +  | DocOrderedList [GenDoc id] +  | DocDefList [(GenDoc id, GenDoc id)] +  | DocCodeBlock (GenDoc id) +  | DocURL String +  | DocAName String +  deriving (Eq, Show) + +type Doc2 = GenDoc [HsQName] + +------------------------------------------------------------------------------ +-- Binary instances for stuff +------------------------------------------------------------------------------ + +instance Binary Module2 where +  put_ bh (Module2 m) = putString bh m +  get bh = do m <- getString bh; return $! (Module2 m) + +instance Binary HsQName where +  put_ bh (Qual m s) = do putByte bh 0; put_ bh m; put_ bh s +  put_ bh (UnQual s) = do putByte bh 1; put_ bh s +  get bh = do b <- getByte bh +	      case b of +		0 -> do m <- get bh; s <- get bh; return (Qual m s) +		_ -> do s <- get bh; return (UnQual s) + +instance Binary HsName where +  put_ bh (HsTyClsName s) = do putByte bh 0; put_ bh s +  put_ bh (HsVarName s)   = do putByte bh 1; put_ bh s +  get bh = do b <- getByte bh +	      case b of +		0 -> do s <- get bh; return (HsTyClsName s) +		_ -> do s <- get bh; return (HsVarName s) + +instance Binary HsIdentifier where +  put_ bh (HsIdent s)   = do putByte bh 0; putString bh s +  put_ bh (HsSymbol s)  = do putByte bh 1; putString bh s +  put_ bh (HsSpecial s) = do putByte bh 2; putString bh s +  get bh = do b <- getByte bh +	      case b of +		0 -> do s <- getString bh; return (HsIdent s) +		1 -> do s <- getString bh; return (HsSymbol s) +		_ -> do s <- getString bh; return (HsSpecial s) + +instance Binary id => Binary (GenDoc id) where +   put_ bh DocEmpty = putByte bh 0 +   put_ bh (DocAppend gd1 gd2) = do putByte bh 1;put_ bh gd1;put_ bh gd2 +   put_ bh (DocString s) = do putByte bh 2;putString bh s +   put_ bh (DocParagraph gd) = do putByte bh 3;put_ bh gd +   put_ bh (DocIdentifier id) = do putByte bh 4;put_ bh id +   put_ bh (DocModule s) = do putByte bh 5;putString bh s +   put_ bh (DocEmphasis gd) = do putByte bh 6;put_ bh gd +   put_ bh (DocMonospaced gd) = do putByte bh 7;put_ bh gd +   put_ bh (DocUnorderedList gd) = do putByte bh 8;put_ bh gd +   put_ bh (DocOrderedList gd) = do putByte bh 9;put_ bh gd +   put_ bh (DocDefList gd) = do putByte bh 10;put_ bh gd +   put_ bh (DocCodeBlock gd) = do putByte bh 11;put_ bh gd +   put_ bh (DocURL s) = do putByte bh 12;putString bh s +   put_ bh (DocAName s) = do putByte bh 13;putString bh s +   get bh = do b <- getByte bh +               case b of +                  0 -> return DocEmpty +                  1 -> do gd1 <- get bh;gd2 <- get bh;return (DocAppend gd1 gd2) +                  2 -> do s <- getString bh;return (DocString s) +                  3 -> do gd <- get bh;return (DocParagraph gd) +                  4 -> do id <- get bh;return (DocIdentifier id) +                  5 -> do s <- getString bh;return (DocModule s) +                  6 -> do gd <- get bh;return (DocEmphasis gd) +                  7 -> do gd <- get bh;return (DocMonospaced gd) +                  8 -> do gd <- get bh;return (DocUnorderedList gd) +                  9 -> do gd <- get bh;return (DocOrderedList gd) +                  10 -> do gd <- get bh;return (DocDefList gd) +                  11 -> do gd <- get bh;return (DocCodeBlock gd) +                  12 -> do s <- getString bh;return (DocURL s) +                  13 -> do s <- getString bh;return (DocAName s)  +                  _ -> error ("Mysterious byte in document in interface"  +                     ++ show b) + +{- +-- | How we store interfaces.  Not everything is stored. +type StoredInterface1 = +   (Module,Maybe Doc,Maybe String,Bool,[(HsName,HsQName)],[(HsName,HsQName)], +      [(HsName,[HsName])]) + +-- | How we used to store interfaces. +type NullVersionStoredInterface =  +   (Module,Maybe String,Bool,[(HsName,HsQName)],[(HsName,HsQName)], +      [(HsName,[HsName])]) + +dumpInterfaces :: [Interface] -> Map HsQName HsQName -> FilePath -> IO () +dumpInterfaces interfaces global_doc_env fileName = +   do +      let +         preparedInterfaces :: [StoredInterface2] +         preparedInterfaces = map from_interface interfaces + +      bh <- openBinMem 100000 +      put_ bh thisFormatVersion +      put_ bh preparedInterfaces +      putDocEnv bh global_doc_env +      writeBinMem bh fileName + + +readIface :: FilePath -> IO ([Interface], Map HsQName HsQName) +readIface fileName = do +   bh <- readBinMem fileName +   formatVersion <- get bh +   case formatVersion of +     v | v == thisFormatVersion -> do +            (stuff :: [StoredInterface2]) <- get bh +	    doc_env <- getDocEnv bh +            return (map to_interface2 stuff, doc_env) +     v | v == mkFormatVersion 1 -> do +            (stuff :: [StoredInterface1]) <- get bh +            return (map to_interface1 stuff, Map.empty) +     v | v == nullFormatVersion -> do +            (stuff :: [NullVersionStoredInterface]) <- get bh +            return (map nullVersion_to_interface stuff, Map.empty) +     otherwise -> do +            noDieMsg ( +               "Warning: The interface file " ++ show fileName  +                  ++ " could not be read.\n" +                  ++ "Maybe it's from a later version of Haddock?\n") +            return ([], Map.empty) + +from_interface :: Interface -> StoredInterface2 +from_interface iface = +   (  iface_module iface, +      toDescription iface,iface_package iface, +      OptHide `elem` iface_options iface, +      [(n,mdl) | (n,Qual mdl n') <- Map.toAscList (iface_env iface), +		 if n /= n' then error "help!" else True],  +      Map.toAscList (iface_sub iface) +      ) + +getDocEnv :: BinHandle -> IO (Map HsQName HsQName) +getDocEnv bh = do +   doc_env_list <- get bh +   return (Map.fromList [(Qual mdl1 nm,Qual mdl2 nm) |  +			 (mdl1,nm,mdl2) <- doc_env_list]) + +to_interface1 :: StoredInterface1 -> Interface +to_interface1 (mdl,descriptionOpt,package, hide, env, _, sub) =  +   Interface {  +      iface_module	 = mdl, +      iface_filename     = "", +      iface_orig_filename= "", +      iface_package      = package, +      iface_env          = Map.fromList env, +      iface_sub          = Map.fromList sub, +      iface_reexported   = [], +      iface_exports      = [], +      iface_orig_exports = [], +      iface_insts        = [], +      iface_decls        = Map.empty, +      iface_info         = toModuleInfo descriptionOpt, +      iface_doc          = Nothing, +      iface_options      = if hide then [OptHide] else [] +      } + +to_interface2 :: StoredInterface2 -> Interface +to_interface2 (mdl,descriptionOpt,package, hide, env, sub) = +   Interface {  +      iface_module	 = mdl, +      iface_filename     = "", +      iface_orig_filename= "", +      iface_package      = package, +      iface_env          =  +	Map.fromList [(n,Qual mdl n) | (n,mdl) <- env], +      iface_sub          = Map.fromList sub, +      iface_reexported   = [], +      iface_exports      = [], +      iface_orig_exports = [], +      iface_insts        = [], +      iface_decls        = Map.empty, +      iface_info         = toModuleInfo descriptionOpt, +      iface_doc          = Nothing, +      iface_options      = if hide then [OptHide] else [] +      } + +nullVersion_to_interface :: NullVersionStoredInterface -> Interface +nullVersion_to_interface (mdl, package, hide, env, reexported, sub) =  +   Interface {  +      iface_module	 = mdl, +      iface_filename     = "", +      iface_orig_filename= "", +      iface_package      = package, +      iface_env          = Map.fromList env, +      iface_sub          = Map.fromList sub, +      iface_reexported   = [], +      iface_exports      = [], +      iface_orig_exports = [], +      iface_insts        = [], +      iface_decls        = Map.empty, +      iface_info         = emptyModuleInfo, +      iface_doc          = Nothing, +      iface_options      = if hide then [OptHide] else [] +      } + +toModuleInfo :: Maybe Doc -> ModuleInfo +toModuleInfo descriptionOpt =  +   emptyModuleInfo {description = descriptionOpt} + +-} diff --git a/src/Main.hs b/src/Main.hs index 44d18f25..29e91591 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -13,50 +13,53 @@ import HaddockRename  import HaddockTypes  import HaddockUtil  import HaddockVersion -import Paths_haddock	( getDataDir ) -import Binary2 +import Paths_haddock         ( getDataDir ) +import Interface             ( Interface, dumpInterface, readInterface ) -import Control.Exception ( bracket, throwIO, catch, Exception(..) )  import Prelude hiding ( catch ) -import Control.Monad ( when, liftM ) -import Control.Monad.Writer ( Writer, runWriter, tell ) -import Data.Char ( isSpace ) -import Data.IORef ( writeIORef ) -import Data.List ( nub, (\\), foldl', sortBy, foldl1, init, mapAccumL, find ) -import Data.Maybe ( isJust, isNothing, maybeToList, listToMaybe ) ---import Debug.Trace -import System.Console.GetOpt ( getOpt, usageInfo, ArgOrder(..), OptDescr(..), ArgDescr(..) ) -import System.Environment ( getArgs ) -import System.IO ( stderr, IOMode(..), openFile, hClose, hGetContents, hPutStrLn ) -import System.Directory ( doesFileExist, doesDirectoryExist ) +import Control.Exception     ( bracket, throwIO, catch, Exception(..) ) +import Control.Monad         ( when, liftM ) +import Control.Monad.Writer  ( Writer, runWriter, tell ) +import Data.Char             ( isSpace ) +import Data.IORef            ( writeIORef ) +import Data.List             ( nub, nubBy, (\\), foldl', sortBy, foldl1, init,  +                               mapAccumL, find ) +import Data.Maybe            ( Maybe(..), isJust, isNothing, maybeToList,  +                               listToMaybe, fromJust, catMaybes ) +import System.Console.GetOpt ( getOpt, usageInfo, ArgOrder(..), OptDescr(..),  +                               ArgDescr(..) ) +import System.Environment    ( getArgs ) +import System.IO             ( stderr, IOMode(..), openFile, hClose,  +                               hGetContents, hPutStrLn ) +import System.Directory      ( doesFileExist, doesDirectoryExist )  #if defined(mingw32_HOST_OS)  import Foreign  import Foreign.C  #endif  import qualified Data.Map as Map -import Data.Map (Map) -import Data.Maybe -import Data.List ( nubBy ) -import Data.FunctorM ( fmapM ) +import Data.Map              (Map) +import Data.FunctorM         ( fmapM ) -import qualified GHC ( init ) -import GHC hiding ( init ) +import qualified GHC         ( init ) +import GHC hiding ( init )   import Outputable  import SrcLoc  import qualified Digraph as Digraph  import Name -import Module ( mkModule )  +import Module                ( mkModule )   import InstEnv  import Class  import TypeRep  import Var hiding ( varName )  import TyCon  import PrelNames +  import FastString  #define FSLIT(x) (mkFastString# (x#)) +  import DynFlags hiding ( Option ) -import StaticFlags ( parseStaticFlags ) -import Unique ( mkUnique ) +import StaticFlags           ( parseStaticFlags ) +import Unique                ( mkUnique )  import Packages  ----------------------------------------------------------------------------- @@ -130,17 +133,16 @@ parseGHCFlag dynflags args = do          Just (_, rest) -> return (Nothing, rest)          Nothing -> die ("Not a GHC flag: " ++ (head args) ++ "\n")    where -    findDynamic = findFlag ( -        \xs ->  -        (do  -           (fs, xs') <- parseDynamicFlags dynflags xs -           if xs' /= xs then return (Just fs) else return Nothing -        )  -        `catch` (\_ -> return Nothing)  +    findDynamic = findFlag (\xs -> (do  +          (fs, xs') <- parseDynamicFlags dynflags xs +          if xs' /= xs then return (Just fs) else return Nothing +        ) `catch` (\_ -> return Nothing)         )  +      findStatic = findFlag (\xs -> do  -      xs' <- parseStaticFlags xs -      if xs /= xs' then return (Just ()) else return Nothing) +        xs' <- parseStaticFlags xs +        if xs /= xs' then return (Just ()) else return Nothing +      )      findFlag p = do         xs <- (sequence . snd) (mapAccumL (f p) [] args) @@ -219,8 +221,17 @@ getIfacesAndHtmls flags dynflags = do      readIfaceFlags = [ parseIfaceOption str | Flag_ReadInterface str <- flags ]      totalFiles = packageFiles ++ readIfaceFlags      (htmlPaths, ifacePaths) = unzip totalFiles -  ifaces <- mapM readIface ifacePaths -  return (ifaces, htmlPaths) +  files <- mapM (\(htmlPath, ifacePath) -> do  +    htmlExist <- doesDirectoryExist htmlPath +    ifaceExist <- doesFileExist ifacePath +    if htmlExist && ifaceExist  +      then do +        iface <- readInterface ifacePath +        return (Just (iface, htmlPath)) +      else return Nothing +    ) totalFiles +   +  return (unzip (catMaybes files))  data Flag    = Flag_CSS String @@ -436,7 +447,7 @@ run flags modules extEnvs = do    -- dump an interface if requested    case dumpIface of      Nothing -> return () -    Just fn -> dumpInterfaces env (map hmod_mod visibleMods) fn  +    Just fn -> dumpInterface env (map hmod_mod visibleMods) fn     where      pprList [] = []      pprList [x] = show x @@ -901,7 +912,6 @@ pruneExportItems items = filter hasDoc items    where hasDoc (ExportDecl2 _ _ d _) = isJust d  	hasDoc _ = True -  -- -----------------------------------------------------------------------------  -- Gather a list of original names exported from this module @@ -1131,8 +1141,9 @@ toHsType t = case t of  type ErrMsg = String  type ErrMsgM a = Writer [ErrMsg] a --- ----------------------------------------------------------------------------- +--------------------------------------------------------------------------------  -- Packages  +--------------------------------------------------------------------------------  getPackageFiles :: DynFlags -> IO [(String, String)]  getPackageFiles dynflags = do @@ -1171,221 +1182,3 @@ getPackageFiles dynflags = do          first []    = []          first (x:_) = x     - --- ----------------------------------------------------------------------------- --- The interface file format --- ehhm. this is a temporary hack... - -thisFormatVersion :: FormatVersion -thisFormatVersion = mkFormatVersion 3 - -dumpInterfaces :: Map Name Name -> [Module] -> FilePath -> IO () -dumpInterfaces globalDocEnv modules fileName = do -  bh <- openBinMem 100000 -  put_ bh thisFormatVersion -  mapM (put_ bh) modules -  putDocEnv bh globalDocEnv -  writeBinMem bh fileName - -putDocEnv :: BinHandle -> Map Name Name -> IO () -putDocEnv bh env = put_ bh list  -  where  -    list = [ (nameModule o, nameOccName o, nameModule e)  |  -             (o, e) <- Map.toList env ] - -getDocEnv :: BinHandle -> IO (Map Name Name) -getDocEnv bh = do -  list <- get bh -  return (Map.fromList [(mkName mdl1 occ, mkName mdl2 occ) |  -                        (mdl1,occ,mdl2) <- list]) - -mkName mdl occ = mkExternalName (mkUnique 'X' 0) mdl occ Nothing noSrcLoc - ---type StoredInterface2 = ---   (Module,Maybe Doc,Maybe String,Bool,[(HsName,Module)], [(HsName,[HsName])]) - -type Interface = ([Module], Map Name Name) - -readIface :: FilePath -> IO Interface -readIface fileName = do -  bh <- readBinMem fileName -  formatVersion <- get bh -  case formatVersion of -    v | v == thisFormatVersion -> do -      modules::[Module] <- get bh  -      env <- getDocEnv bh -      return (modules, env) ---    v | v == mkFormatVersion 2 -> do ---      (stuff :: [StoredInterface2]) <- get bh ---      doc_env <- getDocEnv bh ---      return (map to_interface2 stuff, doc_env) -    otherwise -> do -            noDieMsg ( -               "Warning: The interface file " ++ show fileName  -                  ++ " could not be read.\n" -                  ++ "Interface files from earlier version of Haddock are not " -                  ++ "supported yet.\n") -            return ([],Map.empty) - -encodeNS n  -  | isVarOcc  n = 0 -  | isDataOcc n = 1 -  | isTvOcc   n = 2          -  | isTcOcc   n = 3 - -decodeNS n = case n of  -  0 -> varName -  1 -> dataName -  2 -> tvName -  _ -> tcClsName - -instance Binary OccName where -  put_ bh n = do -    put_ bh (occNameString n) -    putByte bh (encodeNS n) -  get bh = do -    string <- get bh -    ns <- getByte bh -    return (mkOccName (decodeNS ns) string) - -instance Binary Module where -  put_ bh m = do -    put_ bh (moduleString m) -    put_ bh ((packageIdString . modulePackageId) m) -  get bh = do  -    m <- get bh -    p <- get bh -    return (mkModule (stringToPackageId p) (mkModuleName m)) -{- -thisFormatVersion :: FormatVersion -thisFormatVersion = mkFormatVersion 2 - --- | How we store interfaces.  Not everything is stored. -type StoredInterface2 = -   (Module,Maybe Doc,Maybe String,Bool,[(HsName,Module)], [(HsName,[HsName])]) - --- | How we store interfaces.  Not everything is stored. -type StoredInterface1 = -   (Module,Maybe Doc,Maybe String,Bool,[(HsName,HsQName)],[(HsName,HsQName)], -      [(HsName,[HsName])]) - --- | How we used to store interfaces. -type NullVersionStoredInterface =  -   (Module,Maybe String,Bool,[(HsName,HsQName)],[(HsName,HsQName)], -      [(HsName,[HsName])]) - -dumpInterfaces :: [Interface] -> Map HsQName HsQName -> FilePath -> IO () -dumpInterfaces interfaces global_doc_env fileName = -   do -      let -         preparedInterfaces :: [StoredInterface2] -         preparedInterfaces = map from_interface interfaces - -      bh <- openBinMem 100000 -      put_ bh thisFormatVersion -      put_ bh preparedInterfaces -      putDocEnv bh global_doc_env -      writeBinMem bh fileName - - -readIface :: FilePath -> IO ([Interface], Map HsQName HsQName) -readIface fileName = do -   bh <- readBinMem fileName -   formatVersion <- get bh -   case formatVersion of -     v | v == thisFormatVersion -> do -            (stuff :: [StoredInterface2]) <- get bh -	    doc_env <- getDocEnv bh -            return (map to_interface2 stuff, doc_env) -     v | v == mkFormatVersion 1 -> do -            (stuff :: [StoredInterface1]) <- get bh -            return (map to_interface1 stuff, Map.empty) -     v | v == nullFormatVersion -> do -            (stuff :: [NullVersionStoredInterface]) <- get bh -            return (map nullVersion_to_interface stuff, Map.empty) -     otherwise -> do -            noDieMsg ( -               "Warning: The interface file " ++ show fileName  -                  ++ " could not be read.\n" -                  ++ "Maybe it's from a later version of Haddock?\n") -            return ([], Map.empty) - -from_interface :: Interface -> StoredInterface2 -from_interface iface = -   (  iface_module iface, -      toDescription iface,iface_package iface, -      OptHide `elem` iface_options iface, -      [(n,mdl) | (n,Qual mdl n') <- Map.toAscList (iface_env iface), -		 if n /= n' then error "help!" else True],  -      Map.toAscList (iface_sub iface) -      ) - -getDocEnv :: BinHandle -> IO (Map HsQName HsQName) -getDocEnv bh = do -   doc_env_list <- get bh -   return (Map.fromList [(Qual mdl1 nm,Qual mdl2 nm) |  -			 (mdl1,nm,mdl2) <- doc_env_list]) - -to_interface1 :: StoredInterface1 -> Interface -to_interface1 (mdl,descriptionOpt,package, hide, env, _, sub) =  -   Interface {  -      iface_module	 = mdl, -      iface_filename     = "", -      iface_orig_filename= "", -      iface_package      = package, -      iface_env          = Map.fromList env, -      iface_sub          = Map.fromList sub, -      iface_reexported   = [], -      iface_exports      = [], -      iface_orig_exports = [], -      iface_insts        = [], -      iface_decls        = Map.empty, -      iface_info         = toModuleInfo descriptionOpt, -      iface_doc          = Nothing, -      iface_options      = if hide then [OptHide] else [] -      } - -to_interface2 :: StoredInterface2 -> Interface -to_interface2 (mdl,descriptionOpt,package, hide, env, sub) = -   Interface {  -      iface_module	 = mdl, -      iface_filename     = "", -      iface_orig_filename= "", -      iface_package      = package, -      iface_env          =  -	Map.fromList [(n,Qual mdl n) | (n,mdl) <- env], -      iface_sub          = Map.fromList sub, -      iface_reexported   = [], -      iface_exports      = [], -      iface_orig_exports = [], -      iface_insts        = [], -      iface_decls        = Map.empty, -      iface_info         = toModuleInfo descriptionOpt, -      iface_doc          = Nothing, -      iface_options      = if hide then [OptHide] else [] -      } - -nullVersion_to_interface :: NullVersionStoredInterface -> Interface -nullVersion_to_interface (mdl, package, hide, env, reexported, sub) =  -   Interface {  -      iface_module	 = mdl, -      iface_filename     = "", -      iface_orig_filename= "", -      iface_package      = package, -      iface_env          = Map.fromList env, -      iface_sub          = Map.fromList sub, -      iface_reexported   = [], -      iface_exports      = [], -      iface_orig_exports = [], -      iface_insts        = [], -      iface_decls        = Map.empty, -      iface_info         = emptyModuleInfo, -      iface_doc          = Nothing, -      iface_options      = if hide then [OptHide] else [] -      } - -toModuleInfo :: Maybe Doc -> ModuleInfo -toModuleInfo descriptionOpt =  -   emptyModuleInfo {description = descriptionOpt} - --} | 
