hls-call-hierarchy-plugin 2.0.0.1 → 2.1.0.0
raw patch · 4 files changed
+115/−103 lines, 4 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, lsp
API changes (from Hackage documentation)
Files
- hls-call-hierarchy-plugin.cabal +5/−5
- src/Ide/Plugin/CallHierarchy.hs +4/−4
- src/Ide/Plugin/CallHierarchy/Internal.hs +47/−49
- test/Main.hs +59/−45
hls-call-hierarchy-plugin.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: hls-call-hierarchy-plugin-version: 2.0.0.1+version: 2.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>@@ -33,11 +33,11 @@ , base >=4.12 && <5 , containers , extra- , ghcide == 2.0.0.1+ , ghcide == 2.1.0.0 , hiedb- , hls-plugin-api == 2.0.0.1+ , hls-plugin-api == 2.1.0.0 , lens- , lsp >=1.2.0.1+ , lsp >=2.1.0.0 , sqlite-simple , text , unordered-containers@@ -59,7 +59,7 @@ , extra , filepath , hls-call-hierarchy-plugin- , hls-test-utils == 2.0.0.1+ , hls-test-utils == 2.1.0.0 , ghcide-test-utils , lens , lsp
src/Ide/Plugin/CallHierarchy.hs view
@@ -3,12 +3,12 @@ import Development.IDE import qualified Ide.Plugin.CallHierarchy.Internal as X import Ide.Types-import Language.LSP.Types+import Language.LSP.Protocol.Message descriptor :: PluginId -> PluginDescriptor IdeState descriptor plId = (defaultPluginDescriptor plId) { Ide.Types.pluginHandlers =- mkPluginHandler STextDocumentPrepareCallHierarchy X.prepareCallHierarchy- <> mkPluginHandler SCallHierarchyIncomingCalls X.incomingCalls- <> mkPluginHandler SCallHierarchyOutgoingCalls X.outgoingCalls+ mkPluginHandler SMethod_TextDocumentPrepareCallHierarchy X.prepareCallHierarchy+ <> mkPluginHandler SMethod_CallHierarchyIncomingCalls X.incomingCalls+ <> mkPluginHandler SMethod_CallHierarchyOutgoingCalls X.outgoingCalls }
src/Ide/Plugin/CallHierarchy/Internal.hs view
@@ -13,38 +13,38 @@ , outgoingCalls ) where -import Control.Lens ((^.))+import Control.Lens ((^.)) import Control.Monad.IO.Class-import Data.Aeson as A-import Data.List (groupBy, sortBy)-import qualified Data.Map as M+import Data.Aeson as A+import Data.List (groupBy, sortBy)+import qualified Data.Map as M import Data.Maybe-import qualified Data.Set as S-import qualified Data.Text as T+import qualified Data.Set as S+import qualified Data.Text as T import Data.Tuple.Extra import Development.IDE+import qualified Development.IDE.Core.PluginUtils as PluginUtils import Development.IDE.Core.Shake-import Development.IDE.GHC.Compat as Compat+import Development.IDE.GHC.Compat as Compat import Development.IDE.Spans.AtPoint-import HieDb (Symbol (Symbol))-import qualified Ide.Plugin.CallHierarchy.Query as Q+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.Plugin.Error import Ide.Types-import Language.LSP.Types-import qualified Language.LSP.Types.Lens as L-import Text.Read (readMaybe)+import qualified Language.LSP.Protocol.Lens as L+import Language.LSP.Protocol.Message+import Language.LSP.Protocol.Types+import Text.Read (readMaybe) -- | Render prepare call hierarchy request.-prepareCallHierarchy :: PluginMethodHandler IdeState TextDocumentPrepareCallHierarchy-prepareCallHierarchy state _ param = pluginResponse $ do- nfp <- getNormalizedFilePath (param ^. L.textDocument ^. L.uri)+prepareCallHierarchy :: PluginMethodHandler IdeState Method_TextDocumentPrepareCallHierarchy+prepareCallHierarchy state _ param = do+ nfp <- getNormalizedFilePathE (param ^. L.textDocument ^. L.uri) items <- liftIO $ runAction "CallHierarchy.prepareHierarchy" state $ prepareCallHierarchyItem nfp (param ^. L.position)- pure $ List <$> pure items+ pure $ InL items prepareCallHierarchyItem :: NormalizedFilePath -> Position -> Action [CallHierarchyItem] prepareCallHierarchyItem nfp pos = use GetHieAst nfp >>= \case@@ -79,33 +79,33 @@ | Just (RecField RecFieldDecl _) <- recFieldInfo contexts -- ignored type span- = Just $ mkCallHierarchyItem' ident SkField ssp ssp+ = Just $ mkCallHierarchyItem' ident SymbolKind_Field ssp ssp | isJust (matchBindInfo contexts) && isNothing (valBindInfo contexts)- = Just $ mkCallHierarchyItem' ident SkFunction ssp ssp+ = Just $ mkCallHierarchyItem' ident SymbolKind_Function ssp ssp | Just ctx <- valBindInfo contexts = Just $ case ctx of- ValBind _ _ span -> mkCallHierarchyItem' ident SkFunction (renderSpan span) ssp+ ValBind _ _ span -> mkCallHierarchyItem' ident SymbolKind_Function (renderSpan span) ssp _ -> mkCallHierarchyItem' ident skUnknown ssp ssp | Just ctx <- declInfo contexts = Just $ case ctx of- Decl ClassDec span -> mkCallHierarchyItem' ident SkInterface (renderSpan span) ssp- Decl ConDec span -> mkCallHierarchyItem' ident SkConstructor (renderSpan span) ssp- Decl DataDec span -> mkCallHierarchyItem' ident SkStruct (renderSpan span) ssp- Decl FamDec span -> mkCallHierarchyItem' ident SkFunction (renderSpan span) ssp- Decl InstDec span -> mkCallHierarchyItem' ident SkInterface (renderSpan span) ssp- Decl SynDec span -> mkCallHierarchyItem' ident SkTypeParameter (renderSpan span) ssp+ Decl ClassDec span -> mkCallHierarchyItem' ident SymbolKind_Interface (renderSpan span) ssp+ Decl ConDec span -> mkCallHierarchyItem' ident SymbolKind_Constructor (renderSpan span) ssp+ Decl DataDec span -> mkCallHierarchyItem' ident SymbolKind_Struct (renderSpan span) ssp+ Decl FamDec span -> mkCallHierarchyItem' ident SymbolKind_Function (renderSpan span) ssp+ Decl InstDec span -> mkCallHierarchyItem' ident SymbolKind_Interface (renderSpan span) ssp+ Decl SynDec span -> mkCallHierarchyItem' ident SymbolKind_TypeParameter (renderSpan span) ssp _ -> mkCallHierarchyItem' ident skUnknown ssp ssp | Just (ClassTyDecl span) <- classTyDeclInfo contexts- = Just $ mkCallHierarchyItem' ident SkMethod (renderSpan span) ssp+ = Just $ mkCallHierarchyItem' ident SymbolKind_Method (renderSpan span) ssp | Just (PatternBind _ _ span) <- patternBindInfo contexts- = Just $ mkCallHierarchyItem' ident SkFunction (renderSpan span) ssp+ = Just $ mkCallHierarchyItem' ident SymbolKind_Function (renderSpan span) ssp - | Just _ <- useInfo contexts = Just $ mkCallHierarchyItem' ident SkInterface ssp ssp+ | Just _ <- useInfo contexts = Just $ mkCallHierarchyItem' ident SymbolKind_Interface ssp ssp | Just _ <- tyDeclInfo contexts = renderTyDecl @@ -115,7 +115,9 @@ renderSpan _ = ssp -- https://github.com/haskell/lsp/blob/e11b7c09658610f6d815d04db08a64e7cf6b4467/lsp-types/src/Language/LSP/Types/DocumentSymbol.hs#L97- skUnknown = SkUnknown 27 -- 27 is the first unused number while ToJSON+ -- There is no longer an unknown symbol, thus using SymbolKind_Function+ -- as this is the call-hierarchy plugin+ skUnknown = SymbolKind_Function mkCallHierarchyItem' = mkCallHierarchyItem nfp @@ -165,16 +167,13 @@ -------------- Incoming calls and outgoing calls --------------------- ---------------------------------------------------------------------- -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 = pluginResponse $ do+incomingCalls :: PluginMethodHandler IdeState Method_CallHierarchyIncomingCalls+incomingCalls state pluginId param = do calls <- liftIO $ runAction "CallHierarchy.incomingCalls" state $ queryCalls@@ -182,14 +181,14 @@ Q.incomingCalls mkCallHierarchyIncomingCall (mergeCalls CallHierarchyIncomingCall L.from)- pure $ Just $ List calls+ pure $ InL $ calls where mkCallHierarchyIncomingCall :: Vertex -> Action (Maybe CallHierarchyIncomingCall) mkCallHierarchyIncomingCall = mkCallHierarchyCall CallHierarchyIncomingCall -- | Render outgoing calls request.-outgoingCalls :: PluginMethodHandler IdeState CallHierarchyOutgoingCalls-outgoingCalls state pluginId param = pluginResponse $ do+outgoingCalls :: PluginMethodHandler IdeState Method_CallHierarchyOutgoingCalls+outgoingCalls state pluginId param = do calls <- liftIO $ runAction "CallHierarchy.outgoingCalls" state $ queryCalls@@ -197,11 +196,10 @@ Q.outgoingCalls mkCallHierarchyOutgoingCall (mergeCalls CallHierarchyOutgoingCall L.to)- pure $ Just $ List calls+ pure $ InL $ calls where mkCallHierarchyOutgoingCall :: Vertex -> Action (Maybe CallHierarchyOutgoingCall) mkCallHierarchyOutgoingCall = mkCallHierarchyCall CallHierarchyOutgoingCall- -- | Merge calls from the same place mergeCalls constructor target = concatMap merge@@ -210,10 +208,10 @@ where merge [] = [] merge calls@(call:_) =- let ranges = concatMap ((\(List x) -> x) . (^. L.fromRanges)) calls- in [constructor (call ^. target) (List ranges)]+ let ranges = concatMap (^. L.fromRanges) calls+ in [constructor (call ^. target) ranges] -mkCallHierarchyCall :: (CallHierarchyItem -> List Range -> a) -> Vertex -> Action (Maybe a)+mkCallHierarchyCall :: (CallHierarchyItem -> [Range] -> a) -> Vertex -> Action (Maybe a) mkCallHierarchyCall mk v@Vertex{..} = do let pos = Position (fromIntegral $ sl - 1) (fromIntegral $ sc - 1) nfp = toNormalizedFilePath' hieSrc@@ -225,7 +223,7 @@ prepareCallHierarchyItem nfp pos >>= \case- [item] -> pure $ Just $ mk item (List [range])+ [item] -> pure $ Just $ mk item [range] _ -> do ShakeExtras{withHieDb} <- getShakeExtras sps <- liftIO (withHieDb (`Q.getSymbolPosition` v))@@ -235,7 +233,7 @@ nfp (Position (fromIntegral $ psl x - 1) (fromIntegral $ psc x - 1)) case items of- [item] -> pure $ Just $ mk item (List [range])+ [item] -> pure $ Just $ mk item [range] _ -> pure Nothing _ -> pure Nothing @@ -259,10 +257,10 @@ | otherwise = pure mempty where uri = item ^. L.uri- xdata = item ^. L.xdata+ xdata = item ^. L.data_ pos = item ^. (L.selectionRange . L.start) - getSymbol nfp = case item ^. L.xdata of+ getSymbol nfp = case item ^. L.data_ of Just xdata -> case fromJSON xdata of A.Success (symbolStr :: String) -> maybe (getSymbolFromAst nfp pos) (pure . pure) $ readMaybe symbolStr A.Error _ -> getSymbolFromAst nfp pos
test/Main.hs view
@@ -1,26 +1,27 @@ {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TupleSections #-} module Main (main) where -import Control.Lens (set, (^.))+import Control.Lens (set, (^.)) import Control.Monad.Extra import Data.Aeson-import Data.Functor ((<&>))-import Data.List (sort, tails)-import qualified Data.Map as M-import qualified Data.Text as T+import Data.Functor ((<&>))+import Data.List (sort, tails)+import qualified Data.Map as M+import qualified Data.Text as T import Development.IDE.Test import Ide.Plugin.CallHierarchy-import qualified Language.LSP.Test as Test-import qualified Language.LSP.Types.Lens as L+import qualified Language.LSP.Protocol.Lens as L+import qualified Language.LSP.Test as Test import System.Directory.Extra import System.FilePath import qualified System.IO.Extra import Test.Hls-import Test.Hls.Util (withCanonicalTempDir)+import Test.Hls.Util (withCanonicalTempDir) plugin :: PluginTestDescriptor () plugin = mkPluginTestDescriptor' descriptor "call-hierarchy"@@ -41,68 +42,68 @@ let contents = T.unlines ["a=3"] range = mkRange 0 0 0 3 selRange = mkRange 0 0 0 1- expected = mkCallHierarchyItemV "a" SkFunction range selRange+ expected = mkCallHierarchyItemV "a" SymbolKind_Function range selRange oneCaseWithCreate contents 0 0 expected , testCase "function" $ do let contents = T.unlines ["a=(+)"] range = mkRange 0 0 0 5 selRange = mkRange 0 0 0 1- expected = mkCallHierarchyItemV "a" SkFunction range selRange+ expected = mkCallHierarchyItemV "a" SymbolKind_Function range selRange oneCaseWithCreate contents 0 0 expected , testCase "datatype" $ do let contents = T.unlines ["data A=A"] range = mkRange 0 0 0 8 selRange = mkRange 0 5 0 6- expected = mkCallHierarchyItemT "A" SkStruct range selRange+ expected = mkCallHierarchyItemT "A" SymbolKind_Struct range selRange oneCaseWithCreate contents 0 5 expected , testCase "data constructor" $ do let contents = T.unlines ["data A=A"] range = mkRange 0 7 0 8 selRange = mkRange 0 7 0 8- expected = mkCallHierarchyItemC "A" SkConstructor range selRange+ expected = mkCallHierarchyItemC "A" SymbolKind_Constructor range selRange oneCaseWithCreate contents 0 7 expected -- , testCase "record" $ do -- let contents = T.unlines ["data A=A{a::Int}"] -- range = mkRange 0 9 0 10 -- selRange = mkRange 0 9 0 10--- expected = mkCallHierarchyItemV "a" SkField range selRange+-- expected = mkCallHierarchyItemV "a" SymbolKind_Field range selRange -- oneCaseWithCreate contents 0 9 expected , testCase "type operator" $ do let contents = T.unlines ["{-# LANGUAGE TypeOperators #-}", "type (><)=Maybe"] range = mkRange 1 0 1 15 selRange = mkRange 1 5 1 9- expected = mkCallHierarchyItemT "><" SkTypeParameter range selRange+ expected = mkCallHierarchyItemT "><" SymbolKind_TypeParameter range selRange oneCaseWithCreate contents 1 5 expected , testCase "type class" $ do let contents = T.unlines ["class A a where a :: a -> Int"] range = mkRange 0 0 0 29 selRange = mkRange 0 6 0 7- expected = mkCallHierarchyItemT "A" SkInterface range selRange+ expected = mkCallHierarchyItemT "A" SymbolKind_Interface range selRange oneCaseWithCreate contents 0 6 expected , testCase "type class method" $ do let contents = T.unlines ["class A a where a :: a -> Int"] range = mkRange 0 16 0 29 selRange = mkRange 0 16 0 17- expected = mkCallHierarchyItemV "a" SkMethod range selRange+ expected = mkCallHierarchyItemV "a" SymbolKind_Method range selRange oneCaseWithCreate contents 0 16 expected , testCase "type class instance" $ do let contents = T.unlines ["class A a where", "instance A () where"] range = mkRange 1 9 1 10 selRange = mkRange 1 9 1 10- expected = mkCallHierarchyItemT "A" SkInterface range selRange+ expected = mkCallHierarchyItemT "A" SymbolKind_Interface range selRange oneCaseWithCreate contents 1 9 expected , testGroup "type family" [ testCase "1" $ do let contents = T.unlines ["{-# LANGUAGE TypeFamilies #-}", "type family A"] range = mkRange 1 0 1 13 selRange = mkRange 1 12 1 13- expected = mkCallHierarchyItemT "A" SkFunction range selRange+ expected = mkCallHierarchyItemT "A" SymbolKind_Function range selRange oneCaseWithCreate contents 1 12 expected , testCase "2" $ do let contents = T.unlines ["{-# LANGUAGE TypeFamilies #-}", "type family A a"] range = mkRange 1 0 1 15 selRange = mkRange 1 12 1 13- expected = mkCallHierarchyItemT "A" SkFunction range selRange+ expected = mkCallHierarchyItemT "A" SymbolKind_Function range selRange oneCaseWithCreate contents 1 12 expected ] , testCase "type family instance" $ do@@ -113,20 +114,20 @@ ] range = mkRange 2 14 2 23 selRange = mkRange 2 14 2 15- expected = mkCallHierarchyItemT "A" SkInterface range selRange+ expected = mkCallHierarchyItemT "A" SymbolKind_Interface range selRange oneCaseWithCreate contents 2 14 expected , testGroup "data family" [ testCase "1" $ do let contents = T.unlines ["{-# LANGUAGE TypeFamilies #-}", "data family A"] range = mkRange 1 0 1 11 selRange = mkRange 1 12 1 13- expected = mkCallHierarchyItemT "A" SkFunction range selRange+ expected = mkCallHierarchyItemT "A" SymbolKind_Function range selRange oneCaseWithCreate contents 1 12 expected , testCase "2" $ do let contents = T.unlines [ "{-# LANGUAGE TypeFamilies #-}" , "data family A a"] range = mkRange 1 0 1 11 selRange = mkRange 1 12 1 13- expected = mkCallHierarchyItemT "A" SkFunction range selRange+ expected = mkCallHierarchyItemT "A" SymbolKind_Function range selRange oneCaseWithCreate contents 1 12 expected ] , testCase "data family instance" $ do@@ -137,25 +138,25 @@ ] range = mkRange 2 14 2 24 selRange = mkRange 2 14 2 15- expected = mkCallHierarchyItemT "A" SkInterface range selRange+ expected = mkCallHierarchyItemT "A" SymbolKind_Interface range selRange oneCaseWithCreate contents 2 14 expected , testCase "pattern" $ do let contents = T.unlines ["Just x = Just 3"] range = mkRange 0 0 0 15 selRange = mkRange 0 5 0 6- expected = mkCallHierarchyItemV "x" SkFunction range selRange+ expected = mkCallHierarchyItemV "x" SymbolKind_Function range selRange oneCaseWithCreate contents 0 5 expected , testCase "pattern with type signature" $ do let contents = T.unlines ["{-# LANGUAGE ScopedTypeVariables #-}", "a :: () = ()"] range = mkRange 1 0 1 12 selRange = mkRange 1 0 1 1- expected = mkCallHierarchyItemV "a" SkFunction range selRange+ expected = mkCallHierarchyItemV "a" SymbolKind_Function range selRange oneCaseWithCreate contents 1 0 expected , testCase "type synonym" $ do let contents = T.unlines ["type A=Bool"] range = mkRange 0 0 0 11 selRange = mkRange 0 5 0 6- expected = mkCallHierarchyItemT "A" SkTypeParameter range selRange+ expected = mkCallHierarchyItemT "A" SymbolKind_TypeParameter range selRange oneCaseWithCreate contents 0 5 expected , testCase "GADT" $ do let contents = T.unlines@@ -164,20 +165,20 @@ ] range = mkRange 1 13 1 26 selRange = mkRange 1 13 1 14- expected = mkCallHierarchyItemC "A" SkConstructor range selRange+ expected = mkCallHierarchyItemC "A" SymbolKind_Constructor range selRange oneCaseWithCreate contents 1 13 expected , testGroup "type signature" [ 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+ expected = mkCallHierarchyItemV "a" SymbolKind_Function range selRange oneCaseWithCreate contents 0 0 expected , 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- expected = mkCallHierarchyItemV "b" SkFunction range selRange+ expected = mkCallHierarchyItemV "b" SymbolKind_Function range selRange oneCaseWithCreate contents 0 2 expected ] , testCase "multi pattern" $ do@@ -187,7 +188,7 @@ ] range = mkRange 1 0 1 1 selRange = mkRange 1 0 1 1- expected = mkCallHierarchyItemV "f" SkFunction range selRange+ expected = mkCallHierarchyItemV "f" SymbolKind_Function range selRange oneCaseWithCreate contents 1 0 expected ] @@ -201,11 +202,11 @@ doc <- createDoc "A.hs" "haskell" $ T.unlines ["a=3", "b=a"] waitForIndex (testDataDir </> "A.hs") [item] <- Test.prepareCallHierarchy (mkPrepareCallHierarchyParam doc 1 0)- let expected = [CallHierarchyIncomingCall item (List [mkRange 1 2 1 3])]+ let expected = [CallHierarchyIncomingCall item [mkRange 1 2 1 3]] Test.prepareCallHierarchy (mkPrepareCallHierarchyParam doc 0 0) >>= \case [item] -> do- let itemNoData = set L.xdata Nothing item+ let itemNoData = set L.data_ Nothing item Test.incomingCalls (mkIncomingCallsParam itemNoData) >>= \res -> liftIO $ sort expected @=? sort res _ -> liftIO $ assertFailure "Not exactly one element"@@ -326,11 +327,11 @@ doc <- createDoc "A.hs" "haskell" $ T.unlines ["a=3", "b=a"] waitForIndex (dir </> "A.hs") [item] <- Test.prepareCallHierarchy (mkPrepareCallHierarchyParam doc 0 1)- let expected = [CallHierarchyOutgoingCall item (List [mkRange 1 2 1 3])]+ let expected = [CallHierarchyOutgoingCall item [mkRange 1 2 1 3]] Test.prepareCallHierarchy (mkPrepareCallHierarchyParam doc 1 0) >>= \case [item] -> do- let itemNoData = set L.xdata Nothing item+ let itemNoData = set L.data_ Nothing item Test.outgoingCalls (mkOutgoingCallsParam itemNoData) >>= \res -> liftIO $ sort expected @=? sort res _ -> liftIO $ assertFailure "Not exactly one element"@@ -421,8 +422,6 @@ ] ] -deriving instance Ord CallHierarchyIncomingCall-deriving instance Ord CallHierarchyOutgoingCall incomingCallTestCase :: T.Text -> Int -> Int -> [(Int, Int)] -> [Range] -> Assertion incomingCallTestCase contents queryX queryY positions ranges = withCanonicalTempDir $ \dir ->@@ -506,34 +505,49 @@ _ -> liftIO $ assertFailure "Not one element" closeDoc doc -oneCaseWithCreate :: T.Text -> Int -> Int -> (Uri -> CallHierarchyItem) -> Assertion+oneCaseWithCreate :: T.Text -> Int -> Int -> (Uri -> CallHierarchyItem -> Assertion) -> Assertion oneCaseWithCreate contents queryX queryY expected = withCanonicalTempDir $ \dir -> runSessionWithServer plugin dir $ do doc <- createDoc "A.hs" "haskell" contents waitForIndex (dir </> "A.hs") Test.prepareCallHierarchy (mkPrepareCallHierarchyParam doc queryX queryY) >>= \case- [item] -> liftIO $ item @?= expected (doc ^. L.uri)+ [item] -> liftIO $ expected (doc ^. L.uri) item res -> liftIO $ assertFailure "Not one element" closeDoc doc -mkCallHierarchyItem' :: String -> T.Text -> SymbolKind -> Range -> Range -> Uri -> CallHierarchyItem-mkCallHierarchyItem' prefix name kind range selRange uri =- CallHierarchyItem name kind Nothing (Just "Main") uri range selRange (Just v)+mkCallHierarchyItem' :: String -> T.Text -> SymbolKind -> Range -> Range -> Uri -> CallHierarchyItem -> Assertion+mkCallHierarchyItem' prefix name kind range selRange uri c@(CallHierarchyItem name' kind' tags' detail' uri' range' selRange' xdata') = do+ assertHierarchyItem name name'+ assertHierarchyItem kind kind'+ assertHierarchyItem tags tags'+ assertHierarchyItem detail detail'+ assertHierarchyItem uri uri'+ assertHierarchyItem range range'+ assertHierarchyItem selRange selRange'+ case xdata' of+ Nothing -> assertFailure ("In " ++ show c ++ ", got Nothing for data but wanted " ++ show xdata)+ Just v -> case fromJSON v of+ Success v -> assertBool ("In " ++ show c ++ " wanted data prefix: " ++ show xdata) (xdata `T.isPrefixOf` v)+ Error err -> assertFailure ("In " ++ show c ++ " wanted data prefix: " ++ show xdata ++ " but json parsing failed with " ++ show err) where- v = toJSON $ prefix <> ":" <> T.unpack name <> ":Main:main"+ tags = Nothing+ detail = Just "Main"+ assertHierarchyItem :: forall a. (Eq a, Show a) => a -> a -> Assertion+ assertHierarchyItem = assertEqual ("In " ++ show c ++ ", got unexpected value for field")+ xdata = T.pack prefix <> ":" <> name <> ":Main:main" mkCallHierarchyItemC, mkCallHierarchyItemT, mkCallHierarchyItemV ::- T.Text -> SymbolKind -> Range -> Range -> Uri -> CallHierarchyItem+ T.Text -> SymbolKind -> Range -> Range -> Uri -> CallHierarchyItem -> Assertion mkCallHierarchyItemC = mkCallHierarchyItem' "c" mkCallHierarchyItemT = mkCallHierarchyItem' "t" mkCallHierarchyItemV = mkCallHierarchyItem' "v" mkCallHierarchyIncomingCall :: (CallHierarchyItem, Range) -> CallHierarchyIncomingCall-mkCallHierarchyIncomingCall (item, range) = CallHierarchyIncomingCall item (List [range])+mkCallHierarchyIncomingCall (item, range) = CallHierarchyIncomingCall item [range] mkCallHierarchyOutgoingCall :: (CallHierarchyItem, Range) -> CallHierarchyOutgoingCall-mkCallHierarchyOutgoingCall (item, range) = CallHierarchyOutgoingCall item (List [range])+mkCallHierarchyOutgoingCall (item, range) = CallHierarchyOutgoingCall item [range] testDataDir :: FilePath testDataDir = "test" </> "testdata"