diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 4e9fa6beb3..895795c9c1 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -34,7 +34,8 @@ import Data.Version import Development.IDE.Core.OfInterest import Development.IDE.Core.Shake import Development.IDE.Core.RuleTypes -import Development.IDE.GHC.Compat +import Development.IDE.GHC.Compat hiding (Target, TargetModule, TargetFile) +import qualified Development.IDE.GHC.Compat as GHC import Development.IDE.GHC.Util import Development.IDE.Session.VersionCheck import Development.IDE.Types.Diagnostics @@ -59,13 +60,12 @@ import System.IO import GHCi import DynFlags -import HscTypes +import HscTypes (ic_dflags, hsc_IC, hsc_dflags, hsc_NC) import Linker import Module import NameCache import Packages import Control.Exception (evaluate) -import Data.Char -- | Given a root directory, return a Shake 'Action' which setups an -- 'IdeGhcSession' given a file. @@ -120,7 +120,7 @@ loadSession dir = do let extendKnownTargets newTargets = do knownTargets <- forM newTargets $ \TargetDetails{..} -> do found <- filterM (IO.doesFileExist . fromNormalizedFilePath) targetLocations - return (targetModule, found) + return (targetTarget, found) modifyVar_ knownTargetsVar $ traverseHashed $ \known -> do let known' = HM.unionWith (<>) known $ HM.fromList knownTargets when (known /= known') $ @@ -228,7 +228,7 @@ loadSession dir = do -- New HscEnv for the component in question, returns the new HscEnvEq and -- a mapping from FilePath to the newly created HscEnvEq. - let new_cache = newComponentCache logger optExtensions hieYaml hscEnv uids + let new_cache = newComponentCache logger optExtensions hieYaml _cfp hscEnv uids (cs, res) <- new_cache new -- Modified cache targets for everything else in the hie.yaml file -- which now uses the same EPS and so on @@ -374,7 +374,7 @@ emptyHscEnv nc libDir = do data TargetDetails = TargetDetails { - targetModule :: !ModuleName, + targetTarget :: !Target, targetEnv :: !(IdeResult HscEnvEq), targetDepends :: !DependencyInfo, targetLocations :: ![NormalizedFilePath] @@ -387,29 +387,18 @@ fromTargetId :: [FilePath] -- ^ import paths -> DependencyInfo -> IO [TargetDetails] -- For a target module we consider all the import paths -fromTargetId is exts (TargetModule mod) env dep = do +fromTargetId is exts (GHC.TargetModule mod) env dep = do let fps = [i moduleNameSlashes mod -<.> ext <> boot | ext <- exts , i <- is , boot <- ["", "-boot"] ] locs <- mapM (fmap toNormalizedFilePath' . canonicalizePath) fps - return [TargetDetails mod env dep locs] + return [TargetDetails (TargetModule mod) env dep locs] -- For a 'TargetFile' we consider all the possible module names -fromTargetId _ _ (TargetFile f _) env deps = do +fromTargetId _ _ (GHC.TargetFile f _) env deps = do nf <- toNormalizedFilePath' <$> canonicalizePath f - return [TargetDetails m env deps [nf] | m <- moduleNames f] - --- >>> moduleNames "src/A/B.hs" --- [A.B,B] -moduleNames :: FilePath -> [ModuleName] -moduleNames f = map (mkModuleName .intercalate ".") $ init $ tails nameSegments - where - nameSegments = reverse - $ takeWhile (isUpper . head) - $ reverse - $ splitDirectories - $ dropExtension f + return [TargetDetails (TargetFile nf) env deps [nf]] toFlagsMap :: TargetDetails -> [(NormalizedFilePath, (IdeResult HscEnvEq, DependencyInfo))] toFlagsMap TargetDetails{..} = @@ -424,11 +413,12 @@ newComponentCache :: Logger -> [String] -- File extensions to consider -> Maybe FilePath -- Path to cradle + -> NormalizedFilePath -- Path to file that caused the creation of this component -> HscEnv -> [(InstalledUnitId, DynFlags)] -> ComponentInfo -> IO ( [TargetDetails], (IdeResult HscEnvEq, DependencyInfo)) -newComponentCache logger exts cradlePath hsc_env uids ci = do +newComponentCache logger exts cradlePath cfp hsc_env uids ci = do let df = componentDynFlags ci let hscEnv' = hsc_env { hsc_dflags = df , hsc_IC = (hsc_IC hsc_env) { ic_dflags = df } } @@ -448,7 +438,7 @@ newComponentCache logger exts cradlePath hsc_env uids ci = do -- the component, in which case things will be horribly broken anyway. -- Otherwise, we will immediately attempt to reload this module which -- causes an infinite loop and high CPU usage. - let special_target = TargetDetails (mkModuleName "special") targetEnv targetDepends [componentFP ci] + let special_target = TargetDetails (TargetFile cfp) targetEnv targetDepends [componentFP ci] return (special_target:ctargets, res) {- Note [Avoiding bad interface files] @@ -531,7 +521,7 @@ data RawComponentInfo = RawComponentInfo -- We do not want to use them unprocessed. , rawComponentDynFlags :: DynFlags -- | All targets of this components. - , rawComponentTargets :: [Target] + , rawComponentTargets :: [GHC.Target] -- | Filepath which caused the creation of this component , rawComponentFP :: NormalizedFilePath -- | Component Options used to load the component. @@ -552,7 +542,7 @@ data ComponentInfo = ComponentInfo -- ComponentOptions. , _componentInternalUnits :: [InstalledUnitId] -- | All targets of this components. - , componentTargets :: [Target] + , componentTargets :: [GHC.Target] -- | Filepath which caused the creation of this component , componentFP :: NormalizedFilePath -- | Component Options used to load the component. @@ -625,7 +615,7 @@ memoIO op = do Just res -> return (mp, res) -- | Throws if package flags are unsatisfiable -setOptions :: GhcMonad m => ComponentOptions -> DynFlags -> m (DynFlags, [Target]) +setOptions :: GhcMonad m => ComponentOptions -> DynFlags -> m (DynFlags, [GHC.Target]) setOptions (ComponentOptions theOpts compRoot _) dflags = do (dflags', targets) <- addCmdOpts theOpts dflags let dflags'' = diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index edb7004451..d32fde0ebf 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -46,7 +46,7 @@ import Development.IDE.Core.FileExists import Development.IDE.Core.FileStore (modificationTime, getFileContents) import Development.IDE.Types.Diagnostics as Diag import Development.IDE.Types.Location -import Development.IDE.GHC.Compat hiding (parseModule, typecheckModule) +import Development.IDE.GHC.Compat hiding (parseModule, typecheckModule, TargetModule, TargetFile) import Development.IDE.GHC.Util import Development.IDE.GHC.WithDynFlags import Data.Either.Extra @@ -67,7 +67,7 @@ import qualified Data.ByteString.Char8 as BS import Development.IDE.Core.PositionMapping import qualified GHC.LanguageExtensions as LangExt -import HscTypes +import HscTypes hiding (TargetModule, TargetFile) import PackageConfig import DynFlags (gopt_set, xopt) import GHC.Generics(Generic) @@ -336,7 +336,9 @@ getLocatedImportsRule = opt <- getIdeOptions let getTargetExists modName nfp | isImplicitCradle = getFileExists nfp - | HM.member modName targets = getFileExists nfp + | HM.member (TargetModule modName) targets + || HM.member (TargetFile nfp) targets + = getFileExists nfp | otherwise = return False (diags, imports') <- fmap unzip $ forM imports $ \(isSource, (mbPkgName, modName)) -> do diagOrImp <- locateModule dflags import_dirs (optExtensions opt) getTargetExists modName mbPkgName isSource diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index e5e3884264..a41c28c269 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingStrategies #-} -- Copyright (c) 2019 The DAML Authors. All rights reserved. -- SPDX-License-Identifier: Apache-2.0 @@ -24,7 +26,7 @@ module Development.IDE.Core.Shake( IdeState, shakeExtras, ShakeExtras(..), getShakeExtras, getShakeExtrasRules, - KnownTargets, toKnownFiles, + KnownTargets, Target(..), toKnownFiles, IdeRule, IdeResult, GetModificationTime(GetModificationTime, GetModificationTime_, missingFileDiagnostics), shakeOpen, shakeShut, @@ -165,7 +167,11 @@ data ShakeExtras = ShakeExtras } -- | A mapping of module name to known files -type KnownTargets = HashMap ModuleName [NormalizedFilePath] +type KnownTargets = HashMap Target [NormalizedFilePath] + +data Target = TargetModule ModuleName | TargetFile NormalizedFilePath + deriving ( Eq, Generic, Show ) + deriving anyclass (Hashable, NFData) toKnownFiles :: KnownTargets -> HashSet NormalizedFilePath toKnownFiles = HSet.fromList . concat . HMap.elems @@ -720,7 +726,7 @@ usesWithStale_ key files = do Just v -> return v newtype IdeAction a = IdeAction { runIdeActionT :: (ReaderT ShakeExtras IO) a } - deriving (MonadReader ShakeExtras, MonadIO, Functor, Applicative, Monad) + deriving newtype (MonadReader ShakeExtras, MonadIO, Functor, Applicative, Monad) -- | IdeActions are used when we want to return a result immediately, even if it -- is stale Useful for UI actions like hover, completion where we don't want to @@ -802,7 +808,7 @@ isBadDependency x | otherwise = False newtype Q k = Q (k, NormalizedFilePath) - deriving (Eq,Hashable,NFData, Generic) + deriving newtype (Eq, Hashable, NFData) instance Binary k => Binary (Q k) where put (Q (k, fp)) = put (k, fp)