Skip to content

Commit 4977a57

Browse files
committed
have separate linkDocTo and linkSourceTo
1 parent 43b8a5c commit 4977a57

7 files changed

Lines changed: 66 additions & 25 deletions

File tree

ghcide/src/Development/IDE/Core/Rules.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -583,8 +583,8 @@ getDocMapRule recorder =
583583
(tmrTypechecked -> tc, _) <- useWithStale_ TypeCheck file
584584
(hscEnv -> hsc, _) <- useWithStale_ GhcSessionDeps file
585585
(HAR{refMap=rf}, _) <- useWithStale_ GetHieAst file
586-
linkToHackage <- optLinkToHackage <$> getIdeOptions
587-
dkMap <- liftIO $ mkDocMap hsc rf tc linkToHackage
586+
linkTgts <- linkTargets <$> getIdeOptions
587+
dkMap <- liftIO $ mkDocMap hsc rf tc linkTgts
588588
return ([],Just dkMap)
589589

590590
-- | Persistent rule to ensure that hover doesn't block on startup

ghcide/src/Development/IDE/Core/Shake.hs

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -449,7 +449,8 @@ getIdeOptions = do
449449
config <- liftIO $ LSP.runLspT env HLS.getClientConfig
450450
return x{optCheckProject = pure $ checkProject config,
451451
optCheckParents = pure $ checkParents config,
452-
optLinkToHackage = linkToHackage config
452+
optLinkSourceTo = linkSourceTo config,
453+
optLinkDocTo = linkDocTo config
453454
}
454455

455456
getIdeOptionsIO :: ShakeExtras -> IO IdeOptions

ghcide/src/Development/IDE/Plugin/Completions.hs

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -56,7 +56,8 @@ import Development.IDE.Core.Rules (usePropertyAction)
5656

5757
import qualified Ide.Plugin.Config as Config
5858

59-
import Development.IDE.Types.Options (IdeOptions (optLinkToHackage))
59+
import Development.IDE.Types.Options (LinkTargets (..),
60+
linkTargets)
6061
import qualified GHC.LanguageExtensions as LangExt
6162

6263
data Log = LogShake Shake.Log deriving Show
@@ -138,8 +139,8 @@ resolveCompletion ide _pid comp@CompletionItem{_detail,_documentation,_data_} ur
138139
doc <- case lookupNameEnv dm name of
139140
Just doc -> pure $ spanDocToMarkdown doc
140141
Nothing -> liftIO $ do
141-
lc <- optLinkToHackage <$> getIdeOptionsIO (shakeExtras ide)
142-
spanDocToMarkdown . fst <$> getDocumentationTryGhc (hscEnv sess) lc name
142+
ltgts <- linkTargets <$> getIdeOptionsIO (shakeExtras ide)
143+
spanDocToMarkdown . fst <$> getDocumentationTryGhc (hscEnv sess) ltgts name
143144
typ <- case lookupNameEnv km name of
144145
_ | not needType -> pure Nothing
145146
Just ty -> pure (safeTyThingType ty)

ghcide/src/Development/IDE/Spans/Documentation.hs

Lines changed: 22 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -30,8 +30,10 @@ import Development.IDE.GHC.Compat.Util
3030
import Development.IDE.GHC.Error
3131
import Development.IDE.GHC.Util (printOutputable)
3232
import Development.IDE.Spans.Common
33+
import Development.IDE.Types.Options (LinkTargets (..))
3334
import GHC.Iface.Ext.Utils (RefMap)
3435
import GHC.Plugins (GenericUnitInfo (unitPackageName))
36+
import Ide.Types (OptLinkTo (..))
3537
import Language.LSP.Protocol.Types (Uri (..), filePathToUri,
3638
getUri)
3739
import Prelude hiding (mod)
@@ -43,9 +45,9 @@ mkDocMap
4345
:: HscEnv
4446
-> RefMap a
4547
-> TcGblEnv
46-
-> Bool
48+
-> LinkTargets
4749
-> IO DocAndTyThingMap
48-
mkDocMap env rm this_mod linkToHackage =
50+
mkDocMap env rm this_mod linkTgts =
4951
do
5052
(Just Docs{docs_decls = UniqMap this_docs, docs_args = UniqMap this_arg_docs}) <- extractDocs (hsc_dflags env) this_mod
5153
d <- foldrM getDocs (fmap (\(_, x) -> (map hsDocString x) `SpanDocString` SpanDocUris Nothing Nothing) this_docs) names
@@ -56,7 +58,7 @@ mkDocMap env rm this_mod linkToHackage =
5658
getDocs n nameMap
5759
| maybe True (mod ==) $ nameModule_maybe n = pure nameMap -- we already have the docs in this_docs, or they do not exist
5860
| otherwise = do
59-
(doc, _argDoc) <- getDocumentationTryGhc env linkToHackage n
61+
(doc, _argDoc) <- getDocumentationTryGhc env linkTgts n
6062
pure $ extendNameEnv nameMap n doc
6163
getType n nameMap
6264
| Nothing <- lookupNameEnv nameMap n
@@ -66,7 +68,7 @@ mkDocMap env rm this_mod linkToHackage =
6668
getArgDocs n nameMap
6769
| maybe True (mod ==) $ nameModule_maybe n = pure nameMap
6870
| otherwise = do
69-
(_doc, argDoc) <- getDocumentationTryGhc env linkToHackage n
71+
(_doc, argDoc) <- getDocumentationTryGhc env linkTgts n
7072
pure $ extendNameEnv nameMap n argDoc
7173
names = rights $ S.toList idents
7274
idents = M.keysSet rm
@@ -76,13 +78,13 @@ lookupKind :: HscEnv -> Name -> IO (Maybe TyThing)
7678
lookupKind env =
7779
fmap (fromRight Nothing) . catchSrcErrors (hsc_dflags env) "span" . lookupName env
7880

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

