From eada277a0f492e20d034ec6b8fb08a476232c7c4 Mon Sep 17 00:00:00 2001
From: Simon Hengel <sol@typeful.net>
Date: Mon, 5 Mar 2012 11:14:20 +0100
Subject: Save/restore global state for static flags when running GHC actions

This is necessary if we want to run createInterfaces (from
Documentation.Haddock) multiple times in the same process.
---
 src/Main.hs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

(limited to 'src')

diff --git a/src/Main.hs b/src/Main.hs
index 0a3c9ffc..c0b7df4b 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -57,6 +57,7 @@ import Paths_haddock
 import GHC hiding (flags, verbosity)
 import Config
 import DynFlags hiding (flags, verbosity)
+import StaticFlags (saveStaticFlagGlobals, restoreStaticFlagGlobals)
 import Panic (panic, handleGhcException)
 import Module
 
@@ -290,7 +291,7 @@ dumpInterfaceFile path ifaces homeLinks = writeInterfaceFile path ifaceFile
 -- | 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 = do
+withGhc libDir flags ghcActs = saveStaticFlagGlobals >>= \savedFlags -> do
   -- TODO: handle warnings?
   (restFlags, _) <- parseStaticFlags (map noLoc flags)
   runGhc (Just libDir) $ do
@@ -308,6 +309,7 @@ withGhc libDir flags ghcActs = do
         -- dynamic or static linking at all!
         _ <- setSessionDynFlags dynflags'''
         ghcActs dynflags'''
+  `finally` restoreStaticFlagGlobals savedFlags
   where
     parseGhcFlags :: Monad m => DynFlags -> [Located String]
                   -> [String] -> m DynFlags
-- 
cgit v1.2.3