Skip to content

Fix regression in GhcSessionDeps #2380

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 4 commits into from
Nov 22, 2021
Merged
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
9 changes: 0 additions & 9 deletions ghcide/src/Development/IDE/Core/RuleTypes.hs
Original file line number Diff line number Diff line change
Expand Up @@ -252,10 +252,6 @@ type instance RuleResult GetModIfaceFromDiskAndIndex = HiFileResult
-- | Get a module interface details, either from an interface file or a typechecked module
type instance RuleResult GetModIface = HiFileResult

-- | Get a module interface details, without the Linkable
-- For better early cuttoff
type instance RuleResult GetModIfaceWithoutLinkable = HiFileResult

-- | Get the contents of a file, either dirty (if the buffer is modified) or Nothing to mean use from disk.
type instance RuleResult GetFileContents = (FileVersion, Maybe Text)

Expand Down Expand Up @@ -430,11 +426,6 @@ data GetModIface = GetModIface
instance Hashable GetModIface
instance NFData GetModIface

data GetModIfaceWithoutLinkable = GetModIfaceWithoutLinkable
deriving (Eq, Show, Typeable, Generic)
instance Hashable GetModIfaceWithoutLinkable
instance NFData GetModIfaceWithoutLinkable

data IsFileOfInterest = IsFileOfInterest
deriving (Eq, Show, Typeable, Generic)
instance Hashable IsFileOfInterest
Expand Down
24 changes: 4 additions & 20 deletions ghcide/src/Development/IDE/Core/Rules.hs
Original file line number Diff line number Diff line change
Expand Up @@ -41,7 +41,6 @@ module Development.IDE.Core.Rules(
loadGhcSession,
getModIfaceFromDiskRule,
getModIfaceRule,
getModIfaceWithoutLinkableRule,
getModSummaryRule,
isHiFileStableRule,
getModuleGraphRule,
Expand Down Expand Up @@ -688,13 +687,11 @@ loadGhcSession ghcSessionDepsConfig = do

data GhcSessionDepsConfig = GhcSessionDepsConfig
{ checkForImportCycles :: Bool
, forceLinkables :: Bool
, fullModSummary :: Bool
}
instance Default GhcSessionDepsConfig where
def = GhcSessionDepsConfig
{ checkForImportCycles = True
, forceLinkables = False
, fullModSummary = False
}

Expand All @@ -707,17 +704,12 @@ ghcSessionDepsDefinition GhcSessionDepsConfig{..} env file = do
Nothing -> return Nothing
Just deps -> do
when checkForImportCycles $ void $ uses_ ReportImportCycles deps
ms:mss <- map msrModSummary <$> if fullModSummary
then uses_ GetModSummary (file:deps)
else uses_ GetModSummaryWithoutTimestamps (file:deps)
mss <- map msrModSummary <$> if fullModSummary
then uses_ GetModSummary deps
else uses_ GetModSummaryWithoutTimestamps deps

depSessions <- map hscEnv <$> uses_ GhcSessionDeps deps
let uses_th_qq =
xopt LangExt.TemplateHaskell dflags || xopt LangExt.QuasiQuotes dflags
dflags = ms_hspp_opts ms
ifaces <- if uses_th_qq || forceLinkables
then uses_ GetModIface deps
else uses_ GetModIfaceWithoutLinkable deps
ifaces <- uses_ GetModIface deps

let inLoadOrder = map hirHomeMod ifaces
session' <- liftIO $ mergeEnvs hsc mss inLoadOrder depSessions
Expand Down Expand Up @@ -882,13 +874,6 @@ getModIfaceRule = defineEarlyCutoff $ Rule $ \GetModIface f -> do
liftIO $ void $ modifyVar' compiledLinkables $ \old -> extendModuleEnv old mod time
pure res

getModIfaceWithoutLinkableRule :: Rules ()
getModIfaceWithoutLinkableRule = defineEarlyCutoff $ RuleNoDiagnostics $ \GetModIfaceWithoutLinkable f -> do
mhfr <- use GetModIface f
let mhfr' = fmap (\x -> x{ hirHomeMod = (hirHomeMod x){ hm_linkable = Just (error msg) } }) mhfr
msg = "tried to look at linkable for GetModIfaceWithoutLinkable for " ++ show f
pure (hirIfaceFp <$> mhfr', mhfr')

-- | Also generates and indexes the `.hie` file, along with the `.o` file if needed
-- Invariant maintained is that if the `.hi` file was successfully written, then the
-- `.hie` and `.o` file (if needed) were also successfully written
Expand Down Expand Up @@ -1089,7 +1074,6 @@ mainRule RulesConfig{..} = do
getModIfaceFromDiskRule
getModIfaceFromDiskAndIndexRule
getModIfaceRule
getModIfaceWithoutLinkableRule
getModSummaryRule
isHiFileStableRule
getModuleGraphRule
Expand Down
5 changes: 5 additions & 0 deletions ghcide/test/data/THLoading/A.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
module A where
import B (bar)

foo :: ()
foo = bar
4 changes: 4 additions & 0 deletions ghcide/test/data/THLoading/B.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
module B where

bar :: ()
bar = ()
7 changes: 7 additions & 0 deletions ghcide/test/data/THLoading/THA.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,7 @@
{-# LANGUAGE TemplateHaskell #-}
module THA where
import Language.Haskell.TH
import A (foo)

th_a :: DecsQ
th_a = [d| a = foo |]
5 changes: 5 additions & 0 deletions ghcide/test/data/THLoading/THB.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
{-# LANGUAGE TemplateHaskell #-}
module THB where
import THA

$th_a
1 change: 1 addition & 0 deletions ghcide/test/data/THLoading/hie.yaml
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
cradle: {direct: {arguments: ["-package template-haskell", "THA", "THB", "A", "B"]}}
9 changes: 9 additions & 0 deletions ghcide/test/exe/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -4018,6 +4018,7 @@ thTests =
_ <- createDoc "B.hs" "haskell" sourceB
return ()
, thReloadingTest False
, thLoadingTest
, ignoreInWindowsBecause "Broken in windows" $ thReloadingTest True
-- Regression test for https://github.com/haskell/haskell-language-server/issues/891
, thLinkingTest False
Expand Down Expand Up @@ -4055,6 +4056,14 @@ thTests =
expectDiagnostics [ ( cPath, [(DsWarning, (3, 0), "Top-level binding with no type signature: a :: A")] ) ]
]

-- | Test that all modules have linkables
thLoadingTest :: TestTree
thLoadingTest = testCase "Loading linkables" $ runWithExtraFiles "THLoading" $ \dir -> do
let thb = dir </> "THB.hs"
_ <- openDoc thb "haskell"
expectNoMoreDiagnostics 1


-- | test that TH is reevaluated on typecheck
thReloadingTest :: Bool -> TestTree
thReloadingTest unboxed = testCase name $ runWithExtraFiles dir $ \dir -> do
Expand Down
3 changes: 1 addition & 2 deletions plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs
Original file line number Diff line number Diff line change
Expand Up @@ -540,8 +540,7 @@ runGetSession st nfp = liftIO $ runAction "eval" st $ do
((_, res),_) <- liftIO $ loadSessionFun fp
let env = fromMaybe (error $ "Unknown file: " <> fp) res
ghcSessionDepsConfig = def
{ forceLinkables = True
, checkForImportCycles = False
{ checkForImportCycles = False
, fullModSummary = True
}
res <- fmap hscEnvWithImportPaths <$> ghcSessionDepsDefinition ghcSessionDepsConfig env nfp
Expand Down