84-
getDocumentationsTryGhc :: HscEnv -> Bool -> [Name] -> IO [(SpanDoc, IntMap SpanDoc)]
85-
getDocumentationsTryGhc env linkToHackage names = do
86+
getDocumentationsTryGhc :: HscEnv -> LinkTargets -> [Name] -> IO [(SpanDoc, IntMap SpanDoc)]
87+
getDocumentationsTryGhc env linkTgts names = do
8688
resOr <- catchSrcErrors (hsc_dflags env) "docs" $ getDocsBatch env names
8789
case resOr of
8890
Left _ -> return []
@@ -102,10 +104,19 @@ getDocumentationsTryGhc env linkToHackage names = do
102104
doc <- lookupDocHtmlForModule env mod
103105
src <- lookupSrcHtmlForModule env mod
104106
-- 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.
105-
if linkToHackage
106-
then return ( toHackageDocUriText env mod (takeFileName <$> doc)
107-
, toHackageSrcUriText env mod (takeFileName <$> src))
108-
else pure (toFileUriText doc, toFileUriText src)
107+
let
108+
LinkTargets{linkDoc,linkSource} = linkTgts
109+
doc_link = case linkDoc of
110+
LinkToHackage ->
111+
toHackageDocUriText env mod (takeFileName <$> doc)
112+
LinkToLocal ->
113+
toFileUriText doc
114+
src_link = case linkSource of
115+
LinkToHackage ->
116+
toHackageSrcUriText env mod (takeFileName <$> src)
117+
LinkToLocal ->
118+
toFileUriText src
119+
pure (doc_link, src_link)
109120
Nothing -> pure (Nothing, Nothing)
110121

111122
let docUri = (<> "#" <> selector <> printOutputable name) <$> docFu

ghcide/src/Development/IDE/Types/Options.hs

Lines changed: 21 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -16,6 +16,8 @@ module Development.IDE.Types.Options
1616
, IdeGhcSession(..)
1717
, OptHaddockParse(..)
1818
, ProgressReportingStyle(..)
19+
, LinkTargets(..)
20+
, linkTargets
1921
) where
2022

2123
import Control.Lens
@@ -26,7 +28,8 @@ import Development.IDE.GHC.Compat as GHC
2628
import Development.IDE.Graph
2729
import Development.IDE.Types.Diagnostics
2830
import Ide.Plugin.Config
29-
import Ide.Types (DynFlagsModifications)
31+
import Ide.Types (DynFlagsModifications,
32+
OptLinkTo (..))
3033
import qualified Language.LSP.Protocol.Lens as L
3134
import qualified Language.LSP.Protocol.Types as LSP
3235

