@@ -40,7 +40,6 @@ import Data.Function
40
40
import Data.Hashable hiding (hash )
41
41
import qualified Data.HashMap.Strict as HM
42
42
import Data.IORef
43
- import qualified Data.Set as OS
44
43
import Data.List
45
44
import Data.List.NonEmpty (NonEmpty (.. ))
46
45
import Data.List.Extra as L
@@ -66,7 +65,7 @@ import Development.IDE.Graph (Action)
66
65
import Development.IDE.Session.VersionCheck
67
66
import Development.IDE.Types.Diagnostics
68
67
import Development.IDE.Types.Exports
69
- import Development.IDE.Types.HscEnvEq (HscEnvEq , newHscEnvEq , envImportPaths ,
68
+ import Development.IDE.Types.HscEnvEq (HscEnvEq , newHscEnvEq ,
70
69
newHscEnvEqPreserveImportPaths )
71
70
import Development.IDE.Types.Location
72
71
import Development.IDE.Types.Options
@@ -119,13 +118,14 @@ import Development.IDE.GHC.Compat.CmdLine
119
118
120
119
-- See Note [Guidelines For Using CPP In GHCIDE Import Statements]
121
120
#if MIN_VERSION_ghc(9,3,0)
121
+ import qualified Data.Set as OS
122
+
122
123
import GHC.Driver.Errors.Types
123
124
import GHC.Driver.Env (hscSetActiveUnitId , hsc_all_home_unit_ids )
124
125
import GHC.Driver.Make (checkHomeUnitsClosed )
125
126
import GHC.Unit.State
126
127
import GHC.Types.Error (errMsgDiagnostic )
127
128
import GHC.Data.Bag
128
- import GHC.Unit.Env
129
129
#endif
130
130
131
131
import GHC.ResponseFile
@@ -518,17 +518,17 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
518
518
-- compilation but these are the true source of
519
519
-- information.
520
520
new_deps = fmap (\ (df, targets) -> RawComponentInfo (homeUnitId_ df) df targets cfp opts dep_info) newTargetDfs
521
- all_deps = new_deps `appendListToNonEmpty ` maybe [] id oldDeps
521
+ all_deps = new_deps `NE.appendList ` maybe [] id oldDeps
522
522
-- Get all the unit-ids for things in this component
523
- inplace = map rawComponentUnitId $ NE. toList all_deps
523
+ _inplace = map rawComponentUnitId $ NE. toList all_deps
524
524
525
525
all_deps' <- forM all_deps $ \ RawComponentInfo {.. } -> do
526
526
-- Remove all inplace dependencies from package flags for
527
527
-- components in this HscEnv
528
528
#if MIN_VERSION_ghc(9,3,0)
529
529
let (df2, uids) = (rawComponentDynFlags, [] )
530
530
#else
531
- let (df2, uids) = _removeInplacePackages fakeUid inplace rawComponentDynFlags
531
+ let (df2, uids) = _removeInplacePackages fakeUid _inplace rawComponentDynFlags
532
532
#endif
533
533
let prefix = show rawComponentUnitId
534
534
-- See Note [Avoiding bad interface files]
@@ -539,13 +539,15 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
539
539
-- The final component information, mostly the same but the DynFlags don't
540
540
-- contain any packages which are also loaded
541
541
-- into the same component.
542
- pure $ ComponentInfo rawComponentUnitId
543
- processed_df
544
- uids
545
- rawComponentTargets
546
- rawComponentFP
547
- rawComponentCOptions
548
- rawComponentDependencyInfo
542
+ pure $ ComponentInfo
543
+ { componentUnitId = rawComponentUnitId
544
+ , componentDynFlags = processed_df
545
+ , componentInternalUnits = uids
546
+ , componentTargets = rawComponentTargets
547
+ , componentFP = rawComponentFP
548
+ , componentCOptions = rawComponentCOptions
549
+ , componentDependencyInfo = rawComponentDependencyInfo
550
+ }
549
551
-- Modify the map so the hieYaml now maps to the newly updated
550
552
-- ComponentInfos
551
553
-- Returns
@@ -786,7 +788,7 @@ newComponentCache
786
788
-> [ComponentInfo ] -- ^ New components to be loaded
787
789
-> [ComponentInfo ] -- ^ old, already existing components
788
790
-> IO [ ([TargetDetails ], (IdeResult HscEnvEq , DependencyInfo ))]
789
- newComponentCache recorder exts cradlePath cfp hsc_env old_cis new_cis = do
791
+ newComponentCache recorder exts cradlePath _cfp hsc_env old_cis new_cis = do
790
792
let cis = Map. unionWith unionCIs (mkMap new_cis) (mkMap old_cis)
791
793
-- When we have multiple components with the same uid,
792
794
-- prefer the new one over the old.
@@ -809,15 +811,15 @@ newComponentCache recorder exts cradlePath cfp hsc_env old_cis new_cis = do
809
811
810
812
case closure_errs of
811
813
errs@ (_: _) -> do
812
- let rendered_err = map (ideErrorWithSource (Just " cradle" ) (Just DiagnosticSeverity_Error ) cfp . T. pack . Compat. printWithoutUniques) errs
814
+ let rendered_err = map (ideErrorWithSource (Just " cradle" ) (Just DiagnosticSeverity_Error ) _cfp . T. pack . Compat. printWithoutUniques) errs
813
815
res = (rendered_err,Nothing )
814
816
dep_info = foldMap componentDependencyInfo (filter isBad $ Map. elems cis)
815
817
bad_units = OS. fromList $ concat $ do
816
818
x <- bagToList $ mapBag errMsgDiagnostic $ unionManyBags $ map Compat. getMessages errs
817
819
DriverHomePackagesNotClosed us <- pure x
818
820
pure us
819
821
isBad ci = (homeUnitId_ (componentDynFlags ci)) `OS.member` bad_units
820
- return [([TargetDetails (TargetFile cfp ) res dep_info [cfp ]],(res,dep_info))]
822
+ return [([TargetDetails (TargetFile _cfp ) res dep_info [_cfp ]],(res,dep_info))]
821
823
[] -> do
822
824
#else
823
825
do
@@ -968,13 +970,13 @@ data ComponentInfo = ComponentInfo
968
970
-- | Internal units, such as local libraries, that this component
969
971
-- is loaded with. These have been extracted from the original
970
972
-- ComponentOptions.
971
- , _componentInternalUnits :: [UnitId ]
973
+ , componentInternalUnits :: [UnitId ]
972
974
-- | All targets of this components.
973
975
, componentTargets :: [GHC. Target ]
974
976
-- | Filepath which caused the creation of this component
975
977
, componentFP :: NormalizedFilePath
976
978
-- | Component Options used to load the component.
977
- , _componentCOptions :: ComponentOptions
979
+ , componentCOptions :: ComponentOptions
978
980
-- | Maps cradle dependencies, such as `stack.yaml`, or `.cabal` file
979
981
-- to last modification time. See Note [Multi Cradle Dependency Info]
980
982
, componentDependencyInfo :: DependencyInfo
@@ -1050,9 +1052,9 @@ addUnit unit_str = liftEwM $ do
1050
1052
putCmdLineState (unit_str : units)
1051
1053
1052
1054
-- | Throws if package flags are unsatisfiable
1053
- setOptions :: GhcMonad m => NormalizedFilePath -> ComponentOptions -> DynFlags -> m (NE. NonEmpty (DynFlags , [GHC. Target ]))
1055
+ setOptions :: GhcMonad m => NormalizedFilePath -> ComponentOptions -> DynFlags -> m (NonEmpty (DynFlags , [GHC. Target ]))
1054
1056
setOptions cfp (ComponentOptions theOpts compRoot _) dflags = do
1055
- ((theOpts',errs,warns ),units) <- processCmdLineP unit_flags [] (map noLoc theOpts)
1057
+ ((theOpts',_errs,_warns ),units) <- processCmdLineP unit_flags [] (map noLoc theOpts)
1056
1058
case NE. nonEmpty units of
1057
1059
Just us -> initMulti us
1058
1060
Nothing -> do
@@ -1071,14 +1073,14 @@ setOptions cfp (ComponentOptions theOpts compRoot _) dflags = do
1071
1073
-- does list all targets.
1072
1074
abs_fp <- liftIO $ makeAbsolute (fromNormalizedFilePath cfp)
1073
1075
let special_target = Compat. mkSimpleTarget df abs_fp
1074
- pure $ (df, special_target : targets) NE. :| []
1076
+ pure $ (df, special_target : targets) :| []
1075
1077
where
1076
1078
initMulti unitArgFiles =
1077
1079
forM unitArgFiles $ \ f -> do
1078
1080
args <- liftIO $ expandResponse [f]
1079
1081
initOne args
1080
- initOne theOpts = do
1081
- (dflags', targets') <- addCmdOpts theOpts dflags
1082
+ initOne this_opts = do
1083
+ (dflags', targets') <- addCmdOpts this_opts dflags
1082
1084
let dflags'' =
1083
1085
#if MIN_VERSION_ghc(9,3,0)
1084
1086
case unitIdString (homeUnitId_ dflags') of
@@ -1089,7 +1091,7 @@ setOptions cfp (ComponentOptions theOpts compRoot _) dflags = do
1089
1091
-- This works because there won't be any dependencies on the
1090
1092
-- executable unit.
1091
1093
" main" ->
1092
- let hash = B. unpack $ B16. encode $ H. finalize $ H. updates H. init (map B. pack $ theOpts )
1094
+ let hash = B. unpack $ B16. encode $ H. finalize $ H. updates H. init (map B. pack $ this_opts )
1093
1095
hashed_uid = Compat. toUnitId (Compat. stringToUnit (" main-" ++ hash))
1094
1096
in setHomeUnitId_ hashed_uid dflags'
1095
1097
_ -> dflags'
@@ -1202,11 +1204,3 @@ showPackageSetupException (PackageCheckFailed BasePackageAbiMismatch{..}) = unwo
1202
1204
renderPackageSetupException :: FilePath -> PackageSetupException -> (NormalizedFilePath , ShowDiagnostic , Diagnostic )
1203
1205
renderPackageSetupException fp e =
1204
1206
ideErrorWithSource (Just " cradle" ) (Just DiagnosticSeverity_Error ) (toNormalizedFilePath' fp) (T. pack $ showPackageSetupException e)
1205
-
1206
-
1207
- appendListToNonEmpty :: NE. NonEmpty a -> [a ] -> NE. NonEmpty a
1208
- #if MIN_VERSION_base(4,16,0)
1209
- appendListToNonEmpty = NE. appendList
1210
- #else
1211
- appendListToNonEmpty (x NE. :| xs) ys = x NE. :| (xs ++ ys)
1212
- #endif
0 commit comments