From 162364b177c3982c67c842d310aead45434a3760 Mon Sep 17 00:00:00 2001
From: David Waern <david.waern@gmail.com>
Date: Sun, 1 Apr 2012 21:46:04 +0200
Subject: Check qualification option before processing modules.

---
 src/Main.hs | 27 +++++++++++++--------------
 1 file changed, 13 insertions(+), 14 deletions(-)

(limited to 'src')

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
 
-- 
cgit v1.2.3