refactor selection range plugin

exe/Plugins.hs

@@ -77,7 +77,7 @@ import qualified Ide.Plugin.AlternateNumberFormat  as AlternateNumberFormat
 #endif
 
 #if selectionRange
-import           Ide.Plugin.SelectionRange         as SelectionRange
+import qualified Ide.Plugin.SelectionRange         as SelectionRange
 #endif
 
 #if changeTypeSignature
@@ -191,7 +191,7 @@ idePlugins recorder includeExamples = pluginDescToIdePlugins allPlugins
       AlternateNumberFormat.descriptor pluginRecorder :
 #endif
 #if selectionRange
-      SelectionRange.descriptor "selectionRange" :
+      SelectionRange.descriptor pluginRecorder "selectionRange" :
 #endif
 #if changeTypeSignature
       ChangeTypeSignature.descriptor :

ghcide/src/Development/IDE/Core/RuleTypes.hs

@@ -28,7 +28,7 @@ import           Development.IDE.GHC.Compat                   hiding
                                                               (HieFileResult)
 import           Development.IDE.GHC.Compat.Util
 import           Development.IDE.GHC.CoreFile
-import           Development.IDE.GHC.Util
+import           Development.IDE.GHC.Util                     (fingerprintToBS)
 import           Development.IDE.Graph
 import           Development.IDE.Import.DependencyInformation
 import           Development.IDE.Types.HscEnvEq               (HscEnvEq)
@@ -173,17 +173,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 +445,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

plugins/hls-selection-range-plugin/hls-selection-range-plugin.cabal

@@ -23,6 +23,7 @@ extra-source-files:
 library
   exposed-modules:
     Ide.Plugin.SelectionRange
+    Ide.Plugin.SelectionRange.CodeRange
   other-modules:
     Ide.Plugin.SelectionRange.ASTPreProcess
   ghc-options: -Wall
@@ -40,6 +41,8 @@ library
     , text
     , extra
     , semigroupoids
+    , hashable
+    , deepseq
 
 test-suite tests
   type:             exitcode-stdio-1.0
@@ -53,6 +56,7 @@ test-suite tests
     , filepath
     , hls-selection-range-plugin
     , hls-test-utils             ^>=1.2 || ^>=1.3
+    , ghcide                     ^>=1.6 || ^>=1.7
     , lsp
     , lsp-test
     , text

plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange.hs

@@ -1,67 +1,66 @@
-{-# LANGUAGE NamedFieldPuns    #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards   #-}
 
-module Ide.Plugin.SelectionRange (descriptor) where
+module Ide.Plugin.SelectionRange (descriptor, Log) where
 
-import           Control.Monad.Except                    (ExceptT (ExceptT),
-                                                          runExceptT)
-import           Control.Monad.IO.Class                  (liftIO)
-import           Control.Monad.Reader                    (runReader)
-import           Control.Monad.Trans.Maybe               (MaybeT (MaybeT),
-                                                          maybeToExceptT)
-import           Data.Coerce                             (coerce)
-import           Data.Containers.ListUtils               (nubOrd)
-import           Data.Either.Extra                       (maybeToEither)
-import           Data.Foldable                           (find)
-import qualified Data.Map.Strict                         as Map
-import           Data.Maybe                              (fromMaybe, mapMaybe)
-import qualified Data.Text                               as T
-import           Development.IDE                         (GetHieAst (GetHieAst),
-                                                          HieAstResult (HAR, hieAst, refMap),
-                                                          IdeAction,
-                                                          IdeState (shakeExtras),
-                                                          Range (Range),
-                                                          fromNormalizedFilePath,
-                                                          ideLogger, logDebug,
-                                                          realSrcSpanToRange,
-                                                          runIdeAction,
-                                                          toNormalizedFilePath',
-                                                          uriToFilePath')
-import           Development.IDE.Core.Actions            (useE)
-import           Development.IDE.Core.PositionMapping    (PositionMapping,
-                                                          fromCurrentPosition,
-                                                          toCurrentRange)
-import           Development.IDE.GHC.Compat              (HieAST (Node), Span,
-                                                          getAsts)
-import           Development.IDE.GHC.Compat.Util
-import           Ide.Plugin.SelectionRange.ASTPreProcess (PreProcessEnv (PreProcessEnv),
-                                                          preProcessAST)
-import           Ide.PluginUtils                         (pluginResponse)
-import           Ide.Types                               (PluginDescriptor (pluginHandlers),
-                                                          PluginId,
-                                                          defaultPluginDescriptor,
-                                                          mkPluginHandler)
-import           Language.LSP.Server                     (LspM)
-import           Language.LSP.Types                      (List (List),
-                                                          NormalizedFilePath,
-                                                          Position,
-                                                          ResponseError,
-                                                          SMethod (STextDocumentSelectionRange),
-                                                          SelectionRange (..),
-                                                          SelectionRangeParams (..),
-                                                          TextDocumentIdentifier (TextDocumentIdentifier),
-                                                          Uri)
-import           Prelude                                 hiding (span)
+import           Control.Monad.Except                 (ExceptT (ExceptT),
+                                                       runExceptT)
+import           Control.Monad.IO.Class               (liftIO)
+import           Control.Monad.Trans.Maybe            (MaybeT (MaybeT),
+                                                       maybeToExceptT)
+import           Data.Either.Extra                    (maybeToEither)
+import           Data.Maybe                           (fromMaybe, mapMaybe)
+import           Development.IDE                      (IdeAction,
+                                                       IdeState (shakeExtras),
+                                                       Range (Range), Recorder,
+                                                       WithPriority,
+                                                       cmapWithPrio,
+                                                       runIdeAction,
+                                                       toNormalizedFilePath',
+                                                       uriToFilePath')
+import           Development.IDE.Core.Actions         (useE)
+import           Development.IDE.Core.PositionMapping (PositionMapping,
+                                                       fromCurrentPosition,
+                                                       toCurrentRange)
+import           Development.IDE.Types.Logger         (Pretty (..))
+import           Ide.Plugin.SelectionRange.CodeRange  (CodeRange (..),
+                                                       GetCodeRange (..),
+                                                       codeRangeRule)
+import qualified Ide.Plugin.SelectionRange.CodeRange  as CodeRange
+import           Ide.PluginUtils                      (pluginResponse,
+                                                       positionInRange)
+import           Ide.Types                            (PluginDescriptor (pluginHandlers, pluginRules),
+                                                       PluginId,
+                                                       defaultPluginDescriptor,
+                                                       mkPluginHandler)
+import           Language.LSP.Server                  (LspM)
+import           Language.LSP.Types                   (List (List),
+                                                       NormalizedFilePath,
+                                                       Position (..),
+                                                       ResponseError,
+                                                       SMethod (STextDocumentSelectionRange),
+                                                       SelectionRange (..),
+                                                       SelectionRangeParams (..),
+                                                       TextDocumentIdentifier (TextDocumentIdentifier),
+                                                       Uri)
+import           Prelude                              hiding (log, span)
 
-descriptor :: PluginId -> PluginDescriptor IdeState
-descriptor plId = (defaultPluginDescriptor plId)
+descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
+descriptor recorder plId = (defaultPluginDescriptor plId)
     { pluginHandlers = mkPluginHandler STextDocumentSelectionRange selectionRangeHandler
+    -- TODO @sloorush add folding range
+    -- <> mkPluginHandler STextDocumentFoldingRange foldingRangeHandler
+    , pluginRules = codeRangeRule (cmapWithPrio LogCodeRange recorder)
     }
 
+data Log = LogCodeRange CodeRange.Log
+
+instance Pretty Log where
+    pretty log = case log of
+        LogCodeRange codeRangeLog -> pretty codeRangeLog
+
 selectionRangeHandler :: IdeState -> PluginId -> SelectionRangeParams -> LspM c (Either ResponseError (List SelectionRange))
 selectionRangeHandler ide _ SelectionRangeParams{..} = do
-    liftIO $ logDebug logger $ "requesting selection range for file: " <> T.pack (show uri)
     pluginResponse $ do
         filePath <- ExceptT . pure . maybeToEither "fail to convert uri to file path" $
                 toNormalizedFilePath' <$> uriToFilePath' uri
@@ -75,27 +74,45 @@ selectionRangeHandler ide _ SelectionRangeParams{..} = do
     positions :: [Position]
     List positions = _positions
 
-    logger = ideLogger ide
-
 getSelectionRanges :: NormalizedFilePath -> [Position] -> ExceptT String IdeAction [SelectionRange]
 getSelectionRanges file positions = do
-    (HAR{hieAst, refMap}, positionMapping) <- maybeToExceptT "fail to get hie ast" $ useE GetHieAst file
-    -- 'positionMapping' should be applied to the input positions before using them
+    (codeRange, positionMapping) <- maybeToExceptT "fail to get code range" $ useE GetCodeRange file
+    -- 'positionMapping' should be appied to the input before using them
     positions' <- maybeToExceptT "fail to apply position mapping to input positions" . MaybeT . pure $
         traverse (fromCurrentPosition positionMapping) positions
 
-    ast <- maybeToExceptT "fail to get ast for current file" . MaybeT . pure $
-        -- in GHC 9, the 'FastString' in 'HieASTs' is replaced by a newtype wrapper around 'LexicalFastString'
-        -- so we use 'coerce' to make it work in both GHC 8 and 9
-        getAsts hieAst Map.!? (coerce . mkFastString . fromNormalizedFilePath) file
-
-    let ast' = runReader (preProcessAST ast) (PreProcessEnv refMap)
-    let selectionRanges = findSelectionRangesByPositions (astPathsLeafToRoot ast') positions'
+    let selectionRanges = flip fmap positions' $ \pos ->
+            -- codeRange doesn't cover all portions of text in the file, so we need a default value
+            let defaultSelectionRange = SelectionRange (Range pos pos) Nothing
+             in reverseSelectionRange . fromMaybe defaultSelectionRange . findPosition' pos $ codeRange
 
     -- 'positionMapping' should be applied to the output ranges before returning them
     maybeToExceptT "fail to apply position mapping to output positions" . MaybeT . pure $
          traverse (toCurrentSelectionRange positionMapping) selectionRanges
 
+-- Find 'Position' in 'CodeRange'. Producing an inverse 'SelectionRange'
+findPosition' :: Position -> CodeRange -> Maybe SelectionRange
+findPosition' pos (CodeRange range children) =
+    if positionInRange pos range
+    then Just $ case mapMaybe (findPosition' pos) children of
+            [childSelectionRange] -> SelectionRange range (Just childSelectionRange)
+            _                     -> SelectionRange range Nothing
+    else Nothing
+
+-- Reverse 'SelectionRange'. Just like 'reverse' for list.
+reverseSelectionRange :: SelectionRange -> SelectionRange
+reverseSelectionRange = go (SelectionRange invalidRange Nothing)
+  where
+    go :: SelectionRange -> SelectionRange -> SelectionRange
+    go acc (SelectionRange r Nothing) = SelectionRange r (checkRange acc)
+    go acc (SelectionRange r (Just parent)) = go (SelectionRange r (checkRange acc)) parent
+
+    checkRange :: SelectionRange -> Maybe SelectionRange
+    checkRange r@(SelectionRange range _) = if range == invalidRange then Nothing else Just r
+
+    invalidRange :: Range
+    invalidRange = Range (Position (-1) (-1)) (Position (-1) (-1))
+
 -- | Likes 'toCurrentPosition', but works on 'SelectionRange'
 toCurrentSelectionRange :: PositionMapping -> SelectionRange -> Maybe SelectionRange
 toCurrentSelectionRange positionMapping SelectionRange{..} = do
@@ -104,42 +121,3 @@ toCurrentSelectionRange positionMapping SelectionRange{..} = do
         _range = newRange,
         _parent = _parent >>= toCurrentSelectionRange positionMapping
     }
-
--- | Build all paths from ast leaf to root
-astPathsLeafToRoot :: HieAST a -> [SelectionRange]
-astPathsLeafToRoot = mapMaybe (spansToSelectionRange . nubOrd) . go [[]]
-  where
-    go :: [[Span]] -> HieAST a -> [[Span]]
-    go acc (Node _ span [])       = fmap (span:) acc
-    go acc (Node _ span children) = concatMap (go (fmap (span:) acc)) children
-
-spansToSelectionRange :: [Span] -> Maybe SelectionRange
-spansToSelectionRange [] = Nothing
-spansToSelectionRange (span:spans) = Just $
-    SelectionRange {_range = realSrcSpanToRange span, _parent = spansToSelectionRange spans}
-
-{-|
-For each position, find the selection range that contains it, without taking each selection range's
-parent into account. These selection ranges are un-divisible, representing the leaf nodes in original AST, so they
-won't overlap.
--}
-findSelectionRangesByPositions :: [SelectionRange] -- ^ all possible selection ranges
-                               -> [Position] -- ^ requested positions
-                               -> [SelectionRange]
-findSelectionRangesByPositions selectionRanges = fmap findByPosition
-    {-
-        Performance Tips:
-        Doing a linear search from the first selection range for each position is not optimal.
-        If it becomes too slow for a large file and many positions, you may optimize the implementation.
-        Assume the number of selection range is n, then the following techniques may be applied:
-            1. For each position, we may treat HieAST as a position indexed tree to search it in O(log(n)).
-            2. For all positions, a searched position will narrow the search range for other positions.
-    -}
-  where
-    findByPosition :: Position -> SelectionRange
-    findByPosition p = fromMaybe SelectionRange{_range = Range p p, _parent = Nothing} $
-        find (isPositionInSelectionRange p) selectionRanges
-
-    isPositionInSelectionRange :: Position -> SelectionRange -> Bool
-    isPositionInSelectionRange p SelectionRange{_range} =
-        let Range sp ep = _range in sp <= p && p <= ep

plugins/hls-selection-range-plugin/src/Ide/Plugin/SelectionRange/ASTPreProcess.hs

@@ -31,7 +31,7 @@ import           Development.IDE.GHC.Compat.Util (FastString)
 import           Prelude                         hiding (span)
 
 {-|
-Extra arguments for 'preaProcessAST', meant to be used in a 'Reader' context. We use 'Reader' to combine
+Extra arguments for 'preProcessAST'. It's expected to be used in a 'Reader' context
 -}
 newtype PreProcessEnv a = PreProcessEnv
     { preProcessEnvRefMap :: RefMap a