Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
178 changes: 178 additions & 0 deletions ghcide-test/exe/CompletionTests.hs
Original file line number Diff line number Diff line change
Expand Up @@ -43,6 +43,7 @@ tests
, testGroup "package" packageCompletionTests
, testGroup "project" projectCompletionTests
, testGroup "other" otherCompletionTests
, testGroup "context" contextCompletionTests
, testGroup "doc" completionDocTests
]

Expand Down Expand Up @@ -516,6 +517,183 @@ projectCompletionTests =
item ^. L.label @?= "anidentifier"
]

contextCompletionTests :: [TestTree]
contextCompletionTests =
[ completionTest
"type context filters out value completions"
[ "{-# OPTIONS_GHC -Wunused-binds #-}"
, "module A () where"
, "data Xxxtype = Xxxcon"
, "xxxval = ()"
, "g :: Xxx"
]
(Position 4 8)
[("Xxxtype", CompletionItemKind_Struct, "Xxxtype", False, True, Nothing)]

, completionTest
"type sig in where-clause gives type completions"
[ "{-# OPTIONS_GHC -Wunused-binds #-}"
, "module A () where"
, "data Xxxtype = Xxxcon"
, "xxxval = ()"
, "foo x = bar"
, " where"
, " helper :: Xxx"
, " helper = bar"
]
(Position 6 17) -- after "Xxx" in " helper :: Xxx"
[("Xxxtype", CompletionItemKind_Struct, "Xxxtype", False, True, Nothing)]

, testSessionSingleFile "value binding in where-clause gives value completions" "A.hs"
(T.unlines
[ "{-# OPTIONS_GHC -Wunused-binds #-}"
, "module A () where"
-- the type shares the value's prefix, so only the context filter excludes it.
, "data Xxxvaltype = Xxxcon"
, "xxxval = ()"
, "foo x = bar"
, " where"
, " helper = xxxv"
]) $ do
doc <- openDoc "A.hs" "haskell"
_ <- waitForDiagnostics
compls <- getCompletions doc (Position 6 16) -- after "xxxv"
let labels = map (^. L.label) compls
liftIO $ assertBool "xxxval should appear in value context" ("xxxval" `elem` labels)
liftIO $ assertBool "Xxxvaltype should not appear in value context"
(not ("Xxxvaltype" `elem` labels))

, completionTest
"type sig in nested where-clause gives type completions"
[ "{-# OPTIONS_GHC -Wunused-binds #-}"
, "module A () where"
, "data Xxxtype = Xxxcon"
, "xxxval = ()"
, "foo x = outer"
, " where"
, " inner y = result"
, " where"
, " sig :: Xxx"
, " sig = undefined"
]
(Position 8 18)
[("Xxxtype", CompletionItemKind_Struct, "Xxxtype", False, True, Nothing)]

, completionTest
"type sig in match alternative where-clause gives type completions"
[ "{-# OPTIONS_GHC -Wunused-binds #-}"
, "module A () where"
, "data Xxxtype = Xxxcon"
, "xxxval = ()"
, "foo 0 = bar"
, " where helper :: Xxx"
, "foo _ = baz"
]
(Position 5 21) -- after "Xxx" in " where helper :: Xxx"
[("Xxxtype", CompletionItemKind_Struct, "Xxxtype", False, True, Nothing)]

, completionTest
"type sig in pattern binding where-clause gives type completions"
[ "{-# OPTIONS_GHC -Wunused-binds #-}"
, "module A () where"
, "data Xxxtype = Xxxcon"
, "xxxval = ()"
, "(a, b) = (undefined, undefined)"
, " where"
, " helper :: Xxx"
, " helper = undefined"
]
(Position 6 17) -- after "Xxx" in " helper :: Xxx"
[("Xxxtype", CompletionItemKind_Struct, "Xxxtype", False, True, Nothing)]

, completionTest
"type sig in let expression gives type completions"
[ "{-# OPTIONS_GHC -Wunused-binds #-}"
, "module A () where"
, "data Xxxtype = Xxxcon"
, "xxxval = ()"
, "foo ="
, " let helper :: Xxx"
, " helper = undefined"
, " in helper"
]
(Position 5 19) -- after "Xxx" in " let helper :: Xxx"
[("Xxxtype", CompletionItemKind_Struct, "Xxxtype", False, True, Nothing)]

, testSessionSingleFile "nested non-type signature gives value completions" "A.hs"
(T.unlines
[ "{-# OPTIONS_GHC -Wunused-binds #-}"
, "module A () where"
-- the type shares the value's prefix, so only the context filter excludes it.
, "data Barrvaltype = Barrcon"
, "foo = barrval"
, " where"
, " barrval = ()"
, " {-# INLINE barrval #-}"
]) $ do
doc <- openDoc "A.hs" "haskell"
_ <- waitForDiagnostics
compls <- getCompletions doc (Position 6 20) -- after "barrv" in the INLINE pragma
let labels = map (^. L.label) compls
liftIO $ assertBool "barrval should appear (a pragma sig is not a type context)"
("barrval" `elem` labels)
liftIO $ assertBool "Barrvaltype should not appear in value context"
(not ("Barrvaltype" `elem` labels))

, testSessionSingleFile "export list gives value completions" "A.hs"
(T.unlines
[ "{-# OPTIONS_GHC -Wunused-binds #-}"
, "module A (xxx) where"
, "xxx = ()"
, "unused = ()" -- forces a warning so waitForDiagnostics has something to wait on
]) $ do
doc <- openDoc "A.hs" "haskell"
_ <- waitForDiagnostics
compls <- getCompletions doc (Position 1 12) -- inside the export list, within "xxx"
let labels = map (^. L.label) compls
liftIO $ assertBool "xxx should be completable in the export list" ("xxx" `elem` labels)

, testSessionSingleFile "export list offers type completions" "A.hs"
(T.unlines
[ "{-# OPTIONS_GHC -Wunused-binds #-}"
, "module A (Xxx) where"
, "data Xxxtype = Xxxcon"
, "unused = ()" -- forces a warning so waitForDiagnostics has something to wait on
]) $ do
doc <- openDoc "A.hs" "haskell"
_ <- waitForDiagnostics
compls <- getCompletions doc (Position 1 12) -- inside the export list, within "Xxx"
let labels = map (^. L.label) compls
liftIO $ assertBool "the type Xxxtype should be completable in the export list"
("Xxxtype" `elem` labels)

, testSessionSingleFile "import list gives module-export completions" "A.hs"
(T.unlines
[ "module A where"
, "import Data.List (per)"
]) $ do
doc <- openDoc "A.hs" "haskell"
_ <- waitForDiagnostics
compls <- getCompletions doc (Position 1 21) -- inside the import list, after "per"
let labels = map (^. L.label) compls
liftIO $ assertBool "permutations should complete inside the import list"
("permutations" `elem` labels)

, testSessionSingleFile "import hiding list gives module-export completions" "A.hs"
(T.unlines
[ "{-# OPTIONS_GHC -Wunused-binds #-}"
, "module A () where"
, "import Data.List hiding (per)"
, "unused = ()" -- force a warning to wait on with waitForDiagnostics
]) $ do
doc <- openDoc "A.hs" "haskell"
_ <- waitForDiagnostics
compls <- getCompletions doc (Position 2 28) -- inside the hiding list, after "per"
let labels = map (^. L.label) compls
liftIO $ assertBool "permutations should complete inside the hiding list"
("permutations" `elem` labels)
]

