aboutsummaryrefslogtreecommitdiff
path: root/src/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Main.hs')
-rw-r--r--src/Main.hs27
1 files changed, 13 insertions, 14 deletions
diff --git a/src/Main.hs b/src/Main.hs
index 4f0784eb..8c15661d 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -127,9 +127,13 @@ main :: IO ()
main = handleTopExceptions $ do
-- Parse command-line flags and handle some of them initially.
+ -- TODO: unify all of this (and some of what's in the 'render' function),
+ -- into one function that returns a record with a field for each option,
+ -- or which exits with an error or help message.
args <- getArgs
(flags, files) <- parseHaddockOpts args
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
@@ -140,7 +144,7 @@ main = handleTopExceptions $ do
Nothing -> return ()
-- Render the interfaces.
- renderStep flags packages ifaces
+ renderStep flags qual packages ifaces
else do
when (any (`elem` [Flag_Html, Flag_Hoogle, Flag_LaTeX]) flags) $
@@ -150,7 +154,7 @@ main = handleTopExceptions $ do
packages <- readInterfaceFiles freshNameCache (readIfaceArgs flags)
-- Render even though there are no input files (usually contents/index).
- renderStep flags packages []
+ renderStep flags qual packages []
readPackagesAndProcessModules :: [Flag] -> [String]
@@ -176,24 +180,19 @@ readPackagesAndProcessModules flags files = do
return (packages, ifaces, homeLinks)
-renderStep :: [Flag] -> [(DocPaths, InterfaceFile)] -> [Interface] -> IO ()
-renderStep flags pkgs interfaces = do
+renderStep :: [Flag] -> QualOption -> [(DocPaths, InterfaceFile)] -> [Interface] -> IO ()
+renderStep 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 interfaces installedIfaces srcMap
+ render flags qual interfaces installedIfaces srcMap
-- | Render the interfaces with whatever backend is specified in the flags.
-render :: [Flag] -> [Interface] -> [InstalledInterface] -> SrcMap -> IO ()
-render flags ifaces installedIfaces srcMap = do
-
- opt_qualification <-
- case qualification flags of
- Left msg -> throwE msg
- Right q -> return q
+render :: [Flag] -> QualOption -> [Interface] -> [InstalledInterface] -> SrcMap -> IO ()
+render flags qual ifaces installedIfaces srcMap = do
let
title = fromMaybe "" (optTitle flags)
@@ -234,14 +233,14 @@ render flags ifaces installedIfaces srcMap = do
ppHtmlContents odir title pkgStr
themes opt_index_url sourceUrls' opt_wiki_urls
allVisibleIfaces True prologue pretty
- (makeContentsQual opt_qualification)
+ (makeContentsQual qual)
copyHtmlBits odir libDir themes
when (Flag_Html `elem` flags) $ do
ppHtml title pkgStr visibleIfaces odir
prologue
themes sourceUrls' opt_wiki_urls
- opt_contents_url opt_index_url unicode opt_qualification
+ opt_contents_url opt_index_url unicode qual
pretty
copyHtmlBits odir libDir themes