Skip to content

Commit 7dc82ce

Browse files
soulomoonsoulomoon
authored
Merge branch 'master' into fix-stuck-at-exit
2 parents 9953607 + d38af0d commit 7dc82ce

File tree

9 files changed

+103
-13
lines changed

9 files changed

+103
-13
lines changed

‎.github/actions/setup-build/action.yml

+1-1
Original file line numberDiff line numberDiff line change
@@ -31,7 +31,7 @@ runs:
3131
sudo chown -R $USER /usr/local/.ghcup
3232
shell: bash
3333

34-
- uses: haskell-actions/[email protected].2
34+
- uses: haskell-actions/[email protected].3
3535
id: HaskEnvSetup
3636
with:
3737
ghc-version : ${{ inputs.ghc }}

‎.github/workflows/bench.yml

+1-1
Original file line numberDiff line numberDiff line change
@@ -126,7 +126,7 @@ jobs:
126126
example: ['cabal', 'lsp-types']
127127

128128
steps:
129-
- uses: haskell-actions/[email protected].2
129+
- uses: haskell-actions/[email protected].3
130130
with:
131131
ghc-version : ${{ matrix.ghc }}
132132
cabal-version: ${{ matrix.cabal }}

‎bench/config.yaml

+2
Original file line numberDiff line numberDiff line change
@@ -106,6 +106,8 @@ experiments:
106106
- "code actions after cradle edit"
107107
- "documentSymbols after edit"
108108
- "hole fit suggestions"
109+
- "eval execute single-line code lens"
110+
- "eval execute multi-line code lens"
109111

110112
# An ordered list of versions to analyze
111113
versions:

‎ghcide-bench/src/Experiments.hs

+58-1
Original file line numberDiff line numberDiff line change
@@ -241,7 +241,7 @@ experiments =
241241
benchWithSetup
242242
"hole fit suggestions"
243243
( mapM_ $ \DocumentPositions{..} -> do
244-
let edit =TextDocumentContentChangeEvent $ InL $ #range .== Range bottom bottom
244+
let edit = TextDocumentContentChangeEvent $ InL $ #range .== Range bottom bottom
245245
.+ #rangeLength .== Nothing
246246
.+ #text .== t
247247
bottom = Position maxBound 0
@@ -266,6 +266,63 @@ experiments =
266266
case requireDiagnostic diags (DiagnosticSeverity_Error, (fromIntegral bottom, 8), "Found hole", Nothing) of
267267
Nothing -> pure True
268268
Just _err -> pure False
269+
),
270+
---------------------------------------------------------------------------------------
271+
benchWithSetup
272+
"eval execute single-line code lens"
273+
( mapM_ $ \DocumentPositions{..} -> do
274+
let edit = TextDocumentContentChangeEvent $ InL $ #range .== Range bottom bottom
275+
.+ #rangeLength .== Nothing
276+
.+ #text .== t
277+
bottom = Position maxBound 0
278+
t = T.unlines
279+
[ ""
280+
, "-- >>> 1 + 2"
281+
]
282+
changeDoc doc [edit]
283+
)
284+
( \docs -> do
285+
not . null <$> forM docs (\DocumentPositions{..} -> do
286+
lenses <- getCodeLenses doc
287+
forM_ lenses $ \case
288+
CodeLens { _command = Just cmd } -> do
289+
executeCommand cmd
290+
waitForProgressStart
291+
waitForProgressDone
292+
_ -> return ()
293+
)
294+
),
295+
---------------------------------------------------------------------------------------
296+
benchWithSetup
297+
"eval execute multi-line code lens"
298+
( mapM_ $ \DocumentPositions{..} -> do
299+
let edit = TextDocumentContentChangeEvent $ InL $ #range .== Range bottom bottom
300+
.+ #rangeLength .== Nothing
301+
.+ #text .== t
302+
bottom = Position maxBound 0
303+
t = T.unlines
304+
[ ""
305+
, "data T = A | B | C | D"
306+
, " deriving (Show, Eq, Ord, Bounded, Enum)"
307+
, ""
308+
, "{-"
309+
, ">>> import Data.List (nub)"
310+
, ">>> xs = ([minBound..maxBound] ++ [minBound..maxBound] :: [T])"
311+
, ">>> nub xs"
312+
, "-}"
313+
]
314+
changeDoc doc [edit]
315+
)
316+
( \docs -> do
317+
not . null <$> forM docs (\DocumentPositions{..} -> do
318+
lenses <- getCodeLenses doc
319+
forM_ lenses $ \case
320+
CodeLens { _command = Just cmd } -> do
321+
executeCommand cmd
322+
waitForProgressStart
323+
waitForProgressDone
324+
_ -> return ()
325+
)
269326
)
270327
]
271328
where hasDefinitions (InL (Definition (InL _))) = True

