diff --git a/src/Haskell/Ide/Engine/Plugin/GhcMod.hs b/src/Haskell/Ide/Engine/Plugin/GhcMod.hs index 44f63da81..4ee527187 100644 --- a/src/Haskell/Ide/Engine/Plugin/GhcMod.hs +++ b/src/Haskell/Ide/Engine/Plugin/GhcMod.hs @@ -681,21 +681,30 @@ symbolProvider uri = pluginGetFile "ghc-mod symbolProvider: " uri $ goValD (L l (PatBind { pat_lhs = p })) = map (\n -> Decl LSP.SkVariable n [] l) $ hsNamessRdr p +#if __GLASGOW_HASKELL__ >= 806 + goValD (L l (PatSynBind _ idR)) = case idR of + XPatSynBind _ -> error "xPatSynBind" + PSB { psb_id = ln } -> +#else + goValD (L l (PatSynBind (PSB { psb_id = ln }))) = +#endif + -- We are reporting pattern synonyms as functions. There is no such + -- thing as pattern synonym in current LSP specification so we pick up + -- an (arguably) closest match. + pure (Decl LSP.SkFunction ln [] l) + #if __GLASGOW_HASKELL__ >= 806 goValD (L _ (FunBind _ _ (XMatchGroup _) _ _)) = error "goValD" goValD (L _ (VarBind _ _ _ _)) = error "goValD" goValD (L _ (AbsBinds _ _ _ _ _ _ _)) = error "goValD" - goValD (L _ (PatSynBind _ _)) = error "goValD" goValD (L _ (XHsBindsLR _)) = error "goValD" #elif __GLASGOW_HASKELL__ >= 804 goValD (L _ (VarBind _ _ _)) = error "goValD" goValD (L _ (AbsBinds _ _ _ _ _ _)) = error "goValD" - goValD (L _ (PatSynBind _)) = error "goValD" #else goValD (L _ (VarBind _ _ _)) = error "goValD" goValD (L _ (AbsBinds _ _ _ _ _)) = error "goValD" goValD (L _ (AbsBindsSig _ _ _ _ _ _)) = error "goValD" - goValD (L _ (PatSynBind _)) = error "goValD" #endif -- ----------------------------- diff --git a/test/functional/SymbolsSpec.hs b/test/functional/SymbolsSpec.hs index 4fce37033..293ae62b2 100644 --- a/test/functional/SymbolsSpec.hs +++ b/test/functional/SymbolsSpec.hs @@ -12,20 +12,22 @@ spec :: Spec spec = describe "document symbols" $ do -- Some common ranges and selection ranges in Symbols.hs - let fooSR = Range (Position 4 0) (Position 4 3) - fooR = Range (Position 4 0) (Position 6 43) - barSR = Range (Position 5 8) (Position 5 11) - barR = Range (Position 5 8) (Position 6 43) - dogSR = Range (Position 6 17) (Position 6 20) - dogR = Range (Position 6 16) (Position 6 43) - catSR = Range (Position 6 22) (Position 6 25) - catR = Range (Position 6 16) (Position 6 43) - myDataSR = Range (Position 8 5) (Position 8 11) - myDataR = Range (Position 8 0) (Position 9 22) - aSR = Range (Position 8 14) (Position 8 15) - aR = Range (Position 8 14) (Position 8 19) - bSR = Range (Position 9 14) (Position 9 15) - bR = Range (Position 9 14) (Position 9 22) + let fooSR = Range (Position 5 0) (Position 5 3) + fooR = Range (Position 5 0) (Position 7 43) + barSR = Range (Position 6 8) (Position 6 11) + barR = Range (Position 6 8) (Position 7 43) + dogSR = Range (Position 7 17) (Position 7 20) + dogR = Range (Position 7 16) (Position 7 43) + catSR = Range (Position 7 22) (Position 7 25) + catR = Range (Position 7 16) (Position 7 43) + myDataSR = Range (Position 9 5) (Position 9 11) + myDataR = Range (Position 9 0) (Position 10 22) + aSR = Range (Position 9 14) (Position 9 15) + aR = Range (Position 9 14) (Position 9 19) + bSR = Range (Position 10 14) (Position 10 15) + bR = Range (Position 10 14) (Position 10 22) + testPatternSR = Range (Position 13 8) (Position 13 19) + testPatternR = Range (Position 13 0) (Position 13 27) describe "3.10 hierarchical document symbols" $ do it "provides nested data types and constructors" $ runSession hieCommand fullCaps "test/testdata" $ do @@ -48,6 +50,14 @@ spec = describe "document symbols" $ do cat = DocumentSymbol "cat" (Just "") SkVariable Nothing catR catSR (Just mempty) liftIO $ symbs `shouldContain` [foo] + it "provides pattern synonyms" $ runSession hieCommand fullCaps "test/testdata" $ do + doc <- openDoc "Symbols.hs" "haskell" + Left symbs <- getDocumentSymbols doc + + let testPattern = DocumentSymbol "TestPattern" + (Just "") SkFunction Nothing testPatternR testPatternSR (Just mempty) + + liftIO $ symbs `shouldContain` [testPattern] -- TODO: Test module, imports diff --git a/test/testdata/Symbols.hs b/test/testdata/Symbols.hs index aed742d00..4b3627530 100644 --- a/test/testdata/Symbols.hs +++ b/test/testdata/Symbols.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE PatternSynonyms #-} module Symbols where import Data.Maybe @@ -8,3 +9,6 @@ foo = bar data MyData = A Int | B String + +pattern TestPattern :: Int -> MyData +pattern TestPattern x = A x