refactor selection range plugin (#3003)

* update Gitpod config * update nix shellHook & docs * install pre-commit hook * add kokobd as code owner to .gitpod.* * add gen-hie to Gitpod * add tools for doc * remove .pre-commit-config.yaml from .gitignore * set vscode formatter to stylish-haskell in Gitpod * refactor selection range plugin * refine selection range * add CodeKind to CodeRange * rename hls-selection-range-plugin to hls-code-range-plugin * update docs about selection range * cleanup RuleTypes.hs * add the missing bang pattern * fix subRange * add some unit tests to CodeRange.Rules * add tests for removeInterleaving * add even more tests * fix extra sources Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com>
haskell · Jul 11, 2022 · 445192e · 445192e
1 parent b747aa0
commit 445192e
Show file tree

Hide file tree

Showing 30 changed files with 762 additions and 351 deletions.
diff --git a/.github/workflows/hackage.yml b/.github/workflows/hackage.yml
@@ -36,7 +36,7 @@ jobs:
                   "hls-refine-imports-plugin", "hls-rename-plugin", "hls-retrie-plugin",
                   "hls-splice-plugin", "hls-tactics-plugin",
                   "hls-call-hierarchy-plugin", "hls-alternate-number-format-plugin",
-                  "hls-qualify-imported-names-plugin", "hls-selection-range-plugin",
+                  "hls-qualify-imported-names-plugin", "hls-code-range-plugin",
                   "haskell-language-server"]
         ghc: [ "9.0.2"
              , "8.10.7"

diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml
@@ -236,8 +236,8 @@ jobs:
         run: cabal test hls-qualify-imported-names-plugin --test-options="$TEST_OPTS" || cabal test hls-qualify-imported-names-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-qualify-imported-names-plugin --test-options="$TEST_OPTS"
 
       - if: matrix.test
-        name: Test hls-selection-range-plugin test suite
-        run: cabal test hls-selection-range-plugin --test-options="$TEST_OPTS" || cabal test hls-selection-range-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-selection-range-plugin --test-options="$TEST_OPTS"
+        name: Test hls-code-range-plugin test suite
+        run: cabal test hls-code-range-plugin --test-options="$TEST_OPTS" || cabal test hls-code-range-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-code-range-plugin --test-options="$TEST_OPTS"
 
       - if: matrix.test
         name: Test hls-change-type-signature test suite

diff --git a/CODEOWNERS b/CODEOWNERS
@@ -25,7 +25,7 @@
 /plugins/hls-refine-imports-plugin
 /plugins/hls-rename-plugin @OliverMadine
 /plugins/hls-retrie-plugin @pepeiborra
-/plugins/hls-selection-range-plugin @kokobd
+/plugins/hls-code-range-plugin @kokobd
 /plugins/hls-splice-plugin @konn
 /plugins/hls-stylish-haskell-plugin @Ailrun
 /plugins/hls-tactics-plugin @isovector

diff --git a/cabal.project b/cabal.project
@@ -26,7 +26,7 @@ packages:
          ./plugins/hls-call-hierarchy-plugin
          ./plugins/hls-alternate-number-format-plugin
          ./plugins/hls-qualify-imported-names-plugin
-         ./plugins/hls-selection-range-plugin
+         ./plugins/hls-code-range-plugin
          ./plugins/hls-change-type-signature-plugin
          ./plugins/hls-gadt-plugin
 

diff --git a/docs/features.md b/docs/features.md
@@ -317,13 +317,13 @@ Shows module name matching file path, and applies it with a click.
 
 ## Selection range
 
-Provided by: `hls-selection-range-plugin`
+Provided by: `hls-code-range-plugin`
 
 Provides haskell specific
-[shrink/expand selection](https://code.visualstudio.com/docs/editor/codebasics#shrinkexpand-selection)
+[shrink/expand selection](https://code.visualstudio.com/docs/editor/codebasics#_shrinkexpand-selection)
 support.
 
-![Selection range demo](https://user-images.githubusercontent.com/16440269/150301502-4c002605-9f8d-43f5-86d3-28846942c4ff.mov)
+![Selection range demo](https://user-images.githubusercontent.com/16440269/177240833-7dc8fe39-b446-477e-b5b1-7fc303608d4f.gif)
 
 ## Rename
 

diff --git a/docs/supported-versions.md b/docs/supported-versions.md
@@ -68,7 +68,7 @@ Sometimes a plugin will be supported in the pre-built binaries but not in a HLS
 | `hls-splice-plugin`                 | 9.2                      |
 | `hls-stylish-haskell-plugin`        |                          |
 | `hls-tactics-plugin`                | 9.2                      |
-| `hls-selection-range-plugin`        |                          |
+| `hls-code-range-plugin`             |                          |
 | `hls-gadt-plugin`                   |                          |
 
 ### Using deprecated GHC versions

diff --git a/exe/Plugins.hs b/exe/Plugins.hs
@@ -76,8 +76,8 @@ import qualified Ide.Plugin.Splice                 as Splice
 import qualified Ide.Plugin.AlternateNumberFormat  as AlternateNumberFormat
 #endif
 
-#if selectionRange
-import           Ide.Plugin.SelectionRange         as SelectionRange
+#if codeRange
+import qualified Ide.Plugin.CodeRange              as CodeRange
 #endif
 
 #if changeTypeSignature
@@ -190,8 +190,8 @@ idePlugins recorder includeExamples = pluginDescToIdePlugins allPlugins
 #if alternateNumberFormat
       AlternateNumberFormat.descriptor pluginRecorder :
 #endif
-#if selectionRange
-      SelectionRange.descriptor "selectionRange" :
+#if codeRange
+      CodeRange.descriptor pluginRecorder "codeRange" :
 #endif
 #if changeTypeSignature
       ChangeTypeSignature.descriptor :

diff --git a/ghcide/src/Development/IDE/Core/RuleTypes.hs b/ghcide/src/Development/IDE/Core/RuleTypes.hs
@@ -35,7 +35,6 @@ import           Development.IDE.Types.HscEnvEq               (HscEnvEq)
 import           Development.IDE.Types.KnownTargets
 import           GHC.Generics                                 (Generic)
 
-import qualified Data.Binary                                  as B
 import           Data.ByteString                              (ByteString)
 import           Data.Text                                    (Text)
 import           Development.IDE.Import.FindImports           (ArtifactsLocation)
@@ -173,17 +172,17 @@ tmrModSummary :: TcModuleResult -> ModSummary
 tmrModSummary = pm_mod_summary . tmrParsed
 
 data HiFileResult = HiFileResult
-    { hirModSummary :: !ModSummary
+    { hirModSummary     :: !ModSummary
     -- Bang patterns here are important to stop the result retaining
     -- a reference to a typechecked module
-    , hirModIface   :: !ModIface
-    , hirModDetails :: ModDetails
+    , hirModIface       :: !ModIface
+    , hirModDetails     :: ModDetails
     -- ^ Populated lazily
-    , hirIfaceFp    :: !ByteString
+    , hirIfaceFp        :: !ByteString
     -- ^ Fingerprint for the ModIface
     , hirRuntimeModules :: !(ModuleEnv ByteString)
     -- ^ same as tmrRuntimeModules
-    , hirCoreFp     :: !(Maybe (CoreFile, ByteString))
+    , hirCoreFp         :: !(Maybe (CoreFile, ByteString))
     -- ^ If we wrote a core file for this module, then its contents (lazily deserialised)
     -- along with its hash
     }
@@ -445,7 +444,7 @@ newtype GhcSessionDeps = GhcSessionDeps_
 
 instance Show GhcSessionDeps where
     show (GhcSessionDeps_ False) = "GhcSessionDeps"
-    show (GhcSessionDeps_ True) = "GhcSessionDepsFull"
+    show (GhcSessionDeps_ True)  = "GhcSessionDepsFull"
 
 pattern GhcSessionDeps :: GhcSessionDeps
 pattern GhcSessionDeps = GhcSessionDeps_ False

diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs
@@ -32,10 +32,14 @@ module Development.IDE.GHC.Compat(
     myCoreToStgExpr,
 #endif
 
+    FastStringCompat,
     nodeInfo',
     getNodeIds,
-    nodeInfoFromSource,
+    sourceNodeInfo,
+    generatedNodeInfo,
+    simpleNodeInfoCompat,
     isAnnotationInNodeInfo,
+    nodeAnnotations,
     mkAstNode,
     combineRealSrcSpans,
 
@@ -94,7 +98,6 @@ module Development.IDE.GHC.Compat(
     module UniqSet,
     module UniqDFM,
     getDependentMods,
-    diffBinds,
     flattenBinds,
     mkRnEnv2,
     emptyInScopeSet,
@@ -113,6 +116,7 @@ module Development.IDE.GHC.Compat(
 #endif
     ) where
 
+import           Data.Bifunctor
 import           Development.IDE.GHC.Compat.Core
 import           Development.IDE.GHC.Compat.Env
 import           Development.IDE.GHC.Compat.ExactPrint
@@ -125,58 +129,74 @@ import           Development.IDE.GHC.Compat.Units
 import           Development.IDE.GHC.Compat.Util
 import           GHC                                   hiding (HasSrcSpan,
                                                         ModLocation,
-                                                        RealSrcSpan, getLoc,
-                                                        lookupName, exprType)
+                                                        RealSrcSpan, exprType,
+                                                        getLoc, lookupName)
+
+import           Data.Coerce                           (coerce)
+import           Data.String                           (IsString (fromString))
+
+
 #if MIN_VERSION_ghc(9,0,0)
-import GHC.Driver.Hooks (hscCompileCoreExprHook)
-import GHC.Core (CoreExpr, CoreProgram, Unfolding(..), noUnfolding, flattenBinds)
-import qualified GHC.Core.Opt.Pipeline as GHC
-import GHC.Core.Tidy (tidyExpr)
-import GHC.Types.Var.Env (emptyTidyEnv, mkRnEnv2, emptyInScopeSet)
-import qualified GHC.CoreToStg.Prep as GHC
-import GHC.CoreToStg.Prep (corePrepPgm)
-import GHC.Core.Lint (lintInteractiveExpr)
+import           GHC.Core.Lint                         (lintInteractiveExpr)
+import qualified GHC.Core.Opt.Pipeline                 as GHC
+import           GHC.Core.Tidy                         (tidyExpr)
+import           GHC.CoreToStg.Prep                    (corePrepPgm)
+import qualified GHC.CoreToStg.Prep                    as GHC
+import           GHC.Driver.Hooks                      (hscCompileCoreExprHook)
 #if MIN_VERSION_ghc(9,2,0)
-import GHC.Unit.Home.ModInfo (lookupHpt, HomePackageTable)
-import GHC.Runtime.Context (icInteractiveModule)
-import GHC.Unit.Module.Deps (Dependencies(dep_mods))
-import GHC.Linker.Types (isObjectLinkable)
-import GHC.Linker.Loader (loadExpr)
+import           GHC.Linker.Loader                     (loadExpr)
+import           GHC.Linker.Types                      (isObjectLinkable)
+import           GHC.Runtime.Context                   (icInteractiveModule)
+import           GHC.Unit.Home.ModInfo                 (HomePackageTable,
+                                                        lookupHpt)
+import           GHC.Unit.Module.Deps                  (Dependencies (dep_mods))
 #else
-import GHC.CoreToByteCode (coreExprToBCOs)
-import GHC.Driver.Types (Dependencies(dep_mods), icInteractiveModule, lookupHpt, HomePackageTable)
-import GHC.Runtime.Linker (linkExpr)
-#endif
-import GHC.ByteCode.Asm (bcoFreeNames)
-import GHC.Types.Annotations (Annotation(..), AnnTarget(ModuleTarget), extendAnnEnvList)
-import GHC.Types.Unique.DSet as UniqDSet
-import GHC.Types.Unique.Set as UniqSet
-import GHC.Types.Unique.DFM  as UniqDFM
+import           GHC.CoreToByteCode                    (coreExprToBCOs)
+import           GHC.Driver.Types                      (Dependencies (dep_mods),
+                                                        HomePackageTable,
+                                                        icInteractiveModule,
+                                                        lookupHpt)
+import           GHC.Runtime.Linker                    (linkExpr)
+#endif
+import           GHC.ByteCode.Asm                      (bcoFreeNames)
+import           GHC.Types.Annotations                 (AnnTarget (ModuleTarget),
+                                                        Annotation (..),
+                                                        extendAnnEnvList)
+import           GHC.Types.Unique.DFM                  as UniqDFM
+import           GHC.Types.Unique.DSet                 as UniqDSet
+import           GHC.Types.Unique.Set                  as UniqSet
 #else
-import Hooks (hscCompileCoreExprHook)
-import CoreSyn (CoreExpr, flattenBinds, Unfolding(..), noUnfolding)
-import qualified SimplCore as GHC
-import CoreTidy (tidyExpr)
-import VarEnv (emptyTidyEnv, mkRnEnv2, emptyInScopeSet)
-import CorePrep (corePrepExpr, corePrepPgm)
-import CoreLint (lintInteractiveExpr)
-import ByteCodeGen (coreExprToBCOs)
-import HscTypes (icInteractiveModule, HomePackageTable, lookupHpt, Dependencies(dep_mods))
-import Linker (linkExpr)
-import ByteCodeAsm (bcoFreeNames)
-import Annotations (Annotation(..), AnnTarget(ModuleTarget), extendAnnEnvList)
-import UniqDSet
-import UniqSet
-import UniqDFM
+import           Annotations                           (AnnTarget (ModuleTarget),
+                                                        Annotation (..),
+                                                        extendAnnEnvList)
+import           ByteCodeAsm                           (bcoFreeNames)
+import           ByteCodeGen                           (coreExprToBCOs)
+import           CoreLint                              (lintInteractiveExpr)
+import           CorePrep                              (corePrepExpr,
+                                                        corePrepPgm)
+import           CoreSyn                               (CoreExpr,
+                                                        Unfolding (..),
+                                                        flattenBinds,
+                                                        noUnfolding)
+import           CoreTidy                              (tidyExpr)
+import           Hooks                                 (hscCompileCoreExprHook)
+import           Linker                                (linkExpr)
+import qualified SimplCore                             as GHC
+import           UniqDFM
+import           UniqDSet
+import           UniqSet
+import           VarEnv                                (emptyInScopeSet,
+                                                        emptyTidyEnv, mkRnEnv2)
 #endif
 
 #if MIN_VERSION_ghc(9,0,0)
+import           GHC.Core
 import           GHC.Data.StringBuffer
 import           GHC.Driver.Session                    hiding (ExposePackage)
 import qualified GHC.Types.SrcLoc                      as SrcLoc
+import           GHC.Types.Var.Env
 import           GHC.Utils.Error
 #if MIN_VERSION_ghc(9,2,0)
-import           Data.Bifunctor
 import           GHC.Driver.Env                        as Env
 import           GHC.Unit.Module.ModIface
 import           GHC.Unit.Module.ModSummary
@@ -209,41 +229,32 @@ import           System.IO
 
 import           Compat.HieAst                         (enrichHie)
 import           Compat.HieBin
-import           Compat.HieTypes
+import           Compat.HieTypes                       hiding (nodeAnnotations)
+import qualified Compat.HieTypes                       as GHC (nodeAnnotations)
 import           Compat.HieUtils
 import qualified Data.ByteString                       as BS
 import           Data.IORef
 
 import           Data.List                             (foldl')
 import qualified Data.Map                              as Map
-import qualified Data.Set                              as Set
-
-#if MIN_VERSION_ghc(9,0,0)
 import qualified Data.Set                              as S
-#endif
 
 #if !MIN_VERSION_ghc(8,10,0)
 import           Bag                                   (unitBag)
 #endif
 
 #if MIN_VERSION_ghc(9,2,0)
-import GHC.Types.CostCentre
-import GHC.Stg.Syntax
-import GHC.Types.IPE
-import GHC.Stg.Syntax
-import GHC.Types.IPE
-import GHC.Types.CostCentre
-import GHC.Core
-import GHC.Builtin.Uniques
-import GHC.Runtime.Interpreter
-import GHC.StgToByteCode
-import GHC.Stg.Pipeline
-import GHC.ByteCode.Types
-import GHC.Linker.Loader (loadDecls)
-import GHC.Data.Maybe
-import GHC.CoreToStg
-import GHC.Core.Utils
-import GHC.Types.Var.Env
+import           GHC.Builtin.Uniques
+import           GHC.ByteCode.Types
+import           GHC.CoreToStg
+import           GHC.Data.Maybe
+import           GHC.Linker.Loader                     (loadDecls)
+import           GHC.Runtime.Interpreter
+import           GHC.Stg.Pipeline
+import           GHC.Stg.Syntax
+import           GHC.StgToByteCode
+import           GHC.Types.CostCentre
+import           GHC.Types.IPE
 #endif
 
 type ModIfaceAnnotation = Annotation
@@ -506,11 +517,18 @@ nodeInfo' = nodeInfo
 -- unhelpfulSpanFS = id
 #endif
 
-nodeInfoFromSource :: HieAST a -> Maybe (NodeInfo a)
+sourceNodeInfo :: HieAST a -> Maybe (NodeInfo a)
+#if MIN_VERSION_ghc(9,0,0)
+sourceNodeInfo = Map.lookup SourceInfo . getSourcedNodeInfo . sourcedNodeInfo
+#else
+sourceNodeInfo = Just . nodeInfo
+#endif
+
+generatedNodeInfo :: HieAST a -> Maybe (NodeInfo a)
 #if MIN_VERSION_ghc(9,0,0)
-nodeInfoFromSource = Map.lookup SourceInfo . getSourcedNodeInfo . sourcedNodeInfo
+generatedNodeInfo = Map.lookup GeneratedInfo . getSourcedNodeInfo . sourcedNodeInfo
 #else
-nodeInfoFromSource = Just . nodeInfo
+generatedNodeInfo = sourceNodeInfo -- before ghc 9.0, we don't distinguish the source
 #endif
 
 data GhcVersion
@@ -553,11 +571,31 @@ runPp =
     const SysTools.runPp
 #endif
 
-isAnnotationInNodeInfo :: (FastString, FastString) -> NodeInfo a -> Bool
+simpleNodeInfoCompat :: FastStringCompat -> FastStringCompat -> NodeInfo a
+simpleNodeInfoCompat ctor typ = simpleNodeInfo (coerce ctor) (coerce typ)
+
+isAnnotationInNodeInfo :: (FastStringCompat, FastStringCompat) -> NodeInfo a -> Bool
+isAnnotationInNodeInfo p = S.member p . nodeAnnotations
+
+nodeAnnotations :: NodeInfo a -> S.Set (FastStringCompat, FastStringCompat)
+#if MIN_VERSION_ghc(9,2,0)
+nodeAnnotations = S.map (\(NodeAnnotation ctor typ) -> (coerce ctor, coerce typ)) . GHC.nodeAnnotations
+#else
+nodeAnnotations = S.map (bimap coerce coerce) . GHC.nodeAnnotations
+#endif
+
+#if MIN_VERSION_ghc(9,2,0)
+newtype FastStringCompat = FastStringCompat LexicalFastString
+#else
+newtype FastStringCompat = FastStringCompat FastString
+#endif
+    deriving (Show, Eq, Ord)
+
+instance IsString FastStringCompat where
 #if MIN_VERSION_ghc(9,2,0)
-isAnnotationInNodeInfo (ctor, typ) = Set.member (NodeAnnotation ctor typ) . nodeAnnotations
+    fromString = FastStringCompat . LexicalFastString . fromString
 #else
-isAnnotationInNodeInfo p = Set.member p . nodeAnnotations
+    fromString = FastStringCompat . fromString
 #endif
 
 mkAstNode :: NodeInfo a -> Span -> [HieAST a] -> HieAST a