diff options
Diffstat (limited to 'haddock-api/src/Haddock.hs')
| -rw-r--r-- | haddock-api/src/Haddock.hs | 35 |
1 files changed, 17 insertions, 18 deletions
diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs index 0b5e33a3..8dfee5bc 100644 --- a/haddock-api/src/Haddock.hs +++ b/haddock-api/src/Haddock.hs @@ -55,27 +55,25 @@ import Data.Version (makeVersion) import qualified Data.Map as Map import System.IO import System.Exit +import System.FilePath #ifdef IN_GHC_TREE -import System.FilePath import System.Environment (getExecutablePath) #else import qualified GHC.Paths as GhcPaths import Paths_haddock_api (getDataDir) #endif import System.Directory (doesDirectoryExist, getTemporaryDirectory) -import System.FilePath ((</>)) import Text.ParserCombinators.ReadP (readP_to_S) import GHC hiding (verbosity) -import Config -import DynFlags hiding (projectVersion, verbosity) -import ErrUtils -import Packages -import Panic (handleGhcException) -import Module -import FastString -import Outputable (defaultUserStyle) +import GHC.Settings.Config +import GHC.Driver.Session hiding (projectVersion, verbosity) +import GHC.Utils.Outputable (defaultUserStyle, withPprStyle) +import GHC.Utils.Error +import GHC.Unit +import GHC.Utils.Panic (handleGhcException) +import GHC.Data.FastString -------------------------------------------------------------------------------- -- * Exception handling @@ -185,7 +183,7 @@ haddockWithGhc ghc args = handleTopExceptions $ do forM_ (optShowInterfaceFile flags) $ \path -> liftIO $ do mIfaceFile <- readInterfaceFiles freshNameCache [(("", Nothing), path)] noChecks forM_ mIfaceFile $ \(_, ifaceFile) -> do - logOutput dflags (defaultUserStyle dflags) (renderJson (jsonInterfaceFile ifaceFile)) + logOutput dflags $ withPprStyle defaultUserStyle (renderJson (jsonInterfaceFile ifaceFile)) if not (null files) then do (packages, ifaces, homeLinks) <- readPackagesAndProcessModules flags files @@ -286,6 +284,7 @@ render dflags flags sinceQual qual ifaces installedIfaces extSrcMap = do opt_latex_style = optLaTeXStyle flags opt_source_css = optSourceCssFile flags opt_mathjax = optMathjax flags + pkgs = unitState dflags dflags' | unicode = gopt_set dflags Opt_PrintUnicodeSyntax | otherwise = dflags @@ -297,8 +296,8 @@ render dflags flags sinceQual qual ifaces installedIfaces extSrcMap = do allVisibleIfaces = [ i | i <- allIfaces, OptHide `notElem` instOptions i ] pkgMod = fmap ifaceMod (listToMaybe ifaces) - pkgKey = fmap moduleUnitId pkgMod - pkgStr = fmap unitIdString pkgKey + pkgKey = fmap moduleUnit pkgMod + pkgStr = fmap unitString pkgKey pkgNameVer = modulePackageInfo dflags flags pkgMod pkgName = fmap (unpackFS . (\(PackageName n) -> n)) (fst pkgNameVer) sincePkg = case sinceQual of @@ -315,7 +314,7 @@ render dflags flags sinceQual qual ifaces installedIfaces extSrcMap = do (Map.map SrcExternal extSrcMap) (Map.fromList [ (ifaceMod iface, SrcLocal) | iface <- ifaces ]) - pkgSrcMap = Map.mapKeys moduleUnitId extSrcMap + pkgSrcMap = Map.mapKeys moduleUnit extSrcMap pkgSrcMap' | Flag_HyperlinkedSource `elem` flags , Just k <- pkgKey @@ -344,11 +343,11 @@ render dflags flags sinceQual qual ifaces installedIfaces extSrcMap = do -- records the *wired in* identity base. So untranslate it -- so that we can service the request. unwire :: Module -> Module - unwire m = m { moduleUnitId = unwireUnitId dflags (moduleUnitId m) } + unwire m = m { moduleUnit = unwireUnit (unitState dflags) (moduleUnit m) } reexportedIfaces <- concat `fmap` (for (reexportFlags flags) $ \mod_str -> do let warn = hPutStrLn stderr . ("Warning: " ++) - case readP_to_S parseModuleId mod_str of + case readP_to_S parseHoleyModule mod_str of [(m, "")] | Just iface <- Map.lookup m installedMap -> return [iface] @@ -375,7 +374,7 @@ render dflags flags sinceQual qual ifaces installedIfaces extSrcMap = do when (Flag_GenContents `elem` flags) $ do withTiming dflags' "ppHtmlContents" (const ()) $ do _ <- {-# SCC ppHtmlContents #-} - ppHtmlContents dflags' odir title pkgStr + ppHtmlContents pkgs odir title pkgStr themes opt_mathjax opt_index_url sourceUrls' opt_wiki_urls allVisibleIfaces True prologue pretty sincePkg (makeContentsQual qual) @@ -385,7 +384,7 @@ render dflags flags sinceQual qual ifaces installedIfaces extSrcMap = do when (Flag_Html `elem` flags) $ do withTiming dflags' "ppHtml" (const ()) $ do _ <- {-# SCC ppHtml #-} - ppHtml dflags' title pkgStr visibleIfaces reexportedIfaces odir + ppHtml pkgs title pkgStr visibleIfaces reexportedIfaces odir prologue themes opt_mathjax sourceUrls' opt_wiki_urls opt_contents_url opt_index_url unicode sincePkg qual |