mirror of
https://github.com/haskell/ghcide.git
synced 2024-10-26 14:08:12 +03:00
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 commit625d710f11. * Revert "Remove JSON instances for completions, since we are not implementing "resolve"" This reverts commit12ff27dce7. * 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
This commit is contained in:
Alejandro Serrano
Moritz Kiefer
parent
5f4384e8ef
commit
a0aa013e33
@ -83,6 +83,7 @@
|
||||
- Development.IDE.Import.FindImports
|
||||
- Development.IDE.LSP.CodeAction
|
||||
- Development.IDE.Spans.Calculate
|
||||
- Development.IDE.Spans.Documentation
|
||||
- Main
|
||||
|
||||
- flags:
|
||||
|
||||
@ -41,6 +41,7 @@ library
|
||||
extra,
|
||||
fuzzy,
|
||||
filepath,
|
||||
haddock-library,
|
||||
hashable,
|
||||
haskell-lsp-types == 0.19.*,
|
||||
haskell-lsp == 0.19.*,
|
||||
|
||||
@ -7,7 +7,7 @@ module Development.IDE.Core.Completions (
|
||||
) where
|
||||
|
||||
import Control.Applicative
|
||||
import Data.Char (isSpace)
|
||||
import Data.Char (isSpace, isUpper)
|
||||
import Data.Generics
|
||||
import Data.List as List hiding (stripPrefix)
|
||||
import qualified Data.Map as Map
|
||||
@ -33,6 +33,9 @@ import Language.Haskell.LSP.Types.Capabilities
|
||||
import qualified Language.Haskell.LSP.VFS as VFS
|
||||
import Development.IDE.Core.CompletionsTypes
|
||||
import Development.IDE.Spans.Documentation
|
||||
import Development.IDE.GHC.Util
|
||||
import Development.IDE.GHC.Error
|
||||
import Development.IDE.Types.Options
|
||||
|
||||
-- From haskell-ide-engine/src/Haskell/Ide/Engine/Support/HieExtras.hs
|
||||
|
||||
@ -41,6 +44,12 @@ safeTyThingId (AnId i) = Just i
|
||||
safeTyThingId (AConLike (RealDataCon dc)) = Just $ dataConWrapId dc
|
||||
safeTyThingId _ = Nothing
|
||||
|
||||
safeTyThingType :: TyThing -> Maybe Type
|
||||
safeTyThingType thing
|
||||
| Just i <- safeTyThingId thing = Just (varType i)
|
||||
safeTyThingType (ATyCon tycon) = Just (tyConKind tycon)
|
||||
safeTyThingType _ = Nothing
|
||||
|
||||
-- From haskell-ide-engine/hie-plugin-api/Haskell/Ide/Engine/Context.hs
|
||||
|
||||
-- | A context of a declaration in the program
|
||||
@ -135,20 +144,26 @@ getCContext pos pm
|
||||
| otherwise = Nothing
|
||||
importInline _ _ = Nothing
|
||||
|
||||
occNameToComKind :: OccName -> CompletionItemKind
|
||||
occNameToComKind oc
|
||||
| isVarOcc oc = CiFunction
|
||||
| isTcOcc oc = CiClass
|
||||
occNameToComKind :: Maybe T.Text -> OccName -> CompletionItemKind
|
||||
occNameToComKind ty oc
|
||||
| isVarOcc oc = case occNameString oc of
|
||||
i:_ | isUpper i -> CiConstructor
|
||||
_ -> CiFunction
|
||||
| isTcOcc oc = case ty of
|
||||
Just t
|
||||
| "Constraint" `T.isSuffixOf` t
|
||||
-> CiClass
|
||||
_ -> CiStruct
|
||||
| isDataOcc oc = CiConstructor
|
||||
| otherwise = CiVariable
|
||||
|
||||
mkCompl :: CompItem -> CompletionItem
|
||||
mkCompl CI{origName,importedFrom,thingType,label,isInfix,docs} =
|
||||
CompletionItem label kind (Just $ maybe "" (<>"\n") typeText <> importedFrom)
|
||||
(Just $ CompletionDocMarkup $ MarkupContent MkMarkdown $ T.intercalate sectionSeparator docs)
|
||||
mkCompl :: IdeOptions -> CompItem -> CompletionItem
|
||||
mkCompl IdeOptions{..} CI{origName,importedFrom,thingType,label,isInfix,docs} =
|
||||
CompletionItem label kind ((colon <>) <$> typeText)
|
||||
(Just $ CompletionDocMarkup $ MarkupContent MkMarkdown $ T.intercalate sectionSeparator docs')
|
||||
Nothing Nothing Nothing Nothing (Just insertText) (Just Snippet)
|
||||
Nothing Nothing Nothing Nothing Nothing
|
||||
where kind = Just $ occNameToComKind $ occName origName
|
||||
where kind = Just $ occNameToComKind typeText $ occName origName
|
||||
insertText = case isInfix of
|
||||
Nothing -> case getArgText <$> thingType of
|
||||
Nothing -> label
|
||||
@ -159,6 +174,8 @@ mkCompl CI{origName,importedFrom,thingType,label,isInfix,docs} =
|
||||
typeText
|
||||
| Just t <- thingType = Just . stripForall $ T.pack (showGhc t)
|
||||
| otherwise = Nothing
|
||||
docs' = ("*Defined in '" <> importedFrom <> "'*\n") : docs
|
||||
colon = if optNewColonConvention then ": " else ":: "
|
||||
|
||||
stripForall :: T.Text -> T.Text
|
||||
stripForall t
|
||||
@ -215,8 +232,8 @@ mkPragmaCompl label insertText =
|
||||
Nothing Nothing Nothing Nothing Nothing (Just insertText) (Just Snippet)
|
||||
Nothing Nothing Nothing Nothing Nothing
|
||||
|
||||
cacheDataProducer :: DynFlags -> TypecheckedModule -> [TypecheckedModule] -> IO CachedCompletions
|
||||
cacheDataProducer dflags tm tcs = do
|
||||
cacheDataProducer :: HscEnv -> DynFlags -> TypecheckedModule -> [TypecheckedModule] -> IO CachedCompletions
|
||||
cacheDataProducer packageState dflags tm tcs = do
|
||||
let parsedMod = tm_parsed_module tm
|
||||
curMod = moduleName $ ms_mod $ pm_mod_summary parsedMod
|
||||
Just (_,limports,_,_) = tm_renamed_source tm
|
||||
@ -242,42 +259,50 @@ cacheDataProducer dflags tm tcs = do
|
||||
rdrEnv = tcg_rdr_env $ fst $ tm_internals_ tm
|
||||
rdrElts = globalRdrEnvElts rdrEnv
|
||||
|
||||
getCompls :: [GlobalRdrElt] -> ([CompItem],QualCompls)
|
||||
getCompls = foldMap getComplsForOne
|
||||
foldMapM :: (Foldable f, Monad m, Monoid b) => (a -> m b) -> f a -> m b
|
||||
foldMapM f xs = foldr step return xs mempty where
|
||||
step x r z = f x >>= \y -> r $! z `mappend` y
|
||||
|
||||
getComplsForOne :: GlobalRdrElt -> ([CompItem],QualCompls)
|
||||
getCompls :: [GlobalRdrElt] -> IO ([CompItem],QualCompls)
|
||||
getCompls = foldMapM getComplsForOne
|
||||
|
||||
getComplsForOne :: GlobalRdrElt -> IO ([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)
|
||||
Just var -> (\x -> ([x],mempty)) <$> varToCompl var
|
||||
Nothing -> (\x -> ([x],mempty)) <$> toCompItem curMod n
|
||||
Nothing -> (\x -> ([x],mempty)) <$> toCompItem curMod n
|
||||
getComplsForOne (GRE n _ False prov) =
|
||||
flip foldMap (map is_decl prov) $ \spec ->
|
||||
flip foldMapM (map is_decl prov) $ \spec -> do
|
||||
compItem <- toCompItem (is_mod spec) n
|
||||
let unqual
|
||||
| is_qual spec = []
|
||||
| otherwise = compItem
|
||||
| otherwise = [compItem]
|
||||
qual
|
||||
| is_qual spec = Map.singleton asMod compItem
|
||||
| otherwise = Map.fromList [(asMod,compItem),(origMod,compItem)]
|
||||
compItem = [toCompItem (is_mod spec) n]
|
||||
| is_qual spec = Map.singleton asMod [compItem]
|
||||
| otherwise = Map.fromList [(asMod,[compItem]),(origMod,[compItem])]
|
||||
asMod = showModName (is_as spec)
|
||||
origMod = showModName (is_mod spec)
|
||||
in (unqual,QualCompls qual)
|
||||
return (unqual,QualCompls qual)
|
||||
|
||||
varToCompl :: Var -> CompItem
|
||||
varToCompl var = CI name (showModName curMod) typ label Nothing docs
|
||||
where
|
||||
typ = Just $ varType var
|
||||
name = Var.varName var
|
||||
label = T.pack $ showGhc name
|
||||
docs = getDocumentation tcs name
|
||||
varToCompl :: Var -> IO CompItem
|
||||
varToCompl var = do
|
||||
let typ = Just $ varType var
|
||||
name = Var.varName var
|
||||
label = T.pack $ showGhc name
|
||||
docs <- getDocumentationTryGhc packageState (tm:tcs) name
|
||||
return $ CI name (showModName curMod) typ label Nothing docs
|
||||
|
||||
toCompItem :: ModuleName -> Name -> CompItem
|
||||
toCompItem mn n =
|
||||
CI n (showModName mn) Nothing (T.pack $ showGhc n) Nothing (getDocumentation tcs n)
|
||||
toCompItem :: ModuleName -> Name -> IO CompItem
|
||||
toCompItem mn n = do
|
||||
docs <- getDocumentationTryGhc packageState (tm:tcs) n
|
||||
ty <- runGhcEnv packageState $ catchSrcErrors "completion" $ do
|
||||
name' <- lookupName n
|
||||
return $ name' >>= safeTyThingType
|
||||
return $ CI n (showModName mn) (either (const Nothing) id ty) (T.pack $ showGhc n) Nothing docs
|
||||
|
||||
(unquals,quals) = getCompls rdrElts
|
||||
(unquals,quals) <- getCompls rdrElts
|
||||
|
||||
return $ CC
|
||||
{ allModNamesAsNS = allModNamesAsNS
|
||||
@ -297,8 +322,8 @@ toggleSnippets ClientCapabilities { _textDocument } (WithSnippets with) x
|
||||
where supported = fromMaybe False (_textDocument >>= _completion >>= _completionItem >>= _snippetSupport)
|
||||
|
||||
-- | Returns the cached completions for the given module and position.
|
||||
getCompletions :: CachedCompletions -> TypecheckedModule -> VFS.PosPrefixInfo -> ClientCapabilities -> WithSnippets -> IO [CompletionItem]
|
||||
getCompletions CC { allModNamesAsNS, unqualCompls, qualCompls, importableModules }
|
||||
getCompletions :: IdeOptions -> CachedCompletions -> TypecheckedModule -> VFS.PosPrefixInfo -> ClientCapabilities -> WithSnippets -> IO [CompletionItem]
|
||||
getCompletions ideOpts CC { allModNamesAsNS, unqualCompls, qualCompls, importableModules }
|
||||
tm prefixInfo caps withSnippets = do
|
||||
let VFS.PosPrefixInfo { VFS.fullLine, VFS.prefixModule, VFS.prefixText } = prefixInfo
|
||||
enteredQual = if T.null prefixModule then "" else prefixModule <> "."
|
||||
@ -382,7 +407,7 @@ getCompletions CC { allModNamesAsNS, unqualCompls, qualCompls, importableModules
|
||||
= filtPragmaCompls (pragmaSuffix fullLine)
|
||||
| otherwise
|
||||
= filtModNameCompls ++ map (toggleSnippets caps withSnippets
|
||||
. mkCompl . stripAutoGenerated) filtCompls
|
||||
. mkCompl ideOpts . stripAutoGenerated) filtCompls
|
||||
|
||||
return result
|
||||
|
||||
|
||||
@ -311,10 +311,11 @@ produceCompletions =
|
||||
deps <- maybe (TransitiveDependencies [] []) fst <$> useWithStale GetDependencies file
|
||||
tms <- mapMaybe (fmap fst) <$> usesWithStale TypeCheck (transitiveModuleDeps deps)
|
||||
tm <- fmap fst <$> useWithStale TypeCheck file
|
||||
dflags <- fmap (hsc_dflags . hscEnv . fst) <$> useWithStale GhcSession file
|
||||
case (tm, dflags) of
|
||||
(Just tm', Just dflags') -> do
|
||||
cdata <- liftIO $ cacheDataProducer dflags' (tmrModule tm') (map tmrModule tms)
|
||||
packageState <- fmap (hscEnv . fst) <$> useWithStale GhcSession file
|
||||
case (tm, packageState) of
|
||||
(Just tm', Just packageState') -> do
|
||||
cdata <- liftIO $ cacheDataProducer packageState' (hsc_dflags packageState')
|
||||
(tmrModule tm') (map tmrModule tms)
|
||||
return ([], Just (cdata, tm'))
|
||||
_ -> return ([], Nothing)
|
||||
|
||||
|
||||
@ -27,7 +27,7 @@ getCompletionsLSP lsp ide CompletionParams{_textDocument=TextDocumentIdentifier
|
||||
case (contents, uriToFilePath' uri) of
|
||||
(Just cnts, Just path) -> do
|
||||
let npath = toNormalizedFilePath path
|
||||
compls <- runAction ide (useWithStale ProduceCompletions npath)
|
||||
(ideOpts, compls) <- runAction ide ((,) <$> getIdeOptions <*> useWithStale ProduceCompletions npath)
|
||||
case compls of
|
||||
Just ((cci', tm'), mapping) -> do
|
||||
let position' = fromCurrentPosition mapping position
|
||||
@ -35,7 +35,7 @@ getCompletionsLSP lsp ide CompletionParams{_textDocument=TextDocumentIdentifier
|
||||
case pfix of
|
||||
Just pfix' -> do
|
||||
let fakeClientCapabilities = ClientCapabilities Nothing Nothing Nothing Nothing
|
||||
Completions . List <$> getCompletions cci' (tmrModule tm') pfix' fakeClientCapabilities (WithSnippets True)
|
||||
Completions . List <$> getCompletions ideOpts cci' (tmrModule tm') pfix' fakeClientCapabilities (WithSnippets True)
|
||||
_ -> return (Completions $ List [])
|
||||
_ -> return (Completions $ List [])
|
||||
_ -> return (Completions $ List [])
|
||||
|
||||
@ -1,8 +1,12 @@
|
||||
-- Copyright (c) 2019 The DAML Authors. All rights reserved.
|
||||
-- SPDX-License-Identifier: Apache-2.0
|
||||
|
||||
{-# LANGUAGE CPP #-}
|
||||
#include "ghc-api-version.h"
|
||||
|
||||
module Development.IDE.Spans.Documentation (
|
||||
getDocumentation
|
||||
, getDocumentationTryGhc
|
||||
) where
|
||||
|
||||
import Control.Monad
|
||||
@ -16,6 +20,28 @@ import FastString
|
||||
import GHC
|
||||
import SrcLoc
|
||||
|
||||
#if MIN_GHC_API_VERSION(8,6,0)
|
||||
import Data.Char (isSpace)
|
||||
import Development.IDE.GHC.Util
|
||||
import qualified Documentation.Haddock.Parser as H
|
||||
import qualified Documentation.Haddock.Types as H
|
||||
#endif
|
||||
|
||||
getDocumentationTryGhc
|
||||
:: HscEnv
|
||||
-> [TypecheckedModule]
|
||||
-> Name
|
||||
-> IO [T.Text]
|
||||
#if MIN_GHC_API_VERSION(8,6,0)
|
||||
getDocumentationTryGhc packageState tcs name = do
|
||||
res <- runGhcEnv packageState $ catchSrcErrors "docs" $ getDocs name
|
||||
case res of
|
||||
Right (Right (Just docs, _)) -> return [T.pack $ haddockToMarkdown $ H.toRegular $ H._doc $ H.parseParas Nothing $ unpackHDS docs]
|
||||
_ -> return $ getDocumentation tcs name
|
||||
#else
|
||||
getDocumentationTryGhc _packageState tcs name = do
|
||||
return $ getDocumentation tcs name
|
||||
#endif
|
||||
|
||||
getDocumentation
|
||||
:: [TypecheckedModule] -- ^ All of the possible modules it could be defined in.
|
||||
@ -90,3 +116,81 @@ docHeaders = mapMaybe (\(L _ x) -> wrk x)
|
||||
then Just $ T.pack s
|
||||
else Nothing
|
||||
_ -> Nothing
|
||||
|
||||
#if MIN_GHC_API_VERSION(8,6,0)
|
||||
-- Simple (and a bit hacky) conversion from Haddock markup to Markdown
|
||||
haddockToMarkdown
|
||||
:: H.DocH String String -> String
|
||||
|
||||
haddockToMarkdown H.DocEmpty
|
||||
= ""
|
||||
haddockToMarkdown (H.DocAppend d1 d2)
|
||||
= haddockToMarkdown d1 <> haddockToMarkdown d2
|
||||
haddockToMarkdown (H.DocString s)
|
||||
= s
|
||||
haddockToMarkdown (H.DocParagraph p)
|
||||
= "\n\n" ++ haddockToMarkdown p
|
||||
haddockToMarkdown (H.DocIdentifier i)
|
||||
= "`" ++ i ++ "`"
|
||||
haddockToMarkdown (H.DocIdentifierUnchecked i)
|
||||
= "`" ++ i ++ "`"
|
||||
haddockToMarkdown (H.DocModule i)
|
||||
= "`" ++ i ++ "`"
|
||||
haddockToMarkdown (H.DocWarning w)
|
||||
= haddockToMarkdown w
|
||||
haddockToMarkdown (H.DocEmphasis d)
|
||||
= "*" ++ haddockToMarkdown d ++ "*"
|
||||
haddockToMarkdown (H.DocBold d)
|
||||
= "**" ++ haddockToMarkdown d ++ "**"
|
||||
haddockToMarkdown (H.DocMonospaced d)
|
||||
= "`" ++ escapeBackticks (haddockToMarkdown d) ++ "`"
|
||||
where
|
||||
escapeBackticks "" = ""
|
||||
escapeBackticks ('`':ss) = '\\':'`':escapeBackticks ss
|
||||
escapeBackticks (s :ss) = s:escapeBackticks ss
|
||||
haddockToMarkdown (H.DocCodeBlock d)
|
||||
= "\n```haskell\n" ++ haddockToMarkdown d ++ "\n```\n"
|
||||
haddockToMarkdown (H.DocExamples es)
|
||||
= "\n```haskell\n" ++ unlines (map exampleToMarkdown es) ++ "\n```\n"
|
||||
where
|
||||
exampleToMarkdown (H.Example expr result)
|
||||
= ">>> " ++ expr ++ "\n" ++ unlines result
|
||||
haddockToMarkdown (H.DocHyperlink (H.Hyperlink url Nothing))
|
||||
= "<" ++ url ++ ">"
|
||||
#if MIN_VERSION_haddock_library(1,8,0)
|
||||
haddockToMarkdown (H.DocHyperlink (H.Hyperlink url (Just label)))
|
||||
= "[" ++ haddockToMarkdown label ++ "](" ++ url ++ ")"
|
||||
#else
|
||||
haddockToMarkdown (H.DocHyperlink (H.Hyperlink url (Just label)))
|
||||
= "[" ++ label ++ "](" ++ url ++ ")"
|
||||
#endif
|
||||
haddockToMarkdown (H.DocPic (H.Picture url Nothing))
|
||||
= "![](" ++ url ++ ")"
|
||||
haddockToMarkdown (H.DocPic (H.Picture url (Just label)))
|
||||
= "![" ++ label ++ "](" ++ url ++ ")"
|
||||
haddockToMarkdown (H.DocAName aname)
|
||||
= "[" ++ aname ++ "]:"
|
||||
haddockToMarkdown (H.DocHeader (H.Header level title))
|
||||
= replicate level '#' ++ " " ++ haddockToMarkdown title
|
||||
|
||||
haddockToMarkdown (H.DocUnorderedList things)
|
||||
= '\n' : (unlines $ map (\thing -> "+ " ++ dropWhile isSpace (haddockToMarkdown thing)) things)
|
||||
haddockToMarkdown (H.DocOrderedList things)
|
||||
= '\n' : (unlines $ map (\thing -> "1. " ++ dropWhile isSpace (haddockToMarkdown thing)) things)
|
||||
haddockToMarkdown (H.DocDefList things)
|
||||
= '\n' : (unlines $ map (\(term, defn) -> "+ **" ++ haddockToMarkdown term ++ "**: " ++ haddockToMarkdown defn) things)
|
||||
|
||||
-- we cannot render math by default
|
||||
haddockToMarkdown (H.DocMathInline _)
|
||||
= "*cannot render inline math formula*"
|
||||
haddockToMarkdown (H.DocMathDisplay _)
|
||||
= "\n\n*cannot render display math formula*\n\n"
|
||||
|
||||
-- TODO: render tables
|
||||
haddockToMarkdown (H.DocTable _t)
|
||||
= "\n\n*tables are not yet supported*\n\n"
|
||||
|
||||
-- things I don't really know how to handle
|
||||
haddockToMarkdown (H.DocProperty _)
|
||||
= "" -- don't really know what to do
|
||||
#endif
|
||||
@ -7,6 +7,7 @@ extra-deps:
|
||||
- lsp-test-0.10.0.0
|
||||
- hie-bios-0.3.2
|
||||
- fuzzy-0.1.0.0
|
||||
- regex-pcre-builtin-0.95.1.1.8.43
|
||||
- regex-base-0.94.0.0
|
||||
- regex-tdfa-1.3.1.0
|
||||
- parser-combinators-1.2.1
|
||||
|
||||
@ -4,6 +4,7 @@ packages:
|
||||
extra-deps:
|
||||
- hie-bios-0.3.2
|
||||
- fuzzy-0.1.0.0
|
||||
- haddock-library-1.8.0
|
||||
allow-newer: true
|
||||
nix:
|
||||
packages: [zlib]
|
||||
|
||||
@ -1246,31 +1246,66 @@ completionTests
|
||||
let source = T.unlines ["module A where", "f = hea"]
|
||||
docId <- openDoc' "A.hs" "haskell" source
|
||||
compls <- getCompletions docId (Position 1 7)
|
||||
liftIO $ compls @?= [complItem "head" (Just CiFunction)]
|
||||
liftIO $ map dropDocs compls @?=
|
||||
[complItem "head" (Just CiFunction) (Just "[a] -> a")]
|
||||
let [CompletionItem { _documentation = headDocs}] = compls
|
||||
checkDocText "head" headDocs [ "Defined in 'Prelude'"
|
||||
#if MIN_GHC_API_VERSION(8,6,0)
|
||||
, "Extract the first element of a list"
|
||||
#endif
|
||||
]
|
||||
, testSessionWait "constructor" $ do
|
||||
let source = T.unlines ["module A where", "f = Tru"]
|
||||
docId <- openDoc' "A.hs" "haskell" source
|
||||
compls <- getCompletions docId (Position 1 7)
|
||||
liftIO $ map dropDocs compls @?=
|
||||
[ complItem "True" (Just CiConstructor) (Just "Bool")
|
||||
#if MIN_GHC_API_VERSION(8,6,0)
|
||||
, complItem "truncate" (Just CiFunction) (Just "(RealFrac a, Integral b) => a -> b")
|
||||
#else
|
||||
, complItem "truncate" (Just CiFunction) (Just "RealFrac a => forall b. Integral b => a -> b")
|
||||
#endif
|
||||
]
|
||||
, testSessionWait "type" $ do
|
||||
let source = T.unlines ["{-# OPTIONS_GHC -Wall #-}", "module A () where", "f :: ()", "f = ()"]
|
||||
docId <- openDoc' "A.hs" "haskell" source
|
||||
expectDiagnostics [ ("A.hs", [(DsWarning, (3,0), "not used")]) ]
|
||||
changeDoc docId [TextDocumentContentChangeEvent Nothing Nothing $ T.unlines ["{-# OPTIONS_GHC -Wall #-}", "module A () where", "f :: Bo", "f = True"]]
|
||||
compls <- getCompletions docId (Position 2 7)
|
||||
liftIO $ compls @?=
|
||||
[ complItem "Bounded" (Just CiClass)
|
||||
, complItem "Bool" (Just CiClass)
|
||||
]
|
||||
liftIO $ map dropDocs compls @?=
|
||||
[ complItem "Bounded" (Just CiClass) (Just "* -> Constraint")
|
||||
, complItem "Bool" (Just CiStruct) (Just "*") ]
|
||||
let [ CompletionItem { _documentation = boundedDocs},
|
||||
CompletionItem { _documentation = boolDocs } ] = compls
|
||||
checkDocText "Bounded" boundedDocs [ "Defined in 'Prelude'"
|
||||
#if MIN_GHC_API_VERSION(8,6,0)
|
||||
, "name the upper and lower limits"
|
||||
#endif
|
||||
]
|
||||
checkDocText "Bool" boolDocs [ "Defined in 'Prelude'" ]
|
||||
, testSessionWait "qualified" $ do
|
||||
let source = T.unlines ["{-# OPTIONS_GHC -Wunused-binds #-}", "module A () where", "f = ()"]
|
||||
docId <- openDoc' "A.hs" "haskell" source
|
||||
expectDiagnostics [ ("A.hs", [(DsWarning, (2, 0), "not used")]) ]
|
||||
changeDoc docId [TextDocumentContentChangeEvent Nothing Nothing $ T.unlines ["{-# OPTIONS_GHC -Wunused-binds #-}", "module A () where", "f = Prelude.hea"]]
|
||||
compls <- getCompletions docId (Position 2 15)
|
||||
liftIO $ compls @?= [complItem "head" (Just CiFunction)]
|
||||
liftIO $ map dropDocs compls @?=
|
||||
[complItem "head" (Just CiFunction) (Just "[a] -> a")]
|
||||
let [CompletionItem { _documentation = headDocs}] = compls
|
||||
checkDocText "head" headDocs [ "Defined in 'Prelude'"
|
||||
#if MIN_GHC_API_VERSION(8,6,0)
|
||||
, "Extract the first element of a list"
|
||||
#endif
|
||||
]
|
||||
]
|
||||
where
|
||||
complItem label kind = CompletionItem
|
||||
dropDocs :: CompletionItem -> CompletionItem
|
||||
dropDocs ci = ci { _documentation = Nothing }
|
||||
complItem label kind ty = CompletionItem
|
||||
{ _label = label
|
||||
, _kind = kind
|
||||
, _detail = Just "Prelude"
|
||||
, _documentation = Just (CompletionDocMarkup (MarkupContent {_kind = MkMarkdown, _value = ""}))
|
||||
, _detail = (":: " <>) <$> ty
|
||||
, _documentation = Nothing
|
||||
, _deprecated = Nothing
|
||||
, _preselect = Nothing
|
||||
, _sortText = Nothing
|
||||
@ -1283,6 +1318,13 @@ completionTests
|
||||
, _command = Nothing
|
||||
, _xdata = Nothing
|
||||
}
|
||||
getDocText (CompletionDocString s) = s
|
||||
getDocText (CompletionDocMarkup (MarkupContent _ s)) = s
|
||||
checkDocText thing Nothing _
|
||||
= liftIO $ assertFailure $ "docs for " ++ thing ++ " not found"
|
||||
checkDocText thing (Just doc) items
|
||||
= liftIO $ assertBool ("docs for " ++ thing ++ " contain the strings") $
|
||||
all (`T.isInfixOf` getDocText doc) items
|
||||
|
||||
outlineTests :: TestTree
|
||||
outlineTests = testGroup
|
||||
|
||||
Loading…
Reference in New Issue
Block a user