diff options
Diffstat (limited to 'haddock-api/src/Haddock.hs')
| -rw-r--r-- | haddock-api/src/Haddock.hs | 21 |
1 files changed, 12 insertions, 9 deletions
diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs index 8182707d..d955ae4f 100644 --- a/haddock-api/src/Haddock.hs +++ b/haddock-api/src/Haddock.hs @@ -71,6 +71,7 @@ import GHC.Settings.Config import GHC.Driver.Session hiding (projectVersion, verbosity) import GHC.Driver.Env import GHC.Utils.Error +import GHC.Types.Name.Cache import GHC.Unit import GHC.Utils.Panic (handleGhcException) import GHC.Data.FastString @@ -188,7 +189,8 @@ haddockWithGhc ghc args = handleTopExceptions $ do unit_state <- hsc_units <$> getSession forM_ (optShowInterfaceFile flags) $ \path -> liftIO $ do - mIfaceFile <- readInterfaceFiles freshNameCache [(("", Nothing), path)] noChecks + name_cache <- freshNameCache + mIfaceFile <- readInterfaceFiles name_cache [(("", Nothing), path)] noChecks forM_ mIfaceFile $ \(_, ifaceFile) -> do putMsg logger dflags $ renderJson (jsonInterfaceFile ifaceFile) @@ -210,7 +212,8 @@ haddockWithGhc ghc args = handleTopExceptions $ do throwE "No input file(s)." -- Get packages supplied with --read-interface. - packages <- liftIO $ readInterfaceFiles freshNameCache (readIfaceArgs flags) noChecks + name_cache <- liftIO $ freshNameCache + packages <- liftIO $ readInterfaceFiles name_cache (readIfaceArgs flags) noChecks -- Render even though there are no input files (usually contents/index). liftIO $ renderStep logger dflags unit_state flags sinceQual qual packages [] @@ -253,7 +256,8 @@ readPackagesAndProcessModules :: [Flag] -> [String] readPackagesAndProcessModules flags files = do -- Get packages supplied with --read-interface. let noChecks = Flag_BypassInterfaceVersonCheck `elem` flags - packages <- readInterfaceFiles nameCacheFromGhc (readIfaceArgs flags) noChecks + name_cache <- hsc_NC <$> getSession + packages <- liftIO $ readInterfaceFiles name_cache (readIfaceArgs flags) noChecks -- Create the interfaces -- this is the core part of Haddock. let ifaceFiles = map snd packages @@ -441,18 +445,17 @@ render logger dflags unit_state flags sinceQual qual ifaces installedIfaces extS ------------------------------------------------------------------------------- -readInterfaceFiles :: MonadIO m - => NameCacheAccessor m +readInterfaceFiles :: NameCache -> [(DocPaths, FilePath)] -> Bool - -> m [(DocPaths, InterfaceFile)] -readInterfaceFiles name_cache_accessor pairs bypass_version_check = do + -> IO [(DocPaths, InterfaceFile)] +readInterfaceFiles name_cache pairs bypass_version_check = do catMaybes `liftM` mapM ({-# SCC readInterfaceFile #-} tryReadIface) pairs where -- try to read an interface, warn if we can't tryReadIface (paths, file) = - readInterfaceFile name_cache_accessor file bypass_version_check >>= \case - Left err -> liftIO $ do + readInterfaceFile name_cache file bypass_version_check >>= \case + Left err -> do putStrLn ("Warning: Cannot read " ++ file ++ ":") putStrLn (" " ++ err) putStrLn "Skipping this interface." |