hls-code-range-plugin 2.0.0.1 → 2.1.0.0
raw patch · 5 files changed
+76/−115 lines, 5 filesdep ~ghcidedep ~hls-plugin-apidep ~hls-test-utilsPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: ghcide, hls-plugin-api, hls-test-utils
API changes (from Hackage documentation)
Files
- hls-code-range-plugin.cabal +6/−5
- src/Ide/Plugin/CodeRange.hs +41/−85
- src/Ide/Plugin/CodeRange/Rules.hs +6/−5
- test/Ide/Plugin/CodeRangeTest.hs +8/−8
- test/Main.hs +15/−12
hls-code-range-plugin.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: hls-code-range-plugin-version: 2.0.0.1+version: 2.1.0.0 synopsis: HLS Plugin to support smart selection range and Folding range @@ -37,9 +37,9 @@ , containers , deepseq , extra- , ghcide == 2.0.0.1+ , ghcide == 2.1.0.0 , hashable- , hls-plugin-api == 2.0.0.1+ , hls-plugin-api == 2.1.0.0 , lens , lsp , mtl@@ -62,9 +62,10 @@ , bytestring , containers , filepath- , ghcide == 2.0.0.1+ , ghcide == 2.1.0.0 , hls-code-range-plugin- , hls-test-utils == 2.0.0.1+ , hls-plugin-api+ , hls-test-utils == 2.1.0.0 , lens , lsp , lsp-test
src/Ide/Plugin/CodeRange.hs view
@@ -1,8 +1,10 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}-+{-# LANGUAGE TypeOperators #-} module Ide.Plugin.CodeRange ( descriptor , Log@@ -13,140 +15,94 @@ , createFoldingRange ) where -import Control.Monad.Except (ExceptT (ExceptT),- mapExceptT)-import Control.Monad.IO.Class (liftIO)+import Control.Monad.IO.Class (MonadIO (liftIO))+import Control.Monad.Trans.Except (ExceptT, mapExceptT) import Control.Monad.Trans.Maybe (MaybeT (MaybeT), maybeToExceptT)-import Data.Either.Extra (maybeToEither) import Data.List.Extra (drop1) import Data.Maybe (fromMaybe) import Data.Vector (Vector) import qualified Data.Vector as V-import Development.IDE (Action, IdeAction,+import Development.IDE (Action, IdeState (shakeExtras), Range (Range), Recorder, WithPriority,- cmapWithPrio, runAction,- runIdeAction,- toNormalizedFilePath',- uriToFilePath', use,- useWithStaleFast)+ cmapWithPrio)+import Development.IDE.Core.PluginUtils import Development.IDE.Core.PositionMapping (PositionMapping,- fromCurrentPosition, toCurrentRange)-import Development.IDE.Types.Logger (Pretty (..),- Priority (Warning),- logWith)+import Ide.Logger (Pretty (..)) import Ide.Plugin.CodeRange.Rules (CodeRange (..), GetCodeRange (..), codeRangeRule, crkToFrk) import qualified Ide.Plugin.CodeRange.Rules as Rules (Log)-import Ide.PluginUtils (pluginResponse,- positionInRange)+import Ide.Plugin.Error+import Ide.PluginUtils (positionInRange) import Ide.Types (PluginDescriptor (pluginHandlers, pluginRules), PluginId,+ PluginMethodHandler, defaultPluginDescriptor, mkPluginHandler)-import Language.LSP.Server (LspM, LspT)-import Language.LSP.Types (FoldingRange (..),+import Language.LSP.Protocol.Message (Method (Method_TextDocumentFoldingRange, Method_TextDocumentSelectionRange),+ SMethod (SMethod_TextDocumentFoldingRange, SMethod_TextDocumentSelectionRange))+import Language.LSP.Protocol.Types (FoldingRange (..), FoldingRangeParams (..),- List (List),- NormalizedFilePath,+ NormalizedFilePath, Null, Position (..), Range (_start),- ResponseError,- SMethod (STextDocumentFoldingRange, STextDocumentSelectionRange), SelectionRange (..), SelectionRangeParams (..), TextDocumentIdentifier (TextDocumentIdentifier),- Uri)+ Uri, type (|?) (InL)) import Prelude hiding (log, span) descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState descriptor recorder plId = (defaultPluginDescriptor plId)- { pluginHandlers = mkPluginHandler STextDocumentSelectionRange (selectionRangeHandler recorder)- <> mkPluginHandler STextDocumentFoldingRange (foldingRangeHandler recorder)+ { pluginHandlers = mkPluginHandler SMethod_TextDocumentSelectionRange (selectionRangeHandler recorder)+ <> mkPluginHandler SMethod_TextDocumentFoldingRange (foldingRangeHandler recorder) , pluginRules = codeRangeRule (cmapWithPrio LogRules recorder) } data Log = LogRules Rules.Log- | forall rule. Show rule => LogBadDependency rule instance Pretty Log where pretty log = case log of LogRules codeRangeLog -> pretty codeRangeLog- LogBadDependency rule -> pretty $ "bad dependency: " <> show rule -foldingRangeHandler :: Recorder (WithPriority Log) -> IdeState -> PluginId -> FoldingRangeParams -> LspM c (Either ResponseError (List FoldingRange))-foldingRangeHandler recorder ide _ FoldingRangeParams{..} = do- pluginResponse $ do- filePath <- ExceptT . pure . maybeToEither "fail to convert uri to file path" $- toNormalizedFilePath' <$> uriToFilePath' uri- foldingRanges <- mapExceptT runAction' $- getFoldingRanges filePath- pure . List $ foldingRanges+foldingRangeHandler :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'Method_TextDocumentFoldingRange+foldingRangeHandler _ ide _ FoldingRangeParams{..} =+ do+ filePath <- getNormalizedFilePathE uri+ foldingRanges <- runActionE "FoldingRange" ide $ getFoldingRanges filePath+ pure . InL $ foldingRanges where uri :: Uri TextDocumentIdentifier uri = _textDocument - runAction' :: Action (Either FoldingRangeError [FoldingRange]) -> LspT c IO (Either String [FoldingRange])- runAction' action = do- result <- liftIO $ runAction "FoldingRange" ide action- case result of- Left err -> case err of- FoldingRangeBadDependency rule -> do- logWith recorder Warning $ LogBadDependency rule- pure $ Right []- Right list -> pure $ Right list--data FoldingRangeError = forall rule. Show rule => FoldingRangeBadDependency rule--getFoldingRanges :: NormalizedFilePath -> ExceptT FoldingRangeError Action [FoldingRange]+getFoldingRanges :: NormalizedFilePath -> ExceptT PluginError Action [FoldingRange] getFoldingRanges file = do- codeRange <- maybeToExceptT (FoldingRangeBadDependency GetCodeRange) . MaybeT $ use GetCodeRange file+ codeRange <- useE GetCodeRange file pure $ findFoldingRanges codeRange -selectionRangeHandler :: Recorder (WithPriority Log) -> IdeState -> PluginId -> SelectionRangeParams -> LspM c (Either ResponseError (List SelectionRange))-selectionRangeHandler recorder ide _ SelectionRangeParams{..} = do- pluginResponse $ do- filePath <- ExceptT . pure . maybeToEither "fail to convert uri to file path" $- toNormalizedFilePath' <$> uriToFilePath' uri- fmap List . mapExceptT runIdeAction' . getSelectionRanges filePath $ positions+selectionRangeHandler :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'Method_TextDocumentSelectionRange+selectionRangeHandler _ ide _ SelectionRangeParams{..} = do+ do+ filePath <- getNormalizedFilePathE uri+ mapExceptT liftIO $ getSelectionRanges ide filePath positions where uri :: Uri TextDocumentIdentifier uri = _textDocument positions :: [Position]- List positions = _positions+ positions = _positions - runIdeAction' :: IdeAction (Either SelectionRangeError [SelectionRange]) -> LspT c IO (Either String [SelectionRange])- runIdeAction' action = do- result <- liftIO $ runIdeAction "SelectionRange" (shakeExtras ide) action- case result of- Left err -> case err of- SelectionRangeBadDependency rule -> do- logWith recorder Warning $ LogBadDependency rule- -- This might happen if the HieAst is not ready,- -- so we give it a default value instead of throwing an error- pure $ Right []- SelectionRangeInputPositionMappingFailure -> pure $- Left "failed to apply position mapping to input positions"- SelectionRangeOutputPositionMappingFailure -> pure $- Left "failed to apply position mapping to output positions"- Right list -> pure $ Right list -data SelectionRangeError = forall rule. Show rule => SelectionRangeBadDependency rule- | SelectionRangeInputPositionMappingFailure- | SelectionRangeOutputPositionMappingFailure--getSelectionRanges :: NormalizedFilePath -> [Position] -> ExceptT SelectionRangeError IdeAction [SelectionRange]-getSelectionRanges file positions = do- (codeRange, positionMapping) <- maybeToExceptT (SelectionRangeBadDependency GetCodeRange) . MaybeT $- useWithStaleFast GetCodeRange file+getSelectionRanges :: IdeState -> NormalizedFilePath -> [Position] -> ExceptT PluginError IO ([SelectionRange] |? Null)+getSelectionRanges ide file positions = do+ (codeRange, positionMapping) <- runIdeActionE "SelectionRange" (shakeExtras ide) $ useWithStaleFastE GetCodeRange file -- 'positionMapping' should be applied to the input before using them- positions' <- maybeToExceptT SelectionRangeInputPositionMappingFailure . MaybeT . pure $- traverse (fromCurrentPosition positionMapping) positions+ positions' <-+ traverse (fromCurrentPositionE positionMapping) positions let selectionRanges = flip fmap positions' $ \pos -> -- We need a default selection range if the lookup fails,@@ -155,8 +111,8 @@ in fromMaybe defaultSelectionRange . findPosition pos $ codeRange -- 'positionMapping' should be applied to the output ranges before returning them- maybeToExceptT SelectionRangeOutputPositionMappingFailure . MaybeT . pure $- traverse (toCurrentSelectionRange positionMapping) selectionRanges+ maybeToExceptT (PluginInvalidUserState "toCurrentSelectionRange") . MaybeT . pure $+ InL <$> traverse (toCurrentSelectionRange positionMapping) selectionRanges -- | Find 'Position' in 'CodeRange'. This can fail, if the given position is not covered by the 'CodeRange'. findPosition :: Position -> CodeRange -> Maybe SelectionRange@@ -221,7 +177,7 @@ createFoldingRange (CodeRange (Range (Position lineStart charStart) (Position lineEnd charEnd)) _ ck) = do -- Type conversion of codeRangeKind to FoldingRangeKind let frk = crkToFrk ck- Just (FoldingRange lineStart (Just charStart) lineEnd (Just charEnd) (Just frk))+ Just (FoldingRange lineStart (Just charStart) lineEnd (Just charEnd) (Just frk) Nothing) -- | Likes 'toCurrentPosition', but works on 'SelectionRange' toCurrentSelectionRange :: PositionMapping -> SelectionRange -> Maybe SelectionRange
src/Ide/Plugin/CodeRange/Rules.hs view
@@ -53,8 +53,9 @@ PreProcessEnv (..), isCustomNode, preProcessAST)-import Language.LSP.Types (FoldingRangeKind (FoldingRangeComment, FoldingRangeImports, FoldingRangeRegion))-import Language.LSP.Types.Lens (HasEnd (end),+import Language.LSP.Protocol.Types (FoldingRangeKind (FoldingRangeKind_Comment, FoldingRangeKind_Imports, FoldingRangeKind_Region))++import Language.LSP.Protocol.Lens (HasEnd (end), HasStart (start)) import Prelude hiding (log) @@ -195,6 +196,6 @@ -- | Maps type CodeRangeKind to FoldingRangeKind crkToFrk :: CodeRangeKind -> FoldingRangeKind crkToFrk crk = case crk of- CodeKindComment -> FoldingRangeComment- CodeKindImports -> FoldingRangeImports- CodeKindRegion -> FoldingRangeRegion+ CodeKindComment -> FoldingRangeKind_Comment+ CodeKindImports -> FoldingRangeKind_Imports+ CodeKindRegion -> FoldingRangeKind_Region
test/Ide/Plugin/CodeRangeTest.hs view
@@ -73,17 +73,17 @@ (mkCodeRange (Position 1 1) (Position 5 10) [ mkCodeRange (Position 1 2) (Position 3 6) [] CodeKindRegion ] CodeKindRegion)- [FoldingRange 1 (Just 2) 3 (Just 6) (Just FoldingRangeRegion)],+ [FoldingRange 1 (Just 2) 3 (Just 6) (Just FoldingRangeKind_Region) Nothing], testCase "Test Code Kind Comment" $ check (mkCodeRange (Position 1 1) (Position 5 10) [ mkCodeRange (Position 1 2) (Position 3 6) [] CodeKindComment ] CodeKindRegion)- [FoldingRange 1 (Just 2) 3 (Just 6) (Just FoldingRangeComment)],+ [FoldingRange 1 (Just 2) 3 (Just 6) (Just FoldingRangeKind_Comment) Nothing], testCase "Test Code Kind Import" $ check (mkCodeRange (Position 1 1) (Position 5 10) [ mkCodeRange (Position 1 2) (Position 3 6) [] CodeKindImports ] CodeKindRegion)- [FoldingRange 1 (Just 2) 3 (Just 6) (Just FoldingRangeImports)],+ [FoldingRange 1 (Just 2) 3 (Just 6) (Just FoldingRangeKind_Imports) Nothing], -- Test for Code Portions with children testCase "Test Children" $ check@@ -93,9 +93,9 @@ ] CodeKindRegion, mkCodeRange (Position 3 7) (Position 5 10) [] CodeKindRegion ] CodeKindRegion)- [ FoldingRange 1 (Just 2) 3 (Just 6) (Just FoldingRangeRegion),- FoldingRange 1 (Just 3) 1 (Just 5) (Just FoldingRangeRegion),- FoldingRange 3 (Just 7) 5 (Just 10) (Just FoldingRangeRegion)+ [ FoldingRange 1 (Just 2) 3 (Just 6) (Just FoldingRangeKind_Region) Nothing,+ FoldingRange 1 (Just 3) 1 (Just 5) (Just FoldingRangeKind_Region) Nothing,+ FoldingRange 3 (Just 7) 5 (Just 10) (Just FoldingRangeKind_Region) Nothing ] ], @@ -109,10 +109,10 @@ -- General tests testCase "Test General Code Block" $ check (mkCodeRange (Position 1 1) (Position 5 10) [] CodeKindRegion)- (Just (FoldingRange 1 (Just 1) 5 (Just 10) (Just FoldingRangeRegion))),+ (Just (FoldingRange 1 (Just 1) 5 (Just 10) (Just FoldingRangeKind_Region) Nothing)), -- If a range has the same start and end line it need not be folded so Nothing is expected testCase "Test Same Start Line" $ check (mkCodeRange (Position 1 1) (Position 1 10) [] CodeKindRegion)- (Just (FoldingRange 1 (Just 1) 1 (Just 10) (Just FoldingRangeRegion)))+ (Just (FoldingRange 1 (Just 1) 1 (Just 10) (Just FoldingRangeKind_Region) Nothing)) ] ]
test/Main.hs view
@@ -6,7 +6,7 @@ import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy.Char8 as LBSChar8 import Data.String (fromString)-import Development.IDE.Types.Logger (Priority (Debug),+import Ide.Logger (Priority (Debug), Recorder (Recorder), WithPriority (WithPriority), makeDefaultStderrRecorder,@@ -14,7 +14,9 @@ import Ide.Plugin.CodeRange (Log, descriptor) import qualified Ide.Plugin.CodeRange.RulesTest import qualified Ide.Plugin.CodeRangeTest-import Language.LSP.Types.Lens+import Language.LSP.Protocol.Lens+import Language.LSP.Protocol.Message+import Language.LSP.Protocol.Types import System.FilePath ((<.>), (</>)) import Test.Hls @@ -41,19 +43,20 @@ selectionRangeGoldenTest testName positions = goldenGitDiff testName (testDataDir </> testName <.> "golden" <.> "txt") $ do res <- runSessionWithServer plugin testDataDir $ do doc <- openDoc (testName <.> "hs") "haskell"- resp <- request STextDocumentSelectionRange $ SelectionRangeParams Nothing Nothing doc- (List $ fmap (uncurry Position . (\(x, y) -> (x-1, y-1))) positions)+ resp <- request SMethod_TextDocumentSelectionRange $ SelectionRangeParams Nothing Nothing doc+ $ fmap (uncurry Position . (\(x, y) -> (x-1, y-1))) positions let res = resp ^. result- pure $ fmap showSelectionRangesForTest res+ pure $ fmap (showSelectionRangesForTest . absorbNull) res case res of+ Left (ResponseError (InL LSPErrorCodes_RequestFailed) _ _) -> pure "" Left err -> assertFailure (show err) Right golden -> pure golden where testDataDir :: FilePath testDataDir = "test" </> "testdata" </> "selection-range" - showSelectionRangesForTest :: List SelectionRange -> ByteString- showSelectionRangesForTest (List selectionRanges) = LBSChar8.intercalate "\n" $ fmap showSelectionRangeForTest selectionRanges+ showSelectionRangesForTest :: [SelectionRange] -> ByteString+ showSelectionRangesForTest selectionRanges = LBSChar8.intercalate "\n" $ fmap showSelectionRangeForTest selectionRanges showSelectionRangeForTest :: SelectionRange -> ByteString showSelectionRangeForTest selectionRange = go True (Just selectionRange)@@ -70,9 +73,9 @@ foldingRangeGoldenTest testName = goldenGitDiff testName (testDataDir </> testName <.> "golden" <.> "txt") $ do res <- runSessionWithServer plugin testDataDir $ do doc <- openDoc (testName <.> "hs") "haskell"- resp <- request STextDocumentFoldingRange $ FoldingRangeParams Nothing Nothing doc+ resp <- request SMethod_TextDocumentFoldingRange $ FoldingRangeParams Nothing Nothing doc let res = resp ^. result- pure $ fmap showFoldingRangesForTest res+ pure $ fmap (showFoldingRangesForTest . absorbNull) res case res of Left err -> assertFailure (show err)@@ -82,11 +85,11 @@ testDataDir :: FilePath testDataDir = "test" </> "testdata" </> "folding-range" - showFoldingRangesForTest :: List FoldingRange -> ByteString- showFoldingRangesForTest (List foldingRanges) = LBSChar8.intercalate "\n" $ fmap showFoldingRangeForTest foldingRanges+ showFoldingRangesForTest :: [FoldingRange] -> ByteString+ showFoldingRangesForTest foldingRanges = (LBSChar8.intercalate "\n" $ fmap showFoldingRangeForTest foldingRanges) `LBSChar8.snoc` '\n' showFoldingRangeForTest :: FoldingRange -> ByteString- showFoldingRangeForTest f@(FoldingRange sl (Just sc) el (Just ec) (Just frk)) = "((" <> showLBS sl <>", "<> showLBS sc <> ")" <> " : " <> "(" <> showLBS el <>", "<> showLBS ec<> ")) : " <> showFRK frk+ showFoldingRangeForTest f@(FoldingRange sl (Just sc) el (Just ec) (Just frk) _) = "((" <> showLBS sl <>", "<> showLBS sc <> ")" <> " : " <> "(" <> showLBS el <>", "<> showLBS ec<> ")) : " <> showFRK frk showLBS = fromString . show showFRK = fromString . show