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
4 changes: 2 additions & 2 deletions ghcide/src/Development/IDE/Core/Rules.hs
Original file line number Diff line number Diff line change
Expand Up @@ -570,8 +570,8 @@
(tmrTypechecked -> tc, _) <- useWithStale_ TypeCheck file
(hscEnv -> hsc, _) <- useWithStale_ GhcSessionDeps file
(HAR{refMap=rf}, _) <- useWithStale_ GetHieAst file

dkMap <- liftIO $ mkDocMap hsc rf tc
linkToHackage <- optLinkToHackage <$> getIdeOptions
dkMap <- liftIO $ mkDocMap hsc rf tc linkToHackage
return ([],Just dkMap)

-- | Persistent rule to ensure that hover doesn't block on startup
Expand Down Expand Up @@ -803,7 +803,7 @@
{ source_version = ver
, old_value = m_old
, get_file_version = use GetModificationTime_{missingFileDiagnostics = False}
, get_linkable_hashes = \fs -> map (snd . fromJust . hirCoreFp) <$> uses_ GetModIface fs

Check warning on line 806 in ghcide/src/Development/IDE/Core/Rules.hs

View workflow job for this annotation

GitHub Actions / Hlint check run

Suggestion in getModIfaceFromDiskRule in module Development.IDE.Core.Rules: Use fmap ▫︎ Found: "\\ fs -> map (snd . fromJust . hirCoreFp) <$> uses_ GetModIface fs" ▫︎ Perhaps: "fmap (map (snd . fromJust . hirCoreFp)) . uses_ GetModIface"
, get_module_graph = useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph f
, regenerate = regenerateHiFile session f ms
}
Expand Down
3 changes: 2 additions & 1 deletion ghcide/src/Development/IDE/Core/Shake.hs
Original file line number Diff line number Diff line change
Expand Up @@ -441,7 +441,8 @@ getIdeOptions = do
Just env -> do
config <- liftIO $ LSP.runLspT env HLS.getClientConfig
return x{optCheckProject = pure $ checkProject config,
optCheckParents = pure $ checkParents config
optCheckParents = pure $ checkParents config,
optLinkToHackage = linkToHackage config
}

getIdeOptionsIO :: ShakeExtras -> IO IdeOptions
Expand Down
5 changes: 4 additions & 1 deletion ghcide/src/Development/IDE/Plugin/Completions.hs
Original file line number Diff line number Diff line change
Expand Up @@ -56,6 +56,7 @@ import Development.IDE.Core.Rules (usePropertyAction)

import qualified Ide.Plugin.Config as Config

import Development.IDE.Types.Options (IdeOptions (optLinkToHackage))
import qualified GHC.LanguageExtensions as LangExt

data Log = LogShake Shake.Log deriving Show
Expand Down Expand Up @@ -136,7 +137,9 @@ resolveCompletion ide _pid comp@CompletionItem{_detail,_documentation,_data_} ur
Nothing -> (mempty, mempty)
doc <- case lookupNameEnv dm name of
Just doc -> pure $ spanDocToMarkdown doc
Nothing -> liftIO $ spanDocToMarkdown . fst <$> getDocumentationTryGhc (hscEnv sess) name
Nothing -> liftIO $ do
lc <- optLinkToHackage <$> getIdeOptionsIO (shakeExtras ide)
spanDocToMarkdown . fst <$> getDocumentationTryGhc (hscEnv sess) lc name
typ <- case lookupNameEnv km name of
_ | not needType -> pure Nothing
Just ty -> pure (safeTyThingType ty)
Expand Down
54 changes: 40 additions & 14 deletions ghcide/src/Development/IDE/Spans/Documentation.hs
Original file line number Diff line number Diff line change
Expand Up @@ -22,6 +22,7 @@ import qualified Data.Map as M
import Data.Maybe
import qualified Data.Set as S
import qualified Data.Text as T
import Data.Version (showVersion)
import Development.IDE.Core.Compile
import Development.IDE.Core.RuleTypes
import Development.IDE.GHC.Compat
Expand All @@ -30,7 +31,9 @@ import Development.IDE.GHC.Error
import Development.IDE.GHC.Util (printOutputable)
import Development.IDE.Spans.Common
import GHC.Iface.Ext.Utils (RefMap)
import Language.LSP.Protocol.Types (filePathToUri, getUri)
import GHC.Plugins (GenericUnitInfo (unitPackageName))
import Language.LSP.Protocol.Types (Uri (..), filePathToUri,
getUri)
import Prelude hiding (mod)
import System.Directory
import System.FilePath
Expand All @@ -40,8 +43,9 @@ mkDocMap
:: HscEnv
-> RefMap a
-> TcGblEnv
-> Bool
-> IO DocAndTyThingMap
mkDocMap env rm this_mod =
mkDocMap env rm this_mod linkToHackage =
do
(Just Docs{docs_decls = UniqMap this_docs, docs_args = UniqMap this_arg_docs}) <- extractDocs (hsc_dflags env) this_mod
d <- foldrM getDocs (fmap (\(_, x) -> (map hsDocString x) `SpanDocString` SpanDocUris Nothing Nothing) this_docs) names
Expand All @@ -52,7 +56,7 @@ mkDocMap env rm this_mod =
getDocs n nameMap
| maybe True (mod ==) $ nameModule_maybe n = pure nameMap -- we already have the docs in this_docs, or they do not exist
| otherwise = do
(doc, _argDoc) <- getDocumentationTryGhc env n
(doc, _argDoc) <- getDocumentationTryGhc env linkToHackage n
pure $ extendNameEnv nameMap n doc
getType n nameMap
| Nothing <- lookupNameEnv nameMap n
Expand All @@ -62,7 +66,7 @@ mkDocMap env rm this_mod =
getArgDocs n nameMap
| maybe True (mod ==) $ nameModule_maybe n = pure nameMap
| otherwise = do
(_doc, argDoc) <- getDocumentationTryGhc env n
(_doc, argDoc) <- getDocumentationTryGhc env linkToHackage n
pure $ extendNameEnv nameMap n argDoc
names = rights $ S.toList idents
idents = M.keysSet rm
Expand All @@ -72,13 +76,13 @@ lookupKind :: HscEnv -> Name -> IO (Maybe TyThing)
lookupKind env =
fmap (fromRight Nothing) . catchSrcErrors (hsc_dflags env) "span" . lookupName env

