Apoorv Ingle pushed to branch wip/ani/hie-spans at Glasgow Haskell Compiler / GHC

Commits:

2 changed files:

Changes:

  • utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
    ... ... @@ -155,6 +155,53 @@ parse parserOpts sDocContext fpath bs = case unP (go False []) initState of
    155 155
     
    
    156 156
               pure (plainTok : [spaceTok | not (BS.null spaceBStr)], inPrag')
    
    157 157
     
    
    158
    +        GeneratedSrcSpan rsp -> do
    
    159
    +          let typ = if inPrag then TkPragma else classify tok
    
    160
    +              RealSrcLoc lStart _ = srcSpanStart sp -- safe since @sp@ is real
    
    161
    +              (spaceBStr, bStart) = spanPosition lInit lStart bInit
    
    162
    +              inPragDef = inPragma inPrag tok
    
    163
    +
    
    164
    +          (bEnd', inPrag') <- case tok of
    
    165
    +            -- Update internal line + file position if this is a LINE pragma
    
    166
    +            ITline_prag _ -> tryOrElse (bEnd, inPragDef) $ do
    
    167
    +              L _ (ITinteger (IL{il_value = line})) <- tryP wrappedLexer
    
    168
    +              L _ (ITstring _ file) <- tryP wrappedLexer
    
    169
    +              L spF ITclose_prag <- tryP wrappedLexer
    
    170
    +
    
    171
    +              let newLoc = mkRealSrcLoc file (fromIntegral line - 1) (srcSpanEndCol spF)
    
    172
    +              (bEnd'', _) <- lift getInput
    
    173
    +              lift $ setInput (bEnd'', newLoc)
    
    174
    +
    
    175
    +              pure (bEnd'', False)
    
    176
    +
    
    177
    +            -- Update internal column position if this is a COLUMN pragma
    
    178
    +            ITcolumn_prag _ -> tryOrElse (bEnd, inPragDef) $ do
    
    179
    +              L _ (ITinteger (IL{il_value = col})) <- tryP wrappedLexer
    
    180
    +              L spF ITclose_prag <- tryP wrappedLexer
    
    181
    +
    
    182
    +              let newLoc = mkRealSrcLoc (srcSpanFile spF) (srcSpanEndLine spF) (fromIntegral col)
    
    183
    +              (bEnd'', _) <- lift getInput
    
    184
    +              lift $ setInput (bEnd'', newLoc)
    
    185
    +
    
    186
    +              pure (bEnd'', False)
    
    187
    +            _ -> pure (bEnd, inPragDef)
    
    188
    +
    
    189
    +          let tokBStr = splitStringBuffer bStart bEnd'
    
    190
    +              plainTok =
    
    191
    +                T.Token
    
    192
    +                  { tkType = typ
    
    193
    +                  , tkValue = tokBStr
    
    194
    +                  , tkSpan = rsp
    
    195
    +                  }
    
    196
    +              spaceTok =
    
    197
    +                T.Token
    
    198
    +                  { tkType = TkSpace
    
    199
    +                  , tkValue = spaceBStr
    
    200
    +                  , tkSpan = mkRealSrcSpan lInit lStart
    
    201
    +                  }
    
    202
    +
    
    203
    +          pure (plainTok : [spaceTok | not (BS.null spaceBStr)], inPrag')
    
    204
    +
    
    158 205
         -- \| Parse whatever remains of the line as an unknown token (can't fail)
    
    159 206
         unknownLine :: P ([T.Token], Bool)
    
    160 207
         unknownLine = do
    

  • utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
    ... ... @@ -103,6 +103,8 @@ spliceURL' maybe_mod maybe_name maybe_loc = run
    103 103
             case span_ of
    
    104 104
               RealSrcSpan span__ _ ->
    
    105 105
                 show $ srcSpanStartLine span__
    
    106
    +          GeneratedSrcSpan span__ ->
    
    107
    +            show $ srcSpanStartLine span__
    
    106 108
               UnhelpfulSpan _ -> ""
    
    107 109
     
    
    108 110
         run "" = ""