git.iko.soy/ghcide
on master help sign in
Better docs for completions (#288)

* Remove JSON instances for completions, since we are not implementing "resolve" * Remove completion resolve data from tests * Better docs * Fix tests * Fix for 8.4 * Turn Haddock markup into Markdown * Add types to completion items * Make it work on 8.8 and 8.4 * Revert "Remove completion resolve data from tests" This reverts commit 625d710f11db2215a886e0a75e35f646190d4b36. * Revert "Remove JSON instances for completions, since we are not implementing "resolve"" This reverts commit 12ff27dce71d06ba2f74aa8b9695aea95368e1d2. * Fix tests * Require higher version of regex-pcre-builtin * Replace Pandoc with direct conversion from Haddock to Markdown * Show kinds of type constructors too * A few fixed to Markdown conversion * Check optNewColonConvention * Fix build on 8.4 and 8.8 * More fixes for 8.4 and 8.8 * Check only the common part of the completion text * Make icons consistent with Outline * Test docs for completions * Make constructors return the corresponding CompletionItem + tests for that behavior * Make test work on 8.4

commita0aa013e3362d6ae0a963639d7845ec9990350fe authorAlejandro Serrano <trupill@gmail.com> dateThu 9 Jan 2020, 09:44 (7 years ago) parent5f4384e
9 files changed+232−56
compare with master
unifiedsplit
.hlint.yaml+1 ghcide.cabal+1 src/Development/IDE/Core/Completions.hs+66−41 src/Development/IDE/Core/Rules.hs+5−4 src/Development/IDE/LSP/Completions.hs+2−2 src/Development/IDE/Spans/Documentation.hs+104 stack.yaml+1 stack88.yaml+1 test/exe/Main.hs+51−9
.hlint.yaml+1
@@ -83,6 +83,7 @@
8383 - Development.IDE.Import.FindImports
8484 - Development.IDE.LSP.CodeAction
8585 - Development.IDE.Spans.Calculate
86+ - Development.IDE.Spans.Documentation
8687 - Main
8788
8889- flags:
ghcide.cabal+1
@@ -41,6 +41,7 @@ library
4141 extra,
4242 fuzzy,
4343 filepath,
44+ haddock-library,
4445 hashable,
4546 haskell-lsp-types == 0.19.*,
4647 haskell-lsp == 0.19.*,
src/Development/IDE/Core/Completions.hs+66−41
@@ -7,7 +7,7 @@ module Development.IDE.Core.Completions (
77) where
88
99import Control.Applicative
10−import Data.Char (isSpace)
10+import Data.Char (isSpace, isUpper)
1111import Data.Generics
1212import Data.List as List hiding (stripPrefix)
1313import qualified Data.Map as Map
@@ -33,6 +33,9 @@ import Language.Haskell.LSP.Types.Capabilities
3333import qualified Language.Haskell.LSP.VFS as VFS
3434import Development.IDE.Core.CompletionsTypes
3535import Development.IDE.Spans.Documentation
36+import Development.IDE.GHC.Util
37+import Development.IDE.GHC.Error
38+import Development.IDE.Types.Options
3639
3740-- From haskell-ide-engine/src/Haskell/Ide/Engine/Support/HieExtras.hs
3841
@@ -41,6 +44,12 @@ safeTyThingId (AnId i) = Just i
4144safeTyThingId (AConLike (RealDataCon dc)) = Just $ dataConWrapId dc
4245safeTyThingId _ = Nothing
4346
47+safeTyThingType :: TyThing -> Maybe Type
48+safeTyThingType thing
49+ | Just i <- safeTyThingId thing = Just (varType i)
50+safeTyThingType (ATyCon tycon) = Just (tyConKind tycon)
51+safeTyThingType _ = Nothing
52+
4453-- From haskell-ide-engine/hie-plugin-api/Haskell/Ide/Engine/Context.hs
4554
4655-- | A context of a declaration in the program
@@ -135,20 +144,26 @@ getCContext pos pm
135144 | otherwise = Nothing
136145 importInline _ _ = Nothing
137146
138−occNameToComKind :: OccName -> CompletionItemKind
139−occNameToComKind oc
140− | isVarOcc oc = CiFunction
141− | isTcOcc oc = CiClass
147+occNameToComKind :: Maybe T.Text -> OccName -> CompletionItemKind
148+occNameToComKind ty oc
149+ | isVarOcc oc = case occNameString oc of
150+ i:_ | isUpper i -> CiConstructor
151+ _ -> CiFunction
152+ | isTcOcc oc = case ty of
153+ Just t
154+ | "Constraint" `T.isSuffixOf` t
155+ -> CiClass
156+ _ -> CiStruct
142157 | isDataOcc oc = CiConstructor
143158 | otherwise = CiVariable
144159
145−mkCompl :: CompItem -> CompletionItem
146−mkCompl CI{origName,importedFrom,thingType,label,isInfix,docs} =
147− CompletionItem label kind (Just $ maybe "" (<>"\n") typeText <> importedFrom)
148− (Just $ CompletionDocMarkup $ MarkupContent MkMarkdown $ T.intercalate sectionSeparator docs)
160+mkCompl :: IdeOptions -> CompItem -> CompletionItem
161+mkCompl IdeOptions{..} CI{origName,importedFrom,thingType,label,isInfix,docs} =
162+ CompletionItem label kind ((colon <>) <$> typeText)
163+ (Just $ CompletionDocMarkup $ MarkupContent MkMarkdown $ T.intercalate sectionSeparator docs')
149164 Nothing Nothing Nothing Nothing (Just insertText) (Just Snippet)
150165 Nothing Nothing Nothing Nothing Nothing
151− where kind = Just $ occNameToComKind $ occName origName
166+ where kind = Just $ occNameToComKind typeText $ occName origName
152167 insertText = case isInfix of
153168 Nothing -> case getArgText <$> thingType of
154169 Nothing -> label
@@ -159,6 +174,8 @@ mkCompl CI{origName,importedFrom,thingType,label,isInfix,docs} =
159174 typeText
160175 | Just t <- thingType = Just . stripForall $ T.pack (showGhc t)
161176 | otherwise = Nothing
177+ docs' = ("*Defined in '" <> importedFrom <> "'*\n") : docs
178+ colon = if optNewColonConvention then ": " else ":: "
162179
163180stripForall :: T.Text -> T.Text
164181stripForall t
@@ -215,8 +232,8 @@ mkPragmaCompl label insertText =
215232 Nothing Nothing Nothing Nothing Nothing (Just insertText) (Just Snippet)
216233 Nothing Nothing Nothing Nothing Nothing
217234
218−cacheDataProducer :: DynFlags -> TypecheckedModule -> [TypecheckedModule] -> IO CachedCompletions
219−cacheDataProducer dflags tm tcs = do
235+cacheDataProducer :: HscEnv -> DynFlags -> TypecheckedModule -> [TypecheckedModule] -> IO CachedCompletions
236+cacheDataProducer packageState dflags tm tcs = do
220237 let parsedMod = tm_parsed_module tm
221238 curMod = moduleName $ ms_mod $ pm_mod_summary parsedMod
222239 Just (_,limports,_,_) = tm_renamed_source tm
@@ -242,42 +259,50 @@ cacheDataProducer dflags tm tcs = do
242259 rdrEnv = tcg_rdr_env $ fst $ tm_internals_ tm
243260 rdrElts = globalRdrEnvElts rdrEnv
244261
245− getCompls :: [GlobalRdrElt] -> ([CompItem],QualCompls)
246− getCompls = foldMap getComplsForOne
262+ foldMapM :: (Foldable f, Monad m, Monoid b) => (a -> m b) -> f a -> m b
263+ foldMapM f xs = foldr step return xs mempty where
264+ step x r z = f x >>= \y -> r $! z `mappend` y
265+
266+ getCompls :: [GlobalRdrElt] -> IO ([CompItem],QualCompls)
267+ getCompls = foldMapM getComplsForOne
247268
248− getComplsForOne :: GlobalRdrElt -> ([CompItem],QualCompls)
269+ getComplsForOne :: GlobalRdrElt -> IO ([CompItem],QualCompls)
249270 getComplsForOne (GRE n _ True _) =
250271 case lookupTypeEnv typeEnv n of
251272 Just tt -> case safeTyThingId tt of
252− Just var -> ([varToCompl var],mempty)
253− Nothing -> ([toCompItem curMod n],mempty)
254− Nothing -> ([toCompItem curMod n],mempty)
273+ Just var -> (\x -> ([x],mempty)) <$> varToCompl var
274+ Nothing -> (\x -> ([x],mempty)) <$> toCompItem curMod n
275+ Nothing -> (\x -> ([x],mempty)) <$> toCompItem curMod n
255276 getComplsForOne (GRE n _ False prov) =
256− flip foldMap (map is_decl prov) $ \spec ->
277+ flip foldMapM (map is_decl prov) $ \spec -> do
278+ compItem <- toCompItem (is_mod spec) n
257279 let unqual
258280 | is_qual spec = []
259− | otherwise = compItem
281+ | otherwise = [compItem]
260282 qual
261− | is_qual spec = Map.singleton asMod compItem
262− | otherwise = Map.fromList [(asMod,compItem),(origMod,compItem)]
263− compItem = [toCompItem (is_mod spec) n]
283+ | is_qual spec = Map.singleton asMod [compItem]
284+ | otherwise = Map.fromList [(asMod,[compItem]),(origMod,[compItem])]
264285 asMod = showModName (is_as spec)
265286 origMod = showModName (is_mod spec)
266− in (unqual,QualCompls qual)
267−
268− varToCompl :: Var -> CompItem
269− varToCompl var = CI name (showModName curMod) typ label Nothing docs
270− where
271− typ = Just $ varType var
272− name = Var.varName var
273− label = T.pack $ showGhc name
274− docs = getDocumentation tcs name
275−
276− toCompItem :: ModuleName -> Name -> CompItem
277− toCompItem mn n =
278− CI n (showModName mn) Nothing (T.pack $ showGhc n) Nothing (getDocumentation tcs n)
279−
280− (unquals,quals) = getCompls rdrElts
287+ return (unqual,QualCompls qual)
288+
289+ varToCompl :: Var -> IO CompItem
290+ varToCompl var = do
291+ let typ = Just $ varType var
292+ name = Var.varName var
293+ label = T.pack $ showGhc name
294+ docs <- getDocumentationTryGhc packageState (tm:tcs) name
295+ return $ CI name (showModName curMod) typ label Nothing docs
296+
297+ toCompItem :: ModuleName -> Name -> IO CompItem
298+ toCompItem mn n = do
299+ docs <- getDocumentationTryGhc packageState (tm:tcs) n
300+ ty <- runGhcEnv packageState $ catchSrcErrors "completion" $ do
301+ name' <- lookupName n
302+ return $ name' >>= safeTyThingType
303+ return $ CI n (showModName mn) (either (const Nothing) id ty) (T.pack $ showGhc n) Nothing docs
304+
305+ (unquals,quals) <- getCompls rdrElts
281306
282307 return $ CC
283308 { allModNamesAsNS = allModNamesAsNS
@@ -297,8 +322,8 @@ toggleSnippets ClientCapabilities { _textDocument } (WithSnippets with) x
297322 where supported = fromMaybe False (_textDocument >>= _completion >>= _completionItem >>= _snippetSupport)
298323
299324-- | Returns the cached completions for the given module and position.
300−getCompletions :: CachedCompletions -> TypecheckedModule -> VFS.PosPrefixInfo -> ClientCapabilities -> WithSnippets -> IO [CompletionItem]
301−getCompletions CC { allModNamesAsNS, unqualCompls, qualCompls, importableModules }
325+getCompletions :: IdeOptions -> CachedCompletions -> TypecheckedModule -> VFS.PosPrefixInfo -> ClientCapabilities -> WithSnippets -> IO [CompletionItem]
326+getCompletions ideOpts CC { allModNamesAsNS, unqualCompls, qualCompls, importableModules }
302327 tm prefixInfo caps withSnippets = do
303328 let VFS.PosPrefixInfo { VFS.fullLine, VFS.prefixModule, VFS.prefixText } = prefixInfo
304329 enteredQual = if T.null prefixModule then "" else prefixModule <> "."
@@ -382,7 +407,7 @@ getCompletions CC { allModNamesAsNS, unqualCompls, qualCompls, importableModules
382407 = filtPragmaCompls (pragmaSuffix fullLine)
383408 | otherwise
384409 = filtModNameCompls ++ map (toggleSnippets caps withSnippets
385− . mkCompl . stripAutoGenerated) filtCompls
410+ . mkCompl ideOpts . stripAutoGenerated) filtCompls
386411
387412 return result
388413
src/Development/IDE/Core/Rules.hs+5−4
@@ -311,10 +311,11 @@ produceCompletions =
311311 deps <- maybe (TransitiveDependencies [] []) fst <$> useWithStale GetDependencies file
312312 tms <- mapMaybe (fmap fst) <$> usesWithStale TypeCheck (transitiveModuleDeps deps)
313313 tm <- fmap fst <$> useWithStale TypeCheck file
314− dflags <- fmap (hsc_dflags . hscEnv . fst) <$> useWithStale GhcSession file
315− case (tm, dflags) of
316− (Just tm', Just dflags') -> do
317− cdata <- liftIO $ cacheDataProducer dflags' (tmrModule tm') (map tmrModule tms)
314+ packageState <- fmap (hscEnv . fst) <$> useWithStale GhcSession file
315+ case (tm, packageState) of
316+ (Just tm', Just packageState') -> do
317+ cdata <- liftIO $ cacheDataProducer packageState' (hsc_dflags packageState')
318+ (tmrModule tm') (map tmrModule tms)
318319 return ([], Just (cdata, tm'))
319320 _ -> return ([], Nothing)
320321
src/Development/IDE/LSP/Completions.hs+2−2
@@ -27,7 +27,7 @@ getCompletionsLSP lsp ide CompletionParams{_textDocument=TextDocumentIdentifier
2727 case (contents, uriToFilePath' uri) of
2828 (Just cnts, Just path) -> do
2929 let npath = toNormalizedFilePath path
30− compls <- runAction ide (useWithStale ProduceCompletions npath)
30+ (ideOpts, compls) <- runAction ide ((,) <$> getIdeOptions <*> useWithStale ProduceCompletions npath)
3131 case compls of
3232 Just ((cci', tm'), mapping) -> do
3333 let position' = fromCurrentPosition mapping position
@@ -35,7 +35,7 @@ getCompletionsLSP lsp ide CompletionParams{_textDocument=TextDocumentIdentifier
3535 case pfix of
3636 Just pfix' -> do
3737 let fakeClientCapabilities = ClientCapabilities Nothing Nothing Nothing Nothing
38− Completions . List <$> getCompletions cci' (tmrModule tm') pfix' fakeClientCapabilities (WithSnippets True)
38+ Completions . List <$> getCompletions ideOpts cci' (tmrModule tm') pfix' fakeClientCapabilities (WithSnippets True)
3939 _ -> return (Completions $ List [])
4040 _ -> return (Completions $ List [])
4141 _ -> return (Completions $ List [])
src/Development/IDE/Spans/Documentation.hs+104
@@ -1,8 +1,12 @@
11-- Copyright (c) 2019 The DAML Authors. All rights reserved.
22-- SPDX-License-Identifier: Apache-2.0
33
4+{-# LANGUAGE CPP #-}
5+#include "ghc-api-version.h"
6+
47module Development.IDE.Spans.Documentation (
58 getDocumentation
9+ , getDocumentationTryGhc
610 ) where
711
812import Control.Monad
@@ -16,6 +20,28 @@ import FastString
1620import GHC
1721import SrcLoc
1822
23+#if MIN_GHC_API_VERSION(8,6,0)
24+import Data.Char (isSpace)
25+import Development.IDE.GHC.Util
26+import qualified Documentation.Haddock.Parser as H
27+import qualified Documentation.Haddock.Types as H
28+#endif
29+
30+getDocumentationTryGhc
31+ :: HscEnv
32+ -> [TypecheckedModule]
33+ -> Name
34+ -> IO [T.Text]
35+#if MIN_GHC_API_VERSION(8,6,0)
36+getDocumentationTryGhc packageState tcs name = do
37+ res <- runGhcEnv packageState $ catchSrcErrors "docs" $ getDocs name
38+ case res of
39+ Right (Right (Just docs, _)) -> return [T.pack $ haddockToMarkdown $ H.toRegular $ H._doc $ H.parseParas Nothing $ unpackHDS docs]
40+ _ -> return $ getDocumentation tcs name
41+#else
42+getDocumentationTryGhc _packageState tcs name = do
43+ return $ getDocumentation tcs name
44+#endif
1945
2046getDocumentation
2147 :: [TypecheckedModule] -- ^ All of the possible modules it could be defined in.
@@ -90,3 +116,81 @@ docHeaders = mapMaybe (\(L _ x) -> wrk x)
90116 then Just $ T.pack s
91117 else Nothing
92118 _ -> Nothing
119+
120+#if MIN_GHC_API_VERSION(8,6,0)
121+-- Simple (and a bit hacky) conversion from Haddock markup to Markdown
122+haddockToMarkdown
123+ :: H.DocH String String -> String
124+
125+haddockToMarkdown H.DocEmpty
126+ = ""
127+haddockToMarkdown (H.DocAppend d1 d2)
128+ = haddockToMarkdown d1 <> haddockToMarkdown d2
129+haddockToMarkdown (H.DocString s)
130+ = s
131+haddockToMarkdown (H.DocParagraph p)
132+ = "\n\n" ++ haddockToMarkdown p
133+haddockToMarkdown (H.DocIdentifier i)
134+ = "`" ++ i ++ "`"
135+haddockToMarkdown (H.DocIdentifierUnchecked i)
136+ = "`" ++ i ++ "`"
137+haddockToMarkdown (H.DocModule i)
138+ = "`" ++ i ++ "`"
139+haddockToMarkdown (H.DocWarning w)
140+ = haddockToMarkdown w
141+haddockToMarkdown (H.DocEmphasis d)
142+ = "*" ++ haddockToMarkdown d ++ "*"
143+haddockToMarkdown (H.DocBold d)
144+ = "**" ++ haddockToMarkdown d ++ "**"
145+haddockToMarkdown (H.DocMonospaced d)
146+ = "`" ++ escapeBackticks (haddockToMarkdown d) ++ "`"
147+ where
148+ escapeBackticks "" = ""
149+ escapeBackticks ('`':ss) = '\\':'`':escapeBackticks ss
150+ escapeBackticks (s :ss) = s:escapeBackticks ss
151+haddockToMarkdown (H.DocCodeBlock d)
152+ = "\n```haskell\n" ++ haddockToMarkdown d ++ "\n```\n"
153+haddockToMarkdown (H.DocExamples es)
154+ = "\n```haskell\n" ++ unlines (map exampleToMarkdown es) ++ "\n```\n"
155+ where
156+ exampleToMarkdown (H.Example expr result)
157+ = ">>> " ++ expr ++ "\n" ++ unlines result
158+haddockToMarkdown (H.DocHyperlink (H.Hyperlink url Nothing))
159+ = "<" ++ url ++ ">"
160+#if MIN_VERSION_haddock_library(1,8,0)
161+haddockToMarkdown (H.DocHyperlink (H.Hyperlink url (Just label)))
162+ = "[" ++ haddockToMarkdown label ++ "](" ++ url ++ ")"
163+#else
164+haddockToMarkdown (H.DocHyperlink (H.Hyperlink url (Just label)))
165+ = "[" ++ label ++ "](" ++ url ++ ")"
166+#endif
167+haddockToMarkdown (H.DocPic (H.Picture url Nothing))
168+ = "![](" ++ url ++ ")"
169+haddockToMarkdown (H.DocPic (H.Picture url (Just label)))
170+ = "![" ++ label ++ "](" ++ url ++ ")"
171+haddockToMarkdown (H.DocAName aname)
172+ = "[" ++ aname ++ "]:"
173+haddockToMarkdown (H.DocHeader (H.Header level title))
174+ = replicate level '#' ++ " " ++ haddockToMarkdown title
175+
176+haddockToMarkdown (H.DocUnorderedList things)
177+ = '\n' : (unlines $ map (\thing -> "+ " ++ dropWhile isSpace (haddockToMarkdown thing)) things)
178+haddockToMarkdown (H.DocOrderedList things)
179+ = '\n' : (unlines $ map (\thing -> "1. " ++ dropWhile isSpace (haddockToMarkdown thing)) things)
180+haddockToMarkdown (H.DocDefList things)
181+ = '\n' : (unlines $ map (\(term, defn) -> "+ **" ++ haddockToMarkdown term ++ "**: " ++ haddockToMarkdown defn) things)
182+
183+-- we cannot render math by default
184+haddockToMarkdown (H.DocMathInline _)
185+ = "*cannot render inline math formula*"
186+haddockToMarkdown (H.DocMathDisplay _)
187+ = "\n\n*cannot render display math formula*\n\n"
188+
189+-- TODO: render tables
190+haddockToMarkdown (H.DocTable _t)
191+ = "\n\n*tables are not yet supported*\n\n"
192+
193+-- things I don't really know how to handle
194+haddockToMarkdown (H.DocProperty _)
195+ = "" -- don't really know what to do
196+#endif
stack.yaml+1
@@ -7,6 +7,7 @@ extra-deps:
77- lsp-test-0.10.0.0
88- hie-bios-0.3.2
99- fuzzy-0.1.0.0
10+- regex-pcre-builtin-0.95.1.1.8.43
1011- regex-base-0.94.0.0
1112- regex-tdfa-1.3.1.0
1213- parser-combinators-1.2.1
stack88.yaml+1
@@ -4,6 +4,7 @@ packages:
44extra-deps:
55- hie-bios-0.3.2
66- fuzzy-0.1.0.0
7+- haddock-library-1.8.0
78allow-newer: true
89nix:
910 packages: [zlib]
test/exe/Main.hs+51−9
@@ -1246,31 +1246,66 @@ completionTests
12461246 let source = T.unlines ["module A where", "f = hea"]
12471247 docId <- openDoc' "A.hs" "haskell" source
12481248 compls <- getCompletions docId (Position 1 7)
1249− liftIO $ compls @?= [complItem "head" (Just CiFunction)]
1249+ liftIO $ map dropDocs compls @?=
1250+ [complItem "head" (Just CiFunction) (Just "[a] -> a")]
1251+ let [CompletionItem { _documentation = headDocs}] = compls
1252+ checkDocText "head" headDocs [ "Defined in 'Prelude'"
1253+#if MIN_GHC_API_VERSION(8,6,0)
1254+ , "Extract the first element of a list"
1255+#endif
1256+ ]
1257+ , testSessionWait "constructor" $ do
1258+ let source = T.unlines ["module A where", "f = Tru"]
1259+ docId <- openDoc' "A.hs" "haskell" source
1260+ compls <- getCompletions docId (Position 1 7)
1261+ liftIO $ map dropDocs compls @?=
1262+ [ complItem "True" (Just CiConstructor) (Just "Bool")
1263+#if MIN_GHC_API_VERSION(8,6,0)
1264+ , complItem "truncate" (Just CiFunction) (Just "(RealFrac a, Integral b) => a -> b")
1265+#else
1266+ , complItem "truncate" (Just CiFunction) (Just "RealFrac a => forall b. Integral b => a -> b")
1267+#endif
1268+ ]
12501269 , testSessionWait "type" $ do
12511270 let source = T.unlines ["{-# OPTIONS_GHC -Wall #-}", "module A () where", "f :: ()", "f = ()"]
12521271 docId <- openDoc' "A.hs" "haskell" source
12531272 expectDiagnostics [ ("A.hs", [(DsWarning, (3,0), "not used")]) ]
12541273 changeDoc docId [TextDocumentContentChangeEvent Nothing Nothing $ T.unlines ["{-# OPTIONS_GHC -Wall #-}", "module A () where", "f :: Bo", "f = True"]]
12551274 compls <- getCompletions docId (Position 2 7)
1256− liftIO $ compls @?=
1257− [ complItem "Bounded" (Just CiClass)
1258− , complItem "Bool" (Just CiClass)
1259− ]
1275+ liftIO $ map dropDocs compls @?=
1276+ [ complItem "Bounded" (Just CiClass) (Just "* -> Constraint")
1277+ , complItem "Bool" (Just CiStruct) (Just "*") ]
1278+ let [ CompletionItem { _documentation = boundedDocs},
1279+ CompletionItem { _documentation = boolDocs } ] = compls
1280+ checkDocText "Bounded" boundedDocs [ "Defined in 'Prelude'"
1281+#if MIN_GHC_API_VERSION(8,6,0)
1282+ , "name the upper and lower limits"
1283+#endif
1284+ ]
1285+ checkDocText "Bool" boolDocs [ "Defined in 'Prelude'" ]
12601286 , testSessionWait "qualified" $ do
12611287 let source = T.unlines ["{-# OPTIONS_GHC -Wunused-binds #-}", "module A () where", "f = ()"]
12621288 docId <- openDoc' "A.hs" "haskell" source
12631289 expectDiagnostics [ ("A.hs", [(DsWarning, (2, 0), "not used")]) ]
12641290 changeDoc docId [TextDocumentContentChangeEvent Nothing Nothing $ T.unlines ["{-# OPTIONS_GHC -Wunused-binds #-}", "module A () where", "f = Prelude.hea"]]
12651291 compls <- getCompletions docId (Position 2 15)
1266− liftIO $ compls @?= [complItem "head" (Just CiFunction)]
1292+ liftIO $ map dropDocs compls @?=
1293+ [complItem "head" (Just CiFunction) (Just "[a] -> a")]
1294+ let [CompletionItem { _documentation = headDocs}] = compls
1295+ checkDocText "head" headDocs [ "Defined in 'Prelude'"
1296+#if MIN_GHC_API_VERSION(8,6,0)
1297+ , "Extract the first element of a list"
1298+#endif
1299+ ]
12671300 ]
12681301 where
1269− complItem label kind = CompletionItem
1302+ dropDocs :: CompletionItem -> CompletionItem
1303+ dropDocs ci = ci { _documentation = Nothing }
1304+ complItem label kind ty = CompletionItem
12701305 { _label = label
12711306 , _kind = kind
1272− , _detail = Just "Prelude"
1273− , _documentation = Just (CompletionDocMarkup (MarkupContent {_kind = MkMarkdown, _value = ""}))
1307+ , _detail = (":: " <>) <$> ty
1308+ , _documentation = Nothing
12741309 , _deprecated = Nothing
12751310 , _preselect = Nothing
12761311 , _sortText = Nothing
@@ -1283,6 +1318,13 @@ completionTests
12831318 , _command = Nothing
12841319 , _xdata = Nothing
12851320 }
1321+ getDocText (CompletionDocString s) = s
1322+ getDocText (CompletionDocMarkup (MarkupContent _ s)) = s
1323+ checkDocText thing Nothing _
1324+ = liftIO $ assertFailure $ "docs for " ++ thing ++ " not found"
1325+ checkDocText thing (Just doc) items
1326+ = liftIO $ assertBool ("docs for " ++ thing ++ " contain the strings") $
1327+ all (`T.isInfixOf` getDocText doc) items
12861328
12871329outlineTests :: TestTree
12881330outlineTests = testGroup