Oleg Grenrus pushed to branch wip/shorter-this-module-links at Glasgow Haskell Compiler / GHC

Commits:

7 changed files:

Changes:

  • libffi-tarballs
    1 
    -Subproject commit 7c51059557b68d29820a0a87cebfa6fe73c8adf5
    1 
    +Subproject commit 89a9b01c5647c8f0d3899435b99df690f582e9f1

  • nofib
    1 
    -Subproject commit b7391df4540ac8b11b35e1b2e2c15819b5171798
    1 
    +Subproject commit da7eed00e494aba1da9f51cb92089ca10e2454e7

  • utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker.hs
    ... ... @@ -80,7 +80,6 @@ ppHyperlinkedModuleSource verbosity srcdir pretty srcs iface = do
    80 80 
       nc <- freshNameCache
    81 81 
       HieFile
    82 82 
         { hie_hs_file = file
    83 
    -    , hie_module = thisModule
    84 83 
         , hie_asts = HieASTs asts
    85 84 
         , hie_types = types
    86 85 
         , hie_hs_src = rawSrc
    ... ... @@ -117,7 +116,7 @@ ppHyperlinkedModuleSource verbosity srcdir pretty srcs iface = do
    117 116 
       let tokens = fmap (\tk -> tk{tkSpan = (tkSpan tk){srcSpanFile = srcSpanFile $ nodeSpan fullAst}}) tokens'
    118 117
    119 118 
       -- Produce and write out the hyperlinked sources
    120 
    -  writeUtf8File path . renderToString pretty . render' thisModule fullAst $ tokens
    119 
    +  writeUtf8File path . renderToString pretty . render' fullAst $ tokens
    121 120 
       where
    122 121 
         dflags = ifaceDynFlags iface
    123 122 
         sDocContext = DynFlags.initSDocContext dflags Outputable.defaultUserStyle
    ... ... @@ -129,7 +128,7 @@ ppHyperlinkedModuleSource verbosity srcdir pretty srcs iface = do
    129 128 
             False -- lex Haddocks as comment tokens
    130 129 
             True -- produce comment tokens
    131 130 
             False -- produce position pragmas tokens
    132 
    -    render' thisModule = render thisModule (Just srcCssFile) (Just highlightScript) srcs
    131 
    +    render' = render (Just srcCssFile) (Just highlightScript) srcs
    133 132 
         path = srcdir </> hypSrcModuleFile (ifaceMod iface)
    134 133
    135 134 
         emptyHieAst fileFs =

  • utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
    ... ... @@ -15,7 +15,7 @@ import GHC.Iface.Ext.Utils (emptyNodeInfo, isEvidenceContext)
    15 15 
     import GHC.Types.Name (Name, getOccString, isInternalName, nameModule, nameUnique)
    16 16 
     import GHC.Types.SrcLoc
    17 17 
     import GHC.Types.Unique (getKey)
    18 
    -import GHC.Unit.Module (Module, ModuleName, moduleNameString)
    18 
    +import GHC.Unit.Module (ModuleName, moduleNameString)
    19 19 
     import GHC.Utils.Encoding (utf8DecodeByteString)
    20 20 
     import System.FilePath.Posix ((</>))
    21 21 
     import Text.XHtml (Html, HtmlAttr, (!))
    ... ... @@ -28,9 +28,7 @@ type StyleClass = String
    28 28
    29 29 
     -- | Produce the HTML corresponding to a hyperlinked Haskell source
    30 30 
     render
    31 
    -  :: Module
    32 
    -  -- ^ this module
    33 
    -  -> Maybe FilePath
    31 
    +  :: Maybe FilePath
    34 32 
       -- ^ path to the CSS file
    35 33 
       -> Maybe FilePath
    36 34 
       -- ^ path to the JS file
    ... ... @@ -41,12 +39,12 @@ render
    41 39 
       -> [Token]
    42 40 
       -- ^ tokens to render
    43 41 
       -> Html
    44 
    -render thisModule mcss mjs srcs ast tokens = header mcss mjs <> body thisModule srcs ast tokens
    42 
    +render mcss mjs srcs ast tokens = header mcss mjs <> body srcs ast tokens
    45 43
    46 
    -body :: Module -> SrcMaps -> HieAST PrintedType -> [Token] -> Html
    47 
    -body thisModule srcs ast tokens = Html.body . Html.pre $ hypsrc
    44 
    +body :: SrcMaps -> HieAST PrintedType -> [Token] -> Html
    45 
    +body srcs ast tokens = Html.body . Html.pre $ hypsrc
    48 46 
       where
    49 
    -    hypsrc = renderWithAst thisModule srcs ast tokens
    47 
    +    hypsrc = renderWithAst srcs ast tokens
    50 48
    51 49 
     header :: Maybe FilePath -> Maybe FilePath -> Html
    52 50 
     header Nothing Nothing = Html.noHtml
    ... ... @@ -77,9 +75,9 @@ splitTokens ast toks = (before, during, after)
    77 75
    78 76 
     -- | Turn a list of tokens into hyperlinked sources, threading in relevant link
    79 77 
     -- information from the 'HieAST'.
    80 
    -renderWithAst :: Module -> SrcMaps -> HieAST PrintedType -> [Token] -> Html
    81 
    -renderWithAst thisModule srcs Node{..} toks = anchored $ case toks of
    82 
    -  [tok] | nodeSpan == tkSpan tok -> richToken thisModule srcs nodeInfo tok
    78 
    +renderWithAst :: SrcMaps -> HieAST PrintedType -> [Token] -> Html
    79 
    +renderWithAst srcs Node{..} toks = anchored $ case toks of
    80 
    +  [tok] | nodeSpan == tkSpan tok -> richToken srcs nodeInfo tok
    83 81 
       -- NB: the GHC lexer lexes backquoted identifiers and parenthesized operators
    84 82 
       -- as multiple tokens.
    85 83 
       --
    ... ... @@ -94,7 +92,6 @@ renderWithAst thisModule srcs Node{..} toks = anchored $ case toks of
    94 92 
         | realSrcSpanStart s1 == realSrcSpanStart nodeSpan
    95 93 
         , realSrcSpanEnd s2 == realSrcSpanEnd nodeSpan ->
    96 94 
             richToken
    97 
    -          thisModule
    98 95 
               srcs
    99 96 
               nodeInfo
    100 97 
               ( Token
    ... ... @@ -107,7 +104,6 @@ renderWithAst thisModule srcs Node{..} toks = anchored $ case toks of
    107 104 
         | realSrcSpanStart s1 == realSrcSpanStart nodeSpan
    108 105 
         , realSrcSpanEnd s2 == realSrcSpanEnd nodeSpan ->
    109 106 
             richToken
    110 
    -          thisModule
    111 107 
               srcs
    112 108 
               nodeInfo
    113 109 
               ( Token
    ... ... @@ -122,7 +118,7 @@ renderWithAst thisModule srcs Node{..} toks = anchored $ case toks of
    122 118 
         go _ [] = mempty
    123 119 
         go [] xs = foldMap renderToken xs
    124 120 
         go (cur : rest) xs =
    125 
    -      foldMap renderToken before <> renderWithAst thisModule srcs cur during <> go rest after
    121 
    +      foldMap renderToken before <> renderWithAst srcs cur during <> go rest after
    126 122 
           where
    127 123 
             (before, during, after) = splitTokens cur xs
    128 124 
         anchored c = Map.foldrWithKey anchorOne c (nodeIdentifiers nodeInfo)
    ... ... @@ -141,8 +137,8 @@ renderToken Token{..}
    141 137 
         tokenSpan = Html.thespan (Html.toHtml tkValue')
    142 138
    143 139 
     -- | Given information about the source position of definitions, render a token
    144 
    -richToken :: Module -> SrcMaps -> NodeInfo PrintedType -> Token -> Html
    145 
    -richToken thisModule srcs details Token{..}
    140 
    +richToken :: SrcMaps -> NodeInfo PrintedType -> Token -> Html
    141 
    +richToken srcs details Token{..}
    146 142 
       | tkType == TkSpace = renderSpace (srcSpanStartLine tkSpan) tkValue'
    147 143 
       | otherwise = annotate details $ linked content
    148 144 
       where
    ... ... @@ -159,7 +155,7 @@ richToken thisModule srcs details Token{..}
    159 155
    160 156 
         -- If we have name information, we can make links
    161 157 
         linked = case identDet of
    162 
    -      Just (n, _) -> hyperlink thisModule srcs n
    158 
    +      Just (n, _) -> hyperlink srcs n
    163 159 
           Nothing -> id
    164 160
    165 161 
     -- | Remove CRLFs from source
    ... ... @@ -257,8 +253,8 @@ internalAnchorIdent :: Name -> String
    257 253 
     internalAnchorIdent = ("local-" ++) . show . getKey . nameUnique
    258 254
    259 255 
     -- | Generate the HTML hyperlink for an identifier
    260 
    -hyperlink :: Module -> SrcMaps -> Identifier -> Html -> Html
    261 
    -hyperlink thisModule (srcs, srcs') ident = case ident of
    256 
    +hyperlink :: SrcMaps -> Identifier -> Html -> Html
    257 
    +hyperlink (srcs, srcs') ident = case ident of
    262 258 
       Right name
    263 259 
         | isInternalName name -> internalHyperlink name
    264 260 
         | otherwise -> externalNameHyperlink name
    ... ... @@ -274,7 +270,7 @@ hyperlink thisModule (srcs, srcs') ident = case ident of
    274 270 
         externalNameHyperlink name content = case Map.lookup mdl srcs of
    275 271 
           Just SrcLocal ->
    276 272 
             Html.anchor content
    277 
    -          ! [Html.href $ hypSrcModuleNameUrl' thisModule mdl name]
    273 
    +          ! [Html.href $ hypSrcModuleNameUrl mdl name]
    278 274 
           Just (SrcExternal path) ->
    279 275 
             let hyperlinkUrl = hypSrcModuleUrlToNameFormat $ makeHyperlinkUrl path
    280 276 
              in Html.anchor content

  • utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs
    ... ... @@ -9,7 +9,6 @@ module Haddock.Backends.Hyperlinker.Utils
    9 9 
       , hypSrcNameUrl
    10 10 
       , hypSrcLineUrl
    11 11 
       , hypSrcModuleNameUrl
    12 
    -  , hypSrcModuleNameUrl'
    13 12 
       , hypSrcModuleLineUrl
    14 13 
       , hypSrcModuleUrlFormat
    15 14 
       , hypSrcModuleNameUrlFormat
    ... ... @@ -72,12 +71,6 @@ hypSrcLineUrl line = "line-" ++ show line
    72 71 
     hypSrcModuleNameUrl :: Module -> Name -> String
    73 72 
     hypSrcModuleNameUrl mdl name = hypSrcModuleUrl mdl ++ "#" ++ hypSrcNameUrl name
    74 73
    75 
    -{-# INLINE hypSrcModuleNameUrl' #-}
    76 
    -hypSrcModuleNameUrl' :: Module -> Module -> Name -> String
    77 
    -hypSrcModuleNameUrl' this_mdl mdl name
    78 
    -  | this_mdl == mdl = "#" ++ hypSrcNameUrl name
    79 
    -  | otherwise = hypSrcModuleUrl mdl ++ "#" ++ hypSrcNameUrl name
    80 
    -
    81 74 
     {-# INLINE hypSrcModuleLineUrl #-}
    82 75 
     hypSrcModuleLineUrl :: Module -> Int -> String
    83 76 
     hypSrcModuleLineUrl mdl line = hypSrcModuleUrl mdl ++ "#" ++ hypSrcLineUrl line

  • utils/hpc
    1 
    -Subproject commit 5923da3fe77993b7afc15b5163cffcaa7da6ecf5
    1 
    +Subproject commit d1780eb21c1e5a1227fff80c8d325d5142f04255

  • utils/hsc2hs
    1 
    -Subproject commit fe3990b9f35000427b016a79330d9f195587cad8
    1 
    +Subproject commit c3b21800a67366c9591dc85a471d1dfdb1efcf29

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help