aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api/src/Haddock/Backends')
-rw-r--r--haddock-api/src/Haddock/Backends/Hyperlinker.hs12
1 files changed, 10 insertions, 2 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
index 39be6762..68e03fd5 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
@@ -22,7 +22,7 @@ import System.FilePath
import GHC.Iface.Ext.Types ( pattern HiePath, HieFile(..), HieASTs(..), HieAST(..), SourcedNodeInfo(..) )
import GHC.Iface.Ext.Binary ( readHieFile, hie_file_result )
-import GHC.Types.SrcLoc ( realSrcLocSpan, mkRealSrcLoc )
+import GHC.Types.SrcLoc ( realSrcLocSpan, mkRealSrcLoc, srcSpanFile )
import Data.Map as M
import GHC.Data.FastString ( mkFastString )
import GHC.Unit.Module ( Module, moduleName )
@@ -71,7 +71,7 @@ ppHyperlinkedModuleSource verbosity srcdir pretty srcs iface = case ifaceHieFile
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
@@ -81,6 +81,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 ()