aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends/Hyperlinker.hs
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api/src/Haddock/Backends/Hyperlinker.hs')
-rw-r--r--haddock-api/src/Haddock/Backends/Hyperlinker.hs23
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 ()