Skip to content

Commit 89619b5

Browse files
ozkutukozkutuk
committed
Use interval map for efficient range filtering
1 parent d213705 commit 89619b5

File tree

2 files changed

+99
-77
lines changed

2 files changed

+99
-77
lines changed

‎plugins/hls-explicit-record-fields-plugin/hls-explicit-record-fields-plugin.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -38,6 +38,7 @@ library
3838
, transformers
3939
, ghc-boot-th
4040
, unordered-containers
41+
, hw-fingertree
4142
hs-source-dirs: src
4243
default-language: Haskell2010
4344

‎plugins/hls-explicit-record-fields-plugin/src/Ide/Plugin/ExplicitFields.hs

Lines changed: 98 additions & 77 deletions
Original file line numberDiff line numberDiff line change
@@ -1,75 +1,89 @@
1-
{-# LANGUAGE DataKinds #-}
2-
{-# LANGUAGE DeriveGeneric #-}
3-
{-# LANGUAGE FlexibleContexts #-}
4-
{-# LANGUAGE LambdaCase #-}
5-
{-# LANGUAGE OverloadedStrings #-}
6-
{-# LANGUAGE TypeFamilies #-}
7-
{-# LANGUAGE TypeOperators #-}
8-
{-# LANGUAGE ViewPatterns #-}
1+
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE DeriveGeneric #-}
3+
{-# LANGUAGE DuplicateRecordFields #-}
4+
{-# LANGUAGE FlexibleContexts #-}
5+
{-# LANGUAGE LambdaCase #-}
6+
{-# LANGUAGE OverloadedStrings #-}
7+
{-# LANGUAGE TupleSections #-}
8+
{-# LANGUAGE TypeFamilies #-}
9+
{-# LANGUAGE TypeOperators #-}
10+
{-# LANGUAGE ViewPatterns #-}
911

1012
module Ide.Plugin.ExplicitFields
1113
( descriptor
1214
) where
1315

14-
import Control.Lens ((^.))
15-
import Control.Monad.IO.Class (MonadIO, liftIO)
16-
import Control.Monad.Trans.Except (ExceptT)
17-
import Data.Generics (GenericQ, everything, extQ,
18-
mkQ)
19-
import qualified Data.HashMap.Strict as HashMap
20-
import Data.Maybe (catMaybes, isJust, mapMaybe,
21-
maybeToList)
22-
import Data.Text (Text)
23-
import Development.IDE (IdeState, NormalizedFilePath,
24-
Pretty (..), Range (..),
25-
Recorder (..), Rules,
26-
WithPriority (..),
27-
srcSpanToRange)
28-
import Development.IDE.Core.Rules (runAction)
29-
import Development.IDE.Core.RuleTypes (TcModuleResult (..),
30-
TypeCheck (..))
31-
import Development.IDE.Core.Shake (define, use)
32-
import qualified Development.IDE.Core.Shake as Shake
33-
import Development.IDE.GHC.Compat (HasSrcSpan (..),
34-
HsConDetails (RecCon),
35-
HsRecFields (..), LPat,
36-
Outputable, SrcSpan,
37-
pm_mod_summary, unLoc)
38-
import Development.IDE.GHC.Compat.Core (Extension (NamedFieldPuns),
39-
GhcPass (..),
40-
HsExpr (RecordCon, rcon_flds),
41-
LHsExpr, ModSummary (..),
42-
Pass (..), Pat (..),
43-
extensionFlags, hfbPun,
44-
hs_valds, mapLoc)
45-
import Development.IDE.GHC.Compat.Util (toList)
46-
import Development.IDE.GHC.Util (printOutputable)
47-
import Development.IDE.Graph (RuleResult)
48-
import Development.IDE.Graph.Classes (Hashable, NFData (rnf))
49-
import Development.IDE.Spans.Pragmas (NextPragmaInfo (..),
50-
getFirstPragma,
51-
insertNewPragma)
52-
import Development.IDE.Types.Logger (cmapWithPrio)
53-
import GHC.Generics (Generic)
54-
import Ide.PluginUtils (getNormalizedFilePath,
55-
handleMaybeM, pluginResponse,
56-
subRange)
57-
import Ide.Types (PluginDescriptor (..),
58-
PluginId (..),
59-
PluginMethodHandler,
60-
defaultPluginDescriptor,
61-
mkPluginHandler)
62-
import Language.LSP.Types (CodeAction (..),
63-
CodeActionKind (CodeActionRefactorRewrite),
64-
CodeActionParams (..),
65-
Command, List (..),
66-
Method (..), SMethod (..),
67-
TextEdit (..),
68-
WorkspaceEdit (WorkspaceEdit),
69-
fromNormalizedUri,
70-
normalizedFilePathToUri,
71-
type (|?) (InR))
72-
import qualified Language.LSP.Types.Lens as L
16+
import Control.Lens ((^.))
17+
import Control.Monad.IO.Class (MonadIO, liftIO)
18+
import Control.Monad.Trans.Except (ExceptT)
19+
import Data.Foldable (foldl')
20+
import Data.Generics (GenericQ, everything,
21+
extQ, mkQ)
22+
import qualified Data.HashMap.Strict as HashMap
23+
import Data.Maybe (catMaybes, isJust,
24+
mapMaybe,
25+
maybeToList)
26+
import Data.Text (Text)
27+
import Development.IDE (IdeState,
28+
NormalizedFilePath,
29+
Pretty (..),
30+
Range (..),
31+
Recorder (..), Rules,
32+
WithPriority (..),
33+
srcSpanToRange)
34+
import Development.IDE.Core.Rules (runAction)
35+
import Development.IDE.Core.RuleTypes (TcModuleResult (..),
36+
TypeCheck (..))
37+
import Development.IDE.Core.Shake (define, use)
38+
import qualified Development.IDE.Core.Shake as Shake
39+
import Development.IDE.GHC.Compat (HasSrcSpan (..),
40+
HsConDetails (RecCon),
41+
HsRecFields (..),
42+
LPat, Outputable,
43+
SrcSpan,
44+
pm_mod_summary,
45+
unLoc)
46+
import Development.IDE.GHC.Compat.Core (Extension (NamedFieldPuns),
47+
GhcPass (..),
48+
HsExpr (RecordCon, rcon_flds),
49+
LHsExpr,
50+
ModSummary (..),
51+
Pass (..), Pat (..),
52+
extensionFlags,
53+
hfbPun, hs_valds,
54+
mapLoc)
55+
import Development.IDE.GHC.Compat.Util (toList)
56+
import Development.IDE.GHC.Util (printOutputable)
57+
import Development.IDE.Graph (RuleResult)
58+
import Development.IDE.Graph.Classes (Hashable,
59+
NFData (rnf))
60+
import Development.IDE.Spans.Pragmas (NextPragmaInfo (..),
61+
getFirstPragma,
62+
insertNewPragma)
63+
import Development.IDE.Types.Logger (cmapWithPrio)
64+
import GHC.Generics (Generic)
65+
import qualified HaskellWorks.Data.IntervalMap.FingerTree as IM
66+
import Ide.PluginUtils (getNormalizedFilePath,
67+
handleMaybeM,
68+
pluginResponse)
69+
import Ide.Types (PluginDescriptor (..),
70+
PluginId (..),
71+
PluginMethodHandler,
72+
defaultPluginDescriptor,
73+
mkPluginHandler)
74+
import Language.LSP.Types (CodeAction (..),
75+
CodeActionKind (CodeActionRefactorRewrite),
76+
CodeActionParams (..),
77+
Command, List (..),
78+
Method (..),
79+
Position,
80+
SMethod (..),
81+
TextEdit (..),
82+
WorkspaceEdit (WorkspaceEdit),
83+
fromNormalizedUri,
84+
normalizedFilePathToUri,
85+
type (|?) (InR))
86+
import qualified Language.LSP.Types.Lens as L
7387

7488

7589
data Log = LogShake Shake.Log
@@ -88,8 +102,8 @@ codeActionProvider :: PluginMethodHandler IdeState 'TextDocumentCodeAction
88102
codeActionProvider ideState pId (CodeActionParams _ _ docId range _) = pluginResponse $ do
89103
nfp <- getNormalizedFilePath (docId ^. L.uri)
90104
pragma <- getFirstPragma pId ideState nfp
91-
CRR renderedRecs (map unExt -> exts) <- collectRecordsInRange range ideState nfp
92-
let actions = map (mkCodeAction nfp exts pragma) renderedRecs
105+
CRR recMap (map unExt -> exts) <- collectRecords' ideState nfp
106+
let actions = map (mkCodeAction nfp exts pragma) (filterRecords range recMap)
93107
pure $ List actions
94108

95109
where
@@ -134,7 +148,8 @@ collectRecordsRule recorder = define (cmapWithPrio LogShake recorder) $ \Collect
134148
let exts = getEnabledExtensions <$> tmr
135149
recs = getRecords <$> tmr
136150
renderedRecs = mapMaybe renderRecordInfo <$> recs
137-
pure ([], CRR <$> renderedRecs <*> exts)
151+
recMap = buildIntervalMap <$> renderedRecs
152+
pure ([], CRR <$> recMap <*> exts)
138153

139154
getEnabledExtensions :: TcModuleResult -> [GhcExtension]
140155
getEnabledExtensions = map GhcExtension . toList . extensionFlags . ms_hspp_opts . pm_mod_summary . tmrParsed
@@ -150,7 +165,7 @@ instance Hashable CollectRecords
150165
instance NFData CollectRecords
151166

152167
data CollectRecordsResult = CRR
153-
{ recordInfos :: [RenderedRecordInfo]
168+
{ recordInfos :: IM.IntervalMap Position RenderedRecordInfo
154169
, enabledExtensions :: [GhcExtension]
155170
}
156171
deriving (Generic)
@@ -245,11 +260,17 @@ collectRecords' ideState =
245260
. runAction "ExplicitFields" ideState
246261
. use CollectRecords
247262

248-
collectRecordsInRange :: MonadIO m => Range -> IdeState -> NormalizedFilePath -> ExceptT String m CollectRecordsResult
249-
collectRecordsInRange range ideState nfp = do
250-
CRR renderedRecs exts <- collectRecords' ideState nfp
251-
pure $ CRR (filter inRange renderedRecs) exts
263+
rangeToInterval :: Range -> IM.Interval Position
264+
rangeToInterval (Range s e) = IM.Interval s e
252265

266+
buildIntervalMap :: [RenderedRecordInfo] -> IM.IntervalMap Position RenderedRecordInfo
267+
buildIntervalMap recs = toIntervalMap $ mapMaybe (\recInfo -> (,recInfo) <$> srcSpanToInterval (renderedSrcSpan recInfo)) recs
253268
where
254-
inRange :: RenderedRecordInfo -> Bool
255-
inRange (RenderedRecordInfo ss _) = maybe False (subRange range) (srcSpanToRange ss)
269+
toIntervalMap :: Ord v => [(IM.Interval v, a)] -> IM.IntervalMap v a
270+
toIntervalMap = foldl' (\m (i, v) -> IM.insert i v m) IM.empty
271+
272+
srcSpanToInterval :: SrcSpan -> Maybe (IM.Interval Position)
273+
srcSpanToInterval = fmap rangeToInterval . srcSpanToRange
274+
275+
filterRecords :: Range -> IM.IntervalMap Position RenderedRecordInfo -> [RenderedRecordInfo]
276+
filterRecords range = map snd . IM.dominators (rangeToInterval range)

0 commit comments

Comments
 (0)