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, 87 insertions, 11 deletions

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs
index 9de4a03d..4e8b88d2 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 module Haddock.Backends.Hyperlinker.Utils
     ( hypSrcDir, hypSrcModuleFile, hypSrcModuleFile'
     , hypSrcModuleUrl, hypSrcModuleUrl'
@@ -6,21 +7,35 @@ module Haddock.Backends.Hyperlinker.Utils
     , hypSrcModuleNameUrl, hypSrcModuleLineUrl
     , hypSrcModuleUrlFormat
     , hypSrcModuleNameUrlFormat, hypSrcModuleLineUrlFormat
-    ) where
+    , spliceURL, spliceURL'
 
+    -- * HIE file processing
+    , PrintedType
+    , recoverFullIfaceTypes
+    ) where
 
+import Haddock.Utils
 import Haddock.Backends.Xhtml.Utils
 
 import GHC
-import FastString
-import System.FilePath.Posix ((</>))
+import HieTypes     ( HieAST(..), HieType(..), HieArgs(..), TypeIndex, HieTypeFlat )
+import IfaceType
+import Name         ( getOccFS, getOccString )
+import Outputable   ( showSDoc )
+import Var          ( VarBndr(..) )
+
+import System.FilePath.Posix ((</>), (<.>))
 
+import qualified Data.Array as A
 
+
+{-# INLINE hypSrcDir #-}
 hypSrcDir :: FilePath
 hypSrcDir = "src"
 
+{-# INLINE hypSrcModuleFile #-}
 hypSrcModuleFile :: Module -> FilePath
-hypSrcModuleFile = hypSrcModuleFile' . moduleName
+hypSrcModuleFile m = moduleNameString (moduleName m) <.> "html"
 
 hypSrcModuleFile' :: ModuleName -> FilePath
 hypSrcModuleFile' mdl = spliceURL'
@@ -32,20 +47,19 @@ hypSrcModuleUrl = hypSrcModuleFile
 hypSrcModuleUrl' :: ModuleName -> String
 hypSrcModuleUrl' = hypSrcModuleFile'
 
+{-# INLINE hypSrcNameUrl #-}
 hypSrcNameUrl :: Name -> String
-hypSrcNameUrl name = spliceURL
-    Nothing Nothing (Just name) Nothing nameFormat
+hypSrcNameUrl = escapeStr . getOccString
 
+{-# INLINE hypSrcLineUrl #-}
 hypSrcLineUrl :: Int -> String
-hypSrcLineUrl line = spliceURL
-    Nothing Nothing Nothing (Just spn) lineFormat
-  where
-    loc = mkSrcLoc nilFS line 1
-    spn = mkSrcSpan loc loc
+hypSrcLineUrl line = "line-" ++ show line
 
+{-# INLINE hypSrcModuleNameUrl #-}
 hypSrcModuleNameUrl :: Module -> Name -> String
 hypSrcModuleNameUrl mdl name = hypSrcModuleUrl mdl ++ "#" ++ hypSrcNameUrl name
 
+{-# INLINE hypSrcModuleLineUrl #-}
 hypSrcModuleLineUrl :: Module -> Int -> String
 hypSrcModuleLineUrl mdl line = hypSrcModuleUrl mdl ++ "#" ++ hypSrcLineUrl line
 
@@ -66,3 +80,65 @@ nameFormat = "%{NAME}"
 
 lineFormat :: String
 lineFormat = "line-%{LINE}"
+
+
+-- * HIE file procesddsing
+
+-- This belongs in GHC's HieUtils...
+
+-- | Pretty-printed type, ready to be turned into HTML by @xhtml@
+type PrintedType = String
+
+-- | Expand the flattened HIE AST into one where the types printed out and
+-- ready for end-users to look at.
+--
+-- Using just primitives found in GHC's HIE utilities, we could write this as
+-- follows:
+--
+-- > 'recoverFullIfaceTypes' dflags hieTypes hieAst
+-- >     = 'fmap' (\ti -> 'showSDoc' df .
+-- >                      'pprIfaceType' $
+-- >                      'recoverFullType' ti hieTypes)
+-- >       hieAst
+--
+-- However, this is very inefficient (both in time and space) because the
+-- mutliple calls to 'recoverFullType' don't share intermediate results. This
+-- function fixes that.
+recoverFullIfaceTypes
+  :: DynFlags
+  -> A.Array TypeIndex HieTypeFlat -- ^ flat types
+  -> HieAST TypeIndex              -- ^ flattened AST
+  -> HieAST PrintedType       -- ^ full AST
+recoverFullIfaceTypes df flattened ast = fmap (printed A.!) ast
+    where
+
+    -- Splitting this out into its own array is also important: we don't want
+    -- to pretty print the same type many times
+    printed :: A.Array TypeIndex PrintedType
+    printed = fmap (showSDoc df . pprIfaceType) unflattened
+
+    -- The recursion in 'unflattened' is crucial - it's what gives us sharing
+    -- between the IfaceType's produced
+    unflattened :: A.Array TypeIndex IfaceType
+    unflattened = fmap (\flatTy -> go (fmap (unflattened A.!) flatTy)) flattened
+
+    -- Unfold an 'HieType' whose subterms have already been unfolded
+    go :: HieType IfaceType -> IfaceType
+    go (HTyVarTy n) = IfaceTyVar (getOccFS n)
+    go (HAppTy a b) = IfaceAppTy a (hieToIfaceArgs b)
+    go (HLitTy l) = IfaceLitTy l
+    go (HForAllTy ((n,k),af) t) = let b = (getOccFS n, k)
+                                  in IfaceForAllTy (Bndr (IfaceTvBndr b) af) t
+    go (HFunTy a b) = IfaceFunTy a b
+    go (HQualTy con b) = IfaceDFunTy con b
+    go (HCastTy a) = a
+    go HCoercionTy = IfaceTyVar "<coercion type>"
+    go (HTyConApp a xs) = IfaceTyConApp a (hieToIfaceArgs xs)
+
+    -- This isn't fully faithful - we can't produce the 'Inferred' case
+    hieToIfaceArgs :: HieArgs IfaceType -> IfaceAppArgs
+    hieToIfaceArgs (HieArgs args) = go' args
+      where
+        go' [] = IA_Nil
+        go' ((True ,x):xs) = IA_Arg x Required $ go' xs
+        go' ((False,x):xs) = IA_Arg x Specified $ go' xs