getDocumentationTryGhc :: HscEnv -> Name -> IO (SpanDoc, IntMap SpanDoc)
getDocumentationTryGhc env n =
(fromMaybe (emptySpanDoc, mempty) . listToMaybe <$> getDocumentationsTryGhc env [n])
getDocumentationTryGhc :: HscEnv -> Bool -> Name -> IO (SpanDoc, IntMap SpanDoc)
getDocumentationTryGhc env l2h n =
(fromMaybe (emptySpanDoc, mempty) . listToMaybe <$> getDocumentationsTryGhc env l2h [n])
`catch` (\(_ :: IOEnvFailure) -> pure (emptySpanDoc, mempty))

getDocumentationsTryGhc :: HscEnv -> [Name] -> IO [(SpanDoc, IntMap SpanDoc)]
getDocumentationsTryGhc env names = do
getDocumentationsTryGhc :: HscEnv -> Bool -> [Name] -> IO [(SpanDoc, IntMap SpanDoc)]
getDocumentationsTryGhc env linkToHackage names = do
resOr <- catchSrcErrors (hsc_dflags env) "docs" $ getDocsBatch env names
case resOr of
Left _ -> return []
Expand All @@ -95,18 +99,37 @@ getDocumentationsTryGhc env names = do
(docFu, srcFu) <-
case nameModule_maybe name of
Just mod -> liftIO $ do
doc <- toFileUriText $ lookupDocHtmlForModule env mod
src <- toFileUriText $ lookupSrcHtmlForModule env mod
return (doc, src)
doc <- lookupDocHtmlForModule env mod
src <- lookupSrcHtmlForModule env mod
-- If found, the local files are used as hints for the hackage links, this helps with symbols defined in an internal module but re-exported by another.
if linkToHackage
then return ( toHackageDocUriText env mod (takeFileName <$> doc)
, toHackageSrcUriText env mod (takeFileName <$> src))
else pure (toFileUriText doc, toFileUriText src)
Nothing -> pure (Nothing, Nothing)

let docUri = (<> "#" <> selector <> printOutputable name) <$> docFu
srcUri = (<> "#" <> printOutputable name) <$> srcFu
selector
| isValName name = "v:"
| otherwise = "t:"
return $ SpanDocUris docUri srcUri

toFileUriText = (fmap . fmap) (getUri . filePathToUri)
toFileUriText = fmap (getUri . filePathToUri)
toHackageUriText subdir sep env mod hint = do
ui <- lookupUnit env (moduleUnit mod)
let htmlFile = case hint of
Nothing -> T.intercalate sep (map T.pack $ moduleNameChunks mod) <> ".html"
Just foundFile -> T.replace "-" sep $ T.pack foundFile
pure $!
mconcat $
[ "http://hackage.haskell.org/package/"
, printOutputable (unitPackageName ui), "-", T.pack $ showVersion (unitPackageVersion ui), "/"
, subdir , "/"
, htmlFile
]
toHackageDocUriText mod = toHackageUriText "docs" "-" mod
toHackageSrcUriText mod = toHackageUriText "docs/src" "." mod

