Skip to content

Generate FileTarget for all possible targetLocations #3893

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 2 commits into from
Dec 14, 2023
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
47 changes: 32 additions & 15 deletions ghcide/session-loader/Development/IDE/Session.hs
Original file line number Diff line number Diff line change
Expand Up @@ -41,8 +41,8 @@ import Data.Hashable hiding (hash)
import qualified Data.HashMap.Strict as HM
import Data.IORef
import Data.List
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.Extra as L
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as Map
import Data.Maybe
Expand Down Expand Up @@ -113,22 +113,23 @@ import System.Random (RandomGen)

import qualified Development.IDE.Session.Implicit as GhcIde

import Development.IDE.GHC.Compat.CmdLine
import Development.IDE.GHC.Compat.CmdLine


-- See Note [Guidelines For Using CPP In GHCIDE Import Statements]
#if MIN_VERSION_ghc(9,3,0)
import qualified Data.Set as OS

import GHC.Driver.Errors.Types
import GHC.Driver.Env (hscSetActiveUnitId, hsc_all_home_unit_ids)
import GHC.Driver.Make (checkHomeUnitsClosed)
import GHC.Unit.State
import GHC.Types.Error (errMsgDiagnostic)
import GHC.Data.Bag
import GHC.Data.Bag
import GHC.Driver.Env (hscSetActiveUnitId,
hsc_all_home_unit_ids)
import GHC.Driver.Errors.Types
import GHC.Driver.Make (checkHomeUnitsClosed)
import GHC.Types.Error (errMsgDiagnostic)
import GHC.Unit.State
#endif

import GHC.ResponseFile
import GHC.ResponseFile

data Log
= LogSettingInitialDynFlags
Expand Down Expand Up @@ -479,12 +480,28 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
-- files in the project so that `knownFiles` can learn about them and
-- we can generate a complete module graph
let extendKnownTargets newTargets = do
knownTargets <- forM newTargets $ \TargetDetails{..} ->
knownTargets <- concatForM newTargets $ \TargetDetails{..} ->
case targetTarget of
TargetFile f -> pure (targetTarget, [f])
TargetFile f -> do
-- If a target file has multiple possible locations, then we
-- assume they are all separate file targets.
-- This happens with '.hs-boot' files if they are in the root directory of the project.
-- GHC reports options such as '-i. A' as 'TargetFile A.hs' instead of 'TargetModule A'.
-- In 'fromTargetId', we dutifully look for '.hs-boot' files and add them to the
-- targetLocations of the TargetDetails. Then we add everything to the 'knownTargetsVar'.
-- However, when we look for a 'Foo.hs-boot' file in 'FindImports.hs', we look for either
--
-- * TargetFile Foo.hs-boot
-- * TargetModule Foo
--
-- If we don't generate a TargetFile for each potential location, we will only have
-- 'TargetFile Foo.hs' in the 'knownTargetsVar', thus not find 'TargetFile Foo.hs-boot'
-- and also not find 'TargetModule Foo'.
fs <- filterM (IO.doesFileExist . fromNormalizedFilePath) targetLocations
pure $ map (\fp -> (TargetFile fp, [fp])) (nubOrd (f:fs))
TargetModule _ -> do
found <- filterM (IO.doesFileExist . fromNormalizedFilePath) targetLocations
return (targetTarget, found)
return [(targetTarget, found)]
hasUpdate <- join $ atomically $ do
known <- readTVar knownTargetsVar
let known' = flip mapHashed known $ \k ->
Expand Down Expand Up @@ -975,13 +992,13 @@ data ComponentInfo = ComponentInfo
-- | Internal units, such as local libraries, that this component
-- is loaded with. These have been extracted from the original
-- ComponentOptions.
, componentInternalUnits :: [UnitId]
, componentInternalUnits :: [UnitId]
-- | All targets of this components.
, componentTargets :: [GHC.Target]
-- | Filepath which caused the creation of this component
, componentFP :: NormalizedFilePath
-- | Component Options used to load the component.
, componentCOptions :: ComponentOptions
, componentCOptions :: ComponentOptions
-- | Maps cradle dependencies, such as `stack.yaml`, or `.cabal` file
-- to last modification time. See Note [Multi Cradle Dependency Info]
, componentDependencyInfo :: DependencyInfo
Expand Down Expand Up @@ -1106,7 +1123,7 @@ setOptions cfp (ComponentOptions theOpts compRoot _) dflags = do

let targets = makeTargetsAbsolute root targets'
root = case workingDirectory dflags'' of
Nothing -> compRoot
Nothing -> compRoot
Just wdir -> compRoot </> wdir
let dflags''' =
setWorkingDirectory root $
Expand Down
28 changes: 28 additions & 0 deletions ghcide/test/exe/DiagnosticTests.hs
Original file line number Diff line number Diff line change
Expand Up @@ -232,6 +232,34 @@ tests = testGroup "diagnostics"
_ <- createDoc "ModuleB.hs" "haskell" contentB
_ <- createDoc "ModuleB.hs-boot" "haskell" contentBboot
expectDiagnostics [("ModuleB.hs", [(DiagnosticSeverity_Warning, (3,0), "Top-level binding")])]
, testSession' "bidirectional module dependency with hs-boot" $ \path -> do
let cradle = unlines
[ "cradle:"
, " direct: {arguments: [ModuleA, ModuleB]}"
]
let contentA = T.unlines
[ "module ModuleA where"
, "import {-# SOURCE #-} ModuleB"
]
let contentB = T.unlines
[ "{-# OPTIONS -Wmissing-signatures#-}"
, "module ModuleB where"
, "import {-# SOURCE #-} ModuleA"
-- introduce an artificial diagnostic
, "foo = ()"
]
let contentBboot = T.unlines
[ "module ModuleB where"
]
let contentAboot = T.unlines
[ "module ModuleA where"
]
liftIO $ writeFile (path </> "hie.yaml") cradle
_ <- createDoc "ModuleA.hs" "haskell" contentA
_ <- createDoc "ModuleA.hs-boot" "haskell" contentAboot
_ <- createDoc "ModuleB.hs" "haskell" contentB
_ <- createDoc "ModuleB.hs-boot" "haskell" contentBboot
expectDiagnostics [("ModuleB.hs", [(DiagnosticSeverity_Warning, (3,0), "Top-level binding")])]
, testSessionWait "correct reference used with hs-boot" $ do
let contentB = T.unlines
[ "module ModuleB where"
Expand Down