Use `.hie` files for the Hyperlinker backend (#977)

# Summary

This is a large architectural change to the Hyperlinker.

  * extract link (and now also type) information from `.hie` instead
    of doing ad-hoc SYB traversals of the `RenamedSource`. Also
    adds a superb type-on-hover feature (#715).

 * re-engineer the lexer to avoid needless string conversions. By going
    directly through GHC's `P` monad and taking bytestring slices, we
    avoid a ton of allocation and have better handling of position
    pragmas and CPP.

In terms of performance, the Haddock side of things has gotten _much_
more efficient. Unfortunately, much of this is cancelled out by the
increased GHC workload for generating `.hie` files. For the full set of
boot libs (including `ghc`-the-library)

  * the sum of total time went down by 9-10% overall
  * the sum of total allocations went down by 6-7%

# Motivation

Haddock is moving towards working entirely over `.hi` and `.hie` files.
This change means we no longer need the `RenamedSource` from
`TypecheckedModule` (something which is _not_ in `.hi` files).

# Details

Along the way a bunch of things were fixed:

 * Cross package (and other) links are now more reliable (#496)
 * The lexer tries to recover from errors on every line (instead of at CPP
    boundaries)
 * `LINE`/`COLUMN` pragmas are taken into account
 * filter out zero length tokens before rendering
 * avoid recomputing the `ModuleName`-based `SrcMap`
 * remove the last use of `Documentation.Haddock.Utf8` (see  #998)
 * restructure temporary folder logic for `.hi`/`.hie` model

1 files changed, 0 insertions, 237 deletions

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
deleted file mode 100644
index a9ffc36e..00000000
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ /dev/null
@@ -1,237 +0,0 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE ViewPatterns #-}
-
-module Haddock.Backends.Hyperlinker.Ast (enrich) where
-
-
-import qualified Haddock.Syb as Syb
-import Haddock.Backends.Hyperlinker.Types
-
-import qualified GHC
-import qualified SrcLoc
-import qualified Outputable as GHC
-
-import Control.Applicative
-import Control.Monad (guard)
-import Data.Data
-import qualified Data.Map.Strict as Map
-import Data.Maybe
-
-import Prelude hiding (span)
-
-everythingInRenamedSource :: (Alternative f, Data x)
-  => (forall a. Data a => a -> f r) -> x -> f r
-everythingInRenamedSource f = Syb.everythingButType @GHC.Name (<|>) f
-
--- | Add more detailed information to token stream using GHC API.
-enrich :: GHC.RenamedSource -> [Token] -> [RichToken]
-enrich src =
-    map $ \token -> RichToken
-        { rtkToken = token
-        , rtkDetails = enrichToken token detailsMap
-        }
-  where
-    detailsMap =
-      mkDetailsMap (concatMap ($ src)
-                     [ variables
-                     , types
-                     , decls
-                     , binds
-                     , imports
-                     ])
-
-type LTokenDetails = [(GHC.SrcSpan, TokenDetails)]
-
--- | A map containing association between source locations and "details" of
--- this location.
---
-type DetailsMap = Map.Map Position (Span, TokenDetails)
-
-mkDetailsMap :: [(GHC.SrcSpan, TokenDetails)] -> DetailsMap
-mkDetailsMap xs =
-  Map.fromListWith select_details [ (start, (span, token_details))
-                                  | (ghc_span, token_details) <- xs
-                                  , GHC.RealSrcSpan span <- [ghc_span]
-                                  , let start = SrcLoc.realSrcSpanStart span
-                                  ]
-  where
-    -- favour token details which appear earlier in the list
-    select_details _new old = old
-
-lookupBySpan :: Span -> DetailsMap -> Maybe TokenDetails
-lookupBySpan span details = do
-  let pos = SrcLoc.realSrcSpanStart span
-  (_, (tok_span, tok_details)) <- Map.lookupLE pos details
-  guard (tok_span `SrcLoc.containsSpan` span)
-  return tok_details
-
-enrichToken :: Token -> DetailsMap -> Maybe TokenDetails
-enrichToken (Token typ _ spn) dm
-    | typ `elem` [TkIdentifier, TkOperator] = lookupBySpan spn dm
-enrichToken _ _ = Nothing
-
--- | Obtain details map for variables ("normally" used identifiers).
-variables :: GHC.RenamedSource -> LTokenDetails
-variables =
-    everythingInRenamedSource (var `Syb.combine` rec)
-  where
-    var term = case cast term of
-        (Just ((GHC.dL->GHC.L sspan (GHC.HsVar _ name))
-               :: GHC.LHsExpr GHC.GhcRn)) ->
-            pure (sspan, RtkVar (GHC.unLoc name))
-        (Just (GHC.dL->GHC.L _ (GHC.RecordCon _
-                                (GHC.dL->GHC.L sspan name) _))) ->
-            pure (sspan, RtkVar name)
-        _ -> empty
-    rec term = case cast term of
-        Just (GHC.HsRecField (GHC.dL->GHC.L sspan name)
-              (_ :: GHC.LHsExpr GHC.GhcRn) _) ->
-            pure (sspan, RtkVar name)
-        _ -> empty
-
--- | Obtain details map for types.
-types :: GHC.RenamedSource -> LTokenDetails
-types = everythingInRenamedSource ty
-  where
-    ty :: forall a. Data a => a -> [(GHC.SrcSpan, TokenDetails)]
-    ty term = case cast term of
-        (Just ((GHC.dL->GHC.L sspan (GHC.HsTyVar _ _ name))
-               :: GHC.LHsType GHC.GhcRn)) ->
-            pure (sspan, RtkType (GHC.unLoc name))
-        (Just ((GHC.dL->GHC.L sspan (GHC.HsOpTy _ l name r))
-               :: GHC.LHsType GHC.GhcRn)) ->
-            (sspan, RtkType (GHC.unLoc name)):(ty l ++ ty r)
-        _ -> empty
-
--- | Obtain details map for identifier bindings.
---
--- That includes both identifiers bound by pattern matching or declared using
--- ordinary assignment (in top-level declarations, let-expressions and where
--- clauses).
-
-binds :: GHC.RenamedSource -> LTokenDetails
-binds = everythingInRenamedSource
-      (fun `Syb.combine` pat `Syb.combine` tvar)
-  where
-    fun term = case cast term of
-        (Just (GHC.FunBind _ (GHC.dL->GHC.L sspan name) _ _ _
-               :: GHC.HsBind GHC.GhcRn)) ->
-            pure (sspan, RtkBind name)
-        (Just (GHC.PatSynBind _
-               (GHC.PSB _ (GHC.dL->GHC.L sspan name) args _ _))) ->
-            pure (sspan, RtkBind name)
-            ++ everythingInRenamedSource patsyn_binds args
-        _ -> empty
-    patsyn_binds term = case cast term of
-        (Just (GHC.L sspan (name :: GHC.Name))) ->
-          pure (sspan, RtkVar name)
-        _ -> empty
-    pat term = case cast term of
-        (Just ((GHC.dL->GHC.L sspan (GHC.VarPat _ name))
-               :: GHC.LPat GHC.GhcRn)) ->
-            pure (sspan, RtkBind (GHC.unLoc name))
-        (Just (GHC.dL->GHC.L _
-                (GHC.ConPatIn (GHC.dL->GHC.L sspan name) recs))) ->
-            [(sspan, RtkVar name)] ++ everythingInRenamedSource rec recs
-        (Just (GHC.dL->GHC.L _ (GHC.AsPat _ (GHC.dL->GHC.L sspan name) _))) ->
-            pure (sspan, RtkBind name)
-        _ -> empty
-    rec term = case cast term of
-        (Just (GHC.HsRecField (GHC.dL->GHC.L sspan name)
-               (_ :: GHC.LPat GHC.GhcRn) _)) ->
-            pure (sspan, RtkVar name)
-        _ -> empty
-    tvar term = case cast term of
-        (Just ((GHC.dL->GHC.L sspan (GHC.UserTyVar _ name))
-               :: GHC.LHsTyVarBndr GHC.GhcRn)) ->
-            pure (sspan, RtkBind (GHC.unLoc name))
-        (Just (GHC.dL->GHC.L _ (GHC.KindedTyVar _ (GHC.dL->GHC.L sspan name) _))) ->
-            pure (sspan, RtkBind name)
-        _ -> empty
-
--- | Obtain details map for top-level declarations.
-decls :: GHC.RenamedSource -> LTokenDetails
-decls (group, _, _, _) = concatMap ($ group)
-    [ concat . map typ . concat . map GHC.group_tyclds . GHC.hs_tyclds
-    , everythingInRenamedSource fun . GHC.hs_valds
-    , everythingInRenamedSource fix . GHC.hs_fixds
-    , everythingInRenamedSource (con `Syb.combine` ins)
-    ]
-  where
-    typ (GHC.dL->GHC.L _ t) = case t of
-        GHC.DataDecl { tcdLName = name } -> pure . decl $ name
-        GHC.SynDecl _ name _ _ _ -> pure . decl $ name
-        GHC.FamDecl _ fam -> pure . decl $ GHC.fdLName fam
-        GHC.ClassDecl{..} ->
-          [decl tcdLName]
-            ++ concatMap sig tcdSigs
-            ++ concatMap tyfam tcdATs
-        GHC.XTyClDecl {} -> GHC.panic "haddock:decls"
-    fun term = case cast term of
-        (Just (GHC.FunBind _ (GHC.dL->GHC.L sspan name) _ _ _
-               :: GHC.HsBind GHC.GhcRn))
-            | GHC.isExternalName name -> pure (sspan, RtkDecl name)
-        (Just (GHC.PatSynBind _ (GHC.PSB _ (GHC.dL->GHC.L sspan name) _ _ _)))
-            | GHC.isExternalName name -> pure (sspan, RtkDecl name)
-        _ -> empty
-    con term = case cast term of
-        (Just (cdcl :: GHC.ConDecl GHC.GhcRn)) ->
-            map decl (GHC.getConNames cdcl)
-              ++ everythingInRenamedSource fld cdcl
-        Nothing -> empty
-    ins term = case cast term of
-        (Just ((GHC.DataFamInstD _ (GHC.DataFamInstDecl eqn))
-                :: GHC.InstDecl GHC.GhcRn))
-          -> pure . tyref $ GHC.feqn_tycon $ GHC.hsib_body eqn
-        (Just (GHC.TyFamInstD _ (GHC.TyFamInstDecl eqn))) ->
-            pure . tyref $ GHC.feqn_tycon $ GHC.hsib_body eqn
-        _ -> empty
-    fld term = case cast term of
-        Just (field :: GHC.ConDeclField GHC.GhcRn)
-          -> map (decl . fmap GHC.extFieldOcc) $ GHC.cd_fld_names field
-        Nothing -> empty
-    fix term = case cast term of
-        Just ((GHC.FixitySig _ names _) :: GHC.FixitySig GHC.GhcRn)
-          -> map (\(GHC.dL->GHC.L sspan x) -> (sspan, RtkVar x)) names
-        Just ((GHC.XFixitySig {}) :: GHC.FixitySig GHC.GhcRn)
-          -> GHC.panic "haddock:decls"
-        Nothing -> empty
-    tyfam (GHC.dL->GHC.L _ (GHC.FamilyDecl{..})) = [decl fdLName]
-    tyfam (GHC.dL->GHC.L _ (GHC.XFamilyDecl {})) = GHC.panic "haddock:dels"
-    tyfam _ = GHC.panic "tyfam: Impossible Match"
-
-    sig (GHC.dL->GHC.L _ (GHC.TypeSig _ names _)) = map decl names
-    sig (GHC.dL->GHC.L _ (GHC.PatSynSig _ names _)) = map decl names
-    sig (GHC.dL->GHC.L _ (GHC.ClassOpSig _ _ names _)) = map decl names
-    sig _ = []
-    decl (GHC.dL->GHC.L sspan name) = (sspan, RtkDecl name)
-    tyref (GHC.dL->GHC.L sspan name) = (sspan, RtkType name)
-
--- | Obtain details map for import declarations.
---
--- This map also includes type and variable details for items in export and
--- import lists.
-imports :: GHC.RenamedSource -> LTokenDetails
-imports src@(_, imps, _, _) =
-    everythingInRenamedSource ie src ++ mapMaybe (imp . GHC.unLoc) imps
-  where
-    ie term = case cast term of
-        (Just ((GHC.IEVar _ v) :: GHC.IE GHC.GhcRn)) -> pure $ var
-          $ GHC.ieLWrappedName v
-        (Just (GHC.IEThingAbs _ t)) -> pure $ typ $ GHC.ieLWrappedName t
-        (Just (GHC.IEThingAll _ t)) -> pure $ typ $ GHC.ieLWrappedName t
-        (Just (GHC.IEThingWith _ t _ vs _fls)) ->
-          [typ $ GHC.ieLWrappedName t] ++ map (var . GHC.ieLWrappedName) vs
-        (Just (GHC.IEModuleContents _ m)) -> pure $ modu m
-        _ -> empty
-    typ (GHC.dL->GHC.L sspan name) = (sspan, RtkType name)
-    var (GHC.dL->GHC.L sspan name) = (sspan, RtkVar name)
-    modu (GHC.dL->GHC.L sspan name) = (sspan, RtkModule name)
-    imp idecl
-      | not . GHC.ideclImplicit $ idecl = Just (modu (GHC.ideclName idecl))
-      | otherwise = Nothing