Skip to content

Commit

Permalink
werror
Browse files Browse the repository at this point in the history
  • Loading branch information
wz1000 committed Nov 22, 2023
1 parent 7242673 commit dc7af27
Showing 1 changed file with 21 additions and 28 deletions.
49 changes: 21 additions & 28 deletions ghcide/session-loader/Development/IDE/Session.hs
Original file line number Diff line number Diff line change
Expand Up @@ -66,7 +66,7 @@ import Development.IDE.Graph (Action)
import Development.IDE.Session.VersionCheck
import Development.IDE.Types.Diagnostics
import Development.IDE.Types.Exports
import Development.IDE.Types.HscEnvEq (HscEnvEq, newHscEnvEq, envImportPaths,
import Development.IDE.Types.HscEnvEq (HscEnvEq, newHscEnvEq,
newHscEnvEqPreserveImportPaths)
import Development.IDE.Types.Location
import Development.IDE.Types.Options
Expand Down Expand Up @@ -125,7 +125,6 @@ import GHC.Driver.Make (checkHomeUnitsClosed)
import GHC.Unit.State
import GHC.Types.Error (errMsgDiagnostic)
import GHC.Data.Bag
import GHC.Unit.Env
#endif

import GHC.ResponseFile
Expand Down Expand Up @@ -518,17 +517,17 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
-- compilation but these are the true source of
-- information.
new_deps = fmap (\(df, targets) -> RawComponentInfo (homeUnitId_ df) df targets cfp opts dep_info) newTargetDfs
all_deps = new_deps `appendListToNonEmpty` maybe [] id oldDeps
all_deps = new_deps `NE.appendList` maybe [] id oldDeps

Check warning on line 520 in ghcide/session-loader/Development/IDE/Session.hs

View workflow job for this annotation

GitHub Actions / Hlint check run

Warning in loadSessionWithOptions in module Development.IDE.Session: Use fromMaybe ▫︎ Found: "maybe [] id" ▫︎ Perhaps: "fromMaybe []"
-- Get all the unit-ids for things in this component
inplace = map rawComponentUnitId $ NE.toList all_deps
_inplace = map rawComponentUnitId $ NE.toList all_deps

all_deps' <- forM all_deps $ \RawComponentInfo{..} -> do
-- Remove all inplace dependencies from package flags for
-- components in this HscEnv
#if MIN_VERSION_ghc(9,3,0)
let (df2, uids) = (rawComponentDynFlags, [])
#else
let (df2, uids) = _removeInplacePackages fakeUid inplace rawComponentDynFlags
let (df2, uids) = _removeInplacePackages fakeUid _inplace rawComponentDynFlags
#endif
let prefix = show rawComponentUnitId
-- See Note [Avoiding bad interface files]
Expand All @@ -539,13 +538,15 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
-- The final component information, mostly the same but the DynFlags don't
-- contain any packages which are also loaded
-- into the same component.
pure $ ComponentInfo rawComponentUnitId
processed_df
uids
rawComponentTargets
rawComponentFP
rawComponentCOptions
rawComponentDependencyInfo
pure $ ComponentInfo
{ componentUnitId = rawComponentUnitId
, componentDynFlags = processed_df
, componentInternalUnits = uids
, componentTargets = rawComponentTargets
, componentFP = rawComponentFP
, componentCOptions = rawComponentCOptions
, componentDependencyInfo = rawComponentDependencyInfo
}
-- Modify the map so the hieYaml now maps to the newly updated
-- ComponentInfos
-- Returns
Expand Down Expand Up @@ -968,13 +969,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 @@ -1050,9 +1051,9 @@ addUnit unit_str = liftEwM $ do
putCmdLineState (unit_str : units)

-- | Throws if package flags are unsatisfiable
setOptions :: GhcMonad m => NormalizedFilePath -> ComponentOptions -> DynFlags -> m (NE.NonEmpty (DynFlags, [GHC.Target]))
setOptions :: GhcMonad m => NormalizedFilePath -> ComponentOptions -> DynFlags -> m (NonEmpty (DynFlags, [GHC.Target]))
setOptions cfp (ComponentOptions theOpts compRoot _) dflags = do
((theOpts',errs,warns),units) <- processCmdLineP unit_flags [] (map noLoc theOpts)
((theOpts',_errs,_warns),units) <- processCmdLineP unit_flags [] (map noLoc theOpts)
case NE.nonEmpty units of
Just us -> initMulti us
Nothing -> do
Expand All @@ -1071,14 +1072,14 @@ setOptions cfp (ComponentOptions theOpts compRoot _) dflags = do
-- does list all targets.
abs_fp <- liftIO $ makeAbsolute (fromNormalizedFilePath cfp)
let special_target = Compat.mkSimpleTarget df abs_fp
pure $ (df, special_target : targets) NE.:| []
pure $ (df, special_target : targets) :| []
where
initMulti unitArgFiles =
forM unitArgFiles $ \f -> do
args <- liftIO $ expandResponse [f]
initOne args
initOne theOpts = do
(dflags', targets') <- addCmdOpts theOpts dflags
initOne this_opts = do
(dflags', targets') <- addCmdOpts this_opts dflags
let dflags'' =
#if MIN_VERSION_ghc(9,3,0)
case unitIdString (homeUnitId_ dflags') of
Expand All @@ -1089,7 +1090,7 @@ setOptions cfp (ComponentOptions theOpts compRoot _) dflags = do
-- This works because there won't be any dependencies on the
-- executable unit.
"main" ->
let hash = B.unpack $ B16.encode $ H.finalize $ H.updates H.init (map B.pack $ theOpts)
let hash = B.unpack $ B16.encode $ H.finalize $ H.updates H.init (map B.pack $ this_opts)
hashed_uid = Compat.toUnitId (Compat.stringToUnit ("main-"++hash))
in setHomeUnitId_ hashed_uid dflags'
_ -> dflags'
Expand Down Expand Up @@ -1202,11 +1203,3 @@ showPackageSetupException (PackageCheckFailed BasePackageAbiMismatch{..}) = unwo
renderPackageSetupException :: FilePath -> PackageSetupException -> (NormalizedFilePath, ShowDiagnostic, Diagnostic)
renderPackageSetupException fp e =
ideErrorWithSource (Just "cradle") (Just DiagnosticSeverity_Error) (toNormalizedFilePath' fp) (T.pack $ showPackageSetupException e)


appendListToNonEmpty :: NE.NonEmpty a -> [a] -> NE.NonEmpty a
#if MIN_VERSION_base(4,16,0)
appendListToNonEmpty = NE.appendList
#else
appendListToNonEmpty (x NE.:| xs) ys = x NE.:| (xs ++ ys)
#endif

0 comments on commit dc7af27

Please sign in to comment.