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 @@ -586,8 +586,8 @@ getDocMapRule recorder =
(tmrTypechecked -> tc, _) <- useWithStale_ TypeCheck file
(hscEnv -> hsc, _) <- useWithStale_ GhcSessionDeps file
(HAR{refMap=rf}, _) <- useWithStale_ GetHieAst file

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

-- | Persistent rule to ensure that hover doesn't block on startup
Expand Down
4 changes: 3 additions & 1 deletion ghcide/src/Development/IDE/Core/Shake.hs
Original file line number Diff line number Diff line change
Expand Up @@ -450,7 +450,9 @@ 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,
optLinkSourceTo = linkSourceTo config,
optLinkDocTo = linkDocTo config
}

getIdeOptionsIO :: ShakeExtras -> IO IdeOptions
Expand Down
6 changes: 5 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,8 @@ import Development.IDE.Core.Rules (usePropertyAction)

import qualified Ide.Plugin.Config as Config

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

data Log = LogShake Shake.Log deriving Show
Expand Down Expand Up @@ -136,7 +138,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
ltgts <- linkTargets <$> getIdeOptionsIO (shakeExtras ide)
spanDocToMarkdown . fst <$> getDocumentationTryGhc (hscEnv sess) ltgts name
typ <- case lookupNameEnv km name of
_ | not needType -> pure Nothing
Just ty -> pure (safeTyThingType ty)
Expand Down
65 changes: 51 additions & 14 deletions ghcide/src/Development/IDE/Spans/Documentation.hs
Original file line number Diff line number Diff line change
Expand Up @@ -22,15 +22,20 @@ 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
import Development.IDE.GHC.Compat.Util
import Development.IDE.GHC.Error
import Development.IDE.GHC.Util (printOutputable)
import Development.IDE.Spans.Common
import Development.IDE.Types.Options (LinkTargets (..))
import GHC.Iface.Ext.Utils (RefMap)
import Language.LSP.Protocol.Types (filePathToUri, getUri)
import GHC.Plugins (GenericUnitInfo (unitPackageName))
import Ide.Types (OptLinkTo (..))
import Language.LSP.Protocol.Types (Uri (..), filePathToUri,
getUri)
import Prelude hiding (mod)
import System.Directory
import System.FilePath
Expand All @@ -40,8 +45,9 @@ mkDocMap
:: HscEnv
-> RefMap a
-> TcGblEnv
-> LinkTargets
-> IO DocAndTyThingMap
mkDocMap env rm this_mod =
mkDocMap env rm this_mod linkTgts =
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 +58,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 linkTgts n
pure $ extendNameEnv nameMap n doc
getType n nameMap
| Nothing <- lookupNameEnv nameMap n
Expand All @@ -62,7 +68,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 linkTgts n
pure $ extendNameEnv nameMap n argDoc
names = rights $ S.toList idents
idents = M.keysSet rm
Expand All @@ -72,13 +78,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 -> LinkTargets -> 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 -> LinkTargets -> [Name] -> IO [(SpanDoc, IntMap SpanDoc)]
getDocumentationsTryGhc env linkTgts names = do
resOr <- catchSrcErrors (hsc_dflags env) "docs" $ getDocsBatch env names
case resOr of
Left _ -> return []
Expand All @@ -95,18 +101,46 @@ 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.
let
LinkTargets{linkDoc,linkSource} = linkTgts
doc_link = case linkDoc of
LinkToHackage ->
toHackageDocUriText env mod (takeFileName <$> doc)
LinkToLocal ->
toFileUriText doc
src_link = case linkSource of
LinkToHackage ->
toHackageSrcUriText env mod (takeFileName <$> src)
LinkToLocal ->
toFileUriText src
Comment on lines +110 to +118
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

( personal nitpick , this is also fine)
can make these one lines
i.e

    LinkToHackage -> toHackageDocUriText env mod (takeFileName <$> doc)
    LinkToLocal -> toFileUriText doc
src_link = case linkSource of
    LinkToHackage ->  toHackageSrcUriText env mod (takeFileName <$> src)
    LinkToLocal -> toFileUriText src

pure (doc_link, src_link)
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/"
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

We can use https here

, 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 +180,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
22 changes: 21 additions & 1 deletion ghcide/src/Development/IDE/Types/Options.hs
Original file line number Diff line number Diff line change
Expand Up @@ -16,6 +16,8 @@ module Development.IDE.Types.Options
, IdeGhcSession(..)
, OptHaddockParse(..)
, ProgressReportingStyle(..)
, LinkTargets(..)
, linkTargets
) where

import Control.Lens
Expand All @@ -26,7 +28,8 @@ import Development.IDE.GHC.Compat as GHC
import Development.IDE.Graph
import Development.IDE.Types.Diagnostics
import Ide.Plugin.Config
import Ide.Types (DynFlagsModifications)
import Ide.Types (DynFlagsModifications,
OptLinkTo (..))
import qualified Language.LSP.Protocol.Lens as L
import qualified Language.LSP.Protocol.Types as LSP

