Repository : ssh://darcs.haskell.org//srv/darcs/haddock On branch : ghc-7.6
http://hackage.haskell.org/trac/ghc/changeset/d40f783dae503a194c036f5c8272563fcca187a4 >--------------------------------------------------------------- commit d40f783dae503a194c036f5c8272563fcca187a4 Author: David Waern <[email protected]> Date: Fri Sep 28 10:21:32 2012 +0200 Make API buildable with GHC 7.6. >--------------------------------------------------------------- src/Documentation/Haddock.hs | 2 +- src/Main.hs | 24 ++++++++++++++---------- 2 files changed, 15 insertions(+), 11 deletions(-) diff --git a/src/Documentation/Haddock.hs b/src/Documentation/Haddock.hs index 60bb314..cbdc4d6 100644 --- a/src/Documentation/Haddock.hs +++ b/src/Documentation/Haddock.hs @@ -70,6 +70,6 @@ createInterfaces -> [String] -- ^ File or module names -> IO [Interface] -- ^ Resulting list of interfaces createInterfaces flags modules = do - (_, ifaces, _) <- readPackagesAndProcessModules flags modules + (_, ifaces, _) <- withGhc' flags (readPackagesAndProcessModules flags modules) return ifaces diff --git a/src/Main.hs b/src/Main.hs index 31e2726..abeda77 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -15,7 +15,7 @@ -- -- Program entry point and top-level code. ----------------------------------------------------------------------------- -module Main (main, readPackagesAndProcessModules) where +module Main (main, readPackagesAndProcessModules, withGhc') where import Haddock.Backends.Xhtml @@ -135,15 +135,7 @@ main = handleTopExceptions $ do shortcutFlags flags qual <- case qualification flags of {Left msg -> throwE msg; Right q -> return q} - libDir <- fmap snd (getGhcDirs flags) - - -- Catches all GHC source errors, then prints and re-throws them. - let handleSrcErrors action' = flip handleSourceError action' $ \err -> do - printException err - liftIO exitFailure - - -- Initialize GHC. - withGhc libDir (ghcFlags flags) $ \_ -> handleSrcErrors $ do + withGhc' flags $ do dflags <- getDynFlags @@ -169,6 +161,18 @@ main = handleTopExceptions $ do liftIO $ renderStep dflags flags qual packages [] +withGhc' :: [Flag] -> Ghc a -> IO a +withGhc' flags action = do + libDir <- fmap snd (getGhcDirs flags) + + -- Catches all GHC source errors, then prints and re-throws them. + let handleSrcErrors action' = flip handleSourceError action' $ \err -> do + printException err + liftIO exitFailure + + withGhc libDir (ghcFlags flags) (\_ -> handleSrcErrors action) + + readPackagesAndProcessModules :: [Flag] -> [String] -> Ghc ([(DocPaths, InterfaceFile)], [Interface], LinkEnv) readPackagesAndProcessModules flags files = do _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