completionDocTests :: [TestTree]
completionDocTests =
[ testSessionEmpty "local define" $ do
Expand Down
1 change: 1 addition & 0 deletions ghcide/ghcide.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -174,6 +174,7 @@ library
Development.IDE.Monitoring.OpenTelemetry
Development.IDE.Plugin
Development.IDE.Plugin.Completions
Development.IDE.Plugin.Completions.Context
Development.IDE.Plugin.Completions.Types
Development.IDE.Plugin.Completions.Logic
Development.IDE.Plugin.HLS
Expand Down
61 changes: 32 additions & 29 deletions ghcide/src/Development/IDE/Plugin/Completions.hs
Original file line number Diff line number Diff line change
Expand Up @@ -8,57 +8,59 @@ module Development.IDE.Plugin.Completions
, ghcideCompletionsPluginPriority
) where

import Control.Concurrent.Async (concurrently)
import Control.Concurrent.STM.Stats (readTVarIO)
import Control.Lens ((&), (.~), (?~))
import Control.Concurrent.Async (concurrently)
import Control.Concurrent.STM.Stats (readTVarIO)
import Control.Lens ((&), (.~), (?~))
import Control.Monad.IO.Class
import Control.Monad.Trans.Except (ExceptT (ExceptT),
withExceptT)
import qualified Data.HashMap.Strict as Map
import qualified Data.HashSet as Set
import Control.Monad.Trans.Except (ExceptT (ExceptT),
withExceptT)
import qualified Data.HashMap.Strict as Map
import qualified Data.HashSet as Set
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text as T
import Development.IDE.Core.Compile
import Development.IDE.Core.FileStore (getUriContents)
import Development.IDE.Core.FileStore (getUriContents)
import Development.IDE.Core.PluginUtils
import Development.IDE.Core.PositionMapping
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.Service hiding (Log, LogShake)
import Development.IDE.Core.Shake hiding (Log,
knownTargets)
import qualified Development.IDE.Core.Shake as Shake
import Development.IDE.Core.Service hiding (Log,
LogShake)
import Development.IDE.Core.Shake hiding (Log,
knownTargets)
import qualified Development.IDE.Core.Shake as Shake
import Development.IDE.GHC.Compat
import Development.IDE.GHC.Util
import Development.IDE.Graph
import Development.IDE.Plugin.Completions.Context (deduceContext)
import Development.IDE.Plugin.Completions.Logic
import Development.IDE.Plugin.Completions.Types
import Development.IDE.Spans.Common
import Development.IDE.Spans.Documentation
import Development.IDE.Types.Exports
import Development.IDE.Types.HscEnvEq (HscEnvEq (envPackageExports, envVisibleModuleNames),
hscEnv)
import qualified Development.IDE.Types.KnownTargets as KT
import Development.IDE.Types.HscEnvEq (HscEnvEq (envPackageExports, envVisibleModuleNames),
hscEnv)
import qualified Development.IDE.Types.KnownTargets as KT
import Development.IDE.Types.Location
import Ide.Logger (Pretty (pretty),
Recorder,
WithPriority,
cmapWithPrio)
import Ide.Logger (Pretty (pretty),
Recorder,
WithPriority,
cmapWithPrio)
import Ide.Plugin.Error
import Ide.Types
import qualified Language.LSP.Protocol.Lens as L
import qualified Language.LSP.Protocol.Lens as L
import Language.LSP.Protocol.Message
import Language.LSP.Protocol.Types
import Numeric.Natural
import Prelude hiding (mod)
import Text.Fuzzy.Parallel (Scored (..))
import Prelude hiding (mod)
import Text.Fuzzy.Parallel (Scored (..))

import Development.IDE.Core.Rules (usePropertyAction)
import Development.IDE.Core.Rules (usePropertyAction)

import qualified Ide.Plugin.Config as Config
import qualified Ide.Plugin.Config as Config

import Development.IDE.Types.Options (LinkTargets (..),
linkTargets)
import qualified GHC.LanguageExtensions as LangExt
import Development.IDE.Types.Options (LinkTargets (..),
linkTargets)
import qualified GHC.LanguageExtensions as LangExt

data Log = LogShake Shake.Log deriving Show

Expand Down Expand Up @@ -208,9 +210,10 @@ getCompletionsLSP ide plId
(_, _) -> do
let clientCaps = clientCapabilities $ shakeExtras ide
plugins = idePlugins $ shakeExtras ide
context = deduceContext parsedMod position
config <- liftIO $ runAction "" ide $ getCompletionsConfig plId

let allCompletions = getCompletions plugins ideOpts cci' parsedMod astres bindMap pfix clientCaps config moduleExports uri
let allCompletions = getCompletions plugins ideOpts cci' context astres bindMap pfix clientCaps config moduleExports uri
pure $ InL (orderedCompletions allCompletions)
_ -> return (InL [])
_ -> return (InL [])
Expand Down
Loading
Loading