‎ghcide/session-loader/Development/IDE/Session.hs

+26-10
Original file line numberDiff line numberDiff line change
@@ -585,9 +585,21 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
585585
let new_cache = newComponentCache recorder optExtensions hieYaml _cfp hscEnv
586586
all_target_details <- new_cache old_deps new_deps
587587

588-
let all_targets = concatMap fst all_target_details
589-
590-
let this_flags_map = HM.fromList (concatMap toFlagsMap all_targets)
588+
this_dep_info <- getDependencyInfo $ maybeToList hieYaml
589+
let (all_targets, this_flags_map, this_options)
590+
= case HM.lookup _cfp flags_map' of
591+
Just this -> (all_targets', flags_map', this)
592+
Nothing -> (this_target_details : all_targets', HM.insert _cfp this_flags flags_map', this_flags)
593+
where all_targets' = concat all_target_details
594+
flags_map' = HM.fromList (concatMap toFlagsMap all_targets')
595+
this_target_details = TargetDetails (TargetFile _cfp) this_error_env this_dep_info [_cfp]
596+
this_flags = (this_error_env, this_dep_info)
597+
this_error_env = ([this_error], Nothing)
598+
this_error = ideErrorWithSource (Just "cradle") (Just DiagnosticSeverity_Error) _cfp
599+
$ T.unlines
600+
[ "No cradle target found. Is this file listed in the targets of your cradle?"
601+
, "If you are using a .cabal file, please ensure that this module is listed in either the exposed-modules or other-modules section"
602+
]
591603

592604
void $ modifyVar' fileToFlags $
593605
Map.insert hieYaml this_flags_map
@@ -615,7 +627,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
615627
let !exportsMap' = createExportsMap $ mapMaybe (fmap hirModIface) modIfaces
616628
liftIO $ atomically $ modifyTVar' (exportsMap shakeExtras) (exportsMap' <>)
617629

618-
return $ second Map.keys $ this_flags_map HM.! _cfp
630+
return $ second Map.keys this_options
619631

620632
let consultCradle :: Maybe FilePath -> FilePath -> IO (IdeResult HscEnvEq, [FilePath])
621633
consultCradle hieYaml cfp = do
@@ -810,7 +822,7 @@ newComponentCache
810822
-> HscEnv -- ^ An empty HscEnv
811823
-> [ComponentInfo] -- ^ New components to be loaded
812824
-> [ComponentInfo] -- ^ old, already existing components
813-
-> IO [ ([TargetDetails], (IdeResult HscEnvEq, DependencyInfo))]
825+
-> IO [ [TargetDetails] ]
814826
newComponentCache recorder exts cradlePath _cfp hsc_env old_cis new_cis = do
815827
let cis = Map.unionWith unionCIs (mkMap new_cis) (mkMap old_cis)
816828
-- When we have multiple components with the same uid,
@@ -882,14 +894,13 @@ newComponentCache recorder exts cradlePath _cfp hsc_env old_cis new_cis = do
882894
henv <- createHscEnvEq thisEnv (zip uids dfs)
883895
let targetEnv = (if isBad ci then multi_errs else [], Just henv)
884896
targetDepends = componentDependencyInfo ci
885-
res = ( targetEnv, targetDepends)
886-
logWith recorder Debug $ LogNewComponentCache res
897+
logWith recorder Debug $ LogNewComponentCache (targetEnv, targetDepends)
887898
evaluate $ liftRnf rwhnf $ componentTargets ci
888899

