diff options
Diffstat (limited to 'haddock-api/src/Haddock/Backends/Hyperlinker.hs')
-rw-r--r-- | haddock-api/src/Haddock/Backends/Hyperlinker.hs | 23 |
1 files changed, 14 insertions, 9 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs index 5bbea77b..9316da6d 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs @@ -9,6 +9,7 @@ module Haddock.Backends.Hyperlinker import Haddock.Types import Haddock.Utils (writeUtf8File, out, verbose, Verbosity) +import Haddock.InterfaceFile import Haddock.Backends.Hyperlinker.Renderer import Haddock.Backends.Hyperlinker.Parser import Haddock.Backends.Hyperlinker.Types @@ -20,13 +21,11 @@ import System.Directory import System.FilePath import GHC.Iface.Ext.Types ( pattern HiePath, HieFile(..), HieASTs(..), HieAST(..), SourcedNodeInfo(..) ) -import GHC.Iface.Ext.Binary ( readHieFile, hie_file_result, NameCacheUpdater(..)) -import GHC.Types.SrcLoc ( realSrcLocSpan, mkRealSrcLoc ) +import GHC.Iface.Ext.Binary ( readHieFile, hie_file_result ) +import GHC.Types.SrcLoc ( realSrcLocSpan, mkRealSrcLoc, srcSpanFile ) import Data.Map as M import GHC.Data.FastString ( mkFastString ) import GHC.Unit.Module ( Module, moduleName ) -import GHC.Types.Name.Cache ( initNameCache ) -import GHC.Types.Unique.Supply ( mkSplitUniqSupply ) -- | Generate hyperlinked source for given interfaces. @@ -58,21 +57,19 @@ ppHyperlinkedModuleSource :: Verbosity -> FilePath -> Bool -> SrcMaps -> Interfa ppHyperlinkedModuleSource verbosity srcdir pretty srcs iface = case ifaceHieFile iface of Just hfp -> do -- Parse the GHC-produced HIE file - u <- mkSplitUniqSupply 'a' - let nc = (initNameCache u []) - ncu = NCU $ \f -> pure $ snd $ f nc + nc <- freshNameCache HieFile { hie_hs_file = file , hie_asts = HieASTs asts , hie_types = types , hie_hs_src = rawSrc } <- hie_file_result - <$> (readHieFile ncu hfp) + <$> (readHieFile nc hfp) -- Get the AST and tokens corresponding to the source file we want let fileFs = mkFastString file mast | M.size asts == 1 = snd <$> M.lookupMin asts | otherwise = M.lookup (HiePath (mkFastString file)) asts - tokens = parse df file rawSrc + tokens' = parse df file rawSrc ast = fromMaybe (emptyHieAst fileFs) mast fullAst = recoverFullIfaceTypes df types ast @@ -82,6 +79,14 @@ ppHyperlinkedModuleSource verbosity srcdir pretty srcs iface = case ifaceHieFile else out verbosity verbose $ unwords [ "couldn't find ast for" , file, show (M.keys asts) ] + -- The C preprocessor can double the backslashes on tokens (see #19236), + -- which means the source spans will not be comparable and we will not + -- be able to associate the HieAST with the correct tokens. + -- + -- We work around this by setting the source span of the tokens to the file + -- name from the HieAST + let tokens = fmap (\tk -> tk {tkSpan = (tkSpan tk){srcSpanFile = srcSpanFile $ nodeSpan fullAst}}) tokens' + -- Produce and write out the hyperlinked sources writeUtf8File path . renderToString pretty . render' fullAst $ tokens Nothing -> return () |