Skip to content
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.

Commit abbc76c

Browse files
sloorushsloorush
committedAug 12, 2022
format: run formatter
1 parent 892a129 commit abbc76c

File tree

3 files changed

+278
-260
lines changed

3 files changed

+278
-260
lines changed
 

‎plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange.hs

+85-76
Original file line numberDiff line numberDiff line change
@@ -1,22 +1,23 @@
1-
{-# LANGUAGE OverloadedStrings #-}
2-
{-# LANGUAGE RecordWildCards #-}
1+
{-# LANGUAGE OverloadedStrings #-}
2+
{-# LANGUAGE RecordWildCards #-}
33
{-# LANGUAGE ScopedTypeVariables #-}
44

5-
module Ide.Plugin.CodeRange (
6-
descriptor
7-
, Log
5+
module Ide.Plugin.CodeRange
6+
( descriptor,
7+
Log,
88

99
-- * Internal
10-
, findPosition
11-
) where
10+
findPosition,
11+
)
12+
where
1213

1314
import Control.Monad.Except (ExceptT (ExceptT),
1415
runExceptT)
1516
import Control.Monad.IO.Class (liftIO)
1617
import Control.Monad.Trans.Maybe (MaybeT (MaybeT),
1718
maybeToExceptT)
1819
import Data.Either.Extra (maybeToEither)
19-
import Data.Maybe ( fromMaybe, catMaybes )
20+
import Data.Maybe (fromMaybe)
2021
import Data.Vector (Vector)
2122
import qualified Data.Vector as V
2223
import Development.IDE (IdeAction,
@@ -43,62 +44,67 @@ import Ide.Types (PluginDescriptor (pluginH
4344
defaultPluginDescriptor,
4445
mkPluginHandler)
4546
import Language.LSP.Server (LspM)
46-
import Language.LSP.Types (List (List),
47+
import Language.LSP.Types (FoldingRange (..),
48+
FoldingRangeParams (..),
49+
List (List),
4750
NormalizedFilePath,
4851
Position (..),
4952
Range (_start),
5053
ResponseError,
51-
SMethod (STextDocumentSelectionRange, STextDocumentFoldingRange),
54+
SMethod (STextDocumentFoldingRange, STextDocumentSelectionRange),
5255
SelectionRange (..),
5356
SelectionRangeParams (..),
54-
FoldingRange (..),
55-
FoldingRangeParams(..),
5657
TextDocumentIdentifier (TextDocumentIdentifier),
57-
Uri
58-
)
58+
Uri)
5959
import Prelude hiding (log, span)
6060

6161
descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
62-
descriptor recorder plId = (defaultPluginDescriptor plId)
63-
{ pluginHandlers = mkPluginHandler STextDocumentSelectionRange selectionRangeHandler
64-
<> mkPluginHandler STextDocumentFoldingRange foldingRangeHandler
65-
, pluginRules = codeRangeRule (cmapWithPrio LogRules recorder)
62+
descriptor recorder plId =
63+
(defaultPluginDescriptor plId)
64+
{ pluginHandlers =
65+
mkPluginHandler STextDocumentSelectionRange selectionRangeHandler
66+
<> mkPluginHandler STextDocumentFoldingRange foldingRangeHandler,
67+
pluginRules = codeRangeRule (cmapWithPrio LogRules recorder)
6668
}
6769

6870
data Log = LogRules Rules.Log
6971

7072
instance Pretty Log where
71-
pretty log = case log of
72-
LogRules codeRangeLog -> pretty codeRangeLog
73+
pretty log = case log of
74+
LogRules codeRangeLog -> pretty codeRangeLog
7375

7476
foldingRangeHandler :: IdeState -> PluginId -> FoldingRangeParams -> LspM c (Either ResponseError (List FoldingRange))
75-
foldingRangeHandler ide _ FoldingRangeParams{..} = do
76-
pluginResponse $ do
77-
filePath <- ExceptT . pure . maybeToEither "fail to convert uri to file path" $
78-
toNormalizedFilePath' <$> uriToFilePath' uri
79-
foldingRanges <- ExceptT . liftIO . runIdeAction "FoldingRange" (shakeExtras ide) . runExceptT $
80-
getFoldingRanges filePath
81-
pure . List $ foldingRanges
82-
where
83-
uri :: Uri
84-
TextDocumentIdentifier uri = _textDocument
77+
foldingRangeHandler ide _ FoldingRangeParams {..} = do
78+
pluginResponse $ do
79+
filePath <-
80+
ExceptT . pure . maybeToEither "fail to convert uri to file path" $
81+
toNormalizedFilePath' <$> uriToFilePath' uri
82+
foldingRanges <-
83+
ExceptT . liftIO . runIdeAction "FoldingRange" (shakeExtras ide) . runExceptT $
84+
getFoldingRanges filePath
85+
pure . List $ foldingRanges
86+
where
87+
uri :: Uri
88+
TextDocumentIdentifier uri = _textDocument
8589

8690
getFoldingRanges :: NormalizedFilePath -> ExceptT String IdeAction [FoldingRange]
8791
getFoldingRanges file = do
88-
(codeRange, _) <- maybeToExceptT "fail to get code range" $ useE GetCodeRange file
92+
(codeRange, _) <- maybeToExceptT "fail to get code range" $ useE GetCodeRange file
8993

90-
let foldingRanges = findFoldingRanges codeRange
94+
let foldingRanges = findFoldingRanges codeRange
9195

92-
maybeToExceptT "Fail to generate folding range" (MaybeT . pure $ Just foldingRanges)
96+
maybeToExceptT "Fail to generate folding range" (MaybeT . pure $ Just foldingRanges)
9397

9498
selectionRangeHandler :: IdeState -> PluginId -> SelectionRangeParams -> LspM c (Either ResponseError (List SelectionRange))
95-
selectionRangeHandler ide _ SelectionRangeParams{..} = do
96-
pluginResponse $ do
97-
filePath <- ExceptT . pure . maybeToEither "fail to convert uri to file path" $
98-
toNormalizedFilePath' <$> uriToFilePath' uri
99-
selectionRanges <- ExceptT . liftIO . runIdeAction "SelectionRange" (shakeExtras ide) . runExceptT $
100-
getSelectionRanges filePath positions
101-
pure . List $ selectionRanges
99+
selectionRangeHandler ide _ SelectionRangeParams {..} = do
100+
pluginResponse $ do
101+
filePath <-
102+
ExceptT . pure . maybeToEither "fail to convert uri to file path" $
103+
toNormalizedFilePath' <$> uriToFilePath' uri
104+
selectionRanges <-
105+
ExceptT . liftIO . runIdeAction "SelectionRange" (shakeExtras ide) . runExceptT $
106+
getSelectionRanges filePath positions
107+
pure . List $ selectionRanges
102108
where
103109
uri :: Uri
104110
TextDocumentIdentifier uri = _textDocument
@@ -108,19 +114,20 @@ selectionRangeHandler ide _ SelectionRangeParams{..} = do
108114

109115
getSelectionRanges :: NormalizedFilePath -> [Position] -> ExceptT String IdeAction [SelectionRange]
110116
getSelectionRanges file positions = do
111-
(codeRange, positionMapping) <- maybeToExceptT "fail to get code range" $ useE GetCodeRange file
112-
-- 'positionMapping' should be appied to the input before using them
113-
positions' <- maybeToExceptT "fail to apply position mapping to input positions" . MaybeT . pure $
114-
traverse (fromCurrentPosition positionMapping) positions
117+
(codeRange, positionMapping) <- maybeToExceptT "fail to get code range" $ useE GetCodeRange file
118+
-- 'positionMapping' should be appied to the input before using them
119+
positions' <-
120+
maybeToExceptT "fail to apply position mapping to input positions" . MaybeT . pure $
121+
traverse (fromCurrentPosition positionMapping) positions
115122

116-
let selectionRanges = flip fmap positions' $ \pos ->
117-
-- We need a default selection range if the lookup fails, so that other positions can still have valid results.
118-
let defaultSelectionRange = SelectionRange (Range pos pos) Nothing
119-
in fromMaybe defaultSelectionRange . findPosition pos $ codeRange
123+
let selectionRanges = flip fmap positions' $ \pos ->
124+
-- We need a default selection range if the lookup fails, so that other positions can still have valid results.
125+
let defaultSelectionRange = SelectionRange (Range pos pos) Nothing
126+
in fromMaybe defaultSelectionRange . findPosition pos $ codeRange
120127

121-
-- 'positionMapping' should be applied to the output ranges before returning them
122-
maybeToExceptT "fail to apply position mapping to output positions" . MaybeT . pure $
123-
traverse (toCurrentSelectionRange positionMapping) selectionRanges
128+
-- 'positionMapping' should be applied to the output ranges before returning them
129+
maybeToExceptT "fail to apply position mapping to output positions" . MaybeT . pure $
130+
traverse (toCurrentSelectionRange positionMapping) selectionRanges
124131

125132
-- | Find 'Position' in 'CodeRange'. This can fail, if the given position is not covered by the 'CodeRange'.
126133
findPosition :: Position -> CodeRange -> Maybe SelectionRange
@@ -129,54 +136,56 @@ findPosition pos root = go Nothing root
129136
-- Helper function for recursion. The range list is built top-down
130137
go :: Maybe SelectionRange -> CodeRange -> Maybe SelectionRange
131138
go acc node =
132-
if positionInRange pos range
139+
if positionInRange pos range
133140
then maybe acc' (go acc') (binarySearchPos children)
134-
-- If all children doesn't contain pos, acc' will be returned.
141+
else -- If all children doesn't contain pos, acc' will be returned.
135142
-- acc' will be Nothing only if we are in the root level.
136-
else Nothing
143+
Nothing
137144
where
138145
range = _codeRange_range node
139146
children = _codeRange_children node
140147
acc' = Just $ maybe (SelectionRange range Nothing) (SelectionRange range . Just) acc
141148

142149
binarySearchPos :: Vector CodeRange -> Maybe CodeRange
143150
binarySearchPos v
144-
| V.null v = Nothing
145-
| V.length v == 1,
146-
Just r <- V.headM v = if positionInRange pos (_codeRange_range r) then Just r else Nothing
147-
| otherwise = do
148-
let (left, right) = V.splitAt (V.length v `div` 2) v
149-
startOfRight <- _start . _codeRange_range <$> V.headM right
150-
if pos < startOfRight then binarySearchPos left else binarySearchPos right
151+
| V.null v = Nothing
152+
| V.length v == 1,
153+
Just r <- V.headM v =
154+
if positionInRange pos (_codeRange_range r) then Just r else Nothing
155+
| otherwise = do
156+
let (left, right) = V.splitAt (V.length v `div` 2) v
157+
startOfRight <- _start . _codeRange_range <$> V.headM right
158+
if pos < startOfRight then binarySearchPos left else binarySearchPos right
151159

152160
findFoldingRanges :: CodeRange -> [FoldingRange]
153161
findFoldingRanges r@(CodeRange _ children _) =
154162
let frRoot :: [FoldingRange] = case createFoldingRange r of
155-
Just x -> [x]
163+
Just x -> [x]
156164
Nothing -> []
157165

158166
frChildren :: [FoldingRange] = concat $ V.toList $ fmap findFoldingRanges children
159167
in frRoot ++ frChildren
160168

161169
createFoldingRange :: CodeRange -> Maybe FoldingRange
162170
createFoldingRange node1 = do
163-
let range = _codeRange_range node1
164-
let Range startPos endPos = range
165-
let Position lineStart _= startPos
166-
let Position lineEnd _ = endPos
167-
let codeRangeKind = _codeRange_kind node1
171+
let range = _codeRange_range node1
172+
let Range startPos endPos = range
173+
let Position lineStart _ = startPos
174+
let Position lineEnd _ = endPos
175+
let codeRangeKind = _codeRange_kind node1
168176

169-
let frk = crkToFrk codeRangeKind
177+
let frk = crkToFrk codeRangeKind
170178

171-
case frk of
172-
Just _ -> Just (FoldingRange lineStart Nothing lineEnd Nothing frk)
173-
Nothing -> Nothing
179+
case frk of
180+
Just _ -> Just (FoldingRange lineStart Nothing lineEnd Nothing frk)
181+
Nothing -> Nothing
174182

175183
-- | Likes 'toCurrentPosition', but works on 'SelectionRange'
176184
toCurrentSelectionRange :: PositionMapping -> SelectionRange -> Maybe SelectionRange
177-
toCurrentSelectionRange positionMapping SelectionRange{..} = do
178-
newRange <- toCurrentRange positionMapping _range
179-
pure $ SelectionRange {
180-
_range = newRange,
185+
toCurrentSelectionRange positionMapping SelectionRange {..} = do
186+
newRange <- toCurrentRange positionMapping _range
187+
pure $
188+
SelectionRange
189+
{ _range = newRange,
181190
_parent = _parent >>= toCurrentSelectionRange positionMapping
182-
}
191+
}

0 commit comments

Comments
 (0)
Please sign in to comment.