From c8ba22124636eaf60c439e2ac2642b72d72145a2 Mon Sep 17 00:00:00 2001
From: Thomas Schilling <nominolo@googlemail.com>
Date: Mon, 15 Sep 2008 09:11:00 +0000
Subject: Port Haddock.GHC to new GHC API.

---
 src/Haddock/GHC.hs | 26 +++++++++++++-------------
 1 file changed, 13 insertions(+), 13 deletions(-)

(limited to 'src/Haddock/GHC.hs')

diff --git a/src/Haddock/GHC.hs b/src/Haddock/GHC.hs
index 66bd3b1f..ff1c58e4 100644
--- a/src/Haddock/GHC.hs
+++ b/src/Haddock/GHC.hs
@@ -30,25 +30,25 @@ import SrcLoc
 
 -- | Start a GHC session with the -haddock flag set. Also turn off 
 -- compilation and linking.  
-startGhc :: String -> [String] -> IO (Session, DynFlags)
-startGhc libDir flags = do
+startGhc :: String -> [String] -> (DynFlags -> Ghc a) -> IO a
+startGhc libDir flags ghcActs = do
   -- TODO: handle warnings?
 #if __GLASGOW_HASKELL__ >= 609 
   (restFlags, _) <- parseStaticFlags (map noLoc flags)
 #else
   restFlags <- parseStaticFlags flags
 #endif
-  session   <- newSession (Just libDir)
-  dynflags  <- getSessionDynFlags session
-  let dynflags' = dopt_set dynflags Opt_Haddock
-  let dynflags'' = dynflags' {
-      hscTarget = HscAsm,
-      ghcMode   = CompManager,
-      ghcLink   = NoLink
-    }
-  dynflags''' <- parseGhcFlags dynflags'' restFlags flags
-  setSessionDynFlags session dynflags'''
-  return (session, dynflags''')
+  runGhc (Just libDir) $ do
+    dynflags  <- getSessionDynFlags
+    let dynflags' = dopt_set dynflags Opt_Haddock
+    let dynflags'' = dynflags' {
+        hscTarget = HscAsm,
+        ghcMode   = CompManager,
+        ghcLink   = NoLink
+      }
+    dynflags''' <- parseGhcFlags dynflags'' restFlags flags
+    setSessionDynFlags dynflags'''
+    ghcActs dynflags'''
 
 
 -- | Expose the list of packages to GHC. Then initialize GHC's package state
-- 
cgit v1.2.3