diff --git a/src/Haskell/Ide/Engine/Support/HieExtras.hs b/src/Haskell/Ide/Engine/Support/HieExtras.hs index c2cc1a085..2b2867b32 100644 --- a/src/Haskell/Ide/Engine/Support/HieExtras.hs +++ b/src/Haskell/Ide/Engine/Support/HieExtras.hs @@ -8,6 +8,7 @@ module Haskell.Ide.Engine.Support.HieExtras ( getDynFlags , WithSnippets(..) , getCompletions + , resolveCompletion , getTypeForName , getSymbolsAtPoint , getReferencesInDoc @@ -25,8 +26,9 @@ module Haskell.Ide.Engine.Support.HieExtras , getFormattingPlugin ) where +import Data.Semigroup (Semigroup(..)) import ConLike -import Control.Lens.Operators ( (^?), (?~), (&) ) +import Control.Lens.Operators ( (.~), (^.), (^?), (?~), (&) ) import Control.Lens.Prism ( _Just ) import Control.Lens.Setter ((%~)) import Control.Lens.Traversal (traverseOf) @@ -39,7 +41,6 @@ import Data.IORef import qualified Data.List as List import qualified Data.Map as Map import Data.Maybe -import Data.Monoid ( (<>) ) import qualified Data.Text as T import qualified Data.Text.IO as T import Data.Typeable @@ -50,9 +51,11 @@ import FastString import Finder import GHC hiding (getContext) import GHC.Generics (Generic) +import TcRnTypes +import RdrName import qualified GhcMod as GM (splits',SplitResult(..)) -import qualified GhcModCore as GM (GhcModError(..), listVisibleModuleNames,runLightGhc, withMappedFile ) +import qualified GhcModCore as GM (GhcModError(..), listVisibleModuleNames, withMappedFile ) import Haskell.Ide.Engine.ArtifactMap import Haskell.Ide.Engine.Config @@ -60,7 +63,8 @@ import Haskell.Ide.Engine.Context import Haskell.Ide.Engine.MonadFunctions import Haskell.Ide.Engine.MonadTypes import Haskell.Ide.Engine.PluginUtils -import qualified Haskell.Ide.Engine.Support.Fuzzy as Fuzzy +import qualified Haskell.Ide.Engine.Support.Fuzzy as Fuzzy +import qualified Haskell.Ide.Engine.Plugin.Hoogle as Hoogle import HscTypes import qualified Language.Haskell.LSP.Types as J import qualified Language.Haskell.LSP.Types.Lens as J @@ -68,6 +72,7 @@ import qualified Language.Haskell.LSP.VFS as VFS import Language.Haskell.Refact.API (showGhc) import Language.Haskell.Refact.Utils.MonadFunctions import Name +import NameCache import Outputable (Outputable) import qualified Outputable as GHC import Packages @@ -75,6 +80,7 @@ import SrcLoc import TcEnv import Type import Var +import Module hiding (getModule) -- --------------------------------------------------------------------- @@ -122,6 +128,83 @@ occNameToComKind oc | otherwise = J.CiVariable type HoogleQuery = T.Text +data CompItemResolveData + = CompItemResolveData + { nameDetails :: Maybe NameDetails + , hoogleQuery :: HoogleQuery + } deriving (Eq,Generic) + +data NameDetails + = NameDetails Module OccName + deriving (Eq) + +nsJSON :: NameSpace -> Value +nsJSON ns + | isVarNameSpace ns = String "v" + | isDataConNameSpace ns = String "c" + | isTcClsNameSpace ns = String "t" + | isTvNameSpace ns = String "z" + | otherwise = error "namespace not recognized" + +parseNs :: Value -> J.Parser NameSpace +parseNs (String "v") = pure Name.varName +parseNs (String "c") = pure dataName +parseNs (String "t") = pure tcClsName +parseNs (String "z") = pure tvName +parseNs _ = mempty + +instance FromJSON NameDetails where + parseJSON v@(Array _) + = do + [modname,modid,namesp,occname] <- parseJSON v + mn <- parseJSON modname + mid <- parseJSON modid + ns <- parseNs namesp + occn <- parseJSON occname + pure $ NameDetails (mkModule (stringToUnitId mid) (mkModuleName mn)) (mkOccName ns occn) + parseJSON _ = mempty +instance ToJSON NameDetails where + toJSON (NameDetails mdl occ) = toJSON [toJSON mname,toJSON mid,nsJSON ns,toJSON occs] + where + mname = moduleNameString $ moduleName mdl + mid = unitIdString $ moduleUnitId mdl + ns = occNameSpace occ + occs = occNameString occ + +instance FromJSON CompItemResolveData where + parseJSON = genericParseJSON $ customOptions 0 +instance ToJSON CompItemResolveData where + toJSON = genericToJSON $ customOptions 0 + +resolveCompletion :: J.CompletionItem -> IdeM J.CompletionItem +resolveCompletion origCompl = + case fromJSON <$> origCompl ^. J.xdata of + Just (J.Success compdata) -> do + mdocs <- Hoogle.infoCmd' $ hoogleQuery compdata + let docText = case mdocs of + Right x -> Just x + _ -> Nothing + markup = J.MarkupContent J.MkMarkdown <$> docText + docs = J.CompletionDocMarkup <$> markup + (detail,insert) <- case nameDetails compdata of + Nothing -> pure (Nothing,Nothing) + Just nd -> do + mtyp <- getTypeForNameDetails nd + case mtyp of + Nothing -> pure (Nothing, Nothing) + Just typ -> do + let label = origCompl ^. J.label + insertText = label <> " " <> getArgText typ + det = Just . stripForall $ T.pack (showGhc typ) <> "\n" + pure (det,Just insertText) + return $ origCompl & J.documentation .~ docs + & J.insertText .~ insert + & J.detail .~ (detail <> origCompl ^. J.detail) + Just (J.Error err) -> do + debugm $ "resolveCompletion: Decoding data failed because of: " ++ err + pure origCompl + _ -> pure origCompl + mkQuery :: T.Text -> T.Text -> HoogleQuery mkQuery name importedFrom = name <> " module:" <> importedFrom @@ -131,50 +214,62 @@ mkCompl :: CompItem -> J.CompletionItem mkCompl CI{origName,importedFrom,thingType,label,isInfix} = J.CompletionItem label kind (Just $ maybe "" (<>"\n") typeText <> importedFrom) Nothing Nothing Nothing Nothing Nothing (Just insertText) (Just J.Snippet) - Nothing Nothing Nothing Nothing hoogleQuery + Nothing Nothing Nothing Nothing resolveData where kind = Just $ occNameToComKind $ occName origName - hoogleQuery = Just $ toJSON $ mkQuery label importedFrom - argTypes = maybe [] getArgs thingType + resolveData = Just $ toJSON $ CompItemResolveData nameDets hoogleQuery + hoogleQuery = mkQuery label importedFrom insertText = case isInfix of - Nothing -> case argTypes of - [] -> label - _ -> label <> " " <> argText + Nothing -> case getArgText <$> thingType of + Nothing -> label + Just argText -> label <> " " <> argText Just LeftSide -> label <> "`" Just Surrounded -> label - - argText :: T.Text - argText = mconcat $ List.intersperse " " $ zipWith snippet [1..] argTypes - stripForall t - | T.isPrefixOf "forall" t = - -- We drop 2 to remove the '.' and the space after it - T.drop 2 (T.dropWhile (/= '.') t) - | otherwise = t - snippet :: Int -> Type -> T.Text - snippet i t = T.pack $ "${" <> show i <> ":" <> showGhc t <> "}" typeText | Just t <- thingType = Just . stripForall $ T.pack (showGhc t) | otherwise = Nothing - getArgs :: Type -> [Type] - getArgs t - | isPredTy t = [] - | isDictTy t = [] - | isForAllTy t = getArgs $ snd (splitForAllTys t) - | isFunTy t = - let (args, ret) = splitFunTys t - in if isForAllTy ret - then getArgs ret - else filter (not . isDictTy) args - | isPiTy t = getArgs $ snd (splitPiTys t) - | isCoercionTy t = maybe [] (getArgs . snd) (splitCoercionType_maybe t) - | otherwise = [] + nameDets = + case (thingType, nameModule_maybe origName) of + (Just _,_) -> Nothing + (Nothing, Nothing) -> Nothing + (Nothing, Just mdl) -> Just (NameDetails mdl (nameOccName origName)) + +stripForall :: T.Text -> T.Text +stripForall t + | T.isPrefixOf "forall" t = + -- We drop 2 to remove the '.' and the space after it + T.drop 2 (T.dropWhile (/= '.') t) + | otherwise = t + +getArgText :: Type -> T.Text +getArgText typ = argText + where + argTypes = getArgs typ + argText :: T.Text + argText = mconcat $ List.intersperse " " $ zipWith snippet [1..] argTypes + snippet :: Int -> Type -> T.Text + snippet i t = T.pack $ "${" <> show i <> ":" <> showGhc t <> "}" + getArgs :: Type -> [Type] + getArgs t + | isPredTy t = [] + | isDictTy t = [] + | isForAllTy t = getArgs $ snd (splitForAllTys t) + | isFunTy t = + let (args, ret) = splitFunTys t + in if isForAllTy ret + then getArgs ret + else filter (not . isDictTy) args + | isPiTy t = getArgs $ snd (splitPiTys t) + | isCoercionTy t = maybe [] (getArgs . snd) (splitCoercionType_maybe t) + | otherwise = [] mkModCompl :: T.Text -> J.CompletionItem mkModCompl label = J.CompletionItem label (Just J.CiModule) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing - Nothing Nothing Nothing Nothing hoogleQuery - where hoogleQuery = Just $ toJSON $ "module:" <> label + Nothing Nothing Nothing Nothing (Just $ toJSON resolveData) + where hoogleQuery = "module:" <> label + resolveData = Just $ CompItemResolveData Nothing hoogleQuery mkExtCompl :: T.Text -> J.CompletionItem mkExtCompl label = @@ -194,16 +289,26 @@ safeTyThingId (AConLike (RealDataCon dc)) = Just $ dataConWrapId dc safeTyThingId _ = Nothing -- Associates a module's qualifier with its members -type QualCompls = Map.Map T.Text [CompItem] +newtype QualCompls = QualCompls { getQualCompls :: Map.Map T.Text [CompItem] } + +instance Semigroup QualCompls where + (QualCompls a) <> (QualCompls b) = QualCompls $ Map.unionWith (++) a b + +instance Monoid QualCompls where + mempty = QualCompls Map.empty + mappend = (<>) data CachedCompletions = CC { allModNamesAsNS :: [T.Text] , unqualCompls :: [CompItem] , qualCompls :: QualCompls , importableModules :: [T.Text] - , cachedExtensions :: [T.Text] } deriving (Typeable) +-- The supported languages and extensions +languagesAndExts :: [T.Text] +languagesAndExts = map T.pack GHC.supportedLanguagesAndExtensions + instance ModuleCache CachedCompletions where cacheDataProducer tm _ = do let parsedMod = tm_parsed_module tm @@ -227,11 +332,32 @@ instance ModuleCache CachedCompletions where -- The given namespaces for the imported modules (ie. full name, or alias if used) allModNamesAsNS = map (showModName . asNamespace) importDeclerations - -- The supported languages and extensions - languagesAndExts = map T.pack GHC.supportedLanguagesAndExtensions - - typeEnv = md_types $ snd $ tm_internals_ tm - toplevelVars = mapMaybe safeTyThingId $ typeEnvElts typeEnv + typeEnv = tcg_type_env $ fst $ tm_internals_ tm + rdrEnv = tcg_rdr_env $ fst $ tm_internals_ tm + rdrElts = globalRdrEnvElts rdrEnv + + getCompls :: [GlobalRdrElt] -> ([CompItem],QualCompls) + getCompls = foldMap getComplsForOne + + getComplsForOne :: GlobalRdrElt -> ([CompItem],QualCompls) + getComplsForOne (GRE n _ True _) = + case lookupTypeEnv typeEnv n of + Just tt -> case safeTyThingId tt of + Just var -> ([varToCompl var],mempty) + Nothing -> ([toCompItem curMod n],mempty) + Nothing -> ([toCompItem curMod n],mempty) + getComplsForOne (GRE n _ False prov) = + flip foldMap (map is_decl prov) $ \spec -> + let unqual + | is_qual spec = [] + | otherwise = compItem + qual + | is_qual spec = Map.singleton asMod compItem + | otherwise = Map.fromList [(asMod,compItem),(origMod,compItem)] + compItem = [toCompItem (is_mod spec) n] + asMod = showModName (is_as spec) + origMod = showModName (is_mod spec) + in (unqual,QualCompls qual) varToCompl :: Var -> CompItem varToCompl var = CI name (showModName curMod) typ label Nothing @@ -240,92 +366,16 @@ instance ModuleCache CachedCompletions where name = Var.varName var label = T.pack $ showGhc name - toplevelCompls :: [CompItem] - toplevelCompls = map varToCompl toplevelVars - toCompItem :: ModuleName -> Name -> CompItem toCompItem mn n = CI n (showModName mn) Nothing (T.pack $ showGhc n) Nothing - allImportsInfo :: [(Bool, T.Text, ModuleName, Maybe (Bool, [Name]))] - allImportsInfo = map getImpInfo importDeclerations - where - getImpInfo imp = - let modName = iDeclToModName imp - modQual = showModName (asNamespace imp) - isQual = ideclQualified imp - hasHiddsMembers = - case ideclHiding imp of - Nothing -> Nothing - Just (hasHiddens, L _ liens) -> - Just (hasHiddens, concatMap (ieNames . unLoc) liens) - in (isQual, modQual, modName, hasHiddsMembers) - - getModCompls :: GhcMonad m => HscEnv -> m ([CompItem], QualCompls) - getModCompls hscEnv = do - (unquals, qualKVs) <- foldM (orgUnqualQual hscEnv) ([], []) allImportsInfo - return (unquals, Map.fromListWith (++) qualKVs) - - orgUnqualQual hscEnv (prevUnquals, prevQualKVs) (isQual, modQual, modName, hasHiddsMembers) = - let - ifUnqual xs = if isQual then prevUnquals else prevUnquals ++ xs - setTypes = setComplsType hscEnv - in - case hasHiddsMembers of - Just (False, members) -> do - compls <- setTypes (map (toCompItem modName) members) - return - ( ifUnqual compls - , (modQual, compls) : prevQualKVs - ) - Just (True , members) -> do - let hiddens = map (toCompItem modName) members - allCompls <- getComplsFromModName modName - compls <- setTypes (allCompls List.\\ hiddens) - return - ( ifUnqual compls - , (modQual, compls) : prevQualKVs - ) - Nothing -> do - -- debugm $ "///////// Nothing " ++ (show modQual) - compls <- setTypes =<< getComplsFromModName modName - return - ( ifUnqual compls - , (modQual, compls) : prevQualKVs - ) - - getComplsFromModName :: GhcMonad m - => ModuleName -> m [CompItem] - getComplsFromModName mn = do - mminf <- getModuleInfo =<< findModule mn Nothing - return $ case mminf of - Nothing -> [] - Just minf -> map (toCompItem mn) $ modInfoExports minf - - setComplsType :: (Traversable t, MonadIO m) - => HscEnv -> t CompItem -> m (t CompItem) - setComplsType hscEnv xs = - liftIO $ forM xs $ \ci@CI{origName} -> do - mt <- (Just <$> lookupGlobal hscEnv origName) - `catch` \(_ :: SourceError) -> return Nothing - let typ = do - t <- mt - tyid <- safeTyThingId t - return $ varType tyid - return $ ci { thingType = typ } - - hscEnvRef <- ghcSession <$> readMTS - hscEnv <- liftIO $ traverse readIORef hscEnvRef - (unquals, quals) <- maybe - (pure ([], Map.empty)) - (\env -> GM.runLightGhc env (getModCompls env)) - hscEnv + (unquals,quals) = getCompls rdrElts return $ CC { allModNamesAsNS = allModNamesAsNS - , unqualCompls = toplevelCompls ++ unquals + , unqualCompls = unquals , qualCompls = quals , importableModules = moduleNames - , cachedExtensions = languagesAndExts } newtype WithSnippets = WithSnippets Bool @@ -355,7 +405,7 @@ getCompletions uri prefixInfo (WithSnippets withSnippets) = fullPrefix = enteredQual <> prefixText ifCachedModuleAndData file (IdeResultOk []) - $ \tm CachedInfo { newPosToOld } CC { allModNamesAsNS, unqualCompls, qualCompls, importableModules, cachedExtensions } -> + $ \tm CachedInfo { newPosToOld } CC { allModNamesAsNS, unqualCompls, qualCompls, importableModules } -> let -- default to value context if no explicit context context = fromMaybe ValueContext $ getContext pos (tm_parsed_module tm) @@ -423,7 +473,7 @@ getCompletions uri prefixInfo (WithSnippets withSnippets) = compls = if T.null prefixModule then unqualCompls - else Map.findWithDefault [] prefixModule qualCompls + else Map.findWithDefault [] prefixModule $ getQualCompls qualCompls mkImportCompl label = (J.detail ?~ label) . mkModCompl $ fromMaybe @@ -456,7 +506,7 @@ getCompletions uri prefixInfo (WithSnippets withSnippets) = | "import " `T.isPrefixOf` fullLine = filtImportCompls | "{-# language" `T.isPrefixOf` T.toLower fullLine - = filtOptsCompls cachedExtensions + = filtOptsCompls languagesAndExts | "{-# options_ghc" `T.isPrefixOf` T.toLower fullLine = filtOptsCompls (map (T.pack . stripLeading '-') $ GHC.flagsForCompletion False) | "{-# " `T.isPrefixOf` fullLine @@ -493,11 +543,26 @@ getTypeForName n = do hscEnvRef <- ghcSession <$> readMTS mhscEnv <- liftIO $ traverse readIORef hscEnvRef case mhscEnv of - Nothing -> return Nothing + Nothing -> pure Nothing + Just hscEnv -> liftIO $ getTypeForName_ hscEnv n + +getTypeForNameDetails :: NameDetails -> IdeM (Maybe Type) +getTypeForNameDetails (NameDetails mdl occ) = do + hscEnvRef <- ghcSession <$> readMTS + mhscEnv <- liftIO $ traverse readIORef hscEnvRef + case mhscEnv of + Nothing -> pure Nothing Just hscEnv -> do - mt <- liftIO $ (Just <$> lookupGlobal hscEnv n) - `catch` \(_ :: SomeException) -> return Nothing - return $ fmap varType $ safeTyThingId =<< mt + nc <- liftIO $ readIORef $ hsc_NC hscEnv + case lookupOrigNameCache (nsNames nc) mdl occ of + Nothing -> pure Nothing + Just n -> liftIO $ getTypeForName_ hscEnv n + +getTypeForName_ :: HscEnv -> Name -> IO (Maybe Type) +getTypeForName_ hscEnv n = do + mt <- (Just <$> lookupGlobal hscEnv n) + `catch` \(_ :: SomeException) -> return Nothing + pure $ fmap varType $ safeTyThingId =<< mt -- --------------------------------------------------------------------- diff --git a/src/Haskell/Ide/Engine/Transport/LspStdio.hs b/src/Haskell/Ide/Engine/Transport/LspStdio.hs index 59272dc42..3ec5bd81e 100644 --- a/src/Haskell/Ide/Engine/Transport/LspStdio.hs +++ b/src/Haskell/Ide/Engine/Transport/LspStdio.hs @@ -19,7 +19,7 @@ import Control.Concurrent import Control.Concurrent.STM.TChan import qualified Control.Exception as E import qualified Control.FoldDebounce as Debounce -import Control.Lens ( (^.), (.~) ) +import Control.Lens ( (^.) ) import Control.Monad import Control.Monad.IO.Class import Control.Monad.Reader @@ -30,7 +30,6 @@ import qualified Data.ByteString.Lazy as BL import Data.Coerce (coerce) import Data.Default import Data.Foldable -import Data.Function import qualified Data.Map as Map import Data.Maybe import Data.Semigroup (Semigroup(..), Option(..), option) @@ -649,22 +648,11 @@ reactor inp diagIn = do ReqCompletionItemResolve req -> do liftIO $ U.logs $ "reactor:got CompletionItemResolveRequest:" ++ show req let origCompl = req ^. J.params - mquery = case J.fromJSON <$> origCompl ^. J.xdata of - Just (J.Success q) -> Just q - _ -> Nothing - callback docText = do - let markup = J.MarkupContent J.MkMarkdown <$> docText - docs = J.CompletionDocMarkup <$> markup - rspMsg = Core.makeResponseMessage req $ - origCompl & J.documentation .~ docs + callback res = do + let rspMsg = Core.makeResponseMessage req $ res reactorSend $ RspCompletionItemResolve rspMsg - hreq = IReq tn (req ^. J.id) callback $ runIdeResultT $ case mquery of - Nothing -> return Nothing - Just query -> do - result <- lift $ lift $ Hoogle.infoCmd' query - case result of - Right x -> return $ Just x - _ -> return Nothing + hreq = IReq tn (req ^. J.id) callback $ runIdeResultT $ do + lift $ lift $ Hie.resolveCompletion origCompl makeRequest hreq -- ------------------------------- diff --git a/test/functional/CompletionSpec.hs b/test/functional/CompletionSpec.hs index e703b5923..136fdb5c1 100644 --- a/test/functional/CompletionSpec.hs +++ b/test/functional/CompletionSpec.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} module CompletionSpec where import Control.Applicative.Combinators @@ -25,9 +26,15 @@ spec = describe "completions" $ do liftIO $ do item ^. label `shouldBe` "putStrLn" item ^. kind `shouldBe` Just CiFunction - item ^. detail `shouldBe` Just "String -> IO ()\nPrelude" - item ^. insertTextFormat `shouldBe` Just Snippet - item ^. insertText `shouldBe` Just "putStrLn ${1:String}" + item ^. detail `shouldBe` Just "Prelude" + resolvedRes <- request CompletionItemResolve item + let Just (resolved :: CompletionItem) = resolvedRes ^. result + liftIO $ do + resolved ^. label `shouldBe` "putStrLn" + resolved ^. kind `shouldBe` Just CiFunction + resolved ^. detail `shouldBe` Just "String -> IO ()\nPrelude" + resolved ^. insertTextFormat `shouldBe` Just Snippet + resolved ^. insertText `shouldBe` Just "putStrLn ${1:String}" it "completes imports" $ runSession hieCommand fullCaps "test/testdata/completion" $ do doc <- openDoc "Completion.hs" "haskell" @@ -193,8 +200,10 @@ spec = describe "completions" $ do _ <- applyEdit doc te compls <- getCompletions doc (Position 5 9) let item = head $ filter ((== "id") . (^. label)) compls + resolvedRes <- request CompletionItemResolve item + let Just (resolved :: CompletionItem) = resolvedRes ^. result liftIO $ - item ^. detail `shouldBe` Just "a -> a\nPrelude" + resolved ^. detail `shouldBe` Just "a -> a\nPrelude" it "have implicit foralls with multiple type variables" $ runSession hieCommand fullCaps "test/testdata/completion" $ do doc <- openDoc "Completion.hs" "haskell" @@ -203,8 +212,10 @@ spec = describe "completions" $ do _ <- applyEdit doc te compls <- getCompletions doc (Position 5 11) let item = head $ filter ((== "flip") . (^. label)) compls + resolvedRes <- request CompletionItemResolve item + let Just (resolved :: CompletionItem) = resolvedRes ^. result liftIO $ - item ^. detail `shouldBe` Just "(a -> b -> c) -> b -> a -> c\nPrelude" + resolved ^. detail `shouldBe` Just "(a -> b -> c) -> b -> a -> c\nPrelude" describe "snippets" $ do it "work for argumentless constructors" $ runSession hieCommand fullCaps "test/testdata/completion" $ do @@ -229,11 +240,13 @@ spec = describe "completions" $ do compls <- getCompletions doc (Position 5 11) let item = head $ filter ((== "foldl") . (^. label)) compls + resolvedRes <- request CompletionItemResolve item + let Just (resolved :: CompletionItem) = resolvedRes ^. result liftIO $ do - item ^. label `shouldBe` "foldl" - item ^. kind `shouldBe` Just CiFunction - item ^. insertTextFormat `shouldBe` Just Snippet - item ^. insertText `shouldBe` Just "foldl ${1:b -> a -> b} ${2:b} ${3:t a}" + resolved ^. label `shouldBe` "foldl" + resolved ^. kind `shouldBe` Just CiFunction + resolved ^. insertTextFormat `shouldBe` Just Snippet + resolved ^. insertText `shouldBe` Just "foldl ${1:b -> a -> b} ${2:b} ${3:t a}" it "work for complex types" $ runSession hieCommand fullCaps "test/testdata/completion" $ do doc <- openDoc "Completion.hs" "haskell" @@ -244,11 +257,13 @@ spec = describe "completions" $ do compls <- getCompletions doc (Position 5 11) let item = head $ filter ((== "mapM") . (^. label)) compls + resolvedRes <- request CompletionItemResolve item + let Just (resolved :: CompletionItem) = resolvedRes ^. result liftIO $ do - item ^. label `shouldBe` "mapM" - item ^. kind `shouldBe` Just CiFunction - item ^. insertTextFormat `shouldBe` Just Snippet - item ^. insertText `shouldBe` Just "mapM ${1:a -> m b} ${2:t a}" + resolved ^. label `shouldBe` "mapM" + resolved ^. kind `shouldBe` Just CiFunction + resolved ^. insertTextFormat `shouldBe` Just Snippet + resolved ^. insertText `shouldBe` Just "mapM ${1:a -> m b} ${2:t a}" it "work for infix functions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do doc <- openDoc "Completion.hs" "haskell"