Skip to content

Commit fc07c8c

Browse files
Saizanfendor
Saizan
authored and
fendor
committed
have separate linkDocTo and linkSourceTo
1 parent a3e9bf9 commit fc07c8c

File tree

7 files changed

+66
-25
lines changed

7 files changed

+66
-25
lines changed

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

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

593593
-- | 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
@@ -451,7 +451,8 @@ getIdeOptions = do
451451
config <- liftIO $ LSP.runLspT env HLS.getClientConfig
452452
return x{optCheckProject = pure $ checkProject config,
453453
optCheckParents = pure $ checkParents config,
454-
optLinkToHackage = linkToHackage config
454+
optLinkSourceTo = linkSourceTo config,
455+
optLinkDocTo = linkDocTo config
455456
}
456457

457458
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(..)
@@ -179,7 +180,8 @@ data Config =
179180
, cabalFormattingProvider :: !T.Text
180181
, maxCompletions :: !Int
181182
, sessionLoading :: !SessionLoadingPreferenceConfig
182-
, linkToHackage :: !Bool
183+
, linkSourceTo :: !OptLinkTo
184+
, linkDocTo :: !OptLinkTo
183185
, plugins :: !(Map.Map PluginId PluginConfig)
184186
} deriving (Show,Eq)
185187

@@ -191,7 +193,8 @@ instance ToJSON Config where
191193
, "cabalFormattingProvider" .= cabalFormattingProvider
192194
, "maxCompletions" .= maxCompletions
193195
, "sessionLoading" .= sessionLoading
194-
, "linkToHackage" .= linkToHackage
196+
, "linkSourceTo" .= linkSourceTo
197+
, "linkDocTo" .= linkDocTo
195198
, "plugin" .= Map.mapKeysMonotonic (\(PluginId p) -> p) plugins
196199
]
197200

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

@@ -220,6 +224,11 @@ data CheckParents
220224
deriving anyclass (FromJSON, ToJSON)
221225

222226

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

0 commit comments

Comments
 (0)