commit 444fcddc2b3000280816a6d0b488bdbf6d954d89
Author: Gabor Pali <pali.gabor@gmail.com>
Date:   Mon Sep 23 04:14:59 2013 +0100

    Parse static flags for GHC earlier.

diff --git a/src/Documentation/Haddock.hs b/src/Documentation/Haddock.hs
index 36115a2..6dfd33e 100644
--- a/src/Documentation/Haddock.hs
+++ b/src/Documentation/Haddock.hs
@@ -67,6 +67,7 @@ import Haddock.Types
 import Haddock.Options
 import Haddock.Utils
 import Haddock
+import GHC
 
 
 -- | Create 'Interface' structures from a given list of Haddock command-line
@@ -74,9 +75,10 @@ import Haddock
 -- that control documentation generation or show help or version information
 -- are ignored.
 createInterfaces
-  :: [Flag]         -- ^ A list of command-line flags
+  :: [Located String]
+  -> [Flag]         -- ^ A list of command-line flags
   -> [String]       -- ^ File or module names
   -> IO [Interface] -- ^ Resulting list of interfaces
-createInterfaces flags modules = do
-  (_, ifaces, _) <- withGhc' flags (readPackagesAndProcessModules flags modules)
+createInterfaces stFlags flags modules = do
+  (_, ifaces, _) <- withGhc' stFlags flags (readPackagesAndProcessModules flags modules)
   return ifaces
diff --git a/src/Haddock.hs b/src/Haddock.hs
index a7ac5ba..6e555ba 100644
--- a/src/Haddock.hs
+++ b/src/Haddock.hs
@@ -135,11 +135,12 @@ haddock args = handleTopExceptions $ do
   -- into one function that returns a record with a field for each option,
   -- or which exits with an error or help message.
   (flags, files) <- parseHaddockOpts args
+  (stFlags, _) <- parseStaticFlags (map noLoc $ ghcFlags flags)
   shortcutFlags flags
   qual <- case qualification flags of {Left msg -> throwE msg; Right q -> return q}
 
   -- inject dynamic-too into flags before we proceed
-  flags' <- withGhc' flags $ do
+  flags' <- withGhc' stFlags flags $ do
         df <- getDynFlags
         case lookup "GHC Dynamic" (compilerInfo df) of
           Just "YES" -> return $ Flag_OptGhc "-dynamic-too" : flags
@@ -149,7 +150,7 @@ haddock args = handleTopExceptions $ do
     forM_ (warnings args) $ \warning -> do
       hPutStrLn stderr warning
 
-  withGhc' flags' $ do
+  withGhc' stFlags flags' $ do
 
     dflags <- getDynFlags
 
@@ -183,8 +184,8 @@ warnings = map format . filter (isPrefixOf "-optghc")
     format arg = concat ["Warning: `", arg, "' means `-o ", drop 2 arg, "', did you mean `-", arg, "'?"]
 
 
-withGhc' :: [Flag] -> Ghc a -> IO a
-withGhc' flags action = do
+withGhc' :: [Located String] -> [Flag] -> Ghc a -> IO a
+withGhc' stFlags flags action = do
   libDir <- fmap snd (getGhcDirs flags)
 
   -- Catches all GHC source errors, then prints and re-throws them.
@@ -192,7 +193,7 @@ withGhc' flags action = do
         printException err
         liftIO exitFailure
 
-  withGhc libDir (ghcFlags flags) (\_ -> handleSrcErrors action)
+  withGhc libDir stFlags (ghcFlags flags) (\_ -> handleSrcErrors action)
 
 
 readPackagesAndProcessModules :: [Flag] -> [String]
@@ -312,10 +313,8 @@ readInterfaceFiles name_cache_accessor pairs = do
 
 -- | Start a GHC session with the -haddock flag set. Also turn off
 -- compilation and linking. Then run the given 'Ghc' action.
-withGhc :: String -> [String] -> (DynFlags -> Ghc a) -> IO a
-withGhc libDir flags ghcActs = saveStaticFlagGlobals >>= \savedFlags -> do
-  -- TODO: handle warnings?
-  (restFlags, _) <- parseStaticFlags (map noLoc flags)
+withGhc :: String -> [Located String] -> [String] -> (DynFlags -> Ghc a) -> IO a
+withGhc libDir stFlags flags ghcActs = saveStaticFlagGlobals >>= \savedFlags -> do
   runGhc (Just libDir) $ do
     dynflags  <- getSessionDynFlags
     let dynflags' = gopt_set dynflags Opt_Haddock
@@ -324,7 +323,7 @@ withGhc libDir flags ghcActs = saveStaticFlagGlobals >>= \savedFlags -> do
         ghcMode   = CompManager,
         ghcLink   = NoLink
       }
-    dynflags''' <- parseGhcFlags dynflags'' restFlags flags
+    dynflags''' <- parseGhcFlags dynflags'' stFlags flags
     defaultCleanupHandler dynflags''' $ do
         -- ignore the following return-value, which is a list of packages
         -- that may need to be re-linked: Haddock doesn't do any