getDocumentation
:: HasSrcSpan name
Expand Down Expand Up @@ -146,10 +169,13 @@ lookupHtmlForModule mkDocPath hscEnv m = do
-- first Language.LSP.Types.Uri.html and Language-Haskell-LSP-Types-Uri.html
-- then Language.LSP.Types.html and Language-Haskell-LSP-Types.html etc.
mns = do
chunks <- (reverse . drop1 . inits . splitOn ".") $ (moduleNameString . moduleName) m
chunks <- (reverse . drop1 . inits) $ moduleNameChunks m
-- The file might use "." or "-" as separator
map (`intercalate` chunks) [".", "-"]

moduleNameChunks :: Module -> [String]
moduleNameChunks m = splitOn "." $ (moduleNameString . moduleName) m

lookupHtmls :: HscEnv -> Unit -> Maybe [FilePath]
lookupHtmls df ui =
-- use haddockInterfaces instead of haddockHTMLs: GHC treats haddockHTMLs as URL not path
Expand Down
3 changes: 3 additions & 0 deletions ghcide/src/Development/IDE/Types/Options.hs
Original file line number Diff line number Diff line change
Expand Up @@ -85,6 +85,8 @@ data IdeOptions = IdeOptions
-- ^ Experimental feature to re-run only the subset of the Shake graph that has changed
, optVerifyCoreFile :: Bool
-- ^ Verify core files after serialization
, optLinkToHackage :: Bool
-- ^ `Documentation` and `Source` link to Hackage, rather than local docs.
}

data OptHaddockParse = HaddockParse | NoHaddockParse
Expand Down Expand Up @@ -138,6 +140,7 @@ defaultIdeOptions session = IdeOptions
,optRunSubset = True
,optVerifyCoreFile = False
,optMaxDirtyAge = 100
,optLinkToHackage = False
}

defaultSkipProgress :: Typeable a => a -> Bool
Expand Down
1 change: 1 addition & 0 deletions hls-plugin-api/src/Ide/Plugin/Config.hs
Original file line number Diff line number Diff line change
Expand Up @@ -43,6 +43,7 @@ parseConfig idePlugins defValue = A.withObject "settings" $ \o ->
<*> o .:? "cabalFormattingProvider" .!= cabalFormattingProvider defValue
<*> o .:? "maxCompletions" .!= maxCompletions defValue
<*> o .:? "sessionLoading" .!= sessionLoading defValue
<*> o .:? "linkToHackage" .!= linkToHackage defValue
<*> A.explicitParseFieldMaybe (parsePlugins idePlugins) o "plugin" .!= plugins defValue

-- | Parse the 'PluginConfig'.
Expand Down
3 changes: 3 additions & 0 deletions hls-plugin-api/src/Ide/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -178,6 +178,7 @@ data Config =
, cabalFormattingProvider :: !T.Text
, maxCompletions :: !Int
, sessionLoading :: !SessionLoadingPreferenceConfig
, linkToHackage :: !Bool
, plugins :: !(Map.Map PluginId PluginConfig)
} deriving (Show,Eq)

Expand All @@ -189,6 +190,7 @@ instance ToJSON Config where
, "cabalFormattingProvider" .= cabalFormattingProvider
, "maxCompletions" .= maxCompletions
, "sessionLoading" .= sessionLoading
, "linkToHackage" .= linkToHackage
, "plugin" .= Map.mapKeysMonotonic (\(PluginId p) -> p) plugins
]

Expand All @@ -204,6 +206,7 @@ instance Default Config where
-- this string value needs to kept in sync with the value provided in HlsPlugins
, maxCompletions = 40
, sessionLoading = PreferSingleComponentLoading
, linkToHackage = False
, plugins = mempty
}

Expand Down
1 change: 1 addition & 0 deletions test/testdata/schema/ghc910/default-config.golden.json
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,7 @@
"checkParents": "CheckOnSave",
"checkProject": true,
"formattingProvider": "ormolu",
"linkToHackage": false,
"maxCompletions": 40,
"plugin": {
"alternateNumberFormat": {
Expand Down
1 change: 1 addition & 0 deletions test/testdata/schema/ghc912/default-config.golden.json
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,7 @@
"checkParents": "CheckOnSave",
"checkProject": true,
"formattingProvider": "ormolu",
"linkToHackage": false,
"maxCompletions": 40,
"plugin": {
"alternateNumberFormat": {
Expand Down
1 change: 1 addition & 0 deletions test/testdata/schema/ghc96/default-config.golden.json
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,7 @@
"checkParents": "CheckOnSave",
"checkProject": true,
"formattingProvider": "ormolu",
"linkToHackage": false,
"maxCompletions": 40,
"plugin": {
"alternateNumberFormat": {
Expand Down
1 change: 1 addition & 0 deletions test/testdata/schema/ghc98/default-config.golden.json
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,7 @@
"checkParents": "CheckOnSave",
"checkProject": true,
"formattingProvider": "ormolu",
"linkToHackage": false,
"maxCompletions": 40,
"plugin": {
"alternateNumberFormat": {
Expand Down
Loading