@@ -85,8 +88,21 @@ data IdeOptions = IdeOptions
8588
-- ^ Experimental feature to re-run only the subset of the Shake graph that has changed
8689
, optVerifyCoreFile :: Bool
8790
-- ^ Verify core files after serialization
88-
, optLinkToHackage :: Bool
89-
-- ^ `Documentation` and `Source` link to Hackage, rather than local docs.
91+
, optLinkSourceTo :: OptLinkTo
92+
-- ^ `Source` link to Hackage or local sources.
93+
, optLinkDocTo :: OptLinkTo
94+
-- ^ `Documentation` link to Hackage or local docs.
95+
}
96+
97+
data LinkTargets = LinkTargets
98+
{ linkSource :: !OptLinkTo
99+
, linkDoc :: !OptLinkTo
100+
}
101+
102+
linkTargets :: IdeOptions -> LinkTargets
103+
linkTargets IdeOptions{..} = LinkTargets
104+
{ linkSource = optLinkSourceTo
105+
, linkDoc = optLinkDocTo
90106
}
91107

92108
data OptHaddockParse = HaddockParse | NoHaddockParse
@@ -140,7 +156,8 @@ defaultIdeOptions session = IdeOptions
140156
,optRunSubset = True
141157
,optVerifyCoreFile = False
142158
,optMaxDirtyAge = 100
143-
,optLinkToHackage = False
159+
,optLinkSourceTo = LinkToLocal
160+
,optLinkDocTo = LinkToLocal
144161
}
145162

146163
defaultSkipProgress :: Typeable a => a -> Bool

hls-plugin-api/src/Ide/Plugin/Config.hs

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -43,7 +43,9 @@ parseConfig idePlugins defValue = A.withObject "settings" $ \o ->
4343
<*> o .:? "cabalFormattingProvider" .!= cabalFormattingProvider defValue
4444
<*> o .:? "maxCompletions" .!= maxCompletions defValue
4545
<*> o .:? "sessionLoading" .!= sessionLoading defValue
46-
<*> o .:? "linkToHackage" .!= linkToHackage defValue
46+
<*> o .:? "linkSourceTo" .!= linkSourceTo defValue
47+
<*> o .:? "linkDocTo" .!=
48+
linkDocTo defValue
4749
<*> A.explicitParseFieldMaybe (parsePlugins idePlugins) o "plugin" .!= plugins defValue
4850

4951
-- | Parse the 'PluginConfig'.

hls-plugin-api/src/Ide/Types.hs

Lines changed: 12 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,7 @@ module Ide.Types
2323
, IdePlugins(IdePlugins, ipMap)
2424
, DynFlagsModifications(..)
2525
, Config(..), PluginConfig(..), CheckParents(..), SessionLoadingPreferenceConfig(..)
26+
, OptLinkTo(..)
2627
, ConfigDescriptor(..), defaultConfigDescriptor, configForPlugin
2728
, CustomConfig(..), mkCustomConfig
2829
, FallbackCodeActionParams(..)
@@ -178,7 +179,8 @@ data Config =
178179
, cabalFormattingProvider :: !T.Text
179180
, maxCompletions :: !Int
180181
, sessionLoading :: !SessionLoadingPreferenceConfig
181-
, linkToHackage :: !Bool
182+
, linkSourceTo :: !OptLinkTo
183+
, linkDocTo :: !OptLinkTo
182184
, plugins :: !(Map.Map PluginId PluginConfig)
183185
} deriving (Show,Eq)
184186

@@ -190,7 +192,8 @@ instance ToJSON Config where
190192
, "cabalFormattingProvider" .= cabalFormattingProvider
191193
, "maxCompletions" .= maxCompletions
192194
, "sessionLoading" .= sessionLoading
193-
, "linkToHackage" .= linkToHackage
195+
, "linkSourceTo" .= linkSourceTo
196+
, "linkDocTo" .= linkDocTo
194197
, "plugin" .= Map.mapKeysMonotonic (\(PluginId p) -> p) plugins
195198
]
196199

@@ -205,7 +208,8 @@ instance Default Config where
205208
-- this string value needs to kept in sync with the value provided in HlsPlugins
206209
, maxCompletions = 40
207210
, sessionLoading = PreferSingleComponentLoading
208-
, linkToHackage = False
211+
, linkSourceTo = LinkToLocal
212+
, linkDocTo = LinkToLocal
209213
, plugins = mempty
210214
}
211215

@@ -219,6 +223,11 @@ data CheckParents
219223
deriving anyclass (FromJSON, ToJSON)
220224

221225

226+
data OptLinkTo = LinkToHackage | LinkToLocal
227+
deriving stock (Eq, Ord, Show, Enum, Generic)
228+
deriving anyclass (FromJSON, ToJSON)
229+
230+
222231
data SessionLoadingPreferenceConfig
223232
= PreferSingleComponentLoading
224233
-- ^ Always load only a singleComponent when a new component

0 commit comments

Comments
 (0)