889900
let mk t = fromTargetId (importPaths df) exts (targetId t) targetEnv targetDepends
890901
ctargets <- concatMapM mk (componentTargets ci)
891902

892-
return (L.nubOrdOn targetTarget ctargets, res)
903+
return (L.nubOrdOn targetTarget ctargets)
893904

894905
{- Note [Avoiding bad interface files]
895906
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1081,15 +1092,20 @@ setOptions cfp (ComponentOptions theOpts compRoot _) dflags = do
10811092
-- A special target for the file which caused this wonderful
10821093
-- component to be created. In case the cradle doesn't list all the targets for
10831094
-- the component, in which case things will be horribly broken anyway.
1084-
-- Otherwise, we will immediately attempt to reload this module which
1085-
-- causes an infinite loop and high CPU usage.
1095+
--
1096+
-- When we have a single component that is caused to be loaded due to a
1097+
-- file, we assume the file is part of that component. This is useful
1098+
-- for bare GHC sessions, such as many of the ones used in the testsuite
10861099
--
10871100
-- We don't do this when we have multiple components, because each
10881101
-- component better list all targets or there will be anarchy.
10891102
-- It is difficult to know which component to add our file to in
10901103
-- that case.
10911104
-- Multi unit arguments are likely to come from cabal, which
10921105
-- does list all targets.
1106+
--
1107+
-- If we don't end up with a target for the current file in the end, then
1108+
-- we will report it as an error for that file
10931109
abs_fp <- liftIO $ makeAbsolute (fromNormalizedFilePath cfp)
10941110
let special_target = Compat.mkSimpleTarget df abs_fp
10951111
pure $ (df, special_target : targets) :| []

‎plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs

+1
Original file line numberDiff line numberDiff line change
@@ -277,6 +277,7 @@ initialiseSessionForEval needs_quickcheck st nfp = do
277277
. flip xopt_unset LangExt.MonomorphismRestriction
278278
. flip gopt_set Opt_ImplicitImportQualified
279279
. flip gopt_unset Opt_DiagnosticsShowCaret
280+
. setBackend ghciBackend
280281
$ (ms_hspp_opts ms) {
281282
useColor = Never
282283
, canUseColor = False }

‎plugins/hls-eval-plugin/test/Main.hs

+1
Original file line numberDiff line numberDiff line change
@@ -88,6 +88,7 @@ tests =
8888
, goldenWithEval "Reports an error for an incorrect type with :kind" "T13" "hs"
8989
, goldenWithEval' "Returns a fully-instantiated type for :type" "T14" "hs" (if ghcVersion >= GHC98 then "ghc98.expected" else "expected") -- See https://gitlab.haskell.org/ghc/ghc/-/issues/24069
9090
, knownBrokenForGhcVersions [GHC92, GHC94, GHC96, GHC98] "type +v does not work anymore with 9.2" $ goldenWithEval "Returns an uninstantiated type for :type +v, admitting multiple whitespaces around arguments" "T15" "hs"
91+
, goldenWithEval "Doesn't break in module containing main function" "T4139" "hs"
9192
, goldenWithEval "Returns defaulted type for :type +d, admitting multiple whitespaces around arguments" "T16" "hs"
9293
, goldenWithEval ":type reports an error when given with unknown +x option" "T17" "hs"
9394
, goldenWithEval "Reports an error when given with unknown command" "T18" "hs"

‎plugins/hls-eval-plugin/test/testdata/T4139.expected.hs

+7
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
module T4139 where
2+
3+
-- >>> 'x'
4+
-- 'x'
5+
6+
main :: IO ()
7+
main = putStrLn "Hello World!"

‎plugins/hls-eval-plugin/test/testdata/T4139.hs

+6
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
module T4139 where
2+
3+
-- >>> 'x'
4+
5+
main :: IO ()
6+
main = putStrLn "Hello World!"

0 commit comments

Comments
 (0)