Expand Down Expand Up @@ -85,6 +88,21 @@ 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
, optLinkSourceTo :: OptLinkTo
-- ^ `Source` link to Hackage or local sources.
, optLinkDocTo :: OptLinkTo
-- ^ `Documentation` link to Hackage or local docs.
}

data LinkTargets = LinkTargets
{ linkSource :: !OptLinkTo
, linkDoc :: !OptLinkTo
}

linkTargets :: IdeOptions -> LinkTargets
linkTargets IdeOptions{..} = LinkTargets
{ linkSource = optLinkSourceTo
, linkDoc = optLinkDocTo
}

data OptHaddockParse = HaddockParse | NoHaddockParse
Expand Down Expand Up @@ -138,6 +156,8 @@ defaultIdeOptions session = IdeOptions
,optRunSubset = True
,optVerifyCoreFile = False
,optMaxDirtyAge = 100
,optLinkSourceTo = LinkToLocal
,optLinkDocTo = LinkToLocal
}

defaultSkipProgress :: Typeable a => a -> Bool
Expand Down
3 changes: 3 additions & 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,9 @@ parseConfig idePlugins defValue = A.withObject "settings" $ \o ->
<*> o .:? "cabalFormattingProvider" .!= cabalFormattingProvider defValue
<*> o .:? "maxCompletions" .!= maxCompletions defValue
<*> o .:? "sessionLoading" .!= sessionLoading defValue
<*> o .:? "linkSourceTo" .!= linkSourceTo defValue
<*> o .:? "linkDocTo" .!=
linkDocTo defValue
<*> A.explicitParseFieldMaybe (parsePlugins idePlugins) o "plugin" .!= plugins defValue

-- | Parse the 'PluginConfig'.
Expand Down
12 changes: 12 additions & 0 deletions hls-plugin-api/src/Ide/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -23,6 +23,7 @@ module Ide.Types
, IdePlugins(IdePlugins, ipMap)
, DynFlagsModifications(..)
, Config(..), PluginConfig(..), CheckParents(..), SessionLoadingPreferenceConfig(..)
, OptLinkTo(..)
, ConfigDescriptor(..), defaultConfigDescriptor, configForPlugin
, CustomConfig(..), mkCustomConfig
, FallbackCodeActionParams(..)
Expand Down Expand Up @@ -179,6 +180,8 @@ data Config =
, cabalFormattingProvider :: !T.Text
, maxCompletions :: !Int
, sessionLoading :: !SessionLoadingPreferenceConfig
, linkSourceTo :: !OptLinkTo
, linkDocTo :: !OptLinkTo
, plugins :: !(Map.Map PluginId PluginConfig)
} deriving (Show,Eq)

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

Expand All @@ -204,6 +209,8 @@ instance Default Config where
-- this string value needs to kept in sync with the value provided in HlsPlugins
, maxCompletions = 40
, sessionLoading = PreferSingleComponentLoading
, linkSourceTo = LinkToLocal
, linkDocTo = LinkToLocal
, plugins = mempty
}

Expand All @@ -217,6 +224,11 @@ data CheckParents
deriving anyclass (FromJSON, ToJSON)


data OptLinkTo = LinkToHackage | LinkToLocal
deriving stock (Eq, Ord, Show, Enum, Generic)
deriving anyclass (FromJSON, ToJSON)


data SessionLoadingPreferenceConfig
= PreferSingleComponentLoading
-- ^ Always load only a singleComponent when a new component
Expand Down
2 changes: 2 additions & 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,8 @@
"checkParents": "CheckOnSave",
"checkProject": true,
"formattingProvider": "ormolu",
"linkDocTo": "LinkToLocal",
"linkSourceTo": "LinkToLocal",
"maxCompletions": 40,
"plugin": {
"alternateNumberFormat": {
Expand Down
2 changes: 2 additions & 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,8 @@
"checkParents": "CheckOnSave",
"checkProject": true,
"formattingProvider": "ormolu",
"linkDocTo": "LinkToLocal",
"linkSourceTo": "LinkToLocal",
"maxCompletions": 40,
"plugin": {
"alternateNumberFormat": {
Expand Down
2 changes: 2 additions & 0 deletions test/testdata/schema/ghc914/default-config.golden.json
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,8 @@
"checkParents": "CheckOnSave",
"checkProject": true,
"formattingProvider": "ormolu",
"linkDocTo": "LinkToLocal",
"linkSourceTo": "LinkToLocal",
"maxCompletions": 40,
"plugin": {
"alternateNumberFormat": {
Expand Down
2 changes: 2 additions & 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,8 @@
"checkParents": "CheckOnSave",
"checkProject": true,
"formattingProvider": "ormolu",
"linkDocTo": "LinkToLocal",
"linkSourceTo": "LinkToLocal",
"maxCompletions": 40,
"plugin": {
"alternateNumberFormat": {
Expand Down
2 changes: 2 additions & 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,8 @@
"checkParents": "CheckOnSave",
"checkProject": true,
"formattingProvider": "ormolu",
"linkDocTo": "LinkToLocal",
"linkSourceTo": "LinkToLocal",
"maxCompletions": 40,
"plugin": {
"alternateNumberFormat": {
Expand Down
Loading