Skip to content

Commit 4567bf8

Browse files
author
kokobd
committed
add the whole import area as a selection step
1 parent 54c693e commit 4567bf8

File tree

4 files changed

+94
-38
lines changed

4 files changed

+94
-38
lines changed

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

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,8 @@ extra-source-files:
2323
library
2424
exposed-modules:
2525
Ide.Plugin.SelectionRange
26+
other-modules:
27+
Ide.Plugin.SelectionRange.ASTPreProcess
2628

2729
ghc-options: -Wall
2830
hs-source-dirs: src

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

Lines changed: 51 additions & 37 deletions
Original file line numberDiff line numberDiff line change
@@ -4,42 +4,49 @@
44

55
module Ide.Plugin.SelectionRange (descriptor) where
66

7-
import Control.Monad.IO.Class (liftIO)
8-
import Control.Monad.Trans.Maybe (MaybeT (MaybeT),
9-
runMaybeT)
10-
import Data.Foldable (find)
11-
import qualified Data.Map.Strict as Map
12-
import Data.Maybe (fromMaybe, mapMaybe)
13-
import Development.IDE (GetHieAst (GetHieAst),
14-
HieAstResult (HAR, hieAst),
15-
IdeAction,
16-
IdeState (shakeExtras),
17-
Range (Range),
18-
fromNormalizedFilePath,
19-
realSrcSpanToRange,
20-
runIdeAction,
21-
toNormalizedFilePath',
22-
uriToFilePath')
23-
import Development.IDE.Core.Actions (useE)
24-
import Development.IDE.Core.PositionMapping (PositionMapping,
25-
fromCurrentPosition,
26-
toCurrentRange)
27-
import Development.IDE.GHC.Compat (HieAST (Node), Span,
28-
getAsts)
29-
import Development.IDE.GHC.Compat.Util (mkFastString)
30-
import Ide.Types (PluginDescriptor (pluginHandlers),
31-
PluginId,
32-
defaultPluginDescriptor,
33-
mkPluginHandler)
34-
import Language.LSP.Server (LspM)
35-
import Language.LSP.Types (List (List),
36-
NormalizedFilePath,
37-
Position, ResponseError,
38-
SMethod (STextDocumentSelectionRange),
39-
SelectionRange (..),
40-
SelectionRangeParams (..),
41-
TextDocumentIdentifier (TextDocumentIdentifier))
42-
import Prelude hiding (span)
7+
import Control.Monad.IO.Class (liftIO)
8+
import Control.Monad.Reader (MonadReader (ask))
9+
import Control.Monad.Trans.Maybe (MaybeT (MaybeT),
10+
runMaybeT)
11+
import Data.Foldable (find)
12+
import qualified Data.Map.Strict as Map
13+
import Data.Maybe (fromMaybe, mapMaybe)
14+
import qualified Data.Text as T
15+
import Development.IDE (GetHieAst (GetHieAst),
16+
HieAstResult (HAR, hieAst),
17+
IdeAction,
18+
IdeState (shakeExtras),
19+
Range (Range),
20+
fromNormalizedFilePath,
21+
logDebug,
22+
realSrcSpanToRange,
23+
runIdeAction,
24+
toNormalizedFilePath',
25+
uriToFilePath')
26+
import Development.IDE.Core.Actions (useE)
27+
import Development.IDE.Core.PositionMapping (PositionMapping,
28+
fromCurrentPosition,
29+
toCurrentRange)
30+
import Development.IDE.Core.Shake (ShakeExtras (ShakeExtras, logger))
31+
import Development.IDE.GHC.Compat (HieAST (Node, nodeChildren, nodeInfo),
32+
NodeInfo (nodeAnnotations),
33+
Span, getAsts)
34+
import Development.IDE.GHC.Compat.Util (mkFastString)
35+
import Ide.Plugin.SelectionRange.ASTPreProcess (preProcessAST)
36+
import Ide.Types (PluginDescriptor (pluginHandlers),
37+
PluginId,
38+
defaultPluginDescriptor,
39+
mkPluginHandler)
40+
import Language.LSP.Server (LspM)
41+
import Language.LSP.Types (List (List),
42+
NormalizedFilePath,
43+
Position,
44+
ResponseError,
45+
SMethod (STextDocumentSelectionRange),
46+
SelectionRange (..),
47+
SelectionRangeParams (..),
48+
TextDocumentIdentifier (TextDocumentIdentifier))
49+
import Prelude hiding (span)
4350

4451
descriptor :: PluginId -> PluginDescriptor IdeState
4552
descriptor plId = (defaultPluginDescriptor plId)
@@ -62,8 +69,15 @@ getSelectionRanges file positions = fmap (fromMaybe []) <$> runMaybeT $ do
6269
(HAR{hieAst}, positionMapping) <- useE GetHieAst file
6370
positions' <- MaybeT . pure $ traverse (fromCurrentPosition positionMapping) positions
6471
ast <- MaybeT . pure $ getAsts hieAst Map.!? (mkFastString . fromNormalizedFilePath) file
72+
73+
-- FIXME: remove the debug logs when it's done
74+
ShakeExtras{logger} <- ask
75+
let children = nodeAnnotations . nodeInfo <$> nodeChildren ast
76+
liftIO $ logDebug logger $ "children: " <> T.pack (show children)
77+
78+
let ast' = preProcessAST ast
6579
MaybeT . pure . traverse (toCurrentSelectionRange positionMapping) $
66-
findSelectionRangesByPositions (astPathsLeafToRoot ast) positions'
80+
findSelectionRangesByPositions (astPathsLeafToRoot ast') positions'
6781

6882
-- | Like 'toCurrentPosition', but works on 'SelectionRange'
6983
toCurrentSelectionRange :: PositionMapping -> SelectionRange -> Maybe SelectionRange

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

Lines changed: 40 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,40 @@
1+
{-# LANGUAGE ScopedTypeVariables #-}
2+
3+
module Ide.Plugin.SelectionRange.ASTPreProcess
4+
( preProcessAST
5+
) where
6+
7+
import Data.List (groupBy)
8+
import Data.Maybe (mapMaybe)
9+
import qualified Data.Set as Set
10+
import Development.IDE.GHC.Compat (HieAST (..),
11+
NodeInfo (NodeInfo, nodeAnnotations),
12+
mkRealSrcSpan, realSrcSpanEnd,
13+
realSrcSpanStart)
14+
import Development.IDE.GHC.Compat.Util (mkFastString)
15+
16+
-- | Make the AST more suitable for generating selection range.
17+
preProcessAST :: HieAST a -> HieAST a
18+
preProcessAST = mergeImports
19+
20+
mergeImports :: HieAST a -> HieAST a
21+
mergeImports node = node { nodeChildren = children }
22+
where
23+
children = mapMaybe merge
24+
. groupBy (\x y -> nodeIsImport x && nodeIsImport y)
25+
. nodeChildren $ node
26+
27+
merge [] = Nothing
28+
merge [x] = Just x
29+
merge xs = Just (createVirtualNode xs)
30+
31+
nodeIsImport :: HieAST a -> Bool
32+
nodeIsImport node = Set.member (mkFastString "ImportDecl", mkFastString "ImportDecl") annotations
33+
where
34+
annotations = nodeAnnotations . nodeInfo $ node
35+
36+
createVirtualNode :: [HieAST a] -> HieAST a
37+
createVirtualNode nodes = Node (NodeInfo mempty mempty mempty) span' nodes
38+
where
39+
span' = mkRealSrcSpan (minimum locations) (maximum locations)
40+
locations = (\s -> [realSrcSpanStart s, realSrcSpanEnd s]) . nodeSpan =<< nodes

‎plugins/hls-selection-range-plugin/test/testdata/MultiPositions.golden.txt‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,3 @@
1-
(4,33) (4,38) => (4,32) (4,47) => (4,1) (4,47) => (3,1) (10,17)
1+
(4,33) (4,38) => (4,32) (4,47) => (4,1) (4,47) => (3,1) (4,47) => (3,1) (10,17)
22
(8,10) (8,12) => (8,8) (8,14) => (8,5) (10,17) => (7,14) (10,17) => (7,1) (10,17) => (3,1) (10,17)
33
(1,8) (1,8)

0 commit comments

Comments
 (0)