@@ -66,7 +66,7 @@ import Development.IDE.Graph (Action)
66
66
import Development.IDE.Session.VersionCheck
67
67
import Development.IDE.Types.Diagnostics
68
68
import Development.IDE.Types.Exports
69
- import Development.IDE.Types.HscEnvEq (HscEnvEq , newHscEnvEq , envImportPaths ,
69
+ import Development.IDE.Types.HscEnvEq (HscEnvEq , newHscEnvEq ,
70
70
newHscEnvEqPreserveImportPaths )
71
71
import Development.IDE.Types.Location
72
72
import Development.IDE.Types.Options
@@ -125,7 +125,6 @@ import GHC.Driver.Make (checkHomeUnitsClosed)
125
125
import GHC.Unit.State
126
126
import GHC.Types.Error (errMsgDiagnostic )
127
127
import GHC.Data.Bag
128
- import GHC.Unit.Env
129
128
#endif
130
129
131
130
import GHC.ResponseFile
@@ -518,17 +517,17 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
518
517
-- compilation but these are the true source of
519
518
-- information.
520
519
new_deps = fmap (\ (df, targets) -> RawComponentInfo (homeUnitId_ df) df targets cfp opts dep_info) newTargetDfs
521
- all_deps = new_deps `appendListToNonEmpty ` maybe [] id oldDeps
520
+ all_deps = new_deps `NE.appendList ` maybe [] id oldDeps
522
521
-- Get all the unit-ids for things in this component
523
- inplace = map rawComponentUnitId $ NE. toList all_deps
522
+ _inplace = map rawComponentUnitId $ NE. toList all_deps
524
523
525
524
all_deps' <- forM all_deps $ \ RawComponentInfo {.. } -> do
526
525
-- Remove all inplace dependencies from package flags for
527
526
-- components in this HscEnv
528
527
#if MIN_VERSION_ghc(9,3,0)
529
528
let (df2, uids) = (rawComponentDynFlags, [] )
530
529
#else
531
- let (df2, uids) = _removeInplacePackages fakeUid inplace rawComponentDynFlags
530
+ let (df2, uids) = _removeInplacePackages fakeUid _inplace rawComponentDynFlags
532
531
#endif
533
532
let prefix = show rawComponentUnitId
534
533
-- See Note [Avoiding bad interface files]
@@ -539,13 +538,15 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
539
538
-- The final component information, mostly the same but the DynFlags don't
540
539
-- contain any packages which are also loaded
541
540
-- into the same component.
542
- pure $ ComponentInfo rawComponentUnitId
543
- processed_df
544
- uids
545
- rawComponentTargets
546
- rawComponentFP
547
- rawComponentCOptions
548
- rawComponentDependencyInfo
541
+ pure $ ComponentInfo
542
+ { componentUnitId = rawComponentUnitId
543
+ , componentDynFlags = processed_df
544
+ , componentInternalUnits = uids
545
+ , componentTargets = rawComponentTargets
546
+ , componentFP = rawComponentFP
547
+ , componentCOptions = rawComponentCOptions
548
+ , componentDependencyInfo = rawComponentDependencyInfo
549
+ }
549
550
-- Modify the map so the hieYaml now maps to the newly updated
550
551
-- ComponentInfos
551
552
-- Returns
@@ -968,13 +969,13 @@ data ComponentInfo = ComponentInfo
968
969
-- | Internal units, such as local libraries, that this component
969
970
-- is loaded with. These have been extracted from the original
970
971
-- ComponentOptions.
971
- , _componentInternalUnits :: [UnitId ]
972
+ , componentInternalUnits :: [UnitId ]
972
973
-- | All targets of this components.
973
974
, componentTargets :: [GHC. Target ]
974
975
-- | Filepath which caused the creation of this component
975
976
, componentFP :: NormalizedFilePath
976
977
-- | Component Options used to load the component.
977
- , _componentCOptions :: ComponentOptions
978
+ , componentCOptions :: ComponentOptions
978
979
-- | Maps cradle dependencies, such as `stack.yaml`, or `.cabal` file
979
980
-- to last modification time. See Note [Multi Cradle Dependency Info]
980
981
, componentDependencyInfo :: DependencyInfo
@@ -1050,9 +1051,9 @@ addUnit unit_str = liftEwM $ do
1050
1051
putCmdLineState (unit_str : units)
1051
1052
1052
1053
-- | Throws if package flags are unsatisfiable
1053
- setOptions :: GhcMonad m => NormalizedFilePath -> ComponentOptions -> DynFlags -> m (NE. NonEmpty (DynFlags , [GHC. Target ]))
1054
+ setOptions :: GhcMonad m => NormalizedFilePath -> ComponentOptions -> DynFlags -> m (NonEmpty (DynFlags , [GHC. Target ]))
1054
1055
setOptions cfp (ComponentOptions theOpts compRoot _) dflags = do
1055
- ((theOpts',errs,warns ),units) <- processCmdLineP unit_flags [] (map noLoc theOpts)
1056
+ ((theOpts',_errs,_warns ),units) <- processCmdLineP unit_flags [] (map noLoc theOpts)
1056
1057
case NE. nonEmpty units of
1057
1058
Just us -> initMulti us
1058
1059
Nothing -> do
@@ -1071,14 +1072,14 @@ setOptions cfp (ComponentOptions theOpts compRoot _) dflags = do
1071
1072
-- does list all targets.
1072
1073
abs_fp <- liftIO $ makeAbsolute (fromNormalizedFilePath cfp)
1073
1074
let special_target = Compat. mkSimpleTarget df abs_fp
1074
- pure $ (df, special_target : targets) NE. :| []
1075
+ pure $ (df, special_target : targets) :| []
1075
1076
where
1076
1077
initMulti unitArgFiles =
1077
1078
forM unitArgFiles $ \ f -> do
1078
1079
args <- liftIO $ expandResponse [f]
1079
1080
initOne args
1080
- initOne theOpts = do
1081
- (dflags', targets') <- addCmdOpts theOpts dflags
1081
+ initOne this_opts = do
1082
+ (dflags', targets') <- addCmdOpts this_opts dflags
1082
1083
let dflags'' =
1083
1084
#if MIN_VERSION_ghc(9,3,0)
1084
1085
case unitIdString (homeUnitId_ dflags') of
@@ -1089,7 +1090,7 @@ setOptions cfp (ComponentOptions theOpts compRoot _) dflags = do
1089
1090
-- This works because there won't be any dependencies on the
1090
1091
-- executable unit.
1091
1092
" main" ->
1092
- let hash = B. unpack $ B16. encode $ H. finalize $ H. updates H. init (map B. pack $ theOpts )
1093
+ let hash = B. unpack $ B16. encode $ H. finalize $ H. updates H. init (map B. pack $ this_opts )
1093
1094
hashed_uid = Compat. toUnitId (Compat. stringToUnit (" main-" ++ hash))
1094
1095
in setHomeUnitId_ hashed_uid dflags'
1095
1096
_ -> dflags'
@@ -1202,11 +1203,3 @@ showPackageSetupException (PackageCheckFailed BasePackageAbiMismatch{..}) = unwo
1202
1203
renderPackageSetupException :: FilePath -> PackageSetupException -> (NormalizedFilePath , ShowDiagnostic , Diagnostic )
1203
1204
renderPackageSetupException fp e =
1204
1205
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