aboutsummaryrefslogtreecommitdiff
path: root/src/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Main.hs')
-rw-r--r--src/Main.hs64
1 files changed, 33 insertions, 31 deletions
diff --git a/src/Main.hs b/src/Main.hs
index 8c15661d..beb01b86 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