hls-call-hierarchy-plugin 1.0.3.0 → 1.1.0.0
raw patch · 4 files changed
+59/−47 lines, 4 filesdep ~aesondep ~ghcidedep ~hls-plugin-apiPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: aeson, ghcide, hls-plugin-api, hls-test-utils
API changes (from Hackage documentation)
- Ide.Plugin.CallHierarchy: descriptor :: PluginId -> PluginDescriptor IdeState
+ Ide.Plugin.CallHierarchy: descriptor :: PluginDescriptor IdeState
Files
- hls-call-hierarchy-plugin.cabal +7/−5
- src/Ide/Plugin/CallHierarchy.hs +2/−2
- src/Ide/Plugin/CallHierarchy/Internal.hs +27/−22
- test/Main.hs +23/−18
hls-call-hierarchy-plugin.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: hls-call-hierarchy-plugin-version: 1.0.3.0+version: 1.1.0.0 synopsis: Call hierarchy plugin for Haskell Language Server description: Please see the README on GitHub at <https://github.com/haskell/haskell-language-server/tree/master/plugins/hls-call-hierarchy-plugin#readme>@@ -16,6 +16,7 @@ test/testdata/*.hs library+ buildable: True exposed-modules: Ide.Plugin.CallHierarchy other-modules: Ide.Plugin.CallHierarchy.Internal@@ -24,15 +25,15 @@ hs-source-dirs: src build-depends:- , aeson >=1.5.2.0+ , aeson , base >=4.12 && <5 , bytestring , containers , extra , ghc- , ghcide ^>= 1.6 || ^>= 1.7+ , ghcide ^>= 1.8 , hiedb- , hls-plugin-api ^>= 1.2 || ^>= 1.3 || ^>= 1.4+ , hls-plugin-api ^>= 1.5 , lens , lsp >=1.2.0.1 , sqlite-simple@@ -43,6 +44,7 @@ default-extensions: DataKinds test-suite tests+ buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test@@ -55,7 +57,7 @@ , extra , filepath , hls-call-hierarchy-plugin- , hls-test-utils ^>=1.3+ , hls-test-utils ^>=1.4 , lens , lsp , lsp-test
src/Ide/Plugin/CallHierarchy.hs view
@@ -5,8 +5,8 @@ import Ide.Types import Language.LSP.Types -descriptor :: PluginId -> PluginDescriptor IdeState-descriptor plId = (defaultPluginDescriptor plId)+descriptor :: PluginDescriptor IdeState+descriptor = (defaultPluginDescriptor X.callHierarchyId) { Ide.Types.pluginHandlers = mkPluginHandler STextDocumentPrepareCallHierarchy X.prepareCallHierarchy <> mkPluginHandler SCallHierarchyIncomingCalls X.incomingCalls <> mkPluginHandler SCallHierarchyOutgoingCalls X.outgoingCalls
src/Ide/Plugin/CallHierarchy/Internal.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-}@@ -10,6 +11,7 @@ prepareCallHierarchy , incomingCalls , outgoingCalls+, callHierarchyId ) where import Control.Lens ((^.))@@ -34,23 +36,23 @@ import HieDb (Symbol (Symbol)) import qualified Ide.Plugin.CallHierarchy.Query as Q import Ide.Plugin.CallHierarchy.Types+import Ide.PluginUtils (getNormalizedFilePath,+ handleMaybe, pluginResponse,+ throwPluginError) import Ide.Types import Language.LSP.Types import qualified Language.LSP.Types.Lens as L import Text.Read (readMaybe) +callHierarchyId :: PluginId+callHierarchyId = PluginId "callHierarchy"+ -- | Render prepare call hierarchy request. prepareCallHierarchy :: PluginMethodHandler IdeState TextDocumentPrepareCallHierarchy-prepareCallHierarchy state pluginId param- | Just nfp <- uriToNormalizedFilePath $ toNormalizedUri uri =- liftIO (runAction "CallHierarchy.prepareHierarchy" state (prepareCallHierarchyItem nfp pos)) >>=- \case- Just items -> pure $ Right $ Just $ List items- Nothing -> pure $ Right Nothing- | otherwise = pure $ Left $ responseError $ T.pack $ "Call Hierarchy: uriToNormalizedFilePath failed for: " <> show uri- where- uri = param ^. (L.textDocument . L.uri)- pos = param ^. L.position+prepareCallHierarchy state _ param = pluginResponse $ do+ nfp <- getNormalizedFilePath (param ^. L.textDocument ^. L.uri)+ items <- liftIO (runAction "CallHierarchy.prepareHierarchy" state (prepareCallHierarchyItem nfp (param ^. L.position)))+ pure (List <$> items) prepareCallHierarchyItem :: NormalizedFilePath -> Position -> Action (Maybe [CallHierarchyItem]) prepareCallHierarchyItem = constructFromAst@@ -189,16 +191,19 @@ deriving instance Ord SymbolKind deriving instance Ord SymbolTag deriving instance Ord CallHierarchyItem+#if !MIN_VERSION_aeson(1,5,2)+deriving instance Ord Value+#endif -- | Render incoming calls request. incomingCalls :: PluginMethodHandler IdeState CallHierarchyIncomingCalls-incomingCalls state pluginId param = do- liftIO $ runAction "CallHierarchy.incomingCalls" state $+incomingCalls state pluginId param = pluginResponse $ do+ calls <- liftIO $ runAction "CallHierarchy.incomingCalls" state $ queryCalls (param ^. L.item) Q.incomingCalls mkCallHierarchyIncomingCall- mergeIncomingCalls >>=- \case- Just x -> pure $ Right $ Just $ List x- Nothing -> pure $ Left $ responseError "CallHierarchy: IncomingCalls internal error"+ mergeIncomingCalls+ case calls of+ Just x -> pure $ Just $ List x+ Nothing -> throwPluginError "incomingCalls - Internal Error" where mkCallHierarchyIncomingCall :: Vertex -> Action (Maybe CallHierarchyIncomingCall) mkCallHierarchyIncomingCall = mkCallHierarchyCall CallHierarchyIncomingCall@@ -213,13 +218,13 @@ -- Render outgoing calls request. outgoingCalls :: PluginMethodHandler IdeState CallHierarchyOutgoingCalls-outgoingCalls state pluginId param = do- liftIO $ runAction "CallHierarchy.outgoingCalls" state $+outgoingCalls state pluginId param = pluginResponse $ do+ calls <- liftIO $ runAction "CallHierarchy.outgoingCalls" state $ queryCalls (param ^. L.item) Q.outgoingCalls mkCallHierarchyOutgoingCall- mergeOutgoingCalls >>=- \case- Just x -> pure $ Right $ Just $ List x- Nothing -> pure $ Left $ responseError "CallHierarchy: OutgoingCalls internal error"+ mergeOutgoingCalls+ case calls of+ Just x -> pure $ Just $ List x+ Nothing -> throwPluginError "outgoingCalls - Internal Error" where mkCallHierarchyOutgoingCall :: Vertex -> Action (Maybe CallHierarchyOutgoingCall) mkCallHierarchyOutgoingCall = mkCallHierarchyCall CallHierarchyOutgoingCall
test/Main.hs view
@@ -19,9 +19,10 @@ import System.FilePath import qualified System.IO.Extra import Test.Hls+import Test.Hls.Util (withCanonicalTempDir) plugin :: PluginDescriptor IdeState-plugin = descriptor "callHierarchy"+plugin = descriptor main :: IO () main = defaultTestRunner $@@ -165,13 +166,13 @@ expected = mkCallHierarchyItemC "A" SkConstructor range selRange oneCaseWithCreate contents 1 13 expected , testGroup "type signature"- [ testCase "next line" $ do+ [ knownBrokenForGhcVersions [GHC94] "type signature broken" $ testCase "next line" $ do let contents = T.unlines ["a::Int", "a=3"] range = mkRange 1 0 1 3 selRange = mkRange 1 0 1 1 expected = mkCallHierarchyItemV "a" SkFunction range selRange oneCaseWithCreate contents 0 0 expected- , testCase "multi functions" $ do+ , knownBrokenForGhcVersions [GHC94] "type signature broken" $ testCase "multi functions" $ do let contents = T.unlines [ "a,b::Int", "a=3", "b=4"] range = mkRange 2 0 2 3 selRange = mkRange 2 0 2 1@@ -197,6 +198,7 @@ testCase "xdata unavailable" $ runSessionWithServer plugin testDataDir $ do doc <- createDoc "A.hs" "haskell" $ T.unlines ["a=3", "b=a"]+ waitForKickDone [item] <- Test.prepareCallHierarchy (mkPrepareCallHierarchyParam doc 1 0) let expected = [CallHierarchyIncomingCall item (List [mkRange 1 2 1 3])] Test.prepareCallHierarchy (mkPrepareCallHierarchyParam doc 0 0) >>=@@ -318,9 +320,10 @@ testGroup "Outgoing Calls" [ testGroup "single file" [- testCase "xdata unavailable" $ withTempDir $ \dir ->+ testCase "xdata unavailable" $ withCanonicalTempDir $ \dir -> runSessionWithServer plugin dir $ do doc <- createDoc "A.hs" "haskell" $ T.unlines ["a=3", "b=a"]+ waitForKickDone [item] <- Test.prepareCallHierarchy (mkPrepareCallHierarchyParam doc 0 1) let expected = [CallHierarchyOutgoingCall item (List [mkRange 1 2 1 3])] Test.prepareCallHierarchy (mkPrepareCallHierarchyParam doc 1 0) >>=@@ -421,9 +424,10 @@ deriving instance Ord CallHierarchyOutgoingCall incomingCallTestCase :: T.Text -> Int -> Int -> [(Int, Int)] -> [Range] -> Assertion-incomingCallTestCase contents queryX queryY positions ranges = withTempDir $ \dir ->+incomingCallTestCase contents queryX queryY positions ranges = withCanonicalTempDir $ \dir -> runSessionWithServer plugin dir $ do doc <- createDoc "A.hs" "haskell" contents+ waitForKickDone items <- concatMapM (\((x, y), range) -> Test.prepareCallHierarchy (mkPrepareCallHierarchyParam doc x y) <&> map (, range)@@ -443,9 +447,11 @@ incomingCallMultiFileTestCase filepath queryX queryY mp = runSessionWithServer plugin testDataDir $ do doc <- openDoc filepath "haskell"- items <- fmap concat $ sequence $ M.elems $ M.mapWithKey (\fp pr ->- openDoc fp "haskell" >>= \p ->- concatMapM (\((x, y), range) ->+ waitForKickDone+ items <- fmap concat $ sequence $ M.elems $ M.mapWithKey (\fp pr -> do+ p <- openDoc fp "haskell"+ waitForKickDone+ concatMapM (\((x, y), range) -> Test.prepareCallHierarchy (mkPrepareCallHierarchyParam p x y) <&> map (, range) ) pr) mp@@ -460,9 +466,10 @@ closeDoc doc outgoingCallTestCase :: T.Text -> Int -> Int -> [(Int, Int)] -> [Range] -> Assertion-outgoingCallTestCase contents queryX queryY positions ranges = withTempDir $ \dir ->+outgoingCallTestCase contents queryX queryY positions ranges = withCanonicalTempDir $ \dir -> runSessionWithServer plugin dir $ do doc <- createDoc "A.hs" "haskell" contents+ waitForKickDone items <- concatMapM (\((x, y), range) -> Test.prepareCallHierarchy (mkPrepareCallHierarchyParam doc x y) <&> map (, range)@@ -481,9 +488,11 @@ outgoingCallMultiFileTestCase filepath queryX queryY mp = runSessionWithServer plugin testDataDir $ do doc <- openDoc filepath "haskell"- items <- fmap concat $ sequence $ M.elems $ M.mapWithKey (\fp pr ->- openDoc fp "haskell" >>= \p ->- concatMapM (\((x, y), range) ->+ waitForKickDone+ items <- fmap concat $ sequence $ M.elems $ M.mapWithKey (\fp pr -> do+ p <- openDoc fp "haskell"+ waitForKickDone+ concatMapM (\((x, y), range) -> Test.prepareCallHierarchy (mkPrepareCallHierarchyParam p x y) <&> map (, range) ) pr) mp@@ -497,9 +506,10 @@ closeDoc doc oneCaseWithCreate :: T.Text -> Int -> Int -> (Uri -> CallHierarchyItem) -> Assertion-oneCaseWithCreate contents queryX queryY expected = withTempDir $ \dir ->+oneCaseWithCreate contents queryX queryY expected = withCanonicalTempDir $ \dir -> runSessionWithServer plugin dir $ do doc <- createDoc "A.hs" "haskell" contents+ waitForKickDone Test.prepareCallHierarchy (mkPrepareCallHierarchyParam doc queryX queryY) >>= \case [item] -> liftIO $ item @?= expected (doc ^. L.uri)@@ -535,8 +545,3 @@ mkOutgoingCallsParam :: CallHierarchyItem -> CallHierarchyOutgoingCallsParams mkOutgoingCallsParam = CallHierarchyOutgoingCallsParams Nothing Nothing--withTempDir :: (FilePath -> IO a) -> IO a-withTempDir f = System.IO.Extra.withTempDir $ \dir -> do- dir' <- canonicalizePath dir- f dir'