aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorDavid Waern <david.waern@gmail.com>2012-09-28 10:21:32 +0200
committerDavid Waern <david.waern@gmail.com>2012-09-28 10:21:32 +0200
commitd40f783dae503a194c036f5c8272563fcca187a4 (patch)
treeb65d448812ff5709f5f507944373333865e03fc2 /src
parent59ddaa2897ed15cef790dc47aeb00283caf81f33 (diff)
Make API buildable with GHC 7.6.
Diffstat (limited to 'src')
-rw-r--r--src/Documentation/Haddock.hs2
-rw-r--r--src/Main.hs24
2 files changed, 15 insertions, 11 deletions
diff --git a/src/Documentation/Haddock.hs b/src/Documentation/Haddock.hs
index 60bb3147..cbdc4d61 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 31e2726c..abeda77f 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