Add GetHieAsts rule, Replace SpanInfo, add support for DocumentHighlight and scope-aware completions for local variables (#784)

* Add GetHieAsts rule * hlint * fix build for 8.4 * Reimplement Hover/GotoDefn in terms of HIE Files. Implement Document Hightlight LSP request Add GetDocMap, GetHieFile rules. * Fix gotodef for record fields * Completion for locals * Don't need to hack cursor position because of fuzzy ranges * hlint * fix bench and warning on 8.10 * disable 8.4 CI jobs * Don't collect module level bindings * tweaks * Show kinds * docs * Defs for ModuleNames * Fix some tests * hlint * Mark remaining tests as broken * Add completion tests * add highlight tests * Fix HieAst for 8.6 * CPP away the unexpected success * More CPP hacks for 8.10 tests
2024-11-26 12:25:25 +03:00 · 2020-09-27 13:37:25 +05:30 · 2020-09-27 13:37:25 +05:30 · 62f4d0644a
commit 62f4d0644a
parent 1cda5edf0d
26 changed files with 722 additions and 639 deletions
--- a/.azure/linux-stack.yml
+++ b/.azure/linux-stack.yml
@ -11,8 +11,6 @@ jobs:
        STACK_YAML: "stack88.yaml"
      stack_86:
        STACK_YAML: "stack.yaml"
-      stack_84:
-        STACK_YAML: "stack84.yaml"
      stack_ghc_lib_88:
        STACK_YAML: "stack-ghc-lib.yaml"
  variables:
--- a/.azure/windows-stack.yml
+++ b/.azure/windows-stack.yml
@ -11,8 +11,6 @@ jobs:
        STACK_YAML: "stack88.yaml"
      stack_86:
        STACK_YAML: "stack.yaml"
-      stack_84:
-        STACK_YAML: "stack84.yaml"
      stack_ghc_lib_88:
        STACK_YAML: "stack-ghc-lib.yaml"
  variables:
--- a/.hlint.yaml
+++ b/.hlint.yaml
@ -95,7 +95,7 @@
 - flags:
  - default: false
  - {name: [-Wno-missing-signatures, -Wno-orphans, -Wno-overlapping-patterns, -Wno-incomplete-patterns, -Wno-missing-fields, -Wno-unused-matches]}
-  - {name: [-Wno-dodgy-imports], within: [Main, Development.IDE.GHC.Compat]}
+  - {name: [-Wno-dodgy-imports,-Wno-incomplete-uni-patterns], within: [Main, Development.IDE.GHC.Compat]}
 # - modules:
 #   - {name: [Data.Set, Data.HashSet], as: Set} # if you import Data.Set qualified, it must be as 'Set'
 #   - {name: Control.Arrow, within: []} # Certain modules are banned entirely
--- a/ghcide.cabal
+++ b/ghcide.cabal
@ -48,6 +48,7 @@ library
        extra,
        fuzzy,
        filepath,
+        fingertree,
        haddock-library >= 1.8,
        hashable,
        haskell-lsp-types == 0.22.*,
@ -140,6 +141,8 @@ library
        Development.IDE.LSP.Protocol
        Development.IDE.LSP.Server
        Development.IDE.Spans.Common
+        Development.IDE.Spans.AtPoint
+        Development.IDE.Spans.LocalBindings
        Development.IDE.Types.Diagnostics
        Development.IDE.Types.Exports
        Development.IDE.Types.Location
@ -173,10 +176,7 @@ library
        Development.IDE.GHC.WithDynFlags
        Development.IDE.Import.FindImports
        Development.IDE.LSP.Notifications
-        Development.IDE.Spans.AtPoint
-        Development.IDE.Spans.Calculate
        Development.IDE.Spans.Documentation
-        Development.IDE.Spans.Type
        Development.IDE.Plugin.CodeAction.PositionIndexed
        Development.IDE.Plugin.CodeAction.Rules
        Development.IDE.Plugin.CodeAction.RuleTypes
--- a/src-ghc810/Development/IDE/GHC/HieAst.hs
+++ b/src-ghc810/Development/IDE/GHC/HieAst.hs
@ -17,7 +17,7 @@ Main functions for .hie file generation
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE DeriveDataTypeable #-}
-module Development.IDE.GHC.HieAst ( mkHieFile ) where
+module Development.IDE.GHC.HieAst ( mkHieFile, enrichHie ) where

 import GhcPrelude

@ -34,7 +34,7 @@ import GHC.Hs
 import HscTypes
 import Module                     ( ModuleName, ml_hs_file )
 import MonadUtils                 ( concatMapM, liftIO )
-import Name                       ( Name, nameSrcSpan, setNameLoc )
+import Name                       ( Name, nameSrcSpan )
 import NameEnv                    ( NameEnv, emptyNameEnv, extendNameEnv, lookupNameEnv )
 import SrcLoc
 import TcHsSyn                    ( hsLitType, hsPatType )
@ -1131,20 +1131,17 @@ instance ( ToHie (RFContext (Located label))
      , toHie expr
      ]

-removeDefSrcSpan :: Name -> Name
-removeDefSrcSpan n = setNameLoc n noSrcSpan
-
 instance ToHie (RFContext (LFieldOcc GhcRn)) where
  toHie (RFC c rhs (L nspan f)) = concatM $ case f of
    FieldOcc name _ ->
-      [ toHie $ C (RecField c rhs) (L nspan $ removeDefSrcSpan name)
+      [ toHie $ C (RecField c rhs) (L nspan name)
      ]
    XFieldOcc _ -> []

 instance ToHie (RFContext (LFieldOcc GhcTc)) where
  toHie (RFC c rhs (L nspan f)) = concatM $ case f of
    FieldOcc var _ ->
-      let var' = setVarName var (removeDefSrcSpan $ varName var)
+      let var' = setVarName var (varName var)
      in [ toHie $ C (RecField c rhs) (L nspan var')
         ]
    XFieldOcc _ -> []
@ -1152,7 +1149,7 @@ instance ToHie (RFContext (LFieldOcc GhcTc)) where
 instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcRn))) where
  toHie (RFC c rhs (L nspan afo)) = concatM $ case afo of
    Unambiguous name _ ->
-      [ toHie $ C (RecField c rhs) $ L nspan $ removeDefSrcSpan name
+      [ toHie $ C (RecField c rhs) $ L nspan name
      ]
    Ambiguous _name _ ->
      [ ]
@ -1161,11 +1158,11 @@ instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcRn))) where
 instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcTc))) where
  toHie (RFC c rhs (L nspan afo)) = concatM $ case afo of
    Unambiguous var _ ->
-      let var' = setVarName var (removeDefSrcSpan $ varName var)
+      let var' = setVarName var (varName var)
      in [ toHie $ C (RecField c rhs) (L nspan var')
         ]
    Ambiguous var _ ->
-      let var' = setVarName var (removeDefSrcSpan $ varName var)
+      let var' = setVarName var (varName var)
      in [ toHie $ C (RecField c rhs) (L nspan var')
         ]
    XAmbiguousFieldOcc _ -> []
--- a/src-ghc86/Development/IDE/GHC/HieAst.hs
+++ b/src-ghc86/Development/IDE/GHC/HieAst.hs
@ -17,7 +17,7 @@ Main functions for .hie file generation
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE DataKinds #-}
-module Development.IDE.GHC.HieAst ( mkHieFile ) where
+module Development.IDE.GHC.HieAst ( mkHieFile, enrichHie ) where

 import Avail                      ( Avails )
 import Bag                        ( Bag, bagToList )
@ -32,7 +32,7 @@ import HsSyn
 import HscTypes
 import Module                     ( ModuleName, ml_hs_file )
 import MonadUtils                 ( concatMapM, liftIO )
-import Name                       ( Name, nameSrcSpan, setNameLoc )
+import Name                       ( Name, nameSrcSpan )
 import SrcLoc
 import TcHsSyn                    ( hsLitType, hsPatType )
 import Type                       ( mkFunTys, Type )
@ -739,6 +739,8 @@ instance ( a ~ GhcPass p
         , ToHie (RScoped (LHsLocalBinds a))
         , ToHie (TScoped (LHsWcType (NoGhcTc a)))
         , ToHie (TScoped (LHsSigWcType (NoGhcTc a)))
+         , ToHie (TScoped (XExprWithTySig (GhcPass p)))
+         , ToHie (TScoped (XAppTypeE (GhcPass p)))
         , Data (HsExpr a)
         , Data (HsSplice a)
         , Data (HsTupArg a)
@ -771,9 +773,9 @@ instance ( a ~ GhcPass p
        [ toHie a
        , toHie b
        ]
-      HsAppType _sig expr ->
+      HsAppType sig expr ->
        [ toHie expr
-        -- , toHie $ TS (ResolvedScopes []) sig
+        , toHie $ TS (ResolvedScopes []) sig
        ]
      OpApp _ a b c ->
        [ toHie a
@ -831,9 +833,9 @@ instance ( a ~ GhcPass p
        [ toHie expr
        , toHie $ map (RC RecFieldAssign) upds
        ]
-      ExprWithTySig _ expr ->
+      ExprWithTySig sig expr ->
        [ toHie expr
-        -- , toHie $ TS (ResolvedScopes [mkLScope expr]) sig
+        , toHie $ TS (ResolvedScopes [mkLScope expr]) sig
        ]
      ArithSeq _ _ info ->
        [ toHie info
@ -1006,20 +1008,17 @@ instance ( ToHie (RFContext (Located label))
      , toHie expr
      ]

-removeDefSrcSpan :: Name -> Name
-removeDefSrcSpan n = setNameLoc n noSrcSpan
-
 instance ToHie (RFContext (LFieldOcc GhcRn)) where
  toHie (RFC c rhs (L nspan f)) = concatM $ case f of
    FieldOcc name _ ->
-      [ toHie $ C (RecField c rhs) (L nspan $ removeDefSrcSpan name)
+      [ toHie $ C (RecField c rhs) (L nspan name)
      ]
    XFieldOcc _ -> []

 instance ToHie (RFContext (LFieldOcc GhcTc)) where
  toHie (RFC c rhs (L nspan f)) = concatM $ case f of
    FieldOcc var _ ->
-      let var' = setVarName var (removeDefSrcSpan $ varName var)
+      let var' = setVarName var (varName var)
      in [ toHie $ C (RecField c rhs) (L nspan var')
         ]
    XFieldOcc _ -> []
@ -1027,7 +1026,7 @@ instance ToHie (RFContext (LFieldOcc GhcTc)) where
 instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcRn))) where
  toHie (RFC c rhs (L nspan afo)) = concatM $ case afo of
    Unambiguous name _ ->
-      [ toHie $ C (RecField c rhs) $ L nspan $ removeDefSrcSpan name
+      [ toHie $ C (RecField c rhs) $ L nspan name
      ]
    Ambiguous _name _ ->
      [ ]
@ -1036,11 +1035,11 @@ instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcRn))) where
 instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcTc))) where
  toHie (RFC c rhs (L nspan afo)) = concatM $ case afo of
    Unambiguous var _ ->
-      let var' = setVarName var (removeDefSrcSpan $ varName var)
+      let var' = setVarName var (varName var)
      in [ toHie $ C (RecField c rhs) (L nspan var')
         ]
    Ambiguous var _ ->
-      let var' = setVarName var (removeDefSrcSpan $ varName var)
+      let var' = setVarName var (varName var)
      in [ toHie $ C (RecField c rhs) (L nspan var')
         ]
    XAmbiguousFieldOcc _ -> []
--- a/src-ghc88/Development/IDE/GHC/HieAst.hs
+++ b/src-ghc88/Development/IDE/GHC/HieAst.hs
@ -16,7 +16,7 @@ Main functions for .hie file generation
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE DeriveDataTypeable #-}
-module Development.IDE.GHC.HieAst ( mkHieFile ) where
+module Development.IDE.GHC.HieAst ( mkHieFile, enrichHie ) where

 import Avail                      ( Avails )
 import Bag                        ( Bag, bagToList )
@ -31,7 +31,7 @@ import HsSyn
 import HscTypes
 import Module                     ( ModuleName, ml_hs_file )
 import MonadUtils                 ( concatMapM, liftIO )
-import Name                       ( Name, nameSrcSpan, setNameLoc )
+import Name                       ( Name, nameSrcSpan )
 import SrcLoc
 import TcHsSyn                    ( hsLitType, hsPatType )
 import Type                       ( mkFunTys, Type )
@ -998,20 +998,17 @@ instance ( ToHie (RFContext (Located label))
      , toHie expr
      ]

-removeDefSrcSpan :: Name -> Name
-removeDefSrcSpan n = setNameLoc n noSrcSpan
-
 instance ToHie (RFContext (LFieldOcc GhcRn)) where
  toHie (RFC c rhs (L nspan f)) = concatM $ case f of
    FieldOcc name _ ->
-      [ toHie $ C (RecField c rhs) (L nspan $ removeDefSrcSpan name)
+      [ toHie $ C (RecField c rhs) (L nspan name)
      ]
    XFieldOcc _ -> []

 instance ToHie (RFContext (LFieldOcc GhcTc)) where
  toHie (RFC c rhs (L nspan f)) = concatM $ case f of
    FieldOcc var _ ->
-      let var' = setVarName var (removeDefSrcSpan $ varName var)
+      let var' = setVarName var (varName var)
      in [ toHie $ C (RecField c rhs) (L nspan var')
         ]
    XFieldOcc _ -> []
@ -1019,7 +1016,7 @@ instance ToHie (RFContext (LFieldOcc GhcTc)) where
 instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcRn))) where
  toHie (RFC c rhs (L nspan afo)) = concatM $ case afo of
    Unambiguous name _ ->
-      [ toHie $ C (RecField c rhs) $ L nspan $ removeDefSrcSpan name
+      [ toHie $ C (RecField c rhs) $ L nspan name
      ]
    Ambiguous _name _ ->
      [ ]
@ -1028,11 +1025,11 @@ instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcRn))) where
 instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcTc))) where
  toHie (RFC c rhs (L nspan afo)) = concatM $ case afo of
    Unambiguous var _ ->
-      let var' = setVarName var (removeDefSrcSpan $ varName var)
+      let var' = setVarName var (varName var)
      in [ toHie $ C (RecField c rhs) (L nspan var')
         ]
    Ambiguous var _ ->
-      let var' = setVarName var (removeDefSrcSpan $ varName var)
+      let var' = setVarName var (varName var)
      in [ toHie $ C (RecField c rhs) (L nspan var')
         ]
    XAmbiguousFieldOcc _ -> []
--- a/src/Development/IDE/Core/Compile.hs
+++ b/src/Development/IDE/Core/Compile.hs
@ -18,7 +18,8 @@ module Development.IDE.Core.Compile
  , addRelativeImport
  , mkTcModuleResult
  , generateByteCode
-  , generateAndWriteHieFile
+  , generateHieAsts
+  , writeHieFile
  , writeHiFile
  , getModSummaryFromImports
  , loadHieFile
@ -56,7 +57,7 @@ import ErrUtils
 #endif

 import           Finder
-import           Development.IDE.GHC.Compat hiding (parseModule, typecheckModule)
+import           Development.IDE.GHC.Compat hiding (parseModule, typecheckModule, writeHieFile)
 import qualified Development.IDE.GHC.Compat     as GHC
 import qualified Development.IDE.GHC.Compat     as Compat
 import           GhcMonad
@ -65,7 +66,7 @@ import qualified HeaderInfo                     as Hdr
 import           HscMain                        (hscInteractive, hscSimplify)
 import           MkIface
 import           StringBuffer                   as SB
-import           TcRnMonad (tct_id, TcTyThing(AGlobal, ATcId), initTc, initIfaceLoad, tcg_th_coreplugins)
+import           TcRnMonad (tct_id, TcTyThing(AGlobal, ATcId), initTc, initIfaceLoad, tcg_th_coreplugins, tcg_binds)
 import           TcIface                        (typecheckIface)
 import           TidyPgm

@ -320,7 +321,7 @@ mkTcModuleResult tcm upgradedError = do
    (iface, _) <- liftIO $ mkIfaceTc session Nothing sf details tcGblEnv
 #endif
    let mod_info = HomeModInfo iface details Nothing
-    return $ TcModuleResult tcm mod_info upgradedError
+    return $ TcModuleResult tcm mod_info upgradedError Nothing
  where
    (tcGblEnv, details) = tm_internals_ tcm

@ -331,19 +332,25 @@ atomicFileWrite targetPath write = do
  (tempFilePath, cleanUp) <- newTempFileWithin dir
  (write tempFilePath >> renameFile tempFilePath targetPath) `onException` cleanUp

-generateAndWriteHieFile :: HscEnv -> TypecheckedModule -> BS.ByteString -> IO [FileDiagnostic]
-generateAndWriteHieFile hscEnv tcm source =
-  handleGenerationErrors dflags "extended interface generation" $ do
+generateHieAsts :: HscEnv -> TypecheckedModule -> IO ([FileDiagnostic], Maybe (HieASTs Type))
+generateHieAsts hscEnv tcm =
+  handleGenerationErrors' dflags "extended interface generation" $ do
    case tm_renamed_source tcm of
-      Just rnsrc -> do
-        hf <- runHsc hscEnv $
-          GHC.mkHieFile mod_summary (fst $ tm_internals_ tcm) rnsrc source
-        atomicFileWrite targetPath $ flip GHC.writeHieFile hf
+      Just rnsrc -> runHsc hscEnv $
+        Just <$> GHC.enrichHie (tcg_binds $ fst $ tm_internals_ tcm) rnsrc
      _ ->
-        return ()
+        return Nothing
+  where
+    dflags       = hsc_dflags hscEnv
+
+writeHieFile :: HscEnv -> ModSummary -> [GHC.AvailInfo] -> HieASTs Type -> BS.ByteString -> IO [FileDiagnostic]
+writeHieFile hscEnv mod_summary exports ast source =
+  handleGenerationErrors dflags "extended interface write/compression" $ do
+    hf <- runHsc hscEnv $
+      GHC.mkHieFile' mod_summary exports ast source
+    atomicFileWrite targetPath $ flip GHC.writeHieFile hf
  where
    dflags       = hsc_dflags hscEnv
-    mod_summary  = pm_mod_summary $ tm_parsed_module tcm
    mod_location = ms_location mod_summary
    targetPath   = Compat.ml_hie_file mod_location

@ -365,6 +372,14 @@ handleGenerationErrors dflags source action =
    . (("Error during " ++ T.unpack source) ++) . show @SomeException
    ]

+handleGenerationErrors' :: DynFlags -> T.Text -> IO (Maybe a) -> IO ([FileDiagnostic], Maybe a)
+handleGenerationErrors' dflags source action =
+  fmap ([],) action `catches`
+    [ Handler $ return . (,Nothing) . diagFromGhcException source dflags
+    , Handler $ return . (,Nothing) . diagFromString source DsError (noSpan "<internal>")
+    . (("Error during " ++ T.unpack source) ++) . show @SomeException
+    ]
+

 -- | Setup the environment that GHC needs according to our
 -- best understanding (!)
--- a/src/Development/IDE/Core/PositionMapping.hs
+++ b/src/Development/IDE/Core/PositionMapping.hs
@ -74,7 +74,6 @@ toCurrentPosition (PositionMapping pm) = positionResultToMaybe . toDelta pm
 -- a specific version
 newtype PositionMapping = PositionMapping PositionDelta

-
 toCurrentRange :: PositionMapping -> Range -> Maybe Range
 toCurrentRange mapping (Range a b) =
    Range <$> toCurrentPosition mapping a <*> toCurrentPosition mapping b
@ -121,7 +120,7 @@ toCurrent (Range start@(Position startLine startColumn) end@(Position endLine en
    | line > endLine || line == endLine && column >= endColumn =
      -- Position is after the change so increase line and column number
      -- as necessary.
-      PositionExact $ Position newLine newColumn
+      PositionExact $ newLine `seq` newColumn `seq` Position newLine newColumn
    | otherwise = PositionRange start end
    -- Position is in the region that was changed.
    where
@ -131,10 +130,10 @@ toCurrent (Range start@(Position startLine startColumn) end@(Position endLine en
        newEndColumn
          | linesNew == 0 = startColumn + T.length t
          | otherwise = T.length $ T.takeWhileEnd (/= '\n') t
-        !newColumn
+        newColumn
          | line == endLine = column + newEndColumn - endColumn
          | otherwise = column
-        !newLine = line + lineDiff
+        newLine = line + lineDiff

 fromCurrent :: Range -> T.Text -> Position -> PositionResult Position
 fromCurrent (Range start@(Position startLine startColumn) end@(Position endLine endColumn)) t (Position line column)
@ -144,7 +143,7 @@ fromCurrent (Range start@(Position startLine startColumn) end@(Position endLine
    | line > newEndLine || line == newEndLine && column >= newEndColumn =
      -- Position is after the change so increase line and column number
      -- as necessary.
-      PositionExact $ Position newLine newColumn
+      PositionExact $ newLine `seq` newColumn `seq` Position newLine newColumn
    | otherwise = PositionRange start end
    -- Position is in the region that was changed.
    where
@ -155,7 +154,7 @@ fromCurrent (Range start@(Position startLine startColumn) end@(Position endLine
        newEndColumn
          | linesNew == 0 = startColumn + T.length t
          | otherwise = T.length $ T.takeWhileEnd (/= '\n') t
-        !newColumn
+        newColumn
          | line == newEndLine = column - (newEndColumn - endColumn)
          | otherwise = column
-        !newLine = line - lineDiff
+        newLine = line - lineDiff
--- a/src/Development/IDE/Core/RuleTypes.hs
+++ b/src/Development/IDE/Core/RuleTypes.hs
@ -15,22 +15,24 @@ import           Control.DeepSeq
 import Data.Aeson.Types (Value)
 import Data.Binary
 import           Development.IDE.Import.DependencyInformation
-import Development.IDE.GHC.Compat
+import Development.IDE.GHC.Compat hiding (HieFileResult)
 import Development.IDE.GHC.Util
 import Development.IDE.Core.Shake (KnownTargets)
 import           Data.Hashable
 import           Data.Typeable
 import qualified Data.Set as S
+import qualified Data.Map as M
 import           Development.Shake
 import           GHC.Generics                             (Generic)

 import Module (InstalledUnitId)
 import HscTypes (hm_iface, CgGuts, Linkable, HomeModInfo, ModDetails)

-import           Development.IDE.Spans.Type
+import           Development.IDE.Spans.Common
+import           Development.IDE.Spans.LocalBindings
 import           Development.IDE.Import.FindImports (ArtifactsLocation)
 import Data.ByteString (ByteString)
-
+import Language.Haskell.LSP.Types (NormalizedFilePath)

 -- NOTATION
 --   Foo+ means Foo for the dependencies
@ -66,6 +68,7 @@ data TcModuleResult = TcModuleResult
    -- HomeModInfo instead
    , tmrModInfo    :: HomeModInfo
    , tmrDeferedError :: !Bool -- ^ Did we defer any type errors for this module?
+    , tmrHieAsts :: !(Maybe (HieASTs Type)) -- ^ The HieASTs if we computed them
    }
 instance Show TcModuleResult where
    show = show . pm_mod_summary . tm_parsed_module . tmrModule
@ -98,11 +101,38 @@ instance NFData HiFileResult where
 instance Show HiFileResult where
    show = show . hirModSummary

+-- | Save the uncompressed AST here, we compress it just before writing to disk
+data HieAstResult
+  = HAR
+  { hieModule :: Module
+  , hieAst :: !(HieASTs Type)
+  , refMap :: !RefMap
+  , importMap :: !(M.Map ModuleName NormalizedFilePath) -- ^ Where are the modules imported by this file located?
+  }
+ 
+instance NFData HieAstResult where
+    rnf (HAR m hf rm im) = rnf m `seq` rwhnf hf `seq` rnf rm `seq` rnf im
+ 
+instance Show HieAstResult where
+    show = show . hieModule
+
 -- | The type checked version of this file, requires TypeCheck+
 type instance RuleResult TypeCheck = TcModuleResult

-- | Information about what spans occur where, requires TypeCheck
-type instance RuleResult GetSpanInfo = SpansInfo
+-- | The uncompressed HieAST
+type instance RuleResult GetHieAst = HieAstResult
+
+-- | A IntervalMap telling us what is in scope at each point
+type instance RuleResult GetBindings = Bindings
+
+data DocAndKindMap = DKMap {getDocMap :: !DocMap, getKindMap :: !KindMap}
+instance NFData DocAndKindMap where
+    rnf (DKMap a b) = rnf a `seq` rnf b
+
+instance Show DocAndKindMap where
+    show = const "docmap"
+
+type instance RuleResult GetDocMap = DocAndKindMap

 -- | Convert to Core, requires TypeCheck*
 type instance RuleResult GenerateCore = (SafeHaskellMode, CgGuts, ModDetails)
@ -196,11 +226,23 @@ instance Hashable TypeCheck
 instance NFData   TypeCheck
 instance Binary   TypeCheck

-data GetSpanInfo = GetSpanInfo
+data GetDocMap = GetDocMap
    deriving (Eq, Show, Typeable, Generic)
-instance Hashable GetSpanInfo
-instance NFData   GetSpanInfo
-instance Binary   GetSpanInfo
+instance Hashable GetDocMap
+instance NFData   GetDocMap
+instance Binary   GetDocMap
+
+data GetHieAst = GetHieAst
+    deriving (Eq, Show, Typeable, Generic)
+instance Hashable GetHieAst
+instance NFData   GetHieAst
+instance Binary   GetHieAst
+
+data GetBindings = GetBindings
+    deriving (Eq, Show, Typeable, Generic)
+instance Hashable GetBindings
+instance NFData   GetBindings
+instance Binary   GetBindings

 data GenerateCore = GenerateCore
    deriving (Eq, Show, Typeable, Generic)
--- a/src/Development/IDE/Core/Rules.hs
+++ b/src/Development/IDE/Core/Rules.hs
@ -24,6 +24,7 @@ module Development.IDE.Core.Rules(
    getAtPoint,
    getDefinition,
    getTypeDefinition,
+    highlightAtPoint,
    getDependencies,
    getParsedModule,
    generateCore,
@ -39,14 +40,15 @@ import Control.Monad.Trans.Maybe
 import Development.IDE.Core.Compile
 import Development.IDE.Core.OfInterest
 import Development.IDE.Types.Options
-import Development.IDE.Spans.Calculate
+import Development.IDE.Spans.Documentation
+import Development.IDE.Spans.LocalBindings
 import Development.IDE.Import.DependencyInformation
 import Development.IDE.Import.FindImports
 import           Development.IDE.Core.FileExists
 import           Development.IDE.Core.FileStore        (modificationTime, getFileContents)
 import           Development.IDE.Types.Diagnostics as Diag
 import Development.IDE.Types.Location
-import Development.IDE.GHC.Compat hiding (parseModule, typecheckModule, TargetModule, TargetFile)
+import Development.IDE.GHC.Compat hiding (parseModule, typecheckModule, writeHieFile, TargetModule, TargetFile)
 import Development.IDE.GHC.Util
 import Development.IDE.GHC.WithDynFlags
 import Data.Either.Extra
@ -57,14 +59,15 @@ import qualified Data.IntMap.Strict as IntMap
 import Data.IntMap.Strict (IntMap)
 import Data.List
 import qualified Data.Set                                 as Set
+import qualified Data.Map as M
 import qualified Data.Text                                as T
 import qualified Data.Text.Encoding                       as T
 import           Development.IDE.GHC.Error
 import           Development.Shake                        hiding (Diagnostic)
 import Development.IDE.Core.RuleTypes
-import Development.IDE.Spans.Type
 import qualified Data.ByteString.Char8 as BS
 import Development.IDE.Core.PositionMapping
+import           Language.Haskell.LSP.Types (DocumentHighlight (..))

 import qualified GHC.LanguageExtensions as LangExt
 import HscTypes hiding (TargetModule, TargetFile)
@ -134,26 +137,35 @@ getAtPoint :: NormalizedFilePath -> Position -> IdeAction (Maybe (Maybe Range, [
 getAtPoint file pos = fmap join $ runMaybeT $ do
  ide <- ask
  opts <- liftIO $ getIdeOptionsIO ide
-  (spans, mapping) <- useE  GetSpanInfo file
+
+  (hieAst -> hf, mapping) <- useE GetHieAst file
+  dkMap <- lift $ maybe (DKMap mempty mempty) fst <$> (runMaybeT $ useE GetDocMap file)
+
  !pos' <- MaybeT (return $ fromCurrentPosition mapping pos)
-  return $ AtPoint.atPoint opts spans pos'
+  return $ AtPoint.atPoint opts hf dkMap pos'

 -- | Goto Definition.
 getDefinition :: NormalizedFilePath -> Position -> IdeAction (Maybe Location)
 getDefinition file pos = runMaybeT $ do
    ide <- ask
    opts <- liftIO $ getIdeOptionsIO ide
-    (spans,mapping) <- useE GetSpanInfo file
+    (HAR _ hf _ imports, mapping) <- useE GetHieAst file
    !pos' <- MaybeT (return $ fromCurrentPosition mapping pos)
-    AtPoint.gotoDefinition (getHieFile ide file) opts (spansExprs spans) pos'
+    AtPoint.gotoDefinition (getHieFile ide file) opts imports hf pos'

 getTypeDefinition :: NormalizedFilePath -> Position -> IdeAction (Maybe [Location])
 getTypeDefinition file pos = runMaybeT $ do
    ide <- ask
    opts <- liftIO $ getIdeOptionsIO ide
-    (spans,mapping) <- useE GetSpanInfo file
+    (hieAst -> hf, mapping) <- useE GetHieAst file
    !pos' <- MaybeT (return $ fromCurrentPosition mapping pos)
-    AtPoint.gotoTypeDefinition (getHieFile ide file) opts (spansExprs spans) pos'
+    AtPoint.gotoTypeDefinition (getHieFile ide file) opts hf pos'
+
+highlightAtPoint :: NormalizedFilePath -> Position -> IdeAction (Maybe [DocumentHighlight])
+highlightAtPoint file pos = runMaybeT $ do
+    (HAR _ hf rf _,mapping) <- useE GetHieAst file
+    !pos' <- MaybeT (return $ fromCurrentPosition mapping pos)
+    AtPoint.documentHighlight hf rf pos'

 getHieFile
  :: ShakeExtras
@ -507,27 +519,51 @@ getDependenciesRule =
        let mbFingerprints = map (fingerprintString . fromNormalizedFilePath) allFiles <$ optShakeFiles opts
        return (fingerprintToBS . fingerprintFingerprints <$> mbFingerprints, ([], transitiveDeps depInfo file))

-- Source SpanInfo is used by AtPoint and Goto Definition.
-getSpanInfoRule :: Rules ()
-getSpanInfoRule =
-    define $ \GetSpanInfo file -> do
-        tc <- use_ TypeCheck file
-        packageState <- hscEnv <$> use_ GhcSessionDeps file
+getHieAstsRule :: Rules ()
+getHieAstsRule =
+    define $ \GetHieAst f -> do
+      tmr <- use_ TypeCheck f
+      (diags,masts) <- case tmrHieAsts tmr of
+        -- If we already have them from typechecking, return them
+        Just asts -> pure ([], Just asts)
+        -- Compute asts if we haven't already computed them
+        Nothing -> do
+          hsc <- hscEnv <$> use_ GhcSession f
+          (diagsHieGen, masts) <- liftIO $ generateHieAsts hsc (tmrModule tmr)
+          pure (diagsHieGen, masts)
+      let refmap = generateReferencesMap . getAsts <$> masts
+      im <- use GetLocatedImports f
+      let mkImports (fileImports, _) = M.fromList $ mapMaybe (\(m, mfp) -> (unLoc m,) . artifactFilePath <$> mfp)  fileImports
+      pure (diags, HAR (ms_mod  $ tmrModSummary tmr) <$> masts <*> refmap <*> fmap mkImports im)
+
+getBindingsRule :: Rules ()
+getBindingsRule =
+  define $ \GetBindings f -> do
+    har <- use_ GetHieAst f
+    pure ([], Just $ bindings $ refMap har)
+
+getDocMapRule :: Rules ()
+getDocMapRule =
+    define $ \GetDocMap file -> do
+      hmi <- hirModIface <$> use_ GetModIface file
+      hsc <- hscEnv <$> use_ GhcSessionDeps file
+      (refMap -> rf) <- use_ GetHieAst file
+
+      deps <- maybe (TransitiveDependencies [] [] []) fst <$> useWithStale GetDependencies file
+      let tdeps = transitiveModuleDeps deps

 -- When possible, rely on the haddocks embedded in our interface files
 -- This creates problems on ghc-lib, see comment on 'getDocumentationTryGhc'
 #if MIN_GHC_API_VERSION(8,6,0) && !defined(GHC_LIB)
      let parsedDeps = []
 #else
-        deps <- maybe (TransitiveDependencies [] [] []) fst <$> useWithStale GetDependencies file
-        let tdeps = transitiveModuleDeps deps
-        parsedDeps <- mapMaybe (fmap fst) <$> usesWithStale GetParsedModule tdeps
+      parsedDeps <- uses_ GetParsedModule tdeps
 #endif

-        (fileImports, _) <- use_ GetLocatedImports file
-        let imports = second (fmap artifactFilePath) <$> fileImports
-        x <- liftIO $ getSrcSpanInfos packageState imports tc parsedDeps
-        return ([], Just x)
+      ifaces <- uses_ GetModIface tdeps
+
+      dkMap <- liftIO $ evalGhcEnv hsc $ mkDocMap parsedDeps rf hmi (map hirModIface ifaces)
+      return ([],Just dkMap)

 -- Typechecks a module.
 typeCheckRule :: Rules ()
@ -573,14 +609,20 @@ typeCheckRuleDefinition hsc pm isFoi source = do
        case isFoi of
          IsFOI Modified -> return (diags, Just tcm)
          _ -> do -- If the file is saved on disk, or is not a FOI, we write out ifaces
-            diagsHie <- generateAndWriteHieFile hsc (tmrModule tcm) (fromMaybe "" source)
+            let tm = tmrModule tcm
+                ms = tmrModSummary tcm
+                exports = tcg_exports $ fst $ tm_internals_ tm
+            (diagsHieGen, masts) <- generateHieAsts hsc (tmrModule tcm)
+            diagsHieWrite <- case masts of
+              Nothing -> pure mempty
+              Just asts -> writeHieFile hsc ms exports asts $ fromMaybe "" source
            -- Don't save interface files for modules that compiled due to defering
            -- type errors, as we won't get proper diagnostics if we load these from
            -- disk
            diagsHi  <- if not $ tmrDeferedError tcm
                        then writeHiFile hsc tcm
                        else pure mempty
-            return (diags <> diagsHi <> diagsHie, Just tcm)
+            return (diags <> diagsHi <> diagsHieGen <> diagsHieWrite, Just tcm{tmrHieAsts = masts})
      (diags, res) ->
        return (diags, snd <$> res)
 where
@ -849,7 +891,7 @@ mainRule = do
    reportImportCyclesRule
    getDependenciesRule
    typeCheckRule
-    getSpanInfoRule
+    getDocMapRule
    generateCoreRule
    generateByteCodeRule
    loadGhcSession
@ -860,6 +902,8 @@ mainRule = do
    getModuleGraphRule
    knownFilesRule
    getClientSettingsRule
+    getHieAstsRule
+    getBindingsRule

 -- | Given the path to a module src file, this rule returns True if the
 -- corresponding `.hi` file is stable, that is, if it is newer
--- a/src/Development/IDE/GHC/Compat.hs
+++ b/src/Development/IDE/GHC/Compat.hs
@ -5,7 +5,7 @@
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE PatternSynonyms #-}
-{-# OPTIONS -Wno-dodgy-imports #-}
+{-# OPTIONS -Wno-dodgy-imports -Wno-incomplete-uni-patterns #-}
 #include "ghc-api-version.h"

 -- | Attempt at hiding the GHC version differences we can.
@ -16,6 +16,9 @@ module Development.IDE.GHC.Compat(
    NameCacheUpdater(..),
    hieExportNames,
    mkHieFile,
+    mkHieFile',
+    enrichHie,
+    RefMap,
    writeHieFile,
    readHieFile,
    supportsHieFiles,
@ -55,6 +58,15 @@ module Development.IDE.GHC.Compat(
    upNameCache,
    disableWarningsAsErrors,
    fixDetailsForTH,
+    AvailInfo,
+    tcg_exports,
+
+#if MIN_GHC_API_VERSION(8,10,0)
+    module GHC.Hs.Extension,
+#else
+    module HsExtension,
+    noExtField,
+#endif

    module GHC,
    initializePlugins,
@ -69,6 +81,11 @@ module Development.IDE.GHC.Compat(
    module Development.IDE.GHC.HieUtils,
 #endif

+#else
+    HieASTs,
+    getAsts,
+    generateReferencesMap,
+
 #endif
    ) where

@ -81,6 +98,15 @@ import Packages
 import Data.IORef
 import HscTypes
 import NameCache
+import qualified Data.ByteString as BS
+import MkIface
+import TcRnTypes
+
+#if MIN_GHC_API_VERSION(8,10,0)
+import GHC.Hs.Extension
+#else
+import HsExtension
+#endif

 import qualified GHC
 import GHC hiding (
@ -120,13 +146,12 @@ import InstEnv   (tidyClsInstDFun)
 import PatSyn    (PatSyn, tidyPatSynIds)
 #endif

-import TcRnTypes
-
 #if MIN_GHC_API_VERSION(8,6,0)
-import Development.IDE.GHC.HieAst (mkHieFile)
+import Development.IDE.GHC.HieAst (mkHieFile,enrichHie)
 import Development.IDE.GHC.HieBin
 import qualified DynamicLoading
 import Plugins (Plugin(parsedResultAction), withPlugins)
+import Data.Map.Strict (Map)

 #if MIN_GHC_API_VERSION(8,8,0)
 import HieUtils
@ -153,7 +178,6 @@ import IfaceEnv
 import Binary
 import Data.ByteString (ByteString)
 import GhcPlugins (Hsc, srcErrorMessages, Unfolding(BootUnfolding), setIdUnfolding, tidyTopType, setIdType, globaliseId, isWiredInName, elemNameSet, idName, filterOut)
-import MkIface
 #endif

 import Control.Exception (catch)
@ -168,6 +192,12 @@ hPutStringBuffer hdl (StringBuffer buf len cur)

 #endif

+#if !MIN_GHC_API_VERSION(8,10,0)
+noExtField :: NoExt
+noExtField = noExt
+#endif
+
+
 #if MIN_GHC_API_VERSION(8,6,0)
 supportsHieFiles :: Bool
 supportsHieFiles = True
@ -198,6 +228,49 @@ includePathsQuote = const []
 #endif


+#if MIN_GHC_API_VERSION(8,6,0)
+type RefMap = Map Identifier [(Span, IdentifierDetails Type)]
+
+mkHieFile' :: ModSummary
+           -> [AvailInfo]
+           -> HieASTs Type
+           -> BS.ByteString
+           -> Hsc HieFile
+mkHieFile' ms exports asts src = do
+  let Just src_file = ml_hs_file $ ms_location ms
+      (asts',arr) = compressTypes asts
+  return $ HieFile
+      { hie_hs_file = src_file
+      , hie_module = ms_mod ms
+      , hie_types = arr
+      , hie_asts = asts'
+      -- mkIfaceExports sorts the AvailInfos for stability
+      , hie_exports = mkIfaceExports exports
+      , hie_hs_src = src
+      }
+#else
+type RefMap = ()
+type HieASTs a = ()
+
+mkHieFile' :: ModSummary
+           -> [AvailInfo]
+           -> HieASTs Type
+           -> BS.ByteString
+           -> Hsc HieFile
+mkHieFile' ms exports _ _ = return (HieFile (ms_mod ms) es)
+  where
+    es = nameListFromAvails (mkIfaceExports exports)
+
+enrichHie :: TypecheckedSource -> RenamedSource -> Hsc (HieASTs Type)
+enrichHie _ _ = pure ()
+
+getAsts :: HieASTs Type -> ()
+getAsts = id
+
+generateReferencesMap :: () -> RefMap
+generateReferencesMap = id
+#endif
+
 addIncludePathsQuote :: FilePath -> DynFlags -> DynFlags
 #if MIN_GHC_API_VERSION(8,6,0)
 addIncludePathsQuote path x = x{includePaths = f $ includePaths x}
--- a/src/Development/IDE/GHC/Error.hs
+++ b/src/Development/IDE/GHC/Error.hs
@ -14,6 +14,7 @@ module Development.IDE.GHC.Error
  , srcSpanToLocation
  , srcSpanToRange
  , realSrcSpanToRange
+  , realSrcLocToPosition
  , srcSpanToFilename
  , zeroSpan
  , realSpan
@ -72,8 +73,12 @@ srcSpanToRange (RealSrcSpan real) = Just $ realSrcSpanToRange real

 realSrcSpanToRange :: RealSrcSpan -> Range
 realSrcSpanToRange real =
-  Range (Position (srcSpanStartLine real - 1) (srcSpanStartCol real - 1))
-            (Position (srcSpanEndLine real - 1) (srcSpanEndCol real - 1))
+  Range (realSrcLocToPosition $ realSrcSpanStart real)
+        (realSrcLocToPosition $ realSrcSpanEnd   real)
+
+realSrcLocToPosition :: RealSrcLoc -> Position
+realSrcLocToPosition real =
+  Position (srcLocLine real - 1) (srcLocCol real - 1)

 -- | Extract a file name from a GHC SrcSpan (use message for unhelpful ones)
 -- FIXME This may not be an _absolute_ file name, needs fixing.
--- a/src/Development/IDE/GHC/Orphans.hs
+++ b/src/Development/IDE/GHC/Orphans.hs
@ -17,6 +17,7 @@ import qualified StringBuffer as SB
 import Control.DeepSeq
 import Data.Hashable
 import Development.IDE.GHC.Util
+import Bag


 -- Orphan instances for types from the GHC API.
@ -80,3 +81,21 @@ instance Show ModuleName where
    show = moduleNameString
 instance Hashable ModuleName where
    hashWithSalt salt = hashWithSalt salt . show
+
+
+#if MIN_GHC_API_VERSION(8,6,0)
+instance NFData a => NFData (IdentifierDetails a) where
+    rnf (IdentifierDetails a b) = rnf a `seq` rnf (length b)
+ 
+instance NFData RealSrcSpan where
+    rnf = rwhnf
+
+instance NFData Type where
+    rnf = rwhnf
+#endif
+
+instance Show a => Show (Bag a) where
+    show = show . bagToList
+
+instance NFData HsDocString where
+    rnf = rwhnf
--- a/src/Development/IDE/LSP/HoverDefinition.hs
+++ b/src/Development/IDE/LSP/HoverDefinition.hs
@ -7,6 +7,7 @@ module Development.IDE.LSP.HoverDefinition
    ( setHandlersHover
    , setHandlersDefinition
    , setHandlersTypeDefinition
+    , setHandlersDocHighlight
    -- * For haskell-language-server
    , hover
    , gotoDefinition
@ -27,21 +28,25 @@ import qualified Data.Text as T
 gotoDefinition :: IdeState -> TextDocumentPositionParams -> IO (Either ResponseError LocationResponseParams)
 hover          :: IdeState -> TextDocumentPositionParams -> IO (Either ResponseError (Maybe Hover))
 gotoTypeDefinition :: IdeState -> TextDocumentPositionParams -> IO (Either ResponseError LocationResponseParams)
+documentHighlight :: IdeState -> TextDocumentPositionParams -> IO (Either ResponseError (List DocumentHighlight))
 gotoDefinition = request "Definition" getDefinition (MultiLoc []) SingleLoc
 gotoTypeDefinition = request "TypeDefinition" getTypeDefinition (MultiLoc []) MultiLoc
 hover          = request "Hover"      getAtPoint     Nothing      foundHover
+documentHighlight = request "DocumentHighlight" highlightAtPoint (List []) List

 foundHover :: (Maybe Range, [T.Text]) -> Maybe Hover
 foundHover (mbRange, contents) =
  Just $ Hover (HoverContents $ MarkupContent MkMarkdown $ T.intercalate sectionSeparator contents) mbRange

-setHandlersDefinition, setHandlersHover, setHandlersTypeDefinition :: PartialHandlers c
+setHandlersDefinition, setHandlersHover, setHandlersTypeDefinition, setHandlersDocHighlight :: PartialHandlers c
 setHandlersDefinition = PartialHandlers $ \WithMessage{..} x ->
  return x{LSP.definitionHandler = withResponse RspDefinition $ const gotoDefinition}
 setHandlersTypeDefinition = PartialHandlers $ \WithMessage{..} x ->
  return x{LSP.typeDefinitionHandler = withResponse RspDefinition $ const gotoTypeDefinition}
 setHandlersHover      = PartialHandlers $ \WithMessage{..} x ->
  return x{LSP.hoverHandler      = withResponse RspHover      $ const hover}
+setHandlersDocHighlight = PartialHandlers $ \WithMessage{..} x ->
+  return x{LSP.documentHighlightHandler = withResponse RspDocumentHighlights $ const documentHighlight}

 -- | Respond to and log a hover or go-to-definition request
 request
--- a/src/Development/IDE/LSP/LanguageServer.hs
+++ b/src/Development/IDE/LSP/LanguageServer.hs
@ -106,6 +106,7 @@ runLanguageServer options userHandlers onInitialConfig onConfigChange getIdeStat
            initializeRequestHandler <>
            setHandlersIgnore <> -- least important
            setHandlersDefinition <> setHandlersHover <> setHandlersTypeDefinition <>
+            setHandlersDocHighlight <>
            setHandlersOutline <>
            userHandlers <>
            setHandlersNotifications <> -- absolutely critical, join them with user notifications
--- a/src/Development/IDE/Plugin/Completions.hs
+++ b/src/Development/IDE/Plugin/Completions.hs
@ -8,7 +8,6 @@ module Development.IDE.Plugin.Completions
    , getCompletionsLSP
    ) where

-import Control.Applicative
 import Language.Haskell.LSP.Messages
 import Language.Haskell.LSP.Types
 import qualified Language.Haskell.LSP.Core as LSP
@ -20,6 +19,7 @@ import GHC.Generics

 import Development.IDE.Plugin
 import Development.IDE.Core.Service
+import Development.IDE.Core.PositionMapping
 import Development.IDE.Plugin.Completions.Logic
 import Development.IDE.Types.Location
 import Development.IDE.Types.Options
@ -42,7 +42,6 @@ import Development.IDE.Import.DependencyInformation
 plugin :: Plugin c
 plugin = Plugin produceCompletions setHandlersCompletion

-
 produceCompletions :: Rules ()
 produceCompletions = do
    define $ \ProduceCompletions file -> do
@ -127,10 +126,9 @@ instance Hashable NonLocalCompletions
 instance NFData   NonLocalCompletions
 instance Binary   NonLocalCompletions

-
 -- | Generate code actions.
 getCompletionsLSP
-    :: LSP.LspFuncs c
+    :: LSP.LspFuncs cofd
    -> IdeState
    -> CompletionParams
    -> IO (Either ResponseError CompletionResponseResult)
@ -146,9 +144,10 @@ getCompletionsLSP lsp ide
            opts <- liftIO $ getIdeOptionsIO $ shakeExtras ide
            compls <- useWithStaleFast ProduceCompletions npath
            pm <- useWithStaleFast GetParsedModule npath
-            pure (opts, liftA2 (,) compls pm)
+            binds <- fromMaybe (mempty, zeroMapping) <$> useWithStaleFast GetBindings npath
+            pure (opts, fmap (,pm,binds) compls )
        case compls of
-          Just ((cci', _), (pm, mapping)) -> do
+          Just ((cci', _), parsedMod, bindMap) -> do
            pfix <- VFS.getCompletionPrefix position cnts
            case (pfix, completionContext) of
              (Just (VFS.PosPrefixInfo _ "" _ _), Just CompletionContext { _triggerCharacter = Just "."})
@ -156,7 +155,7 @@ getCompletionsLSP lsp ide
              (Just pfix', _) -> do
                  -- TODO pass the real capabilities here (or remove the logic for snippets)
                let fakeClientCapabilities = ClientCapabilities Nothing Nothing Nothing Nothing
-                Completions . List <$> getCompletions ideOpts cci' pm mapping pfix' fakeClientCapabilities (WithSnippets True)
+                Completions . List <$> getCompletions ideOpts cci' parsedMod bindMap pfix' fakeClientCapabilities (WithSnippets True)
              _ -> return (Completions $ List [])
          _ -> return (Completions $ List [])
      _ -> return (Completions $ List [])
--- a/src/Development/IDE/Plugin/Completions/Logic.hs
+++ b/src/Development/IDE/Plugin/Completions/Logic.hs
@ -10,7 +10,7 @@ module Development.IDE.Plugin.Completions.Logic (
 ) where

 import Control.Applicative
-import Data.Char (isSpace, isUpper)
+import Data.Char (isUpper)
 import Data.Generics
 import Data.List.Extra as List hiding (stripPrefix)
 import qualified Data.Map  as Map
@ -41,6 +41,7 @@ import Development.IDE.Core.Compile
 import Development.IDE.Core.PositionMapping
 import Development.IDE.Plugin.Completions.Types
 import Development.IDE.Spans.Documentation
+import Development.IDE.Spans.LocalBindings
 import Development.IDE.GHC.Compat as GHC
 import Development.IDE.GHC.Error
 import Development.IDE.Types.Options
@ -147,14 +148,17 @@ mkCompl IdeOptions{..} CI{compKind,insertText, importedFrom,typeText,label,docs}
    Nothing Nothing Nothing Nothing (Just insertText) (Just Snippet)
    Nothing Nothing Nothing Nothing Nothing
  where kind = Just compKind
-        docs' = ("*Defined in '" <> importedFrom <> "'*\n") : spanDocToMarkdown docs
+        docs' = imported : spanDocToMarkdown docs
+        imported = case importedFrom of
+          Left pos -> "*Defined at '" <> ppr pos <> "'*\n'"
+          Right mod -> "*Defined in '" <> mod <> "'*\n"
        colon = if optNewColonConvention then ": " else ":: "

 mkNameCompItem :: Name -> ModuleName -> Maybe Type -> Maybe Backtick -> SpanDoc -> CompItem
 mkNameCompItem origName origMod thingType isInfix docs = CI{..}
  where
    compKind = occNameToComKind typeText $ occName origName
-    importedFrom = showModName origMod
+    importedFrom = Right $ showModName origMod
    isTypeCompl = isTcOcc $ occName origName
    label = T.pack $ showGhc origName
    insertText = case isInfix of
@ -351,15 +355,15 @@ localCompletionsForParsedModule pm@ParsedModule{pm_parsed_source = L _ HsModule{
        ]

    mkComp n ctyp ty =
-        CI ctyp pn thisModName ty pn Nothing doc (ctyp `elem` [CiStruct, CiClass])
+        CI ctyp pn (Right thisModName) ty pn Nothing doc (ctyp `elem` [CiStruct, CiClass])
      where
        pn = ppr n
        doc = SpanDocText (getDocumentation [pm] n) (SpanDocUris Nothing Nothing)

    thisModName = ppr hsmodName

-    ppr :: Outputable a => a -> T.Text
-    ppr = T.pack . prettyPrint
+ppr :: Outputable a => a -> T.Text
+ppr = T.pack . prettyPrint

 newtype WithSnippets = WithSnippets Bool

@ -375,15 +379,15 @@ toggleSnippets ClientCapabilities { _textDocument } (WithSnippets with) x
 getCompletions
    :: IdeOptions
    -> CachedCompletions
-    -> ParsedModule
-    -> PositionMapping     -- ^ map current position to position in parsed module
+    -> Maybe (ParsedModule, PositionMapping)
+    -> (Bindings, PositionMapping)
    -> VFS.PosPrefixInfo
    -> ClientCapabilities
    -> WithSnippets
    -> IO [CompletionItem]
-getCompletions ideOpts cc pm pmapping prefixInfo caps withSnippets = do
-  let CC { allModNamesAsNS, unqualCompls, qualCompls, importableModules } = cc
-      VFS.PosPrefixInfo { VFS.fullLine, VFS.prefixModule, VFS.prefixText } = prefixInfo
+getCompletions ideOpts CC { allModNamesAsNS, unqualCompls, qualCompls, importableModules}
+               maybe_parsed (localBindings, bmapping) prefixInfo caps withSnippets = do
+  let VFS.PosPrefixInfo { fullLine, prefixModule, prefixText } = prefixInfo
      enteredQual = if T.null prefixModule then "" else prefixModule <> "."
      fullPrefix  = enteredQual <> prefixText

@ -392,19 +396,7 @@ getCompletions ideOpts cc pm pmapping prefixInfo caps withSnippets = do
          to                             'foo :: Int -> String ->    '
                                                              ^
      -}
-      pos =
-        let Position l c = VFS.cursorPos prefixInfo
-            typeStuff = [isSpace, (`elem` (">-." :: String))]
-            stripTypeStuff = T.dropWhileEnd (\x -> any (\f -> f x) typeStuff)
-            -- if oldPos points to
-            -- foo -> bar -> baz
-            --    ^
-            -- Then only take the line up to there, discard '-> bar -> baz'
-            partialLine = T.take c fullLine
-            -- drop characters used when writing incomplete type sigs
-            -- like '-> '
-            d = T.length fullLine - T.length (stripTypeStuff partialLine)
-        in Position l (c - d)
+      pos = VFS.cursorPos prefixInfo

      filtModNameCompls =
        map mkModCompl
@ -413,9 +405,15 @@ getCompletions ideOpts cc pm pmapping prefixInfo caps withSnippets = do

      filtCompls = map Fuzzy.original $ Fuzzy.filter prefixText ctxCompls "" "" label False
        where
-          mcc = do
-              position' <- fromCurrentPosition pmapping pos
-              getCContext position' pm
+
+          mcc = case maybe_parsed of
+            Nothing -> Nothing
+            Just (pm, pmapping) ->
+              let PositionMapping pDelta = pmapping
+                  position' = fromDelta pDelta pos
+                  lpos = lowerRange position'
+                  hpos = upperRange position'
+              in getCContext lpos pm <|> getCContext hpos pm

          -- completions specific to the current context
          ctxCompls' = case mcc of
@ -427,10 +425,26 @@ getCompletions ideOpts cc pm pmapping prefixInfo caps withSnippets = do
          ctxCompls = map (\comp -> comp { isInfix = infixCompls }) ctxCompls'

          infixCompls :: Maybe Backtick
-          infixCompls = isUsedAsInfix fullLine prefixModule prefixText (VFS.cursorPos prefixInfo)
+          infixCompls = isUsedAsInfix fullLine prefixModule prefixText pos
+
+          PositionMapping bDelta = bmapping
+          oldPos = fromDelta bDelta $ VFS.cursorPos prefixInfo
+          startLoc = lowerRange oldPos
+          endLoc = upperRange oldPos
+          localCompls = map (uncurry localBindsToCompItem) $ getFuzzyScope localBindings startLoc endLoc
+          localBindsToCompItem :: Name -> Maybe Type -> CompItem
+          localBindsToCompItem name typ = CI ctyp pn thisModName ty pn Nothing emptySpanDoc (not $ isValOcc occ)
+            where
+              occ = nameOccName name
+              ctyp = occNameToComKind Nothing occ
+              pn = ppr name
+              ty = ppr <$> typ
+              thisModName = case nameModule_maybe name of
+                Nothing -> Left $ nameSrcSpan name
+                Just m -> Right $ ppr m

          compls = if T.null prefixModule
-            then unqualCompls
+            then localCompls ++ unqualCompls
            else Map.findWithDefault [] prefixModule $ getQualCompls qualCompls

      filtListWith f list =
@ -474,6 +488,7 @@ getCompletions ideOpts cc pm pmapping prefixInfo caps withSnippets = do

  return result

+
 -- The supported languages and extensions
 languagesAndExts :: [T.Text]
 #if MIN_GHC_API_VERSION(8,10,0)
--- a/src/Development/IDE/Plugin/Completions/Types.hs
+++ b/src/Development/IDE/Plugin/Completions/Types.hs
@ -5,6 +5,7 @@ module Development.IDE.Plugin.Completions.Types (
 import           Control.DeepSeq
 import qualified Data.Map  as Map
 import qualified Data.Text as T
+import SrcLoc

 import Development.IDE.Spans.Common
 import Language.Haskell.LSP.Types (CompletionItemKind)
@ -17,7 +18,7 @@ data Backtick = Surrounded | LeftSide
 data CompItem = CI
  { compKind     :: CompletionItemKind
  , insertText   :: T.Text         -- ^ Snippet for the completion
-  , importedFrom :: T.Text         -- ^ From where this item is imported from.
+  , importedFrom :: Either SrcSpan T.Text         -- ^ From where this item is imported from.
  , typeText     :: Maybe T.Text   -- ^ Available type information.
  , label        :: T.Text         -- ^ Label to display to the user.
  , isInfix      :: Maybe Backtick -- ^ Did the completion happen
--- a/src/Development/IDE/Spans/AtPoint.hs
+++ b/src/Development/IDE/Spans/AtPoint.hs
@ -7,26 +7,31 @@ module Development.IDE.Spans.AtPoint (
    atPoint
  , gotoDefinition
  , gotoTypeDefinition
+  , documentHighlight
+  , pointCommand
  ) where

 import           Development.IDE.GHC.Error
 import Development.IDE.GHC.Orphans()
 import Development.IDE.Types.Location
+import           Language.Haskell.LSP.Types

 -- DAML compiler and infrastructure
 import Development.IDE.GHC.Compat
 import Development.IDE.Types.Options
-import Development.IDE.Spans.Type as SpanInfo
-import Development.IDE.Spans.Common (showName, spanDocToMarkdown)
+import Development.IDE.Spans.Common
+import Development.IDE.Core.RuleTypes

 -- GHC API imports
 import FastString
 import Name
 import Outputable hiding ((<>))
 import SrcLoc
-import Type
-import VarSet
+import TyCoRep
+import TyCon
+import qualified Var

+import Control.Applicative
 import Control.Monad.Extra
 import Control.Monad.Trans.Maybe
 import Control.Monad.Trans.Class
@ -34,102 +39,91 @@ import Control.Monad.IO.Class
 import           Data.Maybe
 import           Data.List
 import qualified Data.Text as T
+import qualified Data.Map as M
+
+
+import Data.Either
+import Data.List.Extra (dropEnd1)
+
+documentHighlight
+  :: Monad m
+  => HieASTs Type
+  -> RefMap
+  -> Position
+  -> MaybeT m [DocumentHighlight]
+documentHighlight hf rf pos = MaybeT $ pure (Just highlights)
+  where
+    ns = concat $ pointCommand hf pos (rights . M.keys . nodeIdentifiers . nodeInfo)
+    highlights = do
+      n <- ns
+      ref <- maybe [] id (M.lookup (Right n) rf)
+      pure $ makeHighlight ref
+    makeHighlight (sp,dets) =
+      DocumentHighlight (realSrcSpanToRange sp) (Just $ highlightType $ identInfo dets)
+    highlightType s =
+      if any (isJust . getScopeFromContext) s
+        then HkWrite
+        else HkRead

 gotoTypeDefinition
  :: MonadIO m
  => (Module -> MaybeT m (HieFile, FilePath))
  -> IdeOptions
-  -> [SpanInfo]
+  -> HieASTs Type
  -> Position
  -> MaybeT m [Location]
 gotoTypeDefinition getHieFile ideOpts srcSpans pos
-  = typeLocationsAtPoint getHieFile ideOpts pos srcSpans
+  = lift $ typeLocationsAtPoint getHieFile ideOpts pos srcSpans

 -- | Locate the definition of the name at a given position.
 gotoDefinition
  :: MonadIO m
  => (Module -> MaybeT m (HieFile, FilePath))
  -> IdeOptions
-  -> [SpanInfo]
+  -> M.Map ModuleName NormalizedFilePath
+  -> HieASTs Type
  -> Position
  -> MaybeT m Location
-gotoDefinition getHieFile ideOpts srcSpans pos =
-  MaybeT . pure . listToMaybe =<< locationsAtPoint getHieFile ideOpts pos srcSpans
+gotoDefinition getHieFile ideOpts imports srcSpans pos
+  = MaybeT $ fmap listToMaybe $ locationsAtPoint getHieFile ideOpts imports pos srcSpans

 -- | Synopsis for the name at a given position.
 atPoint
  :: IdeOptions
-  -> SpansInfo
+  -> HieASTs Type
+  -> DocAndKindMap
  -> Position
  -> Maybe (Maybe Range, [T.Text])
-atPoint IdeOptions{..} (SpansInfo srcSpans cntsSpans) pos = do
-    firstSpan <- listToMaybe $ deEmpasizeGeneratedEqShow $ spansAtPoint pos srcSpans
-    let constraintsAtPoint = mapMaybe spaninfoType (spansAtPoint pos cntsSpans)
-        -- Filter out the empty lines so we don't end up with a bunch of
-        -- horizontal separators with nothing inside of them
-        text = filter (not . T.null) $ hoverInfo firstSpan constraintsAtPoint
-    return (Just (range firstSpan), text)
+atPoint IdeOptions{} hf (DKMap dm km) pos = listToMaybe $ pointCommand hf pos hoverInfo
  where
-    -- Hover info for types, classes, type variables
-    hoverInfo SpanInfo{spaninfoType = Nothing , spaninfoDocs = docs ,  ..} _ =
-       (wrapLanguageSyntax <$> name) <> location <> spanDocToMarkdown docs
-     where
-       name     = [maybe shouldNotHappen showName  mbName]
-       location = [maybe shouldNotHappen definedAt mbName]
-       shouldNotHappen = "ghcide: did not expect a type level component without a name"
-       mbName = getNameM spaninfoSource
-
    -- Hover info for values/data
-    hoverInfo SpanInfo{spaninfoType = (Just typ), spaninfoDocs = docs , ..} cnts =
-       (wrapLanguageSyntax <$> nameOrSource) <> location <> spanDocToMarkdown docs
+    hoverInfo ast =
+      (Just range, prettyNames ++ pTypes)
      where
-       mbName = getNameM spaninfoSource
-       expr = case spaninfoSource of
-                Named n -> qualifyNameIfPossible n
-                Lit   l -> crop $ T.pack l
-                _       -> ""
-       nameOrSource   = [expr <> "\n" <> typeAnnotation]
-       qualifyNameIfPossible name' = modulePrefix <> showName name'
-         where modulePrefix = maybe "" (<> ".") (getModuleNameAsText name')
-       location = [maybe "" definedAt mbName]
+        pTypes
+          | length names == 1 = dropEnd1 $ map wrapHaskell prettyTypes
+          | otherwise = map wrapHaskell prettyTypes

-       thisFVs = tyCoVarsOfType typ
-       constraintsOverFVs = filter (\cnt -> not (tyCoVarsOfType cnt `disjointVarSet` thisFVs)) cnts
-       constraintsT = T.intercalate ", " (map showName constraintsOverFVs)
+        range = realSrcSpanToRange $ nodeSpan ast

-       typeAnnotation = case constraintsOverFVs of
-                          []  -> colon <> showName typ
-                          [_] -> colon <> constraintsT <> "\n=> " <> showName typ
-                          _   -> colon <> "(" <> constraintsT <> ")\n=> " <> showName typ
+        wrapHaskell x = "\n```haskell\n"<>x<>"\n```\n"
+        info = nodeInfo ast
+        names = M.assocs $ nodeIdentifiers info
+        types = nodeType info

-    definedAt name = "*Defined " <> T.pack (showSDocUnsafe $ pprNameDefnLoc name) <> "*\n"
-
-    crop txt
-      | T.length txt > 50 = T.take 46 txt <> " ..."
-      | otherwise         = txt
-
-    range SpanInfo{..} = Range
-      (Position spaninfoStartLine spaninfoStartCol)
-      (Position spaninfoEndLine spaninfoEndCol)
-
-    colon = if optNewColonConvention then ": " else ":: "
-    wrapLanguageSyntax x = T.unlines [ "```" <> T.pack optLanguageSyntax, x, "```"]
-
-    -- NOTE(RJR): This is a bit hacky.
-    -- We don't want to show the user type signatures generated from Eq and Show
-    -- instances, as they do not appear in the source program.
-    -- However the user could have written an `==` or `show` function directly,
-    -- in which case we still want to show information for that.
-    -- Hence we just move such information later in the list of spans.
-    deEmpasizeGeneratedEqShow :: [SpanInfo] -> [SpanInfo]
-    deEmpasizeGeneratedEqShow = uncurry (++) . partition (not . isTypeclassDeclSpan)
-    isTypeclassDeclSpan :: SpanInfo -> Bool
-    isTypeclassDeclSpan spanInfo =
-      case getNameM (spaninfoSource spanInfo) of
-        Just name -> any (`isInfixOf` getOccString name) ["==", "showsPrec"]
-        Nothing -> False
+        prettyNames :: [T.Text]
+        prettyNames = map prettyName names
+        prettyName (Right n, dets) = T.unlines $
+          wrapHaskell (showName n <> maybe "" ((" :: " <>) . prettyType) (identType dets <|> M.lookup n km))
+          : definedAt n
+          : catMaybes [ T.unlines . spanDocToMarkdown <$> M.lookup n dm
+                      ]
+        prettyName (Left m,_) = showName m

+        prettyTypes = map (("_ :: "<>) . prettyType) types
+        prettyType t = showName t

+        definedAt name = "*Defined " <> T.pack (showSDocUnsafe $ pprNameDefnLoc name) <> "*"

 typeLocationsAtPoint
  :: forall m
@ -137,50 +131,40 @@ typeLocationsAtPoint
  => (Module -> MaybeT m (HieFile, FilePath))
  -> IdeOptions
  -> Position
-  -> [SpanInfo]
-  -> MaybeT m [Location]
-typeLocationsAtPoint getHieFile = querySpanInfoAt getTypeSpan
-  where getTypeSpan :: SpanInfo -> m (Maybe SrcSpan)
-        getTypeSpan SpanInfo { spaninfoType = Just t } =
-          case splitTyConApp_maybe t of
-            Nothing -> return Nothing
-            Just (getName -> name, _) ->
-              nameToLocation getHieFile name
-        getTypeSpan _ = return Nothing
+  -> HieASTs Type
+  -> m [Location]
+typeLocationsAtPoint getHieFile _ideOptions pos ast =
+  let ts = concat $ pointCommand ast pos (nodeType . nodeInfo)
+      ns = flip mapMaybe ts $ \case
+        TyConApp tc _ -> Just $ tyConName tc
+        TyVarTy n -> Just $ Var.varName n
+        _ -> Nothing
+    in mapMaybeM (nameToLocation getHieFile) ns

 locationsAtPoint
  :: forall m
   . MonadIO m
  => (Module -> MaybeT m (HieFile, FilePath))
  -> IdeOptions
+  -> M.Map ModuleName NormalizedFilePath
  -> Position
-  -> [SpanInfo]
-  -> MaybeT m [Location]
-locationsAtPoint getHieFile = querySpanInfoAt (getSpan . spaninfoSource)
-  where getSpan :: SpanSource -> m (Maybe SrcSpan)
-        getSpan NoSource = pure Nothing
-        getSpan (SpanS sp) = pure $ Just sp
-        getSpan (Lit _) = pure Nothing
-        getSpan (Named name) = nameToLocation getHieFile name
-
-querySpanInfoAt :: forall m
-   . MonadIO m
-  => (SpanInfo -> m (Maybe SrcSpan))
-  -> IdeOptions
-  -> Position
-  -> [SpanInfo]
-  -> MaybeT m [Location]
-querySpanInfoAt getSpan _ideOptions pos =
-    lift . fmap (mapMaybe srcSpanToLocation) . mapMaybeM getSpan . spansAtPoint pos
+  -> HieASTs Type
+  -> m [Location]
+locationsAtPoint getHieFile _ideOptions imports pos ast =
+  let ns = concat $ pointCommand ast pos (M.keys . nodeIdentifiers . nodeInfo)
+      zeroPos = Position 0 0
+      zeroRange = Range zeroPos zeroPos
+      modToLocation m = fmap (\fs -> Location (fromNormalizedUri $ filePathToUri' fs) zeroRange) $ M.lookup m imports
+    in mapMaybeM (either (pure . modToLocation) $ nameToLocation getHieFile) ns

 -- | Given a 'Name' attempt to find the location where it is defined.
-nameToLocation :: Monad f => (Module -> MaybeT f (HieFile, String)) -> Name -> f (Maybe SrcSpan)
-nameToLocation getHieFile name =
+nameToLocation :: Monad f => (Module -> MaybeT f (HieFile, String)) -> Name -> f (Maybe Location)
+nameToLocation getHieFile name = fmap (srcSpanToLocation =<<) $
  case nameSrcSpan name of
    sp@(RealSrcSpan _) -> pure $ Just sp
    sp@(UnhelpfulSpan _) -> runMaybeT $ do
      guard (sp /= wiredInSrcSpan)
-      -- This case usually arises when the definition is in an external package (DAML only).
+      -- This case usually arises when the definition is in an external package.
      -- In this case the interface files contain garbage source spans
      -- so we instead read the .hie files to get useful source spans.
      mod <- MaybeT $ return $ nameModule_maybe name
@ -198,24 +182,16 @@ nameToLocation getHieFile name =
    setFileName f (RealSrcSpan span) = RealSrcSpan (span { srcSpanFile = mkFastString f })
    setFileName _ span@(UnhelpfulSpan _) = span

-- | Filter out spans which do not enclose a given point
-spansAtPoint :: Position -> [SpanInfo] -> [SpanInfo]
-spansAtPoint pos = filter atp where
+pointCommand :: HieASTs Type -> Position -> (HieAST Type -> a) -> [a]
+pointCommand hf pos k =
+    catMaybes $ M.elems $ flip M.mapWithKey (getAsts hf) $ \fs ast ->
+      case selectSmallestContaining (sp fs) ast of
+        Nothing -> Nothing
+        Just ast' -> Just $ k ast'
+ where
+   sloc fs = mkRealSrcLoc fs (line+1) (cha+1)
+   sp fs = mkRealSrcSpan (sloc fs) (sloc fs)
   line = _line pos
   cha = _character pos
-  atp SpanInfo{..} =
-      startsBeforePosition && endsAfterPosition
-    where
-      startLineCmp = compare spaninfoStartLine line
-      endLineCmp   = compare spaninfoEndLine   line
-
-      startsBeforePosition = startLineCmp == LT || (startLineCmp == EQ && spaninfoStartCol <= cha)
-                                              -- The end col points to the column after the
-                                              -- last character so we use > instead of >=
-      endsAfterPosition = endLineCmp == GT || (endLineCmp == EQ && spaninfoEndCol > cha)


-getModuleNameAsText :: Name -> Maybe T.Text
-getModuleNameAsText n = do
-  m <- nameModule_maybe n
-  return . T.pack . moduleNameString $ moduleName m
--- a/src/Development/IDE/Spans/Calculate.hs
+++ b/src/Development/IDE/Spans/Calculate.hs
@ -1,268 +0,0 @@
-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0
-
-- ORIGINALLY COPIED FROM https://github.com/commercialhaskell/intero
-
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE RankNTypes #-}
-#include "ghc-api-version.h"
-
-- | Get information on modules, identifiers, etc.
-
-module Development.IDE.Spans.Calculate(getSrcSpanInfos) where
-
-import           ConLike
-import           Control.Monad
-import qualified CoreUtils
-import           Data.List
-import           Data.Maybe
-import           DataCon
-import           Desugar
-import           GhcMonad
-import           HscTypes
-import           FastString (mkFastString)
-import           OccName
-import           Development.IDE.Types.Location
-import           Development.IDE.Spans.Type
-import           Development.IDE.GHC.Error (zeroSpan, catchSrcErrors)
-import           Prelude hiding (mod)
-import           TcHsSyn
-import           Var
-import Development.IDE.Core.Compile
-import qualified Development.IDE.GHC.Compat as Compat
-import Development.IDE.GHC.Compat
-import Development.IDE.GHC.Util
-import Development.IDE.Spans.Common
-import Development.IDE.Spans.Documentation
-import Data.List.Extra (nubOrd)
-import qualified Data.Map.Strict as Map
-
-- A lot of things gained an extra X argument in GHC 8.6, which we mostly ignore
-- this U ignores that arg in 8.6, but is hidden in 8.4
-#if MIN_GHC_API_VERSION(8,6,0)
-#define U _
-#else
-#define U
-#endif
-
-- | Get source span info, used for e.g. AtPoint and Goto Definition.
-getSrcSpanInfos
-    :: HscEnv
-    -> [(Located ModuleName, Maybe NormalizedFilePath)] -- ^ Dependencies in topological order
-    -> TcModuleResult
-    -> [ParsedModule]   -- ^ Dependencies parsed, optional if the 'HscEnv' already contains docs
-    -> IO SpansInfo
-getSrcSpanInfos env imports tc parsedDeps =
-    evalGhcEnv env $
-        getSpanInfo imports tc parsedDeps
-
-- | Get ALL source spans in the module.
-getSpanInfo :: GhcMonad m
-            => [(Located ModuleName, Maybe NormalizedFilePath)] -- ^ imports
-            -> TcModuleResult
-            -> [ParsedModule]
-            -> m SpansInfo
-getSpanInfo mods TcModuleResult{tmrModInfo, tmrModule = tcm@TypecheckedModule{..}} parsedDeps =
-  do let tcs = tm_typechecked_source
-         bs  = listifyAllSpans  tcs :: [LHsBind GhcTc]
-         es  = listifyAllSpans  tcs :: [LHsExpr GhcTc]
-         ps  = listifyAllSpans' tcs :: [Pat GhcTc]
-         ts  = listifyAllSpans tm_renamed_source :: [LHsType GhcRn]
-         allModules = tm_parsed_module : parsedDeps
-         funBinds = funBindMap tm_parsed_module
-         thisMod = ms_mod $ pm_mod_summary tm_parsed_module
-         modIface = hm_iface tmrModInfo
-
-     -- Load this module in HPT to make its interface documentation available
-     modifySession (loadModuleHome $ HomeModInfo modIface (snd tm_internals_) Nothing)
-
-     bts <- mapM (getTypeLHsBind funBinds) bs   -- binds
-     ets <- mapM getTypeLHsExpr es -- expressions
-     pts <- mapM getTypeLPat  ps -- patterns
-     tts <- concat <$> mapM getLHsType ts -- types
-
-     -- Batch extraction of kinds
-     let typeNames = nubOrd [ n | (Named n, _) <- tts]
-     kinds <- Map.fromList . zip typeNames  <$> mapM (lookupKind thisMod) typeNames
-     let withKind (Named n, x) =
-            (Named n, x, join $ Map.lookup n kinds)
-         withKind (other, x) =
-            (other, x, Nothing)
-     tts <- pure $ map withKind tts
-
-     let imports = importInfo mods
-     let exports = getExports tcm
-     let exprs = addEmptyInfo exports ++ addEmptyInfo imports ++ concat bts ++ tts ++ catMaybes (ets ++ pts)
-     let constraints = map constraintToInfo (concatMap getConstraintsLHsBind bs)
-         sortedExprs = sortBy cmp exprs
-         sortedConstraints = sortBy cmp constraints
-
-    -- Batch extraction of Haddocks
-     let names = nubOrd [ s | (Named s,_,_) <- sortedExprs ++ sortedConstraints]
-     docs <- Map.fromList . zip names <$> getDocumentationsTryGhc thisMod allModules names
-     let withDocs (Named n, x, y) = (Named n, x, y, Map.findWithDefault emptySpanDoc n docs)
-         withDocs (other, x, y) = (other, x, y, emptySpanDoc)
-
-     return $ SpansInfo (mapMaybe (toSpanInfo . withDocs) sortedExprs)
-                        (mapMaybe (toSpanInfo . withDocs) sortedConstraints)
-  where cmp (_,a,_) (_,b,_)
-          | a `isSubspanOf` b = LT
-          | b `isSubspanOf` a = GT
-          | otherwise         = compare (srcSpanStart a) (srcSpanStart b)
-
-        addEmptyInfo = map (\(a,b) -> (a,b,Nothing))
-        constraintToInfo (sp, ty) = (SpanS sp, sp, Just ty)
-
-lookupKind :: GhcMonad m => Module -> Name -> m (Maybe Type)
-lookupKind mod =
-    fmap (either (const Nothing) (safeTyThingType =<<)) . catchSrcErrors "span" . lookupName mod
-- | The locations in the typechecked module are slightly messed up in some cases (e.g. HsMatchContext always
-- points to the first match) whereas the parsed module has the correct locations.
-- Therefore we build up a map from OccName to the corresponding definition in the parsed module
-- to lookup precise locations for things like multi-clause function definitions.
--
-- For now this only contains FunBinds.
-funBindMap :: ParsedModule -> OccEnv (HsBind GhcPs)
-funBindMap pm = mkOccEnv $ [ (occName $ unLoc f, bnd) | L _ (Compat.ValD bnd@FunBind{fun_id = f}) <- hsmodDecls $ unLoc $ pm_parsed_source pm ]
-
-getExports :: TypecheckedModule -> [(SpanSource, SrcSpan)]
-getExports m
-    | Just (_, _, Just exports, _) <- renamedSource m =
-    [ (Named $ unLoc n, getLoc n)
-    | (e, _) <- exports
-    , n <- ieLNames $ unLoc e
-    ]
-getExports _ = []
-
-- | Variant of GHC's ieNames that produces LIdP instead of IdP
-ieLNames :: IE pass -> [Located (IdP pass)]
-ieLNames (IEVar       U n   )     = [ieLWrappedName n]
-ieLNames (IEThingAbs  U n   )     = [ieLWrappedName n]
-ieLNames (IEThingAll    n   )     = [ieLWrappedName n]
-ieLNames (IEThingWith   n _ ns _) = ieLWrappedName n : map ieLWrappedName ns
-ieLNames _ = []
-
-- | Get the name and type of a binding.
-getTypeLHsBind :: (Monad m)
-               => OccEnv (HsBind GhcPs)
-               -> LHsBind GhcTc
-               -> m [(SpanSource, SrcSpan, Maybe Type)]
-getTypeLHsBind funBinds (L _spn FunBind{fun_id = pid})
-  | Just FunBind {fun_matches = MG{mg_alts=L _ matches}} <- lookupOccEnv funBinds (occName $ unLoc pid) = do
-  let name = getName (unLoc pid)
-  return [(Named name, getLoc mc_fun, Just (varType (unLoc pid))) | match <- matches, FunRhs{mc_fun = mc_fun} <- [m_ctxt $ unLoc match] ]
-- In theory this shouldn’t ever fail but if it does, we can at least show the first clause.
-getTypeLHsBind _ (L _spn FunBind{fun_id = pid,fun_matches = MG{}}) = do
-  let name = getName (unLoc pid)
-  return [(Named name, getLoc pid, Just (varType (unLoc pid)))]
-getTypeLHsBind _ _ = return []
-
-- | Get information about constraints
-getConstraintsLHsBind :: LHsBind GhcTc
-                      -> [(SrcSpan, Type)]
-getConstraintsLHsBind (L spn AbsBinds { abs_ev_vars = vars })
-  = map (\v -> (spn, varType v)) vars
-getConstraintsLHsBind _ = []
-
-- | Get the name and type of an expression.
-getTypeLHsExpr :: (GhcMonad m)
-               => LHsExpr GhcTc
-               -> m (Maybe (SpanSource, SrcSpan, Maybe Type))
-getTypeLHsExpr e = do
-  hs_env <- getSession
-  (_, mbe) <- liftIO (deSugarExpr hs_env e)
-  case mbe of
-    Just expr -> do
-      let ss = getSpanSource (unLoc e)
-      return $ Just (ss, getLoc e, Just (CoreUtils.exprType expr))
-    Nothing -> return Nothing
-  where
-    getSpanSource :: HsExpr GhcTc -> SpanSource
-    getSpanSource xpr | isLit xpr = Lit (showGhc xpr)
-    getSpanSource (HsVar U (L _ i)) = Named (getName i)
-    getSpanSource (HsConLikeOut U (RealDataCon dc)) = Named (dataConName dc)
-    getSpanSource RecordCon {rcon_con_name} = Named (getName rcon_con_name)
-    getSpanSource (HsWrap U _ xpr) = getSpanSource xpr
-    getSpanSource (HsPar U xpr) = getSpanSource (unLoc xpr)
-    getSpanSource _ = NoSource
-
-    isLit :: HsExpr GhcTc -> Bool
-    isLit (HsLit U _) = True
-    isLit (HsOverLit U _) = True
-    isLit (ExplicitTuple U args _) = all (isTupLit . unLoc) args
-#if MIN_GHC_API_VERSION(8,6,0)
-    isLit (ExplicitSum  U _ _ xpr) = isLitChild (unLoc xpr)
-    isLit (ExplicitList U _ xprs) = all (isLitChild . unLoc) xprs
-#else
-    isLit (ExplicitSum  _ _ xpr _) = isLitChild (unLoc xpr)
-    isLit (ExplicitList _ _ xprs) = all (isLitChild . unLoc) xprs
-#endif
-    isLit _ = False
-
-    isTupLit (Present U xpr) = isLitChild (unLoc xpr)
-    isTupLit _               = False
-
-    -- We need special treatment for children so things like [(1)] are still treated
-    -- as a list literal while not treating (1) as a literal.
-    isLitChild (HsWrap U _ xpr) = isLitChild xpr
-    isLitChild (HsPar U xpr)    = isLitChild (unLoc xpr)
-#if MIN_GHC_API_VERSION(8,8,0)
-    isLitChild (ExprWithTySig U xpr _) = isLitChild (unLoc xpr)
-#elif MIN_GHC_API_VERSION(8,6,0)
-    isLitChild (ExprWithTySig U xpr) = isLitChild (unLoc xpr)
-#else
-    isLitChild (ExprWithTySigOut xpr _) = isLitChild (unLoc xpr)
-    isLitChild (ExprWithTySig xpr _) = isLitChild (unLoc xpr)
-#endif
-    isLitChild e = isLit e
-
-- | Get the name and type of a pattern.
-getTypeLPat :: (Monad m)
-            => Pat GhcTc
-            -> m (Maybe (SpanSource, SrcSpan, Maybe Type))
-getTypeLPat pat = do
-  let (src, spn) = getSpanSource pat
-  return $ Just (src, spn, Just (hsPatType pat))
-  where
-    getSpanSource :: Pat GhcTc -> (SpanSource, SrcSpan)
-    getSpanSource (VarPat (L spn vid)) = (Named (getName vid), spn)
-    getSpanSource (ConPatOut (L spn (RealDataCon dc)) _ _ _ _ _ _) =
-      (Named (dataConName dc), spn)
-    getSpanSource _ = (NoSource, noSrcSpan)
-
-getLHsType
-    :: Monad m
-    => LHsType GhcRn
-    -> m [(SpanSource, SrcSpan)]
-getLHsType (L spn (HsTyVar U _ v)) = do
-  let n = unLoc v
-  pure [(Named n, spn)]
-getLHsType _ = pure []
-
-importInfo :: [(Located ModuleName, Maybe NormalizedFilePath)]
-           -> [(SpanSource, SrcSpan)]
-importInfo = mapMaybe (uncurry wrk) where
-  wrk :: Located ModuleName -> Maybe NormalizedFilePath -> Maybe (SpanSource, SrcSpan)
-  wrk modName = \case
-    Nothing -> Nothing
-    Just fp -> Just (fpToSpanSource $ fromNormalizedFilePath fp, getLoc modName)
-
-  -- TODO make this point to the module name
-  fpToSpanSource :: FilePath -> SpanSource
-  fpToSpanSource fp = SpanS $ RealSrcSpan $ zeroSpan $ mkFastString fp
-
-- | Pretty print the types into a 'SpanInfo'.
-toSpanInfo :: (SpanSource, SrcSpan, Maybe Type, SpanDoc) -> Maybe SpanInfo
-toSpanInfo (name,mspan,typ,docs) =
-  case mspan of
-    RealSrcSpan spn ->
-      -- GHC’s line and column numbers are 1-based while LSP’s line and column
-      -- numbers are 0-based.
-      Just (SpanInfo (srcSpanStartLine spn - 1)
-                     (srcSpanStartCol spn - 1)
-                     (srcSpanEndLine spn - 1)
-                     (srcSpanEndCol spn - 1)
-                     typ
-                     name
-                     docs)
-    _ -> Nothing
--- a/src/Development/IDE/Spans/Common.hs
+++ b/src/Development/IDE/Spans/Common.hs
@ -1,11 +1,11 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE DeriveAnyClass #-}
 #include "ghc-api-version.h"

 module Development.IDE.Spans.Common (
  showGhc
 , showName
-, listifyAllSpans
-, listifyAllSpans'
 , safeTyThingId
 , safeTyThingType
 , SpanDoc(..)
@ -13,13 +13,16 @@ module Development.IDE.Spans.Common (
 , emptySpanDoc
 , spanDocToMarkdown
 , spanDocToMarkdownForTest
+, DocMap
+, KindMap
 ) where

-import Data.Data
-import qualified Data.Generics
 import Data.Maybe
 import qualified Data.Text as T
 import Data.List.Extra
+import Data.Map (Map)
+import Control.DeepSeq
+import GHC.Generics

 import GHC
 import Outputable hiding ((<>))
@ -30,6 +33,10 @@ import Var

 import qualified Documentation.Haddock.Parser as H
 import qualified Documentation.Haddock.Types as H
+import Development.IDE.GHC.Orphans ()
+
+type DocMap = Map Name SpanDoc
+type KindMap = Map Name Type

 showGhc :: Outputable a => a -> String
 showGhc = showPpr unsafeGlobalDynFlags
@ -40,18 +47,6 @@ showName = T.pack . prettyprint
    prettyprint x = renderWithStyle unsafeGlobalDynFlags (ppr x) style
    style = mkUserStyle unsafeGlobalDynFlags neverQualify AllTheWay

-- | Get ALL source spans in the source.
-listifyAllSpans :: (Typeable a, Data m) => m -> [Located a]
-listifyAllSpans tcs =
-  Data.Generics.listify p tcs
-  where p (L spn _) = isGoodSrcSpan spn
-- This is a version of `listifyAllSpans` specialized on picking out
-- patterns.  It comes about since GHC now defines `type LPat p = Pat
-- p` (no top-level locations).
-listifyAllSpans' :: Typeable a
-                   => TypecheckedSource -> [Pat a]
-listifyAllSpans' tcs = Data.Generics.listify (const True) tcs
-
 -- From haskell-ide-engine/src/Haskell/Ide/Engine/Support/HieExtras.hs
 safeTyThingType :: TyThing -> Maybe Type
 safeTyThingType thing
@ -68,13 +63,15 @@ safeTyThingId _                           = Nothing
 data SpanDoc
  = SpanDocString HsDocString SpanDocUris
  | SpanDocText   [T.Text] SpanDocUris
-  deriving (Eq, Show)
+  deriving stock (Eq, Show, Generic)
+  deriving anyclass NFData

 data SpanDocUris =
  SpanDocUris
  { spanDocUriDoc :: Maybe T.Text -- ^ The haddock html page
  , spanDocUriSrc :: Maybe T.Text -- ^ The hyperlinked source html page
-  } deriving (Eq, Show)
+  } deriving stock (Eq, Show, Generic)
+    deriving anyclass NFData

 emptySpanDoc :: SpanDoc
 emptySpanDoc = SpanDocText [] (SpanDocUris Nothing Nothing)
--- a/src/Development/IDE/Spans/Documentation.hs
+++ b/src/Development/IDE/Spans/Documentation.hs
@ -9,6 +9,8 @@ module Development.IDE.Spans.Documentation (
    getDocumentation
  , getDocumentationTryGhc
  , getDocumentationsTryGhc
+  , DocMap
+  , mkDocMap
  ) where

 import           Control.Monad
@ -16,6 +18,7 @@ import           Control.Monad.Extra (findM)
 import           Data.Foldable
 import           Data.List.Extra
 import qualified Data.Map as M
+import qualified Data.Set as S
 import           Data.Maybe
 import qualified Data.Text as T
 #if MIN_GHC_API_VERSION(8,6,0)
@ -24,6 +27,7 @@ import           Development.IDE.Core.Compile
 import           Development.IDE.GHC.Compat
 import           Development.IDE.GHC.Error
 import           Development.IDE.Spans.Common
+import           Development.IDE.Core.RuleTypes
 import           System.Directory
 import           System.FilePath

@ -33,12 +37,42 @@ import           GhcMonad
 import           Packages
 import           Name
 import           Language.Haskell.LSP.Types (getUri, filePathToUri)
+import Data.Either
+
+mkDocMap
+  :: GhcMonad m
+  => [ParsedModule]
+  -> RefMap
+  -> ModIface
+  -> [ModIface]
+  -> m DocAndKindMap
+mkDocMap sources rm hmi deps =
+  do mapM_ (`loadDepModule` Nothing) (reverse deps)
+     loadDepModule hmi Nothing
+     d <- foldrM getDocs M.empty names
+     k <- foldrM getType M.empty names
+     pure $ DKMap d k
+  where
+    getDocs n map = do
+      doc <- getDocumentationTryGhc mod sources n
+      pure $ M.insert n doc map
+    getType n map
+      | isTcOcc $ occName n = do
+        kind <- lookupKind mod n
+        pure $ maybe id (M.insert n) kind map
+      | otherwise = pure map
+    names = rights $ S.toList idents
+    idents = M.keysSet rm
+    mod = mi_module hmi
+
+lookupKind :: GhcMonad m => Module -> Name -> m (Maybe Type)
+lookupKind mod =
+    fmap (either (const Nothing) (safeTyThingType =<<)) . catchSrcErrors "span" . lookupName mod

 getDocumentationTryGhc :: GhcMonad m => Module -> [ParsedModule] -> Name -> m SpanDoc
 getDocumentationTryGhc mod deps n = head <$> getDocumentationsTryGhc mod deps [n]

 getDocumentationsTryGhc :: GhcMonad m => Module -> [ParsedModule] -> [Name] -> m [SpanDoc]
-
 -- Interfaces are only generated for GHC >= 8.6.
 -- In older versions, interface files do not embed Haddocks anyway
 #if MIN_GHC_API_VERSION(8,6,0)
--- a/src/Development/IDE/Spans/LocalBindings.hs
+++ b/src/Development/IDE/Spans/LocalBindings.hs
@ -0,0 +1,77 @@
+{-# LANGUAGE DerivingStrategies         #-}
+
+module Development.IDE.Spans.LocalBindings
+  ( Bindings
+  , getLocalScope
+  , getFuzzyScope
+  , bindings
+  ) where
+
+import           Control.DeepSeq
+import           Data.IntervalMap.FingerTree (IntervalMap, Interval (..))
+import qualified Data.IntervalMap.FingerTree as IM
+import qualified Data.Map as M
+import qualified Data.Set as S
+import qualified Data.List as L
+import           Development.IDE.GHC.Compat (RefMap, identType, identInfo, getScopeFromContext, Scope(..), Name, Type)
+import           Development.IDE.Types.Location
+import           Development.IDE.GHC.Error
+import           SrcLoc
+import           NameEnv
+
+------------------------------------------------------------------------------
+-- | Turn a 'RealSrcSpan' into an 'Interval'.
+realSrcSpanToInterval :: RealSrcSpan -> Interval Position
+realSrcSpanToInterval rss =
+  Interval
+    (realSrcLocToPosition $ realSrcSpanStart rss)
+    (realSrcLocToPosition $ realSrcSpanEnd   rss)
+
+------------------------------------------------------------------------------
+-- | Compute which identifiers are in scope at every point in the AST. Use
+-- 'getLocalScope' to find the results.
+bindings :: RefMap -> Bindings
+bindings refmap = Bindings $ L.foldl' (flip (uncurry IM.insert)) mempty  $ do
+  (ident, refs)      <- M.toList refmap
+  Right name         <- pure ident
+  (_, ident_details) <- refs
+  let ty = identType ident_details
+  info        <- S.toList $ identInfo ident_details
+  Just scopes <- pure $ getScopeFromContext info
+  scope <- scopes >>= \case
+    LocalScope scope -> pure $ realSrcSpanToInterval scope
+    _ -> []
+  pure ( scope
+       , unitNameEnv name (name,ty)
+       )
+
+------------------------------------------------------------------------------
+-- | The available bindings at every point in a Haskell tree.
+newtype Bindings = Bindings
+  { getBindings :: IntervalMap Position (NameEnv (Name, Maybe Type))
+  } deriving newtype (Semigroup, Monoid)
+instance NFData Bindings where
+    rnf = rwhnf
+instance Show Bindings where
+    show _ = "<bindings>"
+
+
+------------------------------------------------------------------------------
+-- | Given a 'Bindings' get every identifier in scope at the given
+-- 'RealSrcSpan',
+getLocalScope :: Bindings -> RealSrcSpan -> [(Name, Maybe Type)]
+getLocalScope bs rss
+  = nameEnvElts
+  $ foldMap snd
+  $ IM.dominators (realSrcSpanToInterval rss)
+  $ getBindings bs
+
+-- | Lookup all names in scope in any span that intersects the interval
+-- defined by the two positions.
+-- This is meant for use with the fuzzy `PositionRange` returned by `PositionMapping`
+getFuzzyScope :: Bindings -> Position -> Position -> [(Name, Maybe Type)]
+getFuzzyScope bs a b
+  = nameEnvElts
+  $ foldMap snd
+  $ IM.intersections (Interval a b)
+  $ getBindings bs
--- a/src/Development/IDE/Spans/Type.hs
+++ b/src/Development/IDE/Spans/Type.hs
@ -1,77 +0,0 @@
-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0
-
-- ORIGINALLY COPIED FROM https://github.com/commercialhaskell/intero
-
-- | Types used separate to GHCi vanilla.
-
-module Development.IDE.Spans.Type(
-    SpansInfo(..)
-  , SpanInfo(..)
-  , SpanSource(..)
-  , getNameM
-  ) where
-
-import GHC
-import Control.DeepSeq
-import OccName
-import Development.IDE.GHC.Util
-import Development.IDE.Spans.Common
-
-data SpansInfo =
-  SpansInfo { spansExprs       :: [SpanInfo]
-            , spansConstraints :: [SpanInfo] }
-  deriving Show
-
-instance NFData SpansInfo where
-  rnf (SpansInfo e c) = liftRnf rnf e `seq` liftRnf rnf c
-
-- | Type of some span of source code. Most of these fields are
-- unboxed but Haddock doesn't show that.
-data SpanInfo =
-  SpanInfo {spaninfoStartLine :: {-# UNPACK #-} !Int
-            -- ^ Start line of the span, zero-based.
-           ,spaninfoStartCol :: {-# UNPACK #-} !Int
-            -- ^ Start column of the span, zero-based.
-           ,spaninfoEndLine :: {-# UNPACK #-} !Int
-            -- ^ End line of the span (absolute), zero-based.
-           ,spaninfoEndCol :: {-# UNPACK #-} !Int
-            -- ^ End column of the span (absolute), zero-based.
-           ,spaninfoType :: !(Maybe Type)
-            -- ^ A pretty-printed representation for the type.
-           ,spaninfoSource :: !SpanSource
-           -- ^ The actutal 'Name' associated with the span, if
-            -- any. This can be useful for accessing a variety of
-            -- information about the identifier such as module,
-            -- locality, definition location, etc.
-           ,spaninfoDocs :: !SpanDoc
-           -- ^ Documentation for the element
-           }
-instance Show SpanInfo where
-  show (SpanInfo sl sc el ec t n docs) =
-    unwords ["(SpanInfo", show sl, show sc, show el, show ec
-            , show $ maybe "NoType" prettyPrint t, "(" <> show n <> "))"
-            , "docs(" <> show docs <> ")"]
-
-instance NFData SpanInfo where
-    rnf = rwhnf
-
-
-- we don't always get a name out so sometimes manually annotating source is more appropriate
-data SpanSource = Named Name
-                | SpanS SrcSpan
-                | Lit String
-                | NoSource
-  deriving (Eq)
-
-instance Show SpanSource where
-  show = \case
-    Named n -> "Named " ++ occNameString (occName n)
-    SpanS sp -> "Span " ++ show sp
-    Lit lit -> "Lit " ++ lit
-    NoSource -> "NoSource"
-
-getNameM :: SpanSource -> Maybe Name
-getNameM = \case
-  Named name -> Just name
-  _ -> Nothing
--- a/test/exe/Main.hs
+++ b/test/exe/Main.hs
@ -75,6 +75,7 @@ main = do
    , codeActionTests
    , codeLensesTests
    , outlineTests
+    , highlightTests
    , findDefinitionAndHoverTests
    , pluginSimpleTests
    , pluginParsedResultTests
@ -117,7 +118,7 @@ initializeResponseTests = withResource acquire release tests where
    -- for now
    , chk "NO goto implementation"  _implementationProvider (Just $ GotoOptionsStatic True)
    , chk "NO find references"          _referencesProvider  Nothing
-    , chk "NO doc highlight"     _documentHighlightProvider  Nothing
+    , chk "   doc highlight"     _documentHighlightProvider  (Just True)
    , chk "   doc symbol"           _documentSymbolProvider  (Just True)
    , chk "NO workspace symbol"    _workspaceSymbolProvider  Nothing
    , chk "   code action"             _codeActionProvider $ Just $ CodeActionOptionsStatic True
@ -2193,7 +2194,7 @@ findDefinitionAndHoverTests = let
  opL18  = Position 22 22  ;  opp    = [mkR  22 13   22 17]
  aL18   = Position 22 20  ;  apmp   = [mkR  22 10   22 11]
  b'L19  = Position 23 13  ;  bp     = [mkR  23  6   23  7]
-  xvL20  = Position 24  8  ;  xvMsg  = [ExpectExternFail,   ExpectHoverText ["Data.Text.pack", ":: String -> Text"]]
+  xvL20  = Position 24  8  ;  xvMsg  = [ExpectExternFail,   ExpectHoverText ["pack", ":: String -> Text", "Data.Text"]]
  clL23  = Position 27 11  ;  cls    = [mkR  25  0   26 20, ExpectHoverText ["MyClass", "GotoHover.hs:26:1"]]
  clL25  = Position 29  9
  eclL15 = Position 19  8  ;  ecls   = [ExpectExternFail, ExpectHoverText ["Num", "Defined in 'GHC.Num'"]]
@ -2227,7 +2228,7 @@ findDefinitionAndHoverTests = let
  mkFindTests
  --      def    hover  look       expect
  [ test  yes    yes    fffL4      fff           "field in record definition"
-  , test  broken broken fffL8      fff           "field in record construction     #71"
+  , test  yes    yes    fffL8      fff           "field in record construction     #71"
  , test  yes    yes    fffL14     fff           "field name used as accessor"          -- 120 in Calculate.hs
  , test  yes    yes    aaaL14     aaa           "top-level name"                       -- 120
  , test  yes    yes    dcL7       tcDC          "data constructor record         #247"
@ -2249,16 +2250,20 @@ findDefinitionAndHoverTests = let
  , test  yes    yes    lclL33     lcb           "listcomp lookup"
  , test  yes    yes    mclL36     mcl           "top-level fn 1st clause"
  , test  yes    yes    mclL37     mcl           "top-level fn 2nd clause         #246"
+#if MIN_GHC_API_VERSION(8,10,0)
  , test  yes    yes    spaceL37   space         "top-level fn on space #315"
+#else
+  , test  yes    broken spaceL37   space         "top-level fn on space #315"
+#endif
  , test  no     yes    docL41     doc           "documentation                     #7"
  , test  no     yes    eitL40     kindE         "kind of Either                  #273"
  , test  no     yes    intL40     kindI         "kind of Int                     #273"
  , test  no     broken tvrL40     kindV         "kind of (* -> *) type variable  #273"
-  , test  no     yes    intL41     litI          "literal Int  in hover info      #274"
-  , test  no     yes    chrL36     litC          "literal Char in hover info      #274"
-  , test  no     yes    txtL8      litT          "literal Text in hover info      #274"
-  , test  no     yes    lstL43     litL          "literal List in hover info      #274"
-  , test  no     yes    docL41     constr        "type constraint in hover info   #283"
+  , test  no     broken intL41     litI          "literal Int  in hover info      #274"
+  , test  no     broken chrL36     litC          "literal Char in hover info      #274"
+  , test  no     broken txtL8      litT          "literal Text in hover info      #274"
+  , test  no     broken lstL43     litL          "literal List in hover info      #274"
+  , test  no     broken docL41     constr        "type constraint in hover info   #283"
  , test  broken broken outL45     outSig        "top-level signature             #310"
  , test  broken broken innL48     innSig        "inner     signature             #310"
  , test  no     yes    cccL17     docLink       "Haddock html links"
@ -2524,6 +2529,7 @@ completionTests :: TestTree
 completionTests
  = testGroup "completion"
    [ testGroup "non local" nonLocalCompletionTests
+    , testGroup "topLevel" topLevelCompletionTests
    , testGroup "local" localCompletionTests
    , testGroup "other" otherCompletionTests
    ]
@ -2542,8 +2548,8 @@ completionTest name src pos expected = testSessionWait name $ do
            when expectedDocs $
                assertBool ("Missing docs: " <> T.unpack _label) (isJust _documentation)

-localCompletionTests :: [TestTree]
-localCompletionTests = [
+topLevelCompletionTests :: [TestTree]
+topLevelCompletionTests = [
    completionTest
        "variable"
        ["bar = xx", "-- | haddock", "xxx :: ()", "xxx = ()", "-- | haddock", "data Xxx = XxxCon"]
@ -2586,6 +2592,67 @@ localCompletionTests = [
        [("XyRecord", CiConstructor, False, True)]
    ]

+localCompletionTests :: [TestTree]
+localCompletionTests = [
+    completionTest
+        "argument"
+        ["bar (Just abcdef) abcdefg = abcd"]
+        (Position 0 32)
+        [("abcdef", CiFunction, True, False),
+         ("abcdefg", CiFunction , True, False)
+        ],
+    completionTest
+        "let"
+        ["bar = let (Just abcdef) = undefined"
+        ,"          abcdefg = let abcd = undefined in undefined"
+        ,"        in abcd"
+        ]
+        (Position 2 15)
+        [("abcdef", CiFunction, True, False),
+         ("abcdefg", CiFunction , True, False)
+        ],
+    completionTest
+        "where"
+        ["bar = abcd"
+        ,"  where (Just abcdef) = undefined"
+        ,"        abcdefg = let abcd = undefined in undefined"
+        ]
+        (Position 0 10)
+        [("abcdef", CiFunction, True, False),
+         ("abcdefg", CiFunction , True, False)
+        ],
+    completionTest
+        "do/1"
+        ["bar = do"
+        ,"  Just abcdef <- undefined"
+        ,"  abcd"
+        ,"  abcdefg <- undefined"
+        ,"  pure ()"
+        ]
+        (Position 2 6)
+        [("abcdef", CiFunction, True, False)
+        ],
+    completionTest
+        "do/2"
+        ["bar abcde = do"
+        ,"    Just [(abcdef,_)] <- undefined"
+        ,"    abcdefg <- undefined"
+        ,"    let abcdefgh = undefined"
+        ,"        (Just [abcdefghi]) = undefined"
+        ,"    abcd"
+        ,"  where"
+        ,"    abcdefghij = undefined"
+        ]
+        (Position 5 8)
+        [("abcde", CiFunction, True, False)
+        ,("abcdefghij", CiFunction, True, False)
+        ,("abcdef", CiFunction, True, False)
+        ,("abcdefg", CiFunction, True, False)
+        ,("abcdefgh", CiFunction, True, False)
+        ,("abcdefghi", CiFunction, True, False)
+        ]
+    ]
+
 nonLocalCompletionTests :: [TestTree]
 nonLocalCompletionTests =
  [ completionTest
@ -2636,6 +2703,76 @@ otherCompletionTests = [
      [("Integer", CiStruct, True, True)]
  ]

+highlightTests :: TestTree
+highlightTests = testGroup "highlight"
+  [ testSessionWait "value" $ do
+    doc <- createDoc "A.hs" "haskell" source
+    _ <- waitForDiagnostics
+    highlights <- getHighlights doc (Position 2 2)
+    liftIO $ highlights @?=
+            [ DocumentHighlight (R 1 0 1 3) (Just HkRead)
+            , DocumentHighlight (R 2 0 2 3) (Just HkWrite)
+            , DocumentHighlight (R 3 6 3 9) (Just HkRead)
+            , DocumentHighlight (R 4 22 4 25) (Just HkRead)
+            ]
+  , testSessionWait "type" $ do
+    doc <- createDoc "A.hs" "haskell" source
+    _ <- waitForDiagnostics
+    highlights <- getHighlights doc (Position 1 8)
+    liftIO $ highlights @?=
+            [ DocumentHighlight (R 1 7 1 10) (Just HkRead)
+            , DocumentHighlight (R 2 11 2 14) (Just HkRead)
+            ]
+  , testSessionWait "local" $ do
+    doc <- createDoc "A.hs" "haskell" source
+    _ <- waitForDiagnostics
+    highlights <- getHighlights doc (Position 5 5)
+    liftIO $ highlights @?=
+            [ DocumentHighlight (R 5 4 5 7) (Just HkWrite)
+            , DocumentHighlight (R 5 10 5 13) (Just HkRead)
+            , DocumentHighlight (R 6 12 6 15) (Just HkRead)
+            ]
+  , testSessionWait "record" $ do
+    doc <- createDoc "A.hs" "haskell" recsource
+    _ <- waitForDiagnostics
+    highlights <- getHighlights doc (Position 3 15)
+    liftIO $ highlights @?=
+      -- Span is just the .. on 8.10, but Rec{..} before
+#if MIN_GHC_API_VERSION(8,10,0)
+            [ DocumentHighlight (R 3 8 3 10) (Just HkWrite)
+#else
+            [ DocumentHighlight (R 3 4 3 11) (Just HkWrite)
+#endif
+            , DocumentHighlight (R 3 14 3 20) (Just HkRead)
+            ]
+    highlights <- getHighlights doc (Position 2 17)
+    liftIO $ highlights @?=
+            [ DocumentHighlight (R 2 17 2 23) (Just HkWrite)
+      -- Span is just the .. on 8.10, but Rec{..} before
+#if MIN_GHC_API_VERSION(8,10,0)
+            , DocumentHighlight (R 3 8 3 10) (Just HkRead)
+#else
+            , DocumentHighlight (R 3 4 3 11) (Just HkRead)
+#endif
+            ]
+  ]
+  where
+    source = T.unlines
+      ["module Highlight where"
+      ,"foo :: Int"
+      ,"foo = 3 :: Int"
+      ,"bar = foo"
+      ,"  where baz = let x = foo in x"
+      ,"baz arg = arg + x"
+      ,"  where x = arg"
+      ]
+    recsource = T.unlines
+      ["{-# LANGUAGE RecordWildCards #-}"
+      ,"module Highlight where"
+      ,"data Rec = Rec { field1 :: Int, field2 :: Char }"
+      ,"foo Rec{..} = field2 + field1"
+      ]
+
 outlineTests :: TestTree
 outlineTests = testGroup
  "outline"