diff options
Diffstat (limited to 'src/Main.hs')
-rw-r--r-- | src/Main.hs | 64 |
1 files changed, 33 insertions, 31 deletions
diff --git a/src/Main.hs b/src/Main.hs index 52406821..31e2726c 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -135,31 +135,6 @@ main = handleTopExceptions $ do shortcutFlags flags qual <- case qualification flags of {Left msg -> throwE msg; Right q -> return q} - if not (null files) then do - (packages, ifaces, homeLinks) <- readPackagesAndProcessModules flags files - - -- Dump an "interface file" (.haddock file), if requested. - case optDumpInterfaceFile flags of - Just f -> dumpInterfaceFile f (map toInstalledIface ifaces) homeLinks - Nothing -> return () - - -- Render the interfaces. - renderStep flags qual packages ifaces - - else do - when (any (`elem` [Flag_Html, Flag_Hoogle, Flag_LaTeX]) flags) $ - throwE "No input file(s)." - - -- Get packages supplied with --read-interface. - packages <- readInterfaceFiles freshNameCache (readIfaceArgs flags) - - -- Render even though there are no input files (usually contents/index). - renderStep flags qual packages [] - - -readPackagesAndProcessModules :: [Flag] -> [String] - -> IO ([(DocPaths, InterfaceFile)], [Interface], LinkEnv) -readPackagesAndProcessModules flags files = do libDir <- fmap snd (getGhcDirs flags) -- Catches all GHC source errors, then prints and re-throws them. @@ -170,6 +145,33 @@ readPackagesAndProcessModules flags files = do -- Initialize GHC. withGhc libDir (ghcFlags flags) $ \_ -> handleSrcErrors $ do + dflags <- getDynFlags + + if not (null files) then do + (packages, ifaces, homeLinks) <- readPackagesAndProcessModules flags files + + -- Dump an "interface file" (.haddock file), if requested. + case optDumpInterfaceFile flags of + Just f -> liftIO $ dumpInterfaceFile f (map toInstalledIface ifaces) homeLinks + Nothing -> return () + + -- Render the interfaces. + liftIO $ renderStep dflags flags qual packages ifaces + + else do + when (any (`elem` [Flag_Html, Flag_Hoogle, Flag_LaTeX]) flags) $ + throwE "No input file(s)." + + -- Get packages supplied with --read-interface. + packages <- liftIO $ readInterfaceFiles freshNameCache (readIfaceArgs flags) + + -- Render even though there are no input files (usually contents/index). + liftIO $ renderStep dflags flags qual packages [] + + +readPackagesAndProcessModules :: [Flag] -> [String] + -> Ghc ([(DocPaths, InterfaceFile)], [Interface], LinkEnv) +readPackagesAndProcessModules flags files = do -- Get packages supplied with --read-interface. packages <- readInterfaceFiles nameCacheFromGhc (readIfaceArgs flags) @@ -180,19 +182,19 @@ readPackagesAndProcessModules flags files = do return (packages, ifaces, homeLinks) -renderStep :: [Flag] -> QualOption -> [(DocPaths, InterfaceFile)] -> [Interface] -> IO () -renderStep flags qual pkgs interfaces = do +renderStep :: DynFlags -> [Flag] -> QualOption -> [(DocPaths, InterfaceFile)] -> [Interface] -> IO () +renderStep dflags flags qual pkgs interfaces = do updateHTMLXRefs pkgs let ifaceFiles = map snd pkgs installedIfaces = concatMap ifInstalledIfaces ifaceFiles srcMap = Map.fromList [ (ifPackageId if_, x) | ((_, Just x), if_) <- pkgs ] - render flags qual interfaces installedIfaces srcMap + render dflags flags qual interfaces installedIfaces srcMap -- | Render the interfaces with whatever backend is specified in the flags. -render :: [Flag] -> QualOption -> [Interface] -> [InstalledInterface] -> SrcMap -> IO () -render flags qual ifaces installedIfaces srcMap = do +render :: DynFlags -> [Flag] -> QualOption -> [Interface] -> [InstalledInterface] -> SrcMap -> IO () +render dflags flags qual ifaces installedIfaces srcMap = do let title = fromMaybe "" (optTitle flags) @@ -246,7 +248,7 @@ render flags qual ifaces installedIfaces srcMap = do when (Flag_Hoogle `elem` flags) $ do let pkgName2 = if pkgName == "main" && title /= [] then title else pkgName - ppHoogle pkgName2 pkgVer title prologue visibleIfaces odir + ppHoogle dflags pkgName2 pkgVer title prologue visibleIfaces odir when (Flag_LaTeX `elem` flags) $ do ppLaTeX title pkgStr visibleIfaces odir prologue opt_latex_style |