diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Main.hs | 51 | 
1 files changed, 47 insertions, 4 deletions
diff --git a/src/Main.hs b/src/Main.hs index 31d109e1..5763e90b 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -452,6 +452,11 @@ run flags modules extEnv = do                  maybe_contents_url maybe_index_url      copyHtmlBits odir libdir css_file +  case [str | Flag_DumpInterface str <- flags] of +        [] -> return () +        fs -> let filename = (last fs) in  +              savePackageFile filename homeEnv +  {-   instance Outputable (DocEntity Name) where    ppr (DocEntity d) = ppr d @@ -1188,9 +1193,11 @@ type ErrMsgM a = Writer [ErrMsg] a  -- Packages   -------------------------------------------------------------------------------- +type DocEnv = Map Name Name +  data PackageData = PackageData {    pdModules  :: [Module], -  pdDocEnv   :: Map Name Name, +  pdDocEnv   :: DocEnv,    pdHtmlPath :: FilePath  } @@ -1246,6 +1253,9 @@ getIface pkgInfo = case haddockInterfaces pkgInfo of  getPackage :: Session -> InstalledPackageInfo -> IO PackageData   getPackage session pkgInfo = do    html <- getHtml pkgInfo +  iface <- getIface pkgInfo +  docEnv <- readPackageFile iface +    let modules = packageModules pkgInfo    -- try to get a ModuleInfo struct for each module @@ -1257,8 +1267,8 @@ getPackage session pkgInfo = do    let modInfos' = sortPackageModules modInfos    return $ PackageData { -    pdModules  = map modInfoMod modInfos', -    pdDocEnv   = packageDocEnv modInfos', +    pdModules  = modules, +    pdDocEnv   = docEnv,      pdHtmlPath = html    }  @@ -1310,5 +1320,38 @@ getPackages session dynflags flags = do  -- | Build one big doc env out of a list of packages. If multiple packages   -- export the same (original) name, we just pick one of the packages as the   -- documentation site. -packagesDocEnv :: [PackageData] -> Map Name Name +packagesDocEnv :: [PackageData] -> DocEnv  packagesDocEnv packages = Map.unions (map pdDocEnv packages) + +-------------------------------------------------------------------------------- +-- Package/Interface files  +-------------------------------------------------------------------------------- + +packageFileMagic = 0xDA303001 :: Word32 + +savePackageFile :: FilePath -> PackageEnv -> IO () +savePackageFile filename pkgEnv = do +  h <- openBinaryFile filename WriteMode    +  bh <- openBinIO h  + +  ud <- newWriteState +  bh <- return $ setUserData bh ud + +  put_ bh packageFileMagic +  put_ bh (Map.toList pkgEnv) +  hClose h + +loadPackageFile :: FilePath -> IO PackageEnv +loadPackageFile filename = do +  h <- openBinaryFile filename ReadMode +  bh <- openBinIO h + +  ud <- newReadState undefined +  bh <- return (setUserData bh ud) + +  magic <- get bh +  when (magic /= packageFileMagic) $ throwE $ +    "Magic number mismatch: couldn't load interface file: " ++ filename +   +  envList <- get bh +  return (Map.fromList